never executed always true always false
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE DeriveFunctor #-}
3 {-# LANGUAGE DeriveGeneric #-}
4 {-# LANGUAGE DerivingVia #-}
5 {-# LANGUAGE ExistentialQuantification #-}
6 {-# LANGUAGE FlexibleContexts #-}
7 {-# LANGUAGE GADTs #-}
8 {-# LANGUAGE LambdaCase #-}
9 {-# LANGUAGE OverloadedStrings #-}
10 {-# LANGUAGE RecordWildCards #-}
11 {-# LANGUAGE StandaloneDeriving #-}
12 {-# LANGUAGE TupleSections #-}
13 {-# LANGUAGE TypeApplications #-}
14 {-# LANGUAGE TypeFamilies #-}
15
16 {-# OPTIONS_HADDOCK prune #-}
17
18 -- |
19 -- Copyright: © 2018-2020 IOHK
20 -- License: Apache-2.0
21
22 module Cardano.Address.Style.Icarus
23 ( -- $overview
24
25 -- * Icarus
26 Icarus
27 , getKey
28 , Role (..)
29 , roleFromIndex
30 , roleToIndex
31
32 -- * Key Derivation
33 -- $keyDerivation
34 , genMasterKeyFromXPrv
35 , genMasterKeyFromMnemonic
36 , deriveAccountPrivateKey
37 , deriveAddressPrivateKey
38 , deriveAddressPublicKey
39
40 -- * Addresses
41 -- $addresses
42 , AddressInfo (..)
43 , eitherInspectAddress
44 , inspectAddress
45 , inspectIcarusAddress
46 , paymentAddress
47 , ErrInspectAddress
48 , prettyErrInspectAddress
49
50 -- * Network Discrimination
51 , icarusMainnet
52 , icarusStaging
53 , icarusTestnet
54 , icarusPreview
55 , icarusPreprod
56
57 -- * Unsafe
58 , liftXPrv
59 , liftXPub
60
61 -- Internals
62 , unsafeGenerateKeyFromHardwareLedger
63 , minSeedLengthBytes
64 ) where
65
66 import Prelude
67
68 import Cardano.Address
69 ( Address
70 , AddressDiscrimination (..)
71 , NetworkDiscriminant (..)
72 , NetworkTag (..)
73 , unAddress
74 , unsafeMkAddress
75 )
76 import Cardano.Address.Derivation
77 ( Depth (..)
78 , DerivationScheme (..)
79 , DerivationType (..)
80 , Index (..)
81 , XPrv
82 , XPub
83 , deriveXPrv
84 , deriveXPub
85 , generateNew
86 , indexFromWord32
87 , unsafeMkIndex
88 , xprvFromBytes
89 )
90 import Cardano.Address.Internal
91 ( DeserialiseFailure, WithErrorMessage (..) )
92 import Cardano.Address.Style.Byron
93 ( byronMainnet, byronPreprod, byronPreview, byronStaging, byronTestnet )
94 import Cardano.Mnemonic
95 ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy, mnemonicToText )
96 import Codec.Binary.Encoding
97 ( AbstractEncoding (..), encode )
98 import Control.DeepSeq
99 ( NFData )
100 import Control.Exception
101 ( Exception, displayException )
102 import Control.Exception.Base
103 ( assert )
104 import Control.Monad.Catch
105 ( MonadThrow, throwM )
106 import Crypto.Hash.Algorithms
107 ( SHA256 (..), SHA512 (..) )
108 import Crypto.MAC.HMAC
109 ( HMAC, hmac )
110 import Data.Aeson
111 ( ToJSON (..), (.=) )
112 import Data.Bifunctor
113 ( bimap, first )
114 import Data.Bits
115 ( clearBit, setBit, testBit )
116 import Data.ByteArray
117 ( ScrubbedBytes )
118 import Data.ByteString
119 ( ByteString )
120 import Data.Function
121 ( (&) )
122 import Data.Maybe
123 ( fromMaybe )
124 import Data.Typeable
125 ( Typeable )
126 import Data.Word
127 ( Word32, Word8 )
128 import Fmt
129 ( format )
130 import GHC.Generics
131 ( Generic )
132
133 import qualified Cardano.Address as Internal
134 import qualified Cardano.Address.Derivation as Internal
135 import qualified Cardano.Codec.Cbor as CBOR
136 import qualified Codec.CBOR.Decoding as CBOR
137 import qualified Crypto.KDF.PBKDF2 as PBKDF2
138 import qualified Data.Aeson as Json
139 import qualified Data.ByteArray as BA
140 import qualified Data.ByteString as BS
141 import qualified Data.Text as T
142 import qualified Data.Text.Encoding as T
143
144 -- $overview
145 --
146 -- This module provides an implementation of:
147 --
148 -- - 'Cardano.Address.Derivation.GenMasterKey': for generating Icarus master keys from mnemonic sentences
149 -- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical hard derivation of parent to child keys
150 -- - 'Cardano.Address.Derivation.SoftDerivation': for hierarchical soft derivation of parent to child keys
151 -- - 'Cardano.Address.PaymentAddress': for constructing addresses from a public key
152 --
153 -- We call 'Icarus' addresses the new format of Cardano addresses which came
154 -- after 'Cardano.Address.Style.Byron.Byron'. This is the format initially used in /Yoroi/
155 -- and now also used by /Daedalus/.
156
157 -- | A cryptographic key for sequential-scheme address derivation, with
158 -- phantom-types to disambiguate key types.
159 --
160 -- @
161 -- let rootPrivateKey = Icarus 'RootK XPrv
162 -- let accountPubKey = Icarus 'AccountK XPub
163 -- let addressPubKey = Icarus 'PaymentK XPub
164 -- @
165 --
166 -- @since 1.0.0
167 newtype Icarus (depth :: Depth) key = Icarus
168 { getKey :: key
169 -- ^ Extract the raw 'XPrv' or 'XPub' wrapped by this type.
170 --
171 -- @since 1.0.0
172 }
173 deriving stock (Generic, Show, Eq)
174
175 deriving instance (Functor (Icarus depth))
176 instance (NFData key) => NFData (Icarus depth key)
177
178 data Role
179 = UTxOExternal
180 | UTxOInternal
181 deriving (Generic, Typeable, Show, Eq, Ord, Bounded)
182
183 instance NFData Role
184
185 roleFromIndex :: Index 'Soft depth -> Maybe Role
186 roleFromIndex ix = case indexToWord32 ix of
187 0 -> Just UTxOExternal
188 1 -> Just UTxOInternal
189 _ -> Nothing
190
191 roleToIndex :: Role -> Index 'Soft depth
192 roleToIndex = unsafeMkIndex . \case
193 UTxOExternal -> 0
194 UTxOInternal -> 1
195
196 --
197 -- Key Derivation
198 --
199 -- $keyDerivation
200 --
201 -- === Generating a root key from 'SomeMnemonic'
202 -- > :set -XOverloadedStrings
203 -- > :set -XTypeApplications
204 -- > :set -XDataKinds
205 -- > :set -XFlexibleContexts
206 -- > import Cardano.Mnemonic ( mkSomeMnemonic )
207 -- > import Cardano.Address ( base58 )
208 -- > import Cardano.Address.Derivation ( toXPub )
209 -- > import qualified Cardano.Address.Style.Icarus as Icarus
210 -- >
211 -- > let (Right mw) = mkSomeMnemonic @'[15] ["network","empty","cause","mean","expire","private","finger","accident","session","problem","absurd","banner","stage","void","what"]
212 -- > let sndFactor = mempty -- Or alternatively, a second factor mnemonic transformed to bytes via someMnemonicToBytes
213 -- > let rootK = Icarus.genMasterKeyFromMnemonic mw sndFactor :: Icarus 'RootK XPrv
214 --
215 -- === Deriving child keys
216 --
217 -- Let's consider the following 3rd, 4th and 5th derivation paths @0'\/0\/14@
218 -- === accIx assumes values from 2147483648 (ie. 0x80000000) to 4294967295 (ie. 0xFFFFFFFF)
219 -- === addIx assume values from 0 to 2147483647 (ie. 7FFFFFFF)
220 -- > let Just accIx = indexFromWord32 0x80000000
221 -- === this is the same as
222 -- > let accIx = minBound @(Index 'Hardened 'AccountK)
223 -- > let acctK = Icarus.deriveAccountPrivateKey rootK accIx
224 -- >
225 -- > let Just addIx = indexFromWord32 0x00000014
226 -- > let addrK = Icarus.deriveAddressPrivateKey acctK Icarus.UTxOExternal addIx
227 -- >
228 -- > base58 $ Icarus.paymentAddress Icarus.icarusMainnet (toXPub <$> addrK)
229 -- >"Ae2tdPwUPEZ8XpsjgQPH2cJdtohkYrxJ3i5y6mVsrkZZkdpdn6mnr4Rt6wG"
230
231 instance Internal.GenMasterKey Icarus where
232 type SecondFactor Icarus = ScrubbedBytes
233
234 genMasterKeyFromXPrv = liftXPrv
235 genMasterKeyFromMnemonic (SomeMnemonic mw) sndFactor =
236 let
237 seed = entropyToBytes $ mnemonicToEntropy mw
238 seedValidated = assert
239 (BA.length seed >= minSeedLengthBytes && BA.length seed <= 255)
240 seed
241 in Icarus $ generateNew seedValidated sndFactor
242
243 instance Internal.HardDerivation Icarus where
244 type AccountIndexDerivationType Icarus = 'Hardened
245 type AddressIndexDerivationType Icarus = 'Soft
246 type WithRole Icarus = Role
247
248 deriveAccountPrivateKey (Icarus rootXPrv) accIx =
249 let
250 Just purposeIx =
251 indexFromWord32 @(Index 'Hardened _) purposeIndex
252 Just coinTypeIx =
253 indexFromWord32 @(Index 'Hardened _) coinTypeIndex
254 purposeXPrv = -- lvl1 derivation; hardened derivation of purpose'
255 deriveXPrv DerivationScheme2 rootXPrv purposeIx
256 coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type'
257 deriveXPrv DerivationScheme2 purposeXPrv coinTypeIx
258 acctXPrv = -- lvl3 derivation; hardened derivation of account' index
259 deriveXPrv DerivationScheme2 coinTypeXPrv accIx
260 in
261 Icarus acctXPrv
262
263 deriveAddressPrivateKey (Icarus accXPrv) role addrIx =
264 let
265 changeXPrv = -- lvl4 derivation; soft derivation of change chain
266 deriveXPrv DerivationScheme2 accXPrv (roleToIndex role)
267 addrXPrv = -- lvl5 derivation; soft derivation of address index
268 deriveXPrv DerivationScheme2 changeXPrv addrIx
269 in
270 Icarus addrXPrv
271
272 instance Internal.SoftDerivation Icarus where
273 deriveAddressPublicKey (Icarus accXPub) role addrIx =
274 fromMaybe errWrongIndex $ do
275 changeXPub <- -- lvl4 derivation in bip44 is derivation of change chain
276 deriveXPub DerivationScheme2 accXPub (roleToIndex role)
277 addrXPub <- -- lvl5 derivation in bip44 is derivation of address chain
278 deriveXPub DerivationScheme2 changeXPub addrIx
279 return $ Icarus addrXPub
280 where
281 errWrongIndex = error $
282 "deriveAddressPublicKey failed: was given an hardened (or too big) \
283 \index for soft path derivation ( " ++ show addrIx ++ "). This is \
284 \either a programmer error, or, we may have reached the maximum \
285 \number of addresses for a given wallet."
286
287 -- | Generate a root key from a corresponding mnemonic.
288 --
289 -- @since 1.0.0
290 genMasterKeyFromMnemonic
291 :: SomeMnemonic
292 -- ^ Some valid mnemonic sentence.
293 -> ScrubbedBytes
294 -- ^ An optional second-factor passphrase (or 'mempty')
295 -> Icarus 'RootK XPrv
296 genMasterKeyFromMnemonic =
297 Internal.genMasterKeyFromMnemonic
298
299 -- | Generate a root key from a corresponding root 'XPrv'
300 --
301 -- @since 1.0.0
302 genMasterKeyFromXPrv
303 :: XPrv
304 -> Icarus 'RootK XPrv
305 genMasterKeyFromXPrv =
306 Internal.genMasterKeyFromXPrv
307
308 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
309 --
310 -- | Derives an account private key from the given root private key.
311 --
312 -- @since 1.0.0
313 deriveAccountPrivateKey
314 :: Icarus 'RootK XPrv
315 -> Index 'Hardened 'AccountK
316 -> Icarus 'AccountK XPrv
317 deriveAccountPrivateKey =
318 Internal.deriveAccountPrivateKey
319
320 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
321 --
322 -- | Derives an address private key from the given account private key.
323 --
324 -- @since 1.0.0
325 deriveAddressPrivateKey
326 :: Icarus 'AccountK XPrv
327 -> Role
328 -> Index 'Soft 'PaymentK
329 -> Icarus 'PaymentK XPrv
330 deriveAddressPrivateKey =
331 Internal.deriveAddressPrivateKey
332
333 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
334 --
335 -- | Derives an address public key from the given account public key.
336 --
337 -- @since 1.0.0
338 deriveAddressPublicKey
339 :: Icarus 'AccountK XPub
340 -> Role
341 -> Index 'Soft 'PaymentK
342 -> Icarus 'PaymentK XPub
343 deriveAddressPublicKey =
344 Internal.deriveAddressPublicKey
345
346 --
347 -- Addresses
348 --
349 -- $addresses
350 -- === Generating a 'PaymentAddress'
351 --
352 -- | Possible errors from inspecting a Shelley address
353 --
354 -- @since 3.0.0
355 data ErrInspectAddress
356 = UnexpectedDerivationPath
357 | DeserialiseError DeserialiseFailure
358 deriving (Generic, Show, Eq)
359 deriving ToJSON via WithErrorMessage ErrInspectAddress
360
361 instance Exception ErrInspectAddress where
362 displayException = prettyErrInspectAddress
363
364 -- | Pretty-print an 'ErrInspectAddress'
365 --
366 -- @since 3.0.0
367 prettyErrInspectAddress :: ErrInspectAddress -> String
368 prettyErrInspectAddress = \case
369 UnexpectedDerivationPath ->
370 "Unexpected derivation path"
371 DeserialiseError e ->
372 format "Deserialisation error (was: {})" (show e)
373
374 -- Determines whether an 'Address' is an Icarus address.
375 --
376 -- Returns a JSON object with information about the address, or throws
377 -- 'ErrInspectAddress' if the address isn't an icarus address.
378 --
379 -- @since 2.0.0
380 inspectIcarusAddress :: MonadThrow m => Address -> m Json.Value
381 inspectIcarusAddress = inspectAddress
382 {-# DEPRECATED inspectIcarusAddress "use qualified 'inspectAddress' instead." #-}
383
384 -- | Determines whether an 'Address' is an Icarus address.
385 --
386 -- Returns a JSON object with information about the address, or throws
387 -- 'ErrInspectAddress' if the address isn't an icarus address.
388 -- λ> :set -XOverloadedStrings
389 -- λ> :set -XTypeApplications
390 -- λ> :set -XDataKinds
391 -- λ> :set -XFlexibleContexts
392 -- λ> import Cardano.Mnemonic ( mkSomeMnemonic )
393 -- λ> import qualified Cardano.Address.Style.Icarus as Icarus
394 -- λ> import Cardano.Address.Derivation ( toXPub )
395 -- λ> import Cardano.Address ( base58 )
396 -- λ> let (Right mw) = mkSomeMnemonic @'[12] ["moon","fox","ostrich","quick","cactus","raven","wasp","intact","first","ring","crumble","error"]
397 -- λ> let sndFactor = mempty
398 -- λ> let rootK = Icarus.genMasterKeyFromMnemonic mw sndFactor :: Icarus 'RootK XPrv
399 -- λ> let Just accIx = indexFromWord32 0x80000000
400 -- λ> let acctK = Icarus.deriveAccountPrivateKey rootK accIx
401 -- λ> let Just addIx = indexFromWord32 0x00000014
402 -- λ> let addrK = Icarus.deriveAddressPrivateKey acctK Icarus.UTxOExternal addIx
403 -- λ> (toXPub <$> addrK)
404 -- Icarus {getKey = XPub {xpubPublicKey = "\223\148\230\206\187\135\253\SO\151\216\183\210]}s:\151\134\174q\173\207\184\202\EM\176\170\220\216\235\&1\243", xpubChaincode = ChainCode "\\\160\196\&8~\208\165\241\138\SOH\222\ETX*\150&\214\185\196 \153\DC2\167\165\243\155\136\228\255\229~d\253"}}
405 -- λ> base58 $ Icarus.paymentAddress icarusMainnet (toXPub <$> addrK)
406 -- "Ae2tdPwUPEYyzBcNXkFWKywMiZ9eSd96dQxhBQd371foiH16Y7gFgLBj9G5"
407 --
408 -- λ> import Cardano.Codec.Cbor
409 -- λ> import Crypto.Hash.Algorithms (Blake2b_224, SHA3_256)
410 -- λ> import Crypto.Hash (hash)
411 -- λ> let blake2b224 = hash @_ @Blake2b_224
412 -- λ> let sha3256 = hash @_ @SHA3_256
413 -- λ> import qualified Codec.CBOR.Encoding as CBOR
414 -- λ> let encodeXPub = CBOR.encodeBytes (xpubToBytes . Icarus.getKey $ icarusAddrKPub)
415 -- λ> let encodeSpendingData = CBOR.encodeListLen 2 <> CBOR.encodeWord8 0 <> encodeXPub
416 -- λ> let encodeAttrs = CBOR.encodeMapLen 0
417 -- λ> import qualified Data.ByteArray as BA
418 -- λ> let rootAddr = BA.convert $ blake2b224 $ sha3256 $ CBOR.toStrictByteString $ mempty <> CBOR.encodeListLen 3 <> CBOR.encodeWord8 0 <> encodeSpendingData <> encodeAttrs
419 -- λ> encode EBase16 rootAddr
420 -- "1fdde02c9e087474aa7ab0a46ae2f6d316a92cd0fa2d4e8b1c2eebdf"
421 --
422 -- $ echo Ae2tdPwUPEYyzBcNXkFWKywMiZ9eSd96dQxhBQd371foiH16Y7gFgLBj9G5 | cardano-address address inspect
423 -- {
424 -- "stake_reference": "none",
425 -- "address_style": "Icarus",
426 -- "address_root": "1fdde02c9e087474aa7ab0a46ae2f6d316a92cd0fa2d4e8b1c2eebdf",
427 -- "network_tag": null,
428 -- "address_type": 8
429 --}
430 -- @since 2.0.0
431 inspectAddress :: MonadThrow m => Address -> m Json.Value
432 inspectAddress = either throwM (pure . toJSON) . eitherInspectAddress
433
434 -- | Determines whether an 'Address' is an Icarus address.
435 --
436 -- Returns either details about the 'Address', or 'ErrInspectAddress' if it's
437 -- not a valid icarus address.
438 --
439 -- @since 3.4.0
440 eitherInspectAddress :: Address -> Either ErrInspectAddress AddressInfo
441 eitherInspectAddress addr = do
442 payload <- first DeserialiseError $
443 CBOR.deserialiseCbor CBOR.decodeAddressPayload $
444 unAddress addr
445 ntwrk <- bimap DeserialiseError (fmap NetworkTag) $
446 CBOR.deserialiseCbor CBOR.decodeProtocolMagicAttr payload
447 (root, attrs) <- first DeserialiseError $
448 CBOR.deserialiseCbor decodePayload payload
449 if (elem 1 $ fst <$> attrs)
450 then Left UnexpectedDerivationPath
451 else Right AddressInfo
452 { infoAddressRoot = root
453 , infoNetworkTag = ntwrk
454 }
455 where
456 decodePayload :: forall s. CBOR.Decoder s (ByteString, [(Word8, ByteString)])
457 decodePayload = do
458 _ <- CBOR.decodeListLenCanonicalOf 3
459 root <- CBOR.decodeBytes
460 (root,) <$> CBOR.decodeAllAttributes
461
462 -- | The result of 'eitherInspectAddress' for Icarus addresses.
463 --
464 -- @since 3.4.0
465 data AddressInfo = AddressInfo
466 { infoAddressRoot :: !ByteString
467 , infoNetworkTag :: !(Maybe NetworkTag)
468 } deriving (Generic, Show, Eq)
469
470 instance ToJSON AddressInfo where
471 toJSON AddressInfo{..} = Json.object
472 [ "network_tag" .= maybe Json.Null toJSON infoNetworkTag
473 , "address_root" .= T.decodeUtf8 (encode EBase16 infoAddressRoot)
474 , "address_type" .= toJSON @Word8 8
475 ]
476
477 instance Internal.PaymentAddress Icarus where
478 paymentAddress discrimination k = unsafeMkAddress
479 $ CBOR.toStrictByteString
480 $ CBOR.encodeAddress (getKey k) attrs
481 where
482 NetworkTag magic = networkTag @Icarus discrimination
483 attrs = case addressDiscrimination @Icarus discrimination of
484 RequiresNetworkTag ->
485 [ CBOR.encodeProtocolMagicAttr magic
486 ]
487 RequiresNoTag ->
488 []
489
490 -- Re-export from 'Cardano.Address' to have it documented specialized in Haddock.
491 --
492 -- | Convert a public key to a payment 'Address' valid for the given
493 -- network discrimination.
494 --
495 -- @since 1.0.0
496 paymentAddress
497 :: NetworkDiscriminant Icarus
498 -> Icarus 'PaymentK XPub
499 -> Address
500 paymentAddress =
501 Internal.paymentAddress
502
503 --
504 -- Network Discrimination
505 --
506
507 instance HasNetworkDiscriminant Icarus where
508 type NetworkDiscriminant Icarus = (AddressDiscrimination, NetworkTag)
509 addressDiscrimination = fst
510 networkTag = snd
511
512 -- | 'NetworkDiscriminant' for Cardano MainNet & 'Icarus'
513 --
514 -- @since 2.0.0
515 icarusMainnet :: NetworkDiscriminant Icarus
516 icarusMainnet = byronMainnet
517
518 -- | 'NetworkDiscriminant' for Cardano Staging & 'Icarus'
519 --
520 -- @since 2.0.0
521 icarusStaging :: NetworkDiscriminant Icarus
522 icarusStaging = byronStaging
523
524 -- | 'NetworkDiscriminant' for Cardano Testnet & 'Icarus'
525 --
526 -- @since 2.0.0
527 icarusTestnet :: NetworkDiscriminant Icarus
528 icarusTestnet = byronTestnet
529
530 -- | 'NetworkDiscriminant' for Cardano Preprod & 'Icarus'
531 --
532 -- @since 3.13.0
533 icarusPreprod :: NetworkDiscriminant Icarus
534 icarusPreprod = byronPreprod
535
536 -- | 'NetworkDiscriminant' for Cardano Preview & 'Icarus'
537 --
538 -- @since 3.13.0
539 icarusPreview :: NetworkDiscriminant Icarus
540 icarusPreview = byronPreview
541
542 --
543 -- Unsafe
544 --
545
546 -- | Unsafe backdoor for constructing an 'Icarus' key from a raw 'XPrv'. this is
547 -- unsafe because it lets the caller choose the actually derivation 'depth'.
548 --
549 -- This can be useful however when serializing / deserializing such a type, or to
550 -- speed up test code (and avoid having to do needless derivations from a master
551 -- key down to an address key for instance).
552 --
553 -- @since 1.0.0
554 liftXPrv :: XPrv -> Icarus depth XPrv
555 liftXPrv = Icarus
556
557 -- | Unsafe backdoor for constructing an 'Icarus' key from a raw 'XPub'. this is
558 -- unsafe because it lets the caller choose the actually derivation 'depth'.
559 --
560 -- This can be useful however when serializing / deserializing such a type, or to
561 -- speed up test code (and avoid having to do needless derivations from a master
562 -- key down to an address key for instance).
563 --
564 -- @since 2.0.0
565 liftXPub :: XPub -> Icarus depth XPub
566 liftXPub = Icarus
567
568 --
569 -- Internal
570 --
571
572 -- Purpose is a constant set to 44' (or 0x8000002C) following the original
573 -- BIP-44 specification.
574 --
575 -- It indicates that the subtree of this node is used according to this
576 -- specification.
577 --
578 -- Hardened derivation is used at this level.
579 purposeIndex :: Word32
580 purposeIndex = 0x8000002C
581
582 -- One master node (seed) can be used for unlimited number of independent
583 -- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the
584 -- same space for various cryptocoins has some disadvantages.
585 --
586 -- This level creates a separate subtree for every cryptocoin, avoiding reusing
587 -- addresses across cryptocoins and improving privacy issues.
588 --
589 -- Coin type is a constant, set for each cryptocoin. For Cardano this constant
590 -- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada
591 -- Lovelace.
592 --
593 -- Hardened derivation is used at this level.
594 coinTypeIndex :: Word32
595 coinTypeIndex = 0x80000717
596
597 -- The minimum seed length for 'generateKeyFromMnemonic' and 'unsafeGenerateKeyFromMnemonic'.
598 minSeedLengthBytes :: Int
599 minSeedLengthBytes = 16
600
601 -- Hardware Ledger devices generates keys from mnemonic using a different
602 -- approach (different from the rest of Cardano).
603 --
604 -- It is a combination of:
605 --
606 -- - [SLIP 0010](https://github.com/satoshilabs/slips/blob/master/slip-0010.md)
607 -- - [BIP 0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)
608 -- - [BIP 0039](https://github.com/bitcoin/bips/blob/master/bip-0039.mediawiki)
609 -- - [RFC 8032](https://tools.ietf.org/html/rfc8032#section-5.1.5)
610 -- - What seems to be arbitrary changes from Ledger regarding the calculation of
611 -- the initial chain code and generation of the root private key.
612 unsafeGenerateKeyFromHardwareLedger
613 :: SomeMnemonic
614 -- ^ The root mnemonic
615 -> Icarus 'RootK XPrv
616 unsafeGenerateKeyFromHardwareLedger (SomeMnemonic mw) = unsafeFromRight $ do
617 let seed = pbkdf2HmacSha512
618 $ T.encodeUtf8
619 $ T.intercalate " "
620 $ mnemonicToText mw
621
622 -- NOTE
623 -- SLIP-0010 refers to `iR` as the chain code. Here however, the chain code
624 -- is obtained as a hash of the initial seed whereas iR is used to make part
625 -- of the root private key itself.
626 let cc = hmacSha256 (BS.pack [1] <> seed)
627 let (iL, iR) = first pruneBuffer $ hashRepeatedly seed
628
629 prv <- maybe (Left "invalid xprv") pure $ xprvFromBytes $ iL <> iR <> cc
630 pure $ Icarus prv
631 where
632 -- Errors yielded in the body of 'unsafeGenerateKeyFromHardwareLedger' are
633 -- programmer errors (out-of-range byte buffer access or, invalid length for
634 -- cryptographic operations). Therefore, we throw badly if we encounter any.
635 unsafeFromRight :: Either String a -> a
636 unsafeFromRight = either error id
637
638 -- This is the algorithm described in SLIP 0010 for master key generation
639 -- with an extra step to discard _some_ of the potential private keys. Why
640 -- this extra step remains a mystery as of today.
641 --
642 -- 1. Generate a seed byte sequence S of 512 bits according to BIP-0039.
643 -- (done in a previous step, passed as argument).
644 --
645 -- 2. Calculate I = HMAC-SHA512(Key = "ed25519 seed", Data = S)
646 --
647 -- 3. Split I into two 32-byte sequences, IL and IR.
648 --
649 -- extra *******************************************************************
650 -- * *
651 -- * 3.5 If the third highest bit of the last byte of IL is not zero *
652 -- * S = I and go back to step 2. *
653 -- * *
654 -- *************************************************************************
655 --
656 -- 4. Use parse256(IL) as master secret key, and IR as master chain code.
657 hashRepeatedly :: ByteString -> (ByteString, ByteString)
658 hashRepeatedly bytes = case BS.splitAt 32 (hmacSha512 bytes) of
659 (iL, iR) | isInvalidKey iL -> hashRepeatedly (iL <> iR)
660 (iL, iR) -> (iL, iR)
661 where
662 isInvalidKey k = testBit (k `BS.index` 31) 5
663
664 -- - Clear the lowest 3 bits of the first byte
665 -- - Clear the highest bit of the last byte
666 -- - Set the second highest bit of the last byte
667 --
668 -- As described in [RFC 8032 - 5.1.5](https://tools.ietf.org/html/rfc8032#section-5.1.5)
669 pruneBuffer :: ByteString -> ByteString
670 pruneBuffer bytes =
671 let
672 (firstByte, rest) = fromMaybe (error "pruneBuffer: no first byte") $
673 BS.uncons bytes
674
675 (rest', lastByte) = fromMaybe (error "pruneBuffer: no last byte") $
676 BS.unsnoc rest
677
678 firstPruned = firstByte
679 & (`clearBit` 0)
680 & (`clearBit` 1)
681 & (`clearBit` 2)
682
683 lastPruned = lastByte
684 & (`setBit` 6)
685 & (`clearBit` 7)
686 in
687 (firstPruned `BS.cons` BS.snoc rest' lastPruned)
688
689 -- As described in [BIP 0039 - From Mnemonic to Seed](https://github.com/bitcoin/bips/blob/master/bip-0039.mediawiki#from-mnemonic-to-seed)
690 pbkdf2HmacSha512 :: ByteString -> ByteString
691 pbkdf2HmacSha512 bytes = PBKDF2.generate
692 (PBKDF2.prfHMAC SHA512)
693 (PBKDF2.Parameters 2048 64)
694 bytes
695 ("mnemonic" :: ByteString)
696
697 hmacSha256 :: ByteString -> ByteString
698 hmacSha256 =
699 BA.convert @(HMAC SHA256) . hmac salt
700
701 -- As described in [SLIP 0010 - Master Key Generation](https://github.com/satoshilabs/slips/blob/master/slip-0010.md#master-key-generation)
702 hmacSha512 :: ByteString -> ByteString
703 hmacSha512 =
704 BA.convert @(HMAC SHA512) . hmac salt
705
706 salt :: ByteString
707 salt = "ed25519 seed"