never executed always true always false
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE DeriveFunctor #-}
3 {-# LANGUAGE DeriveGeneric #-}
4 {-# LANGUAGE DerivingVia #-}
5 {-# LANGUAGE DuplicateRecordFields #-}
6 {-# LANGUAGE ExistentialQuantification #-}
7 {-# LANGUAGE FlexibleContexts #-}
8 {-# LANGUAGE GADTs #-}
9 {-# LANGUAGE LambdaCase #-}
10 {-# LANGUAGE NamedFieldPuns #-}
11 {-# LANGUAGE OverloadedStrings #-}
12 {-# LANGUAGE RankNTypes #-}
13 {-# LANGUAGE RecordWildCards #-}
14 {-# LANGUAGE ScopedTypeVariables #-}
15 {-# LANGUAGE StandaloneDeriving #-}
16 {-# LANGUAGE TupleSections #-}
17 {-# LANGUAGE TypeApplications #-}
18 {-# LANGUAGE TypeFamilies #-}
19 {-# LANGUAGE UndecidableInstances #-}
20
21 {-# OPTIONS_HADDOCK prune #-}
22
23 -- |
24 -- Copyright: © 2018-2020 IOHK
25 -- License: Apache-2.0
26
27 module Cardano.Address.Style.Byron
28 ( -- $overview
29
30 -- * Byron
31 Byron
32 , DerivationPath
33 , payloadPassphrase
34 , derivationPath
35 , getKey
36
37 -- * Key Derivation
38 -- $keyDerivation
39 , genMasterKeyFromXPrv
40 , genMasterKeyFromMnemonic
41 , deriveAccountPrivateKey
42 , deriveAddressPrivateKey
43
44 -- * Addresses
45 -- $addresses
46 , AddressInfo (..)
47 , eitherInspectAddress
48 , inspectAddress
49 , inspectByronAddress
50 , paymentAddress
51 , ErrInspectAddress (..)
52 , prettyErrInspectAddress
53
54 -- * Network Discrimination
55 , byronMainnet
56 , byronStaging
57 , byronTestnet
58 , byronPreprod
59 , byronPreview
60
61 -- * Unsafe
62 , liftXPrv
63 , liftXPub
64
65 -- Internals
66 , minSeedLengthBytes
67 ) where
68
69 import Prelude
70
71 import Cardano.Address
72 ( Address
73 , AddressDiscrimination (..)
74 , HasNetworkDiscriminant (..)
75 , NetworkTag (..)
76 , unAddress
77 , unsafeMkAddress
78 )
79 import Cardano.Address.Derivation
80 ( Depth (..)
81 , DerivationScheme (DerivationScheme1)
82 , DerivationType (..)
83 , Index (..)
84 , XPrv
85 , XPub
86 , deriveXPrv
87 , generate
88 , toXPub
89 , xpubToBytes
90 )
91 import Cardano.Address.Internal
92 ( DeserialiseFailure, WithErrorMessage (..) )
93 import Cardano.Mnemonic
94 ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy )
95 import Codec.Binary.Encoding
96 ( AbstractEncoding (..), encode )
97 import Control.DeepSeq
98 ( NFData )
99 import Control.Exception
100 ( Exception, displayException )
101 import Control.Exception.Base
102 ( assert )
103 import Control.Monad.Catch
104 ( MonadThrow, throwM )
105 import Crypto.Hash
106 ( hash )
107 import Crypto.Hash.Algorithms
108 ( Blake2b_256, SHA512 (..) )
109 import Data.Aeson
110 ( ToJSON (..), (.=) )
111 import Data.Bifunctor
112 ( bimap, first )
113 import Data.ByteArray
114 ( ScrubbedBytes )
115 import Data.ByteString
116 ( ByteString )
117 import Data.Kind
118 ( Type )
119 import Data.List
120 ( find )
121 import Data.Word
122 ( Word32, Word8 )
123 import GHC.Generics
124 ( Generic )
125
126 import qualified Cardano.Address as Internal
127 import qualified Cardano.Address.Derivation as Internal
128 import qualified Cardano.Codec.Cbor as CBOR
129 import qualified Codec.CBOR.Decoding as CBOR
130 import qualified Crypto.KDF.PBKDF2 as PBKDF2
131 import qualified Data.Aeson as Json
132 import qualified Data.ByteArray as BA
133 import qualified Data.Text.Encoding as T
134
135 -- $overview
136 --
137 -- This module provides an implementation of:
138 --
139 -- - 'Cardano.Address.Derivation.GenMasterKey': for generating Byron master keys from mnemonic sentences
140 -- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical derivation of parent to child keys
141 -- - 'Cardano.Address.PaymentAddress': for constructing addresses from a public key
142 --
143 -- We call 'Byron' addresses the old address type used by Daedalus in the early
144 -- days of Cardano. Using this type of addresses and underlying key scheme is
145 -- now considered __deprecated__ because of some security implications.
146 --
147 -- The internals of the 'Byron' does not matter for the reader, but basically
148 -- contains what is necessary to perform key derivation and generate addresses
149 -- from a 'Byron' type.
150 --
151 -- Byron uses WholeDomain (meaning Soft+Hardened) for account key and payment key derivation.
152 -- It should use Hardened for account and Soft for payment as design,
153 -- but due to the error made prior 2019 in cardano-sl
154 -- implementation WholeDomain was adopted to handle all the keys. Nevertheless,
155 -- it was recommended and enforced to use Hardened for account derivation and Soft for payment
156 -- key derivation from 2019 onwards. To sum up both account index and payment index can assume
157 -- values from 0 to 4294967295 (ie. 0xFFFFFFFF)
158
159 -- == Deprecation Notice
160 --
161 -- Unless you have good reason to do so (like writing backward-compatible code
162 -- with an existing piece), any new implementation __should use__ the
163 -- 'Cardano.Address.Style.Icarus.Icarus' style for key and addresses.
164
165
166 -- | Material for deriving HD random scheme keys, which can be used for making
167 -- addresses.
168 --
169 -- @since 1.0.0
170 data Byron (depth :: Depth) key = Byron
171 { getKey :: key
172 -- ^ The raw private or public key.
173 --
174 -- @since 1.0.0
175 , derivationPath :: DerivationPath depth
176 -- ^ The address derivation indices for the level of this key.
177 --
178 -- @since 1.0.0
179 , payloadPassphrase :: ScrubbedBytes
180 -- ^ Used for encryption of the derivation path payload within an address.
181 --
182 -- @since 1.0.0
183 } deriving stock (Generic)
184 {-# DEPRECATED Byron "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
185 {-# DEPRECATED getKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
186 {-# DEPRECATED derivationPath "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
187 {-# DEPRECATED payloadPassphrase "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
188
189 instance (NFData key, NFData (DerivationPath depth)) => NFData (Byron depth key)
190 deriving instance (Show key, Show (DerivationPath depth)) => Show (Byron depth key)
191 deriving instance (Eq key, Eq (DerivationPath depth)) => Eq (Byron depth key)
192 deriving instance (Functor (Byron depth))
193
194 -- | The hierarchical derivation indices for a given level/depth.
195 --
196 -- @since 1.0.0
197 type family DerivationPath (depth :: Depth) :: Type where
198 -- The root key is generated from the seed.
199 DerivationPath 'RootK =
200 ()
201 -- The account key is generated from the root key and account index.
202 DerivationPath 'AccountK =
203 Index 'WholeDomain 'AccountK
204 -- The address key is generated from the account key and address index.
205 DerivationPath 'PaymentK =
206 (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'PaymentK)
207 {-# DEPRECATED DerivationPath "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
208
209 --
210 -- Key Derivation
211 --
212 -- === Generating a root key from 'SomeMnemonic'
213 -- > :set -XOverloadedStrings
214 -- > :set -XTypeApplications
215 -- > :set -XDataKinds
216 -- > :set -XFlexibleContexts
217 -- > import Cardano.Mnemonic ( mkSomeMnemonic )
218 -- > import Cardano.Address ( base58 )
219 -- > import Cardano.Address.Derivation ( toXPub )
220 -- > import qualified Cardano.Address.Style.Byron as Byron
221 -- >
222 -- > let (Right mw) = mkSomeMnemonic @'[12] ["moon","fox","ostrich","quick","cactus","raven","wasp","intact","first","ring","crumble","error"]
223 -- > let rootK = Byron.genMasterKeyFromMnemonic mw :: Byron 'RootK XPrv
224 --
225 -- === Deriving child keys
226 -- === Both accIx and addIx assume values from 0 to 4294967295 (ie. 0xFFFFFFFF)
227 -- === In case of account one can get this bound via
228 -- === let accIxMin = minBound @(Index 'WholeDomain 'AccountK)
229 -- === let accIxMax = maxBound @(Index 'WholeDomain 'AccountK)
230 -- > let Just accIx = wholeDomainIndex 0x80000000
231 -- > let acctK = Byron.deriveAccountPrivateKey rootK accIx
232 -- >
233 -- > let Just addIx = wholeDomainIndex 0x80000014
234 -- > let addrK = Byron.deriveAddressPrivateKey acctK addIx
235 -- >
236 -- > base58 $ Byron.paymentAddress Byron.byronMainnet (toXPub <$> addrK)
237 -- > "DdzFFzCqrhsq3KjLtT51mESbZ4RepiHPzLqEhamexVFTJpGbCXmh7qSxnHvaL88QmtVTD1E1sjx8Z1ZNDhYmcBV38ZjDST9kYVxSkhcw"
238
239 instance Internal.GenMasterKey Byron where
240 type SecondFactor Byron = ()
241
242 genMasterKeyFromXPrv xprv =
243 liftXPrv (toXPub xprv) () xprv
244 genMasterKeyFromMnemonic (SomeMnemonic mw) () =
245 liftXPrv (toXPub xprv) () xprv
246 where
247 xprv = generate (hashSeed seedValidated)
248 seed = entropyToBytes $ mnemonicToEntropy mw
249 seedValidated = assert
250 (BA.length seed >= minSeedLengthBytes && BA.length seed <= 255)
251 seed
252
253 instance Internal.HardDerivation Byron where
254 type AddressIndexDerivationType Byron = 'WholeDomain
255 type AccountIndexDerivationType Byron = 'WholeDomain
256 type WithRole Byron = ()
257
258 deriveAccountPrivateKey rootXPrv accIx = Byron
259 { getKey = deriveXPrv DerivationScheme1 (getKey rootXPrv) accIx
260 , derivationPath = accIx
261 , payloadPassphrase = payloadPassphrase rootXPrv
262 }
263
264 deriveAddressPrivateKey accXPrv () addrIx = Byron
265 { getKey = deriveXPrv DerivationScheme1 (getKey accXPrv) addrIx
266 , derivationPath = (derivationPath accXPrv, addrIx)
267 , payloadPassphrase = payloadPassphrase accXPrv
268 }
269
270 -- | Generate a root key from a corresponding mnemonic.
271 --
272 -- @since 1.0.0
273 genMasterKeyFromMnemonic
274 :: SomeMnemonic
275 -- ^ Some valid mnemonic sentence.
276 -> Byron 'RootK XPrv
277 genMasterKeyFromMnemonic =
278 flip Internal.genMasterKeyFromMnemonic ()
279 {-# DEPRECATED genMasterKeyFromMnemonic "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
280
281 -- | Generate a root key from a corresponding root 'XPrv'
282 --
283 -- @since 1.0.0
284 genMasterKeyFromXPrv
285 :: XPrv
286 -> Byron 'RootK XPrv
287 genMasterKeyFromXPrv =
288 Internal.genMasterKeyFromXPrv
289 {-# DEPRECATED genMasterKeyFromXPrv "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
290
291 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
292 --
293 -- | Derives an account private key from the given root private key.
294 --
295 -- @since 1.0.0
296 deriveAccountPrivateKey
297 :: Byron 'RootK XPrv
298 -> Index 'WholeDomain 'AccountK
299 -> Byron 'AccountK XPrv
300 deriveAccountPrivateKey =
301 Internal.deriveAccountPrivateKey
302 {-# DEPRECATED deriveAccountPrivateKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
303
304 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
305 --
306 -- | Derives an address private key from the given account private key.
307 --
308 -- @since 1.0.0
309 deriveAddressPrivateKey
310 :: Byron 'AccountK XPrv
311 -> Index 'WholeDomain 'PaymentK
312 -> Byron 'PaymentK XPrv
313 deriveAddressPrivateKey acctK =
314 Internal.deriveAddressPrivateKey acctK ()
315 {-# DEPRECATED deriveAddressPrivateKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
316
317 --
318 -- Addresses
319 --
320 -- $addresses
321 -- === Generating a 'PaymentAddress'
322 --
323 -- | Possible errors from inspecting a Byron address
324 --
325 -- @since 3.0.0
326 data ErrInspectAddress
327 = MissingExpectedDerivationPath
328 | DeserialiseError DeserialiseFailure
329 | FailedToDecryptPath
330 deriving (Generic, Show, Eq)
331 deriving ToJSON via WithErrorMessage ErrInspectAddress
332
333 instance Exception ErrInspectAddress where
334 displayException = prettyErrInspectAddress
335
336 -- | Pretty-print an 'ErrInspectAddress'
337 --
338 -- @since 3.0.0
339 prettyErrInspectAddress :: ErrInspectAddress -> String
340 prettyErrInspectAddress = \case
341 MissingExpectedDerivationPath ->
342 "Missing expected derivation path"
343 DeserialiseError e ->
344 displayException e
345 FailedToDecryptPath ->
346 "Failed to decrypt derivation path"
347
348 -- Determines whether an 'Address' is a Byron address.
349 --
350 -- Returns a JSON object with information about the address, or throws
351 -- 'ErrInspectAddress' if the address isn't a byron address.
352 --
353 -- @since 2.0.0
354 inspectByronAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value
355 inspectByronAddress = inspectAddress
356 {-# DEPRECATED inspectByronAddress "use qualified 'inspectAddress' instead." #-}
357
358 -- | Determines whether an 'Address' is a Byron address.
359 --
360 -- Returns a JSON object with information about the address, or throws
361 -- 'ErrInspectAddress' if the address isn't a byron address.
362 --
363 -- @since 3.0.0
364 inspectAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value
365 inspectAddress mRootPub addr = either throwM (pure . toJSON) $
366 eitherInspectAddress mRootPub addr
367
368 -- | Determines whether an 'Address' is a Byron address.
369 --
370 -- Returns either details about the 'Address', or 'ErrInspectAddress' if it's
371 -- not a valid address.
372 --
373 -- @since 3.4.0
374 eitherInspectAddress :: Maybe XPub -> Address -> Either ErrInspectAddress AddressInfo
375 eitherInspectAddress mRootPub addr = do
376 payload <- first DeserialiseError $
377 CBOR.deserialiseCbor CBOR.decodeAddressPayload bytes
378
379 (root, attrs) <- first DeserialiseError $
380 CBOR.deserialiseCbor decodePayload payload
381
382 path <- do
383 attr <- maybe (Left MissingExpectedDerivationPath) Right $
384 find ((== 1) . fst) attrs
385 case mRootPub of
386 Nothing -> Right $ EncryptedDerivationPath $ snd attr
387 Just rootPub -> decryptPath attr rootPub
388
389 ntwrk <- bimap DeserialiseError (fmap NetworkTag) $
390 CBOR.deserialiseCbor CBOR.decodeProtocolMagicAttr payload
391
392 pure AddressInfo
393 { infoAddressRoot = root
394 , infoPayload = path
395 , infoNetworkTag = ntwrk
396 }
397 where
398 bytes :: ByteString
399 bytes = unAddress addr
400
401 decodePayload :: forall s. CBOR.Decoder s (ByteString, [(Word8, ByteString)])
402 decodePayload = do
403 _ <- CBOR.decodeListLenCanonicalOf 3
404 root <- CBOR.decodeBytes
405 (root,) <$> CBOR.decodeAllAttributes
406
407 decryptPath :: (Word8, ByteString) -> XPub -> Either ErrInspectAddress PayloadInfo
408 decryptPath attr rootPub = do
409 let pwd = hdPassphrase rootPub
410 path <- first (const FailedToDecryptPath) $
411 CBOR.deserialiseCbor (CBOR.decodeDerivationPathAttr pwd [attr]) mempty
412 case path of
413 Nothing -> Left FailedToDecryptPath
414 Just (accountIndex, addressIndex) -> Right PayloadDerivationPath{..}
415
416 -- | The result of 'eitherInspectAddress' for Byron addresses.
417 --
418 -- @since 3.4.0
419 data AddressInfo = AddressInfo
420 { infoAddressRoot :: !ByteString
421 , infoPayload :: !PayloadInfo
422 , infoNetworkTag :: !(Maybe NetworkTag)
423 } deriving (Generic, Show, Eq)
424
425 -- | The derivation path in a Byron address payload.
426 --
427 -- @since 3.4.0
428 data PayloadInfo
429 = PayloadDerivationPath
430 { accountIndex :: !Word32
431 , addressIndex :: !Word32
432 }
433 | EncryptedDerivationPath
434 { encryptedDerivationPath :: !ByteString
435 }
436 deriving (Generic, Show, Eq)
437
438 instance ToJSON AddressInfo where
439 toJSON AddressInfo{..} = Json.object
440 [ "address_root" .= T.decodeUtf8 (encode EBase16 infoAddressRoot)
441 , "derivation_path" .= infoPayload
442 , "network_tag" .= maybe Json.Null toJSON infoNetworkTag
443 , "address_type" .= toJSON @Word8 8
444 ]
445
446 instance ToJSON PayloadInfo where
447 toJSON PayloadDerivationPath{..} = Json.object
448 [ "account_index" .= prettyIndex accountIndex
449 , "address_index" .= prettyIndex addressIndex
450 ]
451 where
452 prettyIndex :: Word32 -> String
453 prettyIndex ix
454 | ix >= firstHardened = show (ix - firstHardened) <> "H"
455 | otherwise = show ix
456 where
457 firstHardened = 0x80000000
458 toJSON EncryptedDerivationPath{..} = Json.String $
459 T.decodeUtf8 $ encode EBase16 encryptedDerivationPath
460
461 instance Internal.PaymentAddress Byron where
462 paymentAddress discrimination k = unsafeMkAddress
463 $ CBOR.toStrictByteString
464 $ CBOR.encodeAddress (getKey k) attrs
465 where
466 (acctIx, addrIx) = bimap indexToWord32 indexToWord32 $ derivationPath k
467 pwd = payloadPassphrase k
468 NetworkTag magic = networkTag @Byron discrimination
469 attrs = case addressDiscrimination @Byron discrimination of
470 RequiresNetworkTag ->
471 [ CBOR.encodeDerivationPathAttr pwd acctIx addrIx
472 , CBOR.encodeProtocolMagicAttr magic
473 ]
474 RequiresNoTag ->
475 [ CBOR.encodeDerivationPathAttr pwd acctIx addrIx
476 ]
477
478 -- Re-export from 'Cardano.Address' to have it documented specialized in Haddock.
479 --
480 -- | Convert a public key to a payment 'Address' valid for the given
481 -- network discrimination.
482 --
483 -- @since 1.0.0
484 paymentAddress
485 :: NetworkDiscriminant Byron
486 -> Byron 'PaymentK XPub
487 -> Address
488 paymentAddress =
489 Internal.paymentAddress
490
491 --
492 -- Network Discrimination
493 --
494
495 instance HasNetworkDiscriminant Byron where
496 type NetworkDiscriminant Byron = (AddressDiscrimination, NetworkTag)
497 addressDiscrimination = fst
498 networkTag = snd
499
500 -- | 'NetworkDiscriminant' for Cardano MainNet & Byron
501 --
502 -- @since 2.0.0
503 byronMainnet :: NetworkDiscriminant Byron
504 byronMainnet = (RequiresNoTag, NetworkTag 764824073)
505
506 -- | 'NetworkDiscriminant' for Cardano Staging & Byron
507 --
508 -- @since 2.0.0
509 byronStaging :: NetworkDiscriminant Byron
510 byronStaging = (RequiresNetworkTag, NetworkTag 633343913)
511
512 -- | 'NetworkDiscriminant' for Cardano Testnet & Byron
513 --
514 -- @since 2.0.0
515 byronTestnet :: NetworkDiscriminant Byron
516 byronTestnet = (RequiresNetworkTag, NetworkTag 1097911063)
517
518 -- | 'NetworkDiscriminant' for Cardano Preview & Byron
519 --
520 -- @since 3.13.0
521 byronPreview :: NetworkDiscriminant Byron
522 byronPreview = (RequiresNetworkTag, NetworkTag 2)
523
524 -- | 'NetworkDiscriminant' for Cardano Preprod & Byron
525 --
526 -- @since 3.13.0
527 byronPreprod :: NetworkDiscriminant Byron
528 byronPreprod = (RequiresNetworkTag, NetworkTag 1)
529
530 --
531 -- Unsafe
532 --
533
534 -- | Backdoor for generating a new key from a raw 'XPrv'.
535 --
536 -- Note that the @depth@ is left open so that the caller gets to decide what type
537 -- of key this is. This is mostly for testing, in practice, seeds are used to
538 -- represent root keys, and one should 'genMasterKeyFromXPrv'
539 --
540 -- The first argument is a type-family 'DerivationPath' and its type depends on
541 -- the 'depth' of the key.
542 --
543 -- __examples:__
544 --
545 -- >>> liftXPrv rootPrv () prv
546 -- _ :: Byron RootK XPrv
547 --
548 -- >>> liftXPrv rootPrv minBound prv
549 -- _ :: Byron AccountK XPrv
550 --
551 -- >>> liftXPrv rootPrv (minBound, minBound) prv
552 -- _ :: Byron PaymentK XPrv
553 --
554 -- @since 2.0.0
555 liftXPrv
556 :: XPub -- ^ A root public key
557 -> DerivationPath depth
558 -> XPrv
559 -> Byron depth XPrv
560 liftXPrv rootPub derivationPath getKey = Byron
561 { getKey
562 , derivationPath
563 , payloadPassphrase = hdPassphrase rootPub
564 }
565 {-# DEPRECATED liftXPrv "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
566
567 -- | Backdoor for generating a new key from a raw 'XPub'.
568 --
569 -- Note that the @depth@ is left open so that the caller gets to decide what type
570 -- of key this is. This is mostly for testing, in practice, seeds are used to
571 -- represent root keys, and one should 'genMasterKeyFromXPrv'
572 --
573 -- see also 'liftXPrv'
574 --
575 -- @since 2.0.0
576 liftXPub
577 :: XPub -- ^ A root public key
578 -> DerivationPath depth
579 -> XPub
580 -> Byron depth XPub
581 liftXPub rootPub derivationPath getKey = Byron
582 { getKey
583 , derivationPath
584 , payloadPassphrase = hdPassphrase rootPub
585 }
586 {-# DEPRECATED liftXPub "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
587
588 --
589 -- Internal
590 --
591
592 -- The amount of entropy carried by a BIP-39 12-word mnemonic is 16 bytes.
593 minSeedLengthBytes :: Int
594 minSeedLengthBytes = 16
595
596 -- Hash the seed entropy (generated from mnemonic) used to initiate a HD
597 -- wallet. This increases the key length to 34 bytes, selectKey is greater than the
598 -- minimum for 'generate' (32 bytes).
599 --
600 -- Note that our current implementation deviates from BIP-39 because we use a
601 -- hash function (Blake2b) rather than key stretching with PBKDF2.
602 --
603 -- There are two methods of hashing the seed entropy, for different use cases.
604 --
605 -- 1. Normal random derivation wallet seeds. The seed entropy is hashed using
606 -- Blake2b_256, inside a double CBOR serialization sandwich.
607 --
608 -- 2. Seeds for redeeming paper wallets. The seed entropy is hashed using
609 -- Blake2b_256, without any serialization.
610 hashSeed :: ScrubbedBytes -> ScrubbedBytes
611 hashSeed = serialize . blake2b256 . serialize
612 where
613 serialize = BA.convert . cbor . BA.convert
614 cbor = CBOR.toStrictByteString . CBOR.encodeBytes
615
616 -- Hash a byte string through blake2b 256
617 blake2b256 :: ScrubbedBytes -> ScrubbedBytes
618 blake2b256 = BA.convert . hash @ScrubbedBytes @Blake2b_256
619
620 -- Derive a symmetric key for encrypting and authenticating the address
621 -- derivation path. PBKDF2 encryption using HMAC with the hash algorithm SHA512
622 -- is employed.
623 hdPassphrase :: XPub -> ScrubbedBytes
624 hdPassphrase masterKey =
625 PBKDF2.generate
626 (PBKDF2.prfHMAC SHA512)
627 (PBKDF2.Parameters 500 32)
628 (xpubToBytes masterKey)
629 ("address-hashing" :: ByteString)