{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_HADDOCK prune #-}

module Cardano.Address.Derivation
    (
    -- * Overview
    -- $overview

    -- * Key Derivation
    -- ** Types
      Index
    , indexToWord32
    , indexFromWord32
    , wholeDomainIndex
    , coerceWholeDomainIndex
    , nextIndex
    , Depth (..)
    , DerivationType (..)

    -- * Abstractions
    , GenMasterKey (..)
    , HardDerivation (..)
    , SoftDerivation (..)

    -- * Low-Level Cryptography Primitives
    -- ** XPrv
    , XPrv
    , xprvFromBytes
    , xprvToBytes
    , xprvPrivateKey
    , xprvChainCode
    , toXPub

    -- ** XPub
    , XPub
    , xpubFromBytes
    , xpubToBytes
    , xpubPublicKey
    , xpubChainCode

    -- ** XSignature
    , XSignature
    , sign
    , verify

    -- Internal / Not exposed by Haddock
    , DerivationScheme (..)
    , deriveXPrv
    , deriveXPub
    , generate
    , generateNew
    , hashCredential
    , hashWalletId
    , credentialHashSize
    , unsafeMkIndex
    ------------------
    ) where

import Prelude

import Cardano.Crypto.Wallet
    ( DerivationScheme (..) )
import Cardano.Mnemonic
    ( SomeMnemonic )
import Control.DeepSeq
    ( NFData )
import Crypto.Error
    ( eitherCryptoError )
import Crypto.Hash
    ( hash )
import Crypto.Hash.Algorithms
    ( Blake2b_160 (..), Blake2b_224 (..) )
import Crypto.Hash.IO
    ( HashAlgorithm (hashDigestSize) )
import Data.ByteArray
    ( ByteArrayAccess, ScrubbedBytes )
import Data.ByteString
    ( ByteString )
import Data.Coerce
    ( coerce )
import Data.Either.Extra
    ( eitherToMaybe )
import Data.Kind
    ( Type )
import Data.String
    ( fromString )
import Data.Word
    ( Word32 )
import Fmt
    ( Buildable (..) )
import GHC.Generics
    ( Generic )
import GHC.Stack
    ( HasCallStack )

import qualified Cardano.Crypto.Wallet as CC
import qualified Crypto.ECC.Edwards25519 as Ed25519
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS

-- $overview
--
-- These abstractions allow generating root private key, also called /Master Key/
-- and then basing on it enable address derivation

--
-- Low-Level Cryptography Primitives
--

-- | An opaque type representing an extended private key.
--
-- __Properties:__
--
-- ===== Roundtripping
--
-- @forall xprv. 'xprvFromBytes' ('xprvToBytes' xprv) == 'Just' xprv@
--
-- ===== Chain Code Invariance
--
-- @forall xprv. 'xprvChainCode' xprv == 'xpubChainCode' ('toXPub' xprv)@
--
-- ===== Public Key Signature
--
-- @forall xprv msg. 'verify' ('toXPub' xprv) msg ('sign' xprv msg) == 'True'@
--
-- @since 1.0.0
type XPrv = CC.XPrv

-- | An opaque type representing an extended public key.
--
-- __Properties:__
--
-- ===== Roundtripping
--
-- @forall xpub. 'xpubFromBytes' ('xpubToBytes' xpub) == 'Just' xpub@
--
-- @since 1.0.0
type XPub = CC.XPub

-- | An opaque type representing a signature made from an 'XPrv'.
--
-- @since 1.0.0
type XSignature = CC.XSignature

-- | Construct an 'XPub' from raw 'ByteString' (64 bytes).
--
-- @since 1.0.0
xpubFromBytes :: ByteString -> Maybe XPub
xpubFromBytes :: ByteString -> Maybe XPub
xpubFromBytes = Either String XPub -> Maybe XPub
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String XPub -> Maybe XPub)
-> (ByteString -> Either String XPub) -> ByteString -> Maybe XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String XPub
CC.xpub

-- | Convert an 'XPub' to a raw 'ByteString' (64 bytes).
--
-- @since 1.0.0
xpubToBytes :: XPub -> ByteString
xpubToBytes :: XPub -> ByteString
xpubToBytes XPub
xpub = XPub -> ByteString
xpubPublicKey XPub
xpub ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPub -> ByteString
xpubChainCode XPub
xpub

-- | Extract the public key from an 'XPub' as a raw 'ByteString' (32 bytes).
--
-- @since 2.0.0
xpubPublicKey :: XPub -> ByteString
xpubPublicKey :: XPub -> ByteString
xpubPublicKey (CC.XPub ByteString
pub ChainCode
_cc) = ByteString
pub

-- | Extract the chain code from an 'XPub' as a raw 'ByteString' (32 bytes).
--
-- @since 2.0.0
xpubChainCode :: XPub -> ByteString
xpubChainCode :: XPub -> ByteString
xpubChainCode (CC.XPub ByteString
_pub (CC.ChainCode ByteString
cc)) = ByteString
cc

-- | Construct an 'XPrv' from raw 'ByteString' (96 bytes).
--
-- @since 1.0.0
xprvFromBytes :: ByteString -> Maybe XPrv
xprvFromBytes :: ByteString -> Maybe XPrv
xprvFromBytes ByteString
bytes
    | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
96 = Maybe XPrv
forall a. Maybe a
Nothing
    | Bool
otherwise = do
        let (ByteString
prv, ByteString
cc) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
64 ByteString
bytes
        ByteString
pub <- ByteString -> Maybe ByteString
ed25519ScalarMult (Int -> ByteString -> ByteString
BS.take Int
32 ByteString
prv)
        Either String XPrv -> Maybe XPrv
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String XPrv -> Maybe XPrv)
-> Either String XPrv -> Maybe XPrv
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
CC.xprv (ByteString -> Either String XPrv)
-> ByteString -> Either String XPrv
forall a b. (a -> b) -> a -> b
$ ByteString
prv ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
pub ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cc
  where
    ed25519ScalarMult :: ByteString -> Maybe ByteString
    ed25519ScalarMult :: ByteString -> Maybe ByteString
ed25519ScalarMult ByteString
bs = do
        Scalar
scalar <- Either CryptoError Scalar -> Maybe Scalar
forall a b. Either a b -> Maybe b
eitherToMaybe (Either CryptoError Scalar -> Maybe Scalar)
-> Either CryptoError Scalar -> Maybe Scalar
forall a b. (a -> b) -> a -> b
$ CryptoFailable Scalar -> Either CryptoError Scalar
forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError (CryptoFailable Scalar -> Either CryptoError Scalar)
-> CryptoFailable Scalar -> Either CryptoError Scalar
forall a b. (a -> b) -> a -> b
$ ByteString -> CryptoFailable Scalar
forall bs. ByteArrayAccess bs => bs -> CryptoFailable Scalar
Ed25519.scalarDecodeLong ByteString
bs
        ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Point -> ByteString
forall bs. ByteArray bs => Point -> bs
Ed25519.pointEncode (Point -> ByteString) -> Point -> ByteString
forall a b. (a -> b) -> a -> b
$ Scalar -> Point
Ed25519.toPoint Scalar
scalar

-- From  < xprv | pub | cc >
-- ↳ To  < xprv |     | cc >
--
-- | Convert an 'XPrv' to a raw 'ByteString' (96 bytes).
--
-- @since 1.0.0
xprvToBytes :: XPrv -> ByteString
xprvToBytes :: XPrv -> ByteString
xprvToBytes XPrv
xprv =
    XPrv -> ByteString
xprvPrivateKey XPrv
xprv ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPrv -> ByteString
xprvChainCode XPrv
xprv

-- | Extract the private key from an 'XPrv' as a raw 'ByteString' (64 bytes).
--
-- @since 2.0.0
xprvPrivateKey :: XPrv -> ByteString
xprvPrivateKey :: XPrv -> ByteString
xprvPrivateKey = Int -> ByteString -> ByteString
BS.take Int
64 (ByteString -> ByteString)
-> (XPrv -> ByteString) -> XPrv -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> ByteString
CC.unXPrv

-- | Extract the chain code from an 'XPrv' as a raw 'ByteString' (32 bytes).
--
-- @since 2.0.0
xprvChainCode :: XPrv -> ByteString
xprvChainCode :: XPrv -> ByteString
xprvChainCode = Int -> ByteString -> ByteString
BS.drop Int
96 (ByteString -> ByteString)
-> (XPrv -> ByteString) -> XPrv -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> ByteString
CC.unXPrv

-- | Derive the 'XPub' associated with an 'XPrv'.
--
-- @since 1.0.0
toXPub :: HasCallStack => XPrv -> XPub
toXPub :: XPrv -> XPub
toXPub = HasCallStack => XPrv -> XPub
XPrv -> XPub
CC.toXPub

-- | Produce a signature of the given 'msg' from an 'XPrv'.
--
-- @since 1.0.0
sign
    :: ByteArrayAccess msg
    => XPrv
    -> msg
    -> XSignature
sign :: XPrv -> msg -> XSignature
sign =
    ScrubbedBytes -> XPrv -> msg -> XSignature
forall passPhrase msg.
(ByteArrayAccess passPhrase, ByteArrayAccess msg) =>
passPhrase -> XPrv -> msg -> XSignature
CC.sign (ScrubbedBytes
forall a. Monoid a => a
mempty :: ScrubbedBytes)

-- | Verify the 'XSignature' of a 'msg' with the 'XPub' associated with the
-- 'XPrv' used for signing.
--
-- @since 1.0.0
verify
    :: ByteArrayAccess msg
    => XPub
    -> msg
    -> XSignature
    -> Bool
verify :: XPub -> msg -> XSignature -> Bool
verify =
    XPub -> msg -> XSignature -> Bool
forall msg.
ByteArrayAccess msg =>
XPub -> msg -> XSignature -> Bool
CC.verify -- re-exported for the sake of documentation.

-- Derive a child extended private key from an extended private key
--
-- __internal__
deriveXPrv
    :: DerivationScheme
    -> XPrv
    -> Index derivationType depth
    -> XPrv
deriveXPrv :: DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
deriveXPrv DerivationScheme
ds XPrv
prv (Index Word32
ix) =
    DerivationScheme -> ScrubbedBytes -> XPrv -> Word32 -> XPrv
forall passPhrase.
ByteArrayAccess passPhrase =>
DerivationScheme -> passPhrase -> XPrv -> Word32 -> XPrv
CC.deriveXPrv DerivationScheme
ds (ScrubbedBytes
forall a. Monoid a => a
mempty :: ScrubbedBytes) XPrv
prv Word32
ix

-- Derive a child extended public key from an extended public key
--
-- __internal__
deriveXPub
    :: DerivationScheme
    -> XPub
    -> Index derivationType depth
    -> Maybe XPub
deriveXPub :: DerivationScheme
-> XPub -> Index derivationType depth -> Maybe XPub
deriveXPub DerivationScheme
ds XPub
pub (Index Word32
ix) =
    DerivationScheme -> XPub -> Word32 -> Maybe XPub
CC.deriveXPub DerivationScheme
ds XPub
pub Word32
ix

-- Generate an XPrv using the legacy method (Byron).
--
-- The seed needs to be at least 32 bytes, otherwise an asynchronous error is thrown.
--
-- __internal__
generate
    :: ByteArrayAccess seed
    => seed
    -> XPrv
generate :: seed -> XPrv
generate seed
seed =
    seed -> ScrubbedBytes -> XPrv
forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
CC.generate seed
seed (ScrubbedBytes
forall a. Monoid a => a
mempty :: ScrubbedBytes)

-- Generate an XPrv using the new method (Icarus).
--
-- The seed needs to be at least 16 bytes.
--
-- __internal__
generateNew
    :: (ByteArrayAccess seed, ByteArrayAccess sndFactor)
    => seed
    -> sndFactor
    -> XPrv
generateNew :: seed -> sndFactor -> XPrv
generateNew seed
seed sndFactor
sndFactor =
    seed -> sndFactor -> ScrubbedBytes -> XPrv
forall keyPassPhrase generationPassPhrase seed.
(ByteArrayAccess keyPassPhrase,
 ByteArrayAccess generationPassPhrase, ByteArrayAccess seed) =>
seed -> generationPassPhrase -> keyPassPhrase -> XPrv
CC.generateNew seed
seed sndFactor
sndFactor (ScrubbedBytes
forall a. Monoid a => a
mempty :: ScrubbedBytes)

-- Hash a credential (pub key or script).
--
-- __internal__
hashCredential :: ByteString -> ByteString
hashCredential :: ByteString -> ByteString
hashCredential =
    Digest Blake2b_224 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest Blake2b_224 -> ByteString)
-> (ByteString -> Digest Blake2b_224) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArrayAccess ByteString, HashAlgorithm Blake2b_224) =>
ByteString -> Digest Blake2b_224
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @_ @Blake2b_224

-- Hash a extended root or account key to calculate walletid.
--
-- __internal__
hashWalletId :: ByteString -> ByteString
hashWalletId :: ByteString -> ByteString
hashWalletId =
    Digest Blake2b_160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest Blake2b_160 -> ByteString)
-> (ByteString -> Digest Blake2b_160) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArrayAccess ByteString, HashAlgorithm Blake2b_160) =>
ByteString -> Digest Blake2b_160
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @_ @Blake2b_160

-- Size, in bytes, of a hash of credential (pub key or script).
--
-- __internal__
credentialHashSize :: Int
credentialHashSize :: Int
credentialHashSize = Blake2b_224 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize Blake2b_224
Blake2b_224

--
-- Key Derivation
--

-- | Key Depth in the derivation path, according to BIP-0039 / BIP-0044
--
-- @
-- root | purpose' | cointype' | account' | role | address@
-- 0th      1st         2nd        3rd       4th     5th
-- @
--
-- We do not manipulate purpose, cointype and change paths directly, so there
-- are no constructors for these.
--
-- @since 1.0.0
data Depth = RootK | AccountK | PaymentK | DelegationK | ScriptK | PolicyK

-- | A derivation index, with phantom-types to disambiguate derivation type.
--
-- @
-- let accountIx = Index 'Hardened 'AccountK
-- let addressIx = Index 'Soft 'PaymentK
-- @
--
-- @since 1.0.0
newtype Index (derivationType :: DerivationType) (depth :: Depth) = Index
    { Index derivationType depth -> Word32
indexToWord32 :: Word32
    -- ^ Get the index as a 'Word32'
    -- @since 3.3.0
    }
    deriving stock ((forall x.
 Index derivationType depth -> Rep (Index derivationType depth) x)
-> (forall x.
    Rep (Index derivationType depth) x -> Index derivationType depth)
-> Generic (Index derivationType depth)
forall x.
Rep (Index derivationType depth) x -> Index derivationType depth
forall x.
Index derivationType depth -> Rep (Index derivationType depth) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (derivationType :: DerivationType) (depth :: Depth) x.
Rep (Index derivationType depth) x -> Index derivationType depth
forall (derivationType :: DerivationType) (depth :: Depth) x.
Index derivationType depth -> Rep (Index derivationType depth) x
$cto :: forall (derivationType :: DerivationType) (depth :: Depth) x.
Rep (Index derivationType depth) x -> Index derivationType depth
$cfrom :: forall (derivationType :: DerivationType) (depth :: Depth) x.
Index derivationType depth -> Rep (Index derivationType depth) x
Generic, Int -> Index derivationType depth -> ShowS
[Index derivationType depth] -> ShowS
Index derivationType depth -> String
(Int -> Index derivationType depth -> ShowS)
-> (Index derivationType depth -> String)
-> ([Index derivationType depth] -> ShowS)
-> Show (Index derivationType depth)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (derivationType :: DerivationType) (depth :: Depth).
Int -> Index derivationType depth -> ShowS
forall (derivationType :: DerivationType) (depth :: Depth).
[Index derivationType depth] -> ShowS
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> String
showList :: [Index derivationType depth] -> ShowS
$cshowList :: forall (derivationType :: DerivationType) (depth :: Depth).
[Index derivationType depth] -> ShowS
show :: Index derivationType depth -> String
$cshow :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> String
showsPrec :: Int -> Index derivationType depth -> ShowS
$cshowsPrec :: forall (derivationType :: DerivationType) (depth :: Depth).
Int -> Index derivationType depth -> ShowS
Show, Index derivationType depth -> Index derivationType depth -> Bool
(Index derivationType depth -> Index derivationType depth -> Bool)
-> (Index derivationType depth
    -> Index derivationType depth -> Bool)
-> Eq (Index derivationType depth)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Index derivationType depth -> Bool
/= :: Index derivationType depth -> Index derivationType depth -> Bool
$c/= :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Index derivationType depth -> Bool
== :: Index derivationType depth -> Index derivationType depth -> Bool
$c== :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Index derivationType depth -> Bool
Eq, Eq (Index derivationType depth)
Eq (Index derivationType depth)
-> (Index derivationType depth
    -> Index derivationType depth -> Ordering)
-> (Index derivationType depth
    -> Index derivationType depth -> Bool)
-> (Index derivationType depth
    -> Index derivationType depth -> Bool)
-> (Index derivationType depth
    -> Index derivationType depth -> Bool)
-> (Index derivationType depth
    -> Index derivationType depth -> Bool)
-> (Index derivationType depth
    -> Index derivationType depth -> Index derivationType depth)
-> (Index derivationType depth
    -> Index derivationType depth -> Index derivationType depth)
-> Ord (Index derivationType depth)
Index derivationType depth -> Index derivationType depth -> Bool
Index derivationType depth
-> Index derivationType depth -> Ordering
Index derivationType depth
-> Index derivationType depth -> Index derivationType depth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (derivationType :: DerivationType) (depth :: Depth).
Eq (Index derivationType depth)
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Index derivationType depth -> Bool
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth
-> Index derivationType depth -> Ordering
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth
-> Index derivationType depth -> Index derivationType depth
min :: Index derivationType depth
-> Index derivationType depth -> Index derivationType depth
$cmin :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth
-> Index derivationType depth -> Index derivationType depth
max :: Index derivationType depth
-> Index derivationType depth -> Index derivationType depth
$cmax :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth
-> Index derivationType depth -> Index derivationType depth
>= :: Index derivationType depth -> Index derivationType depth -> Bool
$c>= :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Index derivationType depth -> Bool
> :: Index derivationType depth -> Index derivationType depth -> Bool
$c> :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Index derivationType depth -> Bool
<= :: Index derivationType depth -> Index derivationType depth -> Bool
$c<= :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Index derivationType depth -> Bool
< :: Index derivationType depth -> Index derivationType depth -> Bool
$c< :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Index derivationType depth -> Bool
compare :: Index derivationType depth
-> Index derivationType depth -> Ordering
$ccompare :: forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth
-> Index derivationType depth -> Ordering
$cp1Ord :: forall (derivationType :: DerivationType) (depth :: Depth).
Eq (Index derivationType depth)
Ord)

instance NFData (Index derivationType depth)

instance Bounded (Index 'Hardened depth) where
    minBound :: Index 'Hardened depth
minBound = Word32 -> Index 'Hardened depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index Word32
0x80000000
    maxBound :: Index 'Hardened depth
maxBound = Word32 -> Index 'Hardened depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index Word32
forall a. Bounded a => a
maxBound

instance Bounded (Index 'Soft depth) where
    minBound :: Index 'Soft depth
minBound = Word32 -> Index 'Soft depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index Word32
forall a. Bounded a => a
minBound
    maxBound :: Index 'Soft depth
maxBound = let (Index Word32
ix) = Bounded (Index 'Hardened Any) => Index 'Hardened Any
forall a. Bounded a => a
minBound @(Index 'Hardened _) in Word32 -> Index 'Soft depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index (Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1)

instance Bounded (Index 'WholeDomain depth) where
    minBound :: Index 'WholeDomain depth
minBound = Word32 -> Index 'WholeDomain depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index Word32
forall a. Bounded a => a
minBound
    maxBound :: Index 'WholeDomain depth
maxBound = Word32 -> Index 'WholeDomain depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index Word32
forall a. Bounded a => a
maxBound

-- Construct an 'Index' from any Word32 value, without any validation, for
-- internal use only.
--
-- Always use 'indexFromWord32' or 'wholeDomainIndex' instead of this function.
unsafeMkIndex :: Word32 -> Index ty depth
unsafeMkIndex :: Word32 -> Index ty depth
unsafeMkIndex = Word32 -> Index ty depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index

-- | Construct derivation path indices from raw 'Word32' values.
indexFromWord32
    :: forall ix derivationType depth.
       (ix ~ Index derivationType depth, Bounded ix)
    => Word32 -> Maybe ix
indexFromWord32 :: Word32 -> Maybe ix
indexFromWord32 Word32
ix
    | Word32
ix Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Index derivationType depth -> Word32
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Word32
indexToWord32 (Bounded ix => ix
forall a. Bounded a => a
minBound @ix) Bool -> Bool -> Bool
&& Word32
ix Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Index derivationType depth -> Word32
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Word32
indexToWord32 (Bounded ix => ix
forall a. Bounded a => a
maxBound @ix) =
        Index derivationType depth -> Maybe (Index derivationType depth)
forall a. a -> Maybe a
Just (Word32 -> Index derivationType depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index Word32
ix)
    | Bool
otherwise =
        Maybe ix
forall a. Maybe a
Nothing

-- | Increment an index, if possible.
--
-- @since 3.3.0
nextIndex
    :: forall ix derivationType depth.
       (ix ~ Index derivationType depth, Bounded ix)
    => ix -> Maybe ix
nextIndex :: ix -> Maybe ix
nextIndex (Index ix) = Word32 -> Maybe ix
forall ix (derivationType :: DerivationType) (depth :: Depth).
(ix ~ Index derivationType depth, Bounded ix) =>
Word32 -> Maybe ix
indexFromWord32 (Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)

-- | Constructs a full domain 'Index'. This can't fail, unlike 'fromWord32'.
--
-- @since 3.3.0
wholeDomainIndex :: Word32 -> Index 'WholeDomain depth
wholeDomainIndex :: Word32 -> Index 'WholeDomain depth
wholeDomainIndex = Word32 -> Index 'WholeDomain depth
forall (derivationType :: DerivationType) (depth :: Depth).
Word32 -> Index derivationType depth
Index

-- | Upcasts an 'Index' to one with the full 'Word32' domain.
--
-- @since 3.3.0
coerceWholeDomainIndex :: Index ty depth0 -> Index 'WholeDomain depth1
coerceWholeDomainIndex :: Index ty depth0 -> Index 'WholeDomain depth1
coerceWholeDomainIndex = Index ty depth0 -> Index 'WholeDomain depth1
coerce

instance Buildable (Index derivationType depth) where
    build :: Index derivationType depth -> Builder
build (Index Word32
ix) = String -> Builder
forall a. IsString a => String -> a
fromString (Word32 -> String
forall a. Show a => a -> String
show Word32
ix)


-- | Type of derivation that should be used with the given indexes.
--
-- In theory, we should only consider two derivation types: soft and hard.
--
-- However, historically, addresses in Cardano used to be generated across both
-- the soft and the hard domain. We therefore introduce a 'WholeDomain' derivation
-- type that is the exact union of `Hardened` and `Soft`.
--
-- @since 1.0.0
data DerivationType = Hardened | Soft | WholeDomain

-- | An interface for doing hard derivations from the root private key, /Master Key/
--
-- @since 1.0.0
class HardDerivation (key :: Depth -> Type -> Type) where
    type AccountIndexDerivationType key :: DerivationType
    type AddressIndexDerivationType key :: DerivationType
    type WithRole key :: Type

    -- | Derives account private key from the given root private key, using
    -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
    -- package for more details).
    --
    -- @since 1.0.0
    deriveAccountPrivateKey
        :: key 'RootK XPrv
        -> Index (AccountIndexDerivationType key) 'AccountK
        -> key 'AccountK XPrv

    -- | Derives address private key from the given account private key, using
    -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
    -- package for more details).
    --
    -- @since 1.0.0
    deriveAddressPrivateKey
        :: key 'AccountK XPrv
        -> WithRole key
        -> Index (AddressIndexDerivationType key) 'PaymentK
        -> key 'PaymentK XPrv

-- | An interface for doing soft derivations from an account public key
class HardDerivation key => SoftDerivation (key :: Depth -> Type -> Type) where
    -- | Derives address public key from the given account public key, using
    -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
    -- package for more details).
    --
    -- This is the preferred way of deriving new sequential address public keys.
    --
    -- @since 1.0.0
    deriveAddressPublicKey
        :: key 'AccountK XPub
        -> WithRole key
        -> Index 'Soft 'PaymentK
        -> key 'PaymentK XPub


-- | Abstract interface for constructing a /Master Key/.
--
-- @since 1.0.0
class GenMasterKey (key :: Depth -> Type -> Type) where
    type SecondFactor key :: Type

    -- | Generate a root key from a corresponding mnemonic.
    --
    -- @since 1.0.0
    genMasterKeyFromMnemonic
        :: SomeMnemonic -> SecondFactor key -> key 'RootK XPrv

    -- | Generate a root key from a corresponding root 'XPrv'
    --
    -- @since 1.0.0
    genMasterKeyFromXPrv
        :: XPrv -> key 'RootK XPrv