never executed always true always false
    1 {-# LANGUAGE DataKinds #-}
    2 {-# LANGUAGE DeriveGeneric #-}
    3 {-# LANGUAGE DerivingStrategies #-}
    4 {-# LANGUAGE FlexibleContexts #-}
    5 {-# LANGUAGE FlexibleInstances #-}
    6 {-# LANGUAGE ScopedTypeVariables #-}
    7 {-# LANGUAGE TypeApplications #-}
    8 {-# LANGUAGE TypeFamilies #-}
    9 {-# LANGUAGE TypeOperators #-}
   10 
   11 {-# OPTIONS_HADDOCK prune #-}
   12 
   13 module Cardano.Address.Derivation
   14     (
   15     -- * Overview
   16     -- $overview
   17 
   18     -- * Key Derivation
   19     -- ** Types
   20       Index
   21     , indexToWord32
   22     , indexFromWord32
   23     , wholeDomainIndex
   24     , coerceWholeDomainIndex
   25     , nextIndex
   26     , Depth (..)
   27     , DerivationType (..)
   28 
   29     -- * Abstractions
   30     , GenMasterKey (..)
   31     , HardDerivation (..)
   32     , SoftDerivation (..)
   33 
   34     -- * Low-Level Cryptography Primitives
   35     -- ** XPrv
   36     , XPrv
   37     , xprvFromBytes
   38     , xprvToBytes
   39     , xprvPrivateKey
   40     , xprvChainCode
   41     , toXPub
   42 
   43     -- ** XPub
   44     , XPub
   45     , xpubFromBytes
   46     , xpubToBytes
   47     , xpubPublicKey
   48     , xpubChainCode
   49 
   50     -- ** Pub
   51     , Pub
   52     , pubFromBytes
   53     , pubToBytes
   54     , xpubToPub
   55 
   56     -- ** XSignature
   57     , XSignature
   58     , sign
   59     , verify
   60 
   61     -- Internal / Not exposed by Haddock
   62     , DerivationScheme (..)
   63     , deriveXPrv
   64     , deriveXPub
   65     , generate
   66     , generateNew
   67     , hashCredential
   68     , hashWalletId
   69     , credentialHashSize
   70     , unsafeMkIndex
   71     ------------------
   72     ) where
   73 
   74 import Prelude
   75 
   76 import Cardano.Crypto.Wallet
   77     ( DerivationScheme (..) )
   78 import Cardano.Mnemonic
   79     ( SomeMnemonic )
   80 import Control.DeepSeq
   81     ( NFData )
   82 import Crypto.Error
   83     ( eitherCryptoError )
   84 import Crypto.Hash
   85     ( hash )
   86 import Crypto.Hash.Algorithms
   87     ( Blake2b_160 (..), Blake2b_224 (..) )
   88 import Crypto.Hash.IO
   89     ( HashAlgorithm (hashDigestSize) )
   90 import Data.ByteArray
   91     ( ByteArrayAccess, ScrubbedBytes )
   92 import Data.ByteString
   93     ( ByteString )
   94 import Data.Coerce
   95     ( coerce )
   96 import Data.Either.Extra
   97     ( eitherToMaybe )
   98 import Data.Kind
   99     ( Type )
  100 import Data.String
  101     ( fromString )
  102 import Data.Word
  103     ( Word32 )
  104 import Fmt
  105     ( Buildable (..) )
  106 import GHC.Generics
  107     ( Generic )
  108 import GHC.Stack
  109     ( HasCallStack )
  110 
  111 import qualified Cardano.Crypto.Wallet as CC
  112 import qualified Crypto.ECC.Edwards25519 as Ed25519
  113 import qualified Data.ByteArray as BA
  114 import qualified Data.ByteString as BS
  115 
  116 -- $overview
  117 --
  118 -- These abstractions allow generating root private key, also called /Master Key/
  119 -- and then basing on it enable address derivation
  120 
  121 --
  122 -- Low-Level Cryptography Primitives
  123 --
  124 
  125 -- | An opaque type representing an extended private key.
  126 --
  127 -- __Properties:__
  128 --
  129 -- ===== Roundtripping
  130 --
  131 -- @forall xprv. 'xprvFromBytes' ('xprvToBytes' xprv) == 'Just' xprv@
  132 --
  133 -- ===== Chain Code Invariance
  134 --
  135 -- @forall xprv. 'xprvChainCode' xprv == 'xpubChainCode' ('toXPub' xprv)@
  136 --
  137 -- ===== Public Key Signature
  138 --
  139 -- @forall xprv msg. 'verify' ('toXPub' xprv) msg ('sign' xprv msg) == 'True'@
  140 --
  141 -- @since 1.0.0
  142 type XPrv = CC.XPrv
  143 
  144 -- | An opaque type representing an extended public key.
  145 --
  146 -- __Properties:__
  147 --
  148 -- ===== Roundtripping
  149 --
  150 -- @forall xpub. 'xpubFromBytes' ('xpubToBytes' xpub) == 'Just' xpub@
  151 --
  152 -- @since 1.0.0
  153 type XPub = CC.XPub
  154 
  155 -- | An opaque type representing a signature made from an 'XPrv'.
  156 --
  157 -- @since 1.0.0
  158 type XSignature = CC.XSignature
  159 
  160 -- | Construct an 'XPub' from raw 'ByteString' (64 bytes).
  161 --
  162 -- @since 1.0.0
  163 xpubFromBytes :: ByteString -> Maybe XPub
  164 xpubFromBytes = eitherToMaybe . CC.xpub
  165 
  166 -- | Convert an 'XPub' to a raw 'ByteString' (64 bytes).
  167 --
  168 -- @since 1.0.0
  169 xpubToBytes :: XPub -> ByteString
  170 xpubToBytes xpub = xpubPublicKey xpub <> xpubChainCode xpub
  171 
  172 -- | Extract the public key from an 'XPub' as a raw 'ByteString' (32 bytes).
  173 --
  174 -- @since 2.0.0
  175 xpubPublicKey :: XPub -> ByteString
  176 xpubPublicKey (CC.XPub pub _cc) = pub
  177 
  178 -- | Extract the chain code from an 'XPub' as a raw 'ByteString' (32 bytes).
  179 --
  180 -- @since 2.0.0
  181 xpubChainCode :: XPub -> ByteString
  182 xpubChainCode (CC.XPub _pub (CC.ChainCode cc)) = cc
  183 
  184 -- | An opaque type representing a non-extended public key.
  185 --
  186 -- __Properties:__
  187 --
  188 -- ===== Roundtripping
  189 --
  190 -- @forall pub. 'pubFromBytes' ('pubToBytes' pub) == 'Just' pub@
  191 --
  192 -- @since 3.12.0
  193 newtype Pub = Pub ByteString
  194     deriving (Show, Eq)
  195 
  196 -- | Construct a 'Pub' from raw 'ByteString' (32 bytes).
  197 --
  198 -- @since 3.12.0
  199 pubFromBytes :: ByteString -> Maybe Pub
  200 pubFromBytes bytes
  201     | BS.length bytes /= 32 = Nothing
  202     | otherwise = Just $ Pub bytes
  203 
  204 -- | Convert an 'Pub' to a raw 'ByteString' (32 bytes).
  205 --
  206 -- @since 3.12.0
  207 pubToBytes :: Pub -> ByteString
  208 pubToBytes (Pub pub) = pub
  209 
  210 -- | Extract the public key from an 'XPub' as a 'Pub' (32 bytes).
  211 --
  212 -- @since 3.12.0
  213 xpubToPub :: XPub -> Pub
  214 xpubToPub (CC.XPub pub _cc) = Pub pub
  215 
  216 -- | Construct an 'XPrv' from raw 'ByteString' (96 bytes).
  217 --
  218 -- @since 1.0.0
  219 xprvFromBytes :: ByteString -> Maybe XPrv
  220 xprvFromBytes bytes
  221     | BS.length bytes /= 96 = Nothing
  222     | otherwise = do
  223         let (prv, cc) = BS.splitAt 64 bytes
  224         pub <- ed25519ScalarMult (BS.take 32 prv)
  225         eitherToMaybe $ CC.xprv $ prv <> pub <> cc
  226   where
  227     ed25519ScalarMult :: ByteString -> Maybe ByteString
  228     ed25519ScalarMult bs = do
  229         scalar <- eitherToMaybe $ eitherCryptoError $ Ed25519.scalarDecodeLong bs
  230         pure $ Ed25519.pointEncode $ Ed25519.toPoint scalar
  231 
  232 -- From  < xprv | pub | cc >
  233 -- ↳ To  < xprv |     | cc >
  234 --
  235 -- | Convert an 'XPrv' to a raw 'ByteString' (96 bytes).
  236 --
  237 -- @since 1.0.0
  238 xprvToBytes :: XPrv -> ByteString
  239 xprvToBytes xprv =
  240     xprvPrivateKey xprv <> xprvChainCode xprv
  241 
  242 -- | Extract the private key from an 'XPrv' as a raw 'ByteString' (64 bytes).
  243 --
  244 -- @since 2.0.0
  245 xprvPrivateKey :: XPrv -> ByteString
  246 xprvPrivateKey = BS.take 64 . CC.unXPrv
  247 
  248 -- | Extract the chain code from an 'XPrv' as a raw 'ByteString' (32 bytes).
  249 --
  250 -- @since 2.0.0
  251 xprvChainCode :: XPrv -> ByteString
  252 xprvChainCode = BS.drop 96 . CC.unXPrv
  253 
  254 -- | Derive the 'XPub' associated with an 'XPrv'.
  255 --
  256 -- @since 1.0.0
  257 toXPub :: HasCallStack => XPrv -> XPub
  258 toXPub = CC.toXPub
  259 
  260 -- | Produce a signature of the given 'msg' from an 'XPrv'.
  261 --
  262 -- @since 1.0.0
  263 sign
  264     :: ByteArrayAccess msg
  265     => XPrv
  266     -> msg
  267     -> XSignature
  268 sign =
  269     CC.sign (mempty :: ScrubbedBytes)
  270 
  271 -- | Verify the 'XSignature' of a 'msg' with the 'XPub' associated with the
  272 -- 'XPrv' used for signing.
  273 --
  274 -- @since 1.0.0
  275 verify
  276     :: ByteArrayAccess msg
  277     => XPub
  278     -> msg
  279     -> XSignature
  280     -> Bool
  281 verify =
  282     CC.verify -- re-exported for the sake of documentation.
  283 
  284 -- Derive a child extended private key from an extended private key
  285 --
  286 -- __internal__
  287 deriveXPrv
  288     :: DerivationScheme
  289     -> XPrv
  290     -> Index derivationType depth
  291     -> XPrv
  292 deriveXPrv ds prv (Index ix) =
  293     CC.deriveXPrv ds (mempty :: ScrubbedBytes) prv ix
  294 
  295 -- Derive a child extended public key from an extended public key
  296 --
  297 -- __internal__
  298 deriveXPub
  299     :: DerivationScheme
  300     -> XPub
  301     -> Index derivationType depth
  302     -> Maybe XPub
  303 deriveXPub ds pub (Index ix) =
  304     CC.deriveXPub ds pub ix
  305 
  306 -- Generate an XPrv using the legacy method (Byron).
  307 --
  308 -- The seed needs to be at least 32 bytes, otherwise an asynchronous error is thrown.
  309 --
  310 -- __internal__
  311 generate
  312     :: ByteArrayAccess seed
  313     => seed
  314     -> XPrv
  315 generate seed =
  316     CC.generate seed (mempty :: ScrubbedBytes)
  317 
  318 -- Generate an XPrv using the new method (Icarus).
  319 --
  320 -- The seed needs to be at least 16 bytes.
  321 --
  322 -- __internal__
  323 generateNew
  324     :: (ByteArrayAccess seed, ByteArrayAccess sndFactor)
  325     => seed
  326     -> sndFactor
  327     -> XPrv
  328 generateNew seed sndFactor =
  329     CC.generateNew seed sndFactor (mempty :: ScrubbedBytes)
  330 
  331 -- Hash a credential (pub key or script).
  332 --
  333 -- __internal__
  334 hashCredential :: ByteString -> ByteString
  335 hashCredential =
  336     BA.convert . hash @_ @Blake2b_224
  337 
  338 -- Hash a extended root or account key to calculate walletid.
  339 --
  340 -- __internal__
  341 hashWalletId :: ByteString -> ByteString
  342 hashWalletId =
  343     BA.convert . hash @_ @Blake2b_160
  344 
  345 -- Size, in bytes, of a hash of credential (pub key or script).
  346 --
  347 -- __internal__
  348 credentialHashSize :: Int
  349 credentialHashSize = hashDigestSize Blake2b_224
  350 
  351 --
  352 -- Key Derivation
  353 --
  354 
  355 -- | Key Depth in the derivation path, according to BIP-0039 / BIP-0044
  356 --
  357 -- @
  358 -- root | purpose' | cointype' | account' | role | address@
  359 -- 0th      1st         2nd        3rd       4th     5th
  360 -- @
  361 --
  362 -- We do not manipulate purpose, cointype and change paths directly, so there
  363 -- are no constructors for these.
  364 --
  365 -- @since 1.0.0
  366 data Depth = RootK | AccountK | PaymentK | DelegationK | ScriptK | PolicyK
  367 
  368 -- | A derivation index, with phantom-types to disambiguate derivation type.
  369 --
  370 -- @
  371 -- let accountIx = Index 'Hardened 'AccountK
  372 -- let addressIx = Index 'Soft 'PaymentK
  373 -- @
  374 --
  375 -- @since 1.0.0
  376 newtype Index (derivationType :: DerivationType) (depth :: Depth) = Index
  377     { indexToWord32 :: Word32
  378     -- ^ Get the index as a 'Word32'
  379     -- @since 3.3.0
  380     }
  381     deriving stock (Generic, Show, Eq, Ord)
  382 
  383 instance NFData (Index derivationType depth)
  384 
  385 instance Bounded (Index 'Hardened depth) where
  386     minBound = Index 0x80000000
  387     maxBound = Index maxBound
  388 
  389 instance Bounded (Index 'Soft depth) where
  390     minBound = Index minBound
  391     maxBound = let (Index ix) = minBound @(Index 'Hardened _) in Index (ix - 1)
  392 
  393 instance Bounded (Index 'WholeDomain depth) where
  394     minBound = Index minBound
  395     maxBound = Index maxBound
  396 
  397 -- Construct an 'Index' from any Word32 value, without any validation, for
  398 -- internal use only.
  399 --
  400 -- Always use 'indexFromWord32' or 'wholeDomainIndex' instead of this function.
  401 unsafeMkIndex :: Word32 -> Index ty depth
  402 unsafeMkIndex = Index
  403 
  404 -- | Construct derivation path indices from raw 'Word32' values.
  405 indexFromWord32
  406     :: forall ix derivationType depth.
  407        (ix ~ Index derivationType depth, Bounded ix)
  408     => Word32 -> Maybe ix
  409 indexFromWord32 ix
  410     | ix >= indexToWord32 (minBound @ix) && ix <= indexToWord32 (maxBound @ix) =
  411         Just (Index ix)
  412     | otherwise =
  413         Nothing
  414 
  415 -- | Increment an index, if possible.
  416 --
  417 -- @since 3.3.0
  418 nextIndex
  419     :: forall ix derivationType depth.
  420        (ix ~ Index derivationType depth, Bounded ix)
  421     => ix -> Maybe ix
  422 nextIndex (Index ix) = indexFromWord32 (ix + 1)
  423 
  424 -- | Constructs a full domain 'Index'. This can't fail, unlike 'fromWord32'.
  425 --
  426 -- @since 3.3.0
  427 wholeDomainIndex :: Word32 -> Index 'WholeDomain depth
  428 wholeDomainIndex = Index
  429 
  430 -- | Upcasts an 'Index' to one with the full 'Word32' domain.
  431 --
  432 -- @since 3.3.0
  433 coerceWholeDomainIndex :: Index ty depth0 -> Index 'WholeDomain depth1
  434 coerceWholeDomainIndex = coerce
  435 
  436 instance Buildable (Index derivationType depth) where
  437     build (Index ix) = fromString (show ix)
  438 
  439 
  440 -- | Type of derivation that should be used with the given indexes.
  441 --
  442 -- In theory, we should only consider two derivation types: soft and hard.
  443 --
  444 -- However, historically, addresses in Cardano used to be generated across both
  445 -- the soft and the hard domain. We therefore introduce a 'WholeDomain' derivation
  446 -- type that is the exact union of `Hardened` and `Soft`.
  447 --
  448 -- @since 1.0.0
  449 data DerivationType = Hardened | Soft | WholeDomain
  450 
  451 -- | An interface for doing hard derivations from the root private key, /Master Key/
  452 --
  453 -- @since 1.0.0
  454 class HardDerivation (key :: Depth -> Type -> Type) where
  455     type AccountIndexDerivationType key :: DerivationType
  456     type AddressIndexDerivationType key :: DerivationType
  457     type WithRole key :: Type
  458 
  459     -- | Derives account private key from the given root private key, using
  460     -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
  461     -- package for more details).
  462     --
  463     -- @since 1.0.0
  464     deriveAccountPrivateKey
  465         :: key 'RootK XPrv
  466         -> Index (AccountIndexDerivationType key) 'AccountK
  467         -> key 'AccountK XPrv
  468 
  469     -- | Derives address private key from the given account private key, using
  470     -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
  471     -- package for more details).
  472     --
  473     -- @since 1.0.0
  474     deriveAddressPrivateKey
  475         :: key 'AccountK XPrv
  476         -> WithRole key
  477         -> Index (AddressIndexDerivationType key) 'PaymentK
  478         -> key 'PaymentK XPrv
  479 
  480 -- | An interface for doing soft derivations from an account public key
  481 class HardDerivation key => SoftDerivation (key :: Depth -> Type -> Type) where
  482     -- | Derives address public key from the given account public key, using
  483     -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
  484     -- package for more details).
  485     --
  486     -- This is the preferred way of deriving new sequential address public keys.
  487     --
  488     -- @since 1.0.0
  489     deriveAddressPublicKey
  490         :: key 'AccountK XPub
  491         -> WithRole key
  492         -> Index 'Soft 'PaymentK
  493         -> key 'PaymentK XPub
  494 
  495 
  496 -- | Abstract interface for constructing a /Master Key/.
  497 --
  498 -- @since 1.0.0
  499 class GenMasterKey (key :: Depth -> Type -> Type) where
  500     type SecondFactor key :: Type
  501 
  502     -- | Generate a root key from a corresponding mnemonic.
  503     --
  504     -- @since 1.0.0
  505     genMasterKeyFromMnemonic
  506         :: SomeMnemonic -> SecondFactor key -> key 'RootK XPrv
  507 
  508     -- | Generate a root key from a corresponding root 'XPrv'
  509     --
  510     -- @since 1.0.0
  511     genMasterKeyFromXPrv
  512         :: XPrv -> key 'RootK XPrv