never executed always true always false
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE BinaryLiterals #-}
3 {-# LANGUAGE DataKinds #-}
4 {-# LANGUAGE DeriveFunctor #-}
5 {-# LANGUAGE DeriveGeneric #-}
6 {-# LANGUAGE DerivingVia #-}
7 {-# LANGUAGE DuplicateRecordFields #-}
8 {-# LANGUAGE FlexibleContexts #-}
9 {-# LANGUAGE GADTs #-}
10 {-# LANGUAGE LambdaCase #-}
11 {-# LANGUAGE OverloadedStrings #-}
12 {-# LANGUAGE RecordWildCards #-}
13 {-# LANGUAGE StandaloneDeriving #-}
14 {-# LANGUAGE TypeApplications #-}
15 {-# LANGUAGE TypeFamilies #-}
16 {-# LANGUAGE ViewPatterns #-}
17
18 {-# OPTIONS_HADDOCK prune #-}
19
20 -- |
21 -- Copyright: © 2018-2021 IOHK
22 -- License: Apache-2.0
23
24 module Cardano.Address.Style.Shelley
25 ( -- $overview
26
27 -- * Shelley
28 Shelley
29 , getKey
30 , Role (..)
31 , roleFromIndex
32 , roleToIndex
33 , Credential (..)
34 , CredentialType (..)
35
36 -- * Key Derivation
37 -- $keyDerivation
38 , genMasterKeyFromXPrv
39 , genMasterKeyFromMnemonic
40 , deriveAccountPrivateKey
41 , deriveAddressPrivateKey
42 , deriveDelegationPrivateKey
43 , deriveAddressPublicKey
44 , derivePolicyPrivateKey
45
46 -- * Addresses
47 -- $addresses
48 , InspectAddress (..)
49 , AddressInfo (..)
50 , ReferenceInfo (..)
51 , eitherInspectAddress
52 , inspectAddress
53 , inspectShelleyAddress
54 , paymentAddress
55 , delegationAddress
56 , pointerAddress
57 , stakeAddress
58 , extendAddress
59 , ErrExtendAddress (..)
60 , ErrInspectAddressOnlyShelley (..)
61 , ErrInspectAddress (..)
62 , prettyErrInspectAddressOnlyShelley
63 , prettyErrInspectAddress
64
65 -- * Network Discrimination
66 , MkNetworkDiscriminantError (..)
67 , mkNetworkDiscriminant
68 , inspectNetworkDiscriminant
69 , shelleyMainnet
70 , shelleyTestnet
71
72 -- * Unsafe
73 , liftXPrv
74 , liftXPub
75 , liftPub
76 , unsafeFromRight
77
78 -- Internals
79 , minSeedLengthBytes
80 , genMasterKeyFromMnemonicShelley
81 , deriveAccountPrivateKeyShelley
82 , deriveAddressPrivateKeyShelley
83 , deriveAddressPublicKeyShelley
84 ) where
85
86 import Prelude
87
88 import Cardano.Address
89 ( Address (..)
90 , AddressDiscrimination (..)
91 , ChainPointer (..)
92 , NetworkDiscriminant (..)
93 , NetworkTag (..)
94 , invariantNetworkTag
95 , invariantSize
96 , unsafeMkAddress
97 )
98 import Cardano.Address.Derivation
99 ( Depth (..)
100 , DerivationScheme (..)
101 , DerivationType (..)
102 , Index (..)
103 , Pub
104 , XPrv
105 , XPub
106 , credentialHashSize
107 , deriveXPrv
108 , deriveXPub
109 , generateNew
110 , hashCredential
111 , indexFromWord32
112 , pubToBytes
113 , unsafeMkIndex
114 , xpubPublicKey
115 )
116 import Cardano.Address.Internal
117 ( WithErrorMessage (..), orElse )
118 import Cardano.Address.Script
119 ( KeyHash (..), KeyRole (..), Script, ScriptHash (..), toScriptHash )
120 import Cardano.Mnemonic
121 ( SomeMnemonic, someMnemonicToBytes )
122 import Codec.Binary.Encoding
123 ( AbstractEncoding (..), encode )
124 import Control.Applicative
125 ( Alternative )
126 import Control.DeepSeq
127 ( NFData )
128 import Control.Exception
129 ( Exception, displayException )
130 import Control.Exception.Base
131 ( assert )
132 import Control.Monad
133 ( unless, when )
134 import Control.Monad.Catch
135 ( MonadThrow, throwM )
136 import Data.Aeson
137 ( ToJSON (..), (.=) )
138 import Data.Bifunctor
139 ( bimap, first )
140 import Data.Binary.Get
141 ( runGetOrFail )
142 import Data.Binary.Put
143 ( putByteString, putWord8, runPut )
144 import Data.Bits
145 ( shiftR, (.&.) )
146 import Data.ByteArray
147 ( ScrubbedBytes )
148 import Data.ByteString
149 ( ByteString )
150 import Data.Maybe
151 ( fromMaybe, isNothing )
152 import Data.Typeable
153 ( Typeable )
154 import Data.Word
155 ( Word32, Word8 )
156 import Data.Word7
157 ( getVariableLengthNat, putVariableLengthNat )
158 import Fmt
159 ( Buildable, build, format, (+|), (|+) )
160 import GHC.Generics
161 ( Generic )
162
163 import qualified Cardano.Address.Derivation as Internal
164 import qualified Cardano.Address.Style.Byron as Byron
165 import qualified Cardano.Address.Style.Icarus as Icarus
166 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
167 import qualified Data.Aeson as Json
168 import qualified Data.ByteArray as BA
169 import qualified Data.ByteString as BS
170 import qualified Data.ByteString.Lazy as BL
171 import qualified Data.Text as T
172 import qualified Data.Text.Encoding as T
173
174 -- $overview
175 --
176 -- This module provides an implementation of:
177 --
178 -- - 'Cardano.Address.Derivation.GenMasterKey': for generating Shelley master keys from mnemonic sentences
179 -- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical hard derivation of parent to child keys
180 -- - 'Cardano.Address.Derivation.SoftDerivation': for hierarchical soft derivation of parent to child keys
181 --
182 -- - 'paymentAddress': for constructing payment addresses from a address public key or a script
183 -- - 'delegationAddress': for constructing delegation addresses from payment credential (public key or script) and stake credential (public key or script)
184 -- - 'pointerAddress': for constructing delegation addresses from payment credential (public key or script) and chain pointer
185 -- - 'stakeAddress': for constructing reward accounts from stake credential (public key or script)
186
187 -- | A cryptographic key for sequential-scheme address derivation, with
188 -- phantom-types to disambiguate key types.
189 --
190 -- @
191 -- let rootPrivateKey = Shelley 'RootK XPrv
192 -- let accountPubKey = Shelley 'AccountK XPub
193 -- let addressPubKey = Shelley 'PaymentK XPub
194 -- @
195 --
196 -- @since 2.0.0
197 newtype Shelley (depth :: Depth) key = Shelley
198 { getKey :: key
199 -- ^ Extract the raw 'XPrv' or 'XPub' wrapped by this type.
200 --
201 -- @since 1.0.0
202 }
203 deriving stock (Generic, Show, Eq)
204
205 deriving instance (Functor (Shelley depth))
206 instance (NFData key) => NFData (Shelley depth key)
207
208 -- | Describe what the keys within an account are used for.
209 --
210 -- - UTxOExternal: used for public addresses sent to other parties for receiving money.
211 -- - UTxOInternal: generated by wallet software to send change back to the wallet.
212 -- - Stake: used for stake key(s) and delegation.
213 --
214 -- @since 3.0.0
215 data Role
216 = UTxOExternal
217 | UTxOInternal
218 | Stake
219 deriving (Generic, Typeable, Show, Eq, Ord, Bounded)
220
221 instance NFData Role
222
223 roleFromIndex :: Index 'Soft depth -> Maybe Role
224 roleFromIndex ix = case indexToWord32 ix of
225 0 -> Just UTxOExternal
226 1 -> Just UTxOInternal
227 2 -> Just Stake
228 _ -> Nothing
229
230 roleToIndex :: Role -> Index 'Soft depth
231 roleToIndex = unsafeMkIndex . \case
232 UTxOExternal -> 0
233 UTxOInternal -> 1
234 Stake -> 2
235
236 --
237 -- Key Derivation
238 --
239 -- $keyDerivation
240 --
241 -- === Generating a root key from 'SomeMnemonic'
242 -- > :set -XOverloadedStrings
243 -- > :set -XTypeApplications
244 -- > :set -XDataKinds
245 -- > import Cardano.Mnemonic ( mkSomeMnemonic )
246 -- >
247 -- > let (Right mw) = mkSomeMnemonic @'[15] ["network","empty","cause","mean","expire","private","finger","accident","session","problem","absurd","banner","stage","void","what"]
248 -- > let sndFactor = mempty -- Or alternatively, a second factor mnemonic transformed to bytes via someMnemonicToBytes
249 -- > let rootK = genMasterKeyFromMnemonic mw sndFactor :: Shelley 'RootK XPrv
250 --
251 -- === Deriving child keys
252 --
253 -- Let's consider the following 3rd, 4th and 5th derivation paths @0'\/0\/14@
254 --
255 -- > let Just accIx = indexFromWord32 0x80000000
256 -- > let acctK = deriveAccountPrivateKey rootK accIx
257 -- >
258 -- > let Just addIx = indexFromWord32 0x00000014
259 -- > let addrK = deriveAddressPrivateKey acctK UTxOExternal addIx
260 --
261 -- > let stakeK = deriveDelegationPrivateKey acctK
262
263 instance Internal.GenMasterKey Shelley where
264 type SecondFactor Shelley = ScrubbedBytes
265
266 genMasterKeyFromXPrv = liftXPrv
267 genMasterKeyFromMnemonic fstFactor sndFactor =
268 Shelley $ genMasterKeyFromMnemonicShelley fstFactor sndFactor
269
270 instance Internal.HardDerivation Shelley where
271 type AccountIndexDerivationType Shelley = 'Hardened
272 type AddressIndexDerivationType Shelley = 'Soft
273 type WithRole Shelley = Role
274
275 deriveAccountPrivateKey (Shelley rootXPrv) accIx =
276 Shelley $ deriveAccountPrivateKeyShelley rootXPrv accIx purposeIndex
277
278 deriveAddressPrivateKey (Shelley accXPrv) role addrIx =
279 Shelley $ deriveAddressPrivateKeyShelley accXPrv role addrIx
280
281 instance Internal.SoftDerivation Shelley where
282 deriveAddressPublicKey (Shelley accXPub) role addrIx =
283 Shelley $ deriveAddressPublicKeyShelley accXPub role addrIx
284
285 -- | Generate a root key from a corresponding mnemonic.
286 --
287 -- @since 2.0.0
288 genMasterKeyFromMnemonic
289 :: SomeMnemonic
290 -- ^ Some valid mnemonic sentence.
291 -> ScrubbedBytes
292 -- ^ An optional second-factor passphrase (or 'mempty')
293 -> Shelley 'RootK XPrv
294 genMasterKeyFromMnemonic =
295 Internal.genMasterKeyFromMnemonic
296
297 -- | Generate a root key from a corresponding root 'XPrv'
298 --
299 -- @since 2.0.0
300 genMasterKeyFromXPrv
301 :: XPrv -> Shelley 'RootK XPrv
302 genMasterKeyFromXPrv =
303 Internal.genMasterKeyFromXPrv
304
305 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
306 --
307 -- | Derives an account private key from the given root private key.
308 --
309 -- @since 2.0.0
310 deriveAccountPrivateKey
311 :: Shelley 'RootK XPrv
312 -> Index 'Hardened 'AccountK
313 -> Shelley 'AccountK XPrv
314 deriveAccountPrivateKey =
315 Internal.deriveAccountPrivateKey
316
317 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
318 --
319 -- | Derives a policy private key from the given root private key.
320 --
321 -- @since 3.9.0
322 derivePolicyPrivateKey
323 :: Shelley 'RootK XPrv
324 -> Index 'Hardened 'PolicyK
325 -> Shelley 'PolicyK XPrv
326 derivePolicyPrivateKey (Shelley rootXPrv) policyIx =
327 Shelley $ deriveAccountPrivateKeyShelley rootXPrv policyIx policyPurposeIndex
328
329 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
330 --
331 -- | Derives an address private key from the given account private key.
332 --
333 -- @since 2.0.0
334 deriveAddressPrivateKey
335 :: Shelley 'AccountK XPrv
336 -> Role
337 -> Index 'Soft 'PaymentK
338 -> Shelley 'PaymentK XPrv
339 deriveAddressPrivateKey =
340 Internal.deriveAddressPrivateKey
341
342 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
343 --
344 -- | Derives an address public key from the given account public key.
345 --
346 -- @since 2.0.0
347 deriveAddressPublicKey
348 :: Shelley 'AccountK XPub
349 -> Role
350 -> Index 'Soft 'PaymentK
351 -> Shelley 'PaymentK XPub
352 deriveAddressPublicKey =
353 Internal.deriveAddressPublicKey
354
355 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
356 --
357 -- | Derive a delegation key for a corresponding 'AccountK'. Note that wallet
358 -- software are by convention only using one delegation key per account, and always
359 -- the first account (with index 0').
360 --
361 -- Deriving delegation keys for something else than the initial account is not
362 -- recommended and can lead to incompatibility with existing wallet softwares
363 -- (Daedalus, Yoroi, Adalite...).
364 --
365 -- @since 2.0.0
366 deriveDelegationPrivateKey
367 :: Shelley 'AccountK XPrv
368 -> Shelley 'DelegationK XPrv
369 deriveDelegationPrivateKey accXPrv =
370 let (Shelley stakeXPrv) =
371 deriveAddressPrivateKey accXPrv Stake (minBound @(Index 'Soft _))
372 in Shelley stakeXPrv
373
374 --
375 -- Addresses
376 --
377 -- $addresses
378 -- === Generating a 'PaymentAddress' from public key credential
379 --
380 -- > import Cardano.Address ( bech32 )
381 -- > import Cardano.Address.Derivation ( toXPub )
382 -- >
383 -- > let (Right tag) = mkNetworkDiscriminant 1
384 -- > let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK)
385 -- > bech32 $ paymentAddress tag paymentCredential
386 -- > "addr1vxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdncxsce5t"
387 --
388 -- === Generating a 'PaymentAddress' from script credential
389 --
390 -- > import Cardano.Address.Script.Parser ( scriptFromString )
391 -- > import Cardano.Address.Script ( toScriptHash )
392 -- > import Codec.Binary.Encoding ( encode )
393 -- > import Data.Text.Encoding ( decodeUtf8 )
394 -- >
395 -- > let (Right tag) = mkNetworkDiscriminant 1
396 -- > let verKey1 = "script_vkh18srsxr3khll7vl3w9mqfu55n6wzxxlxj7qzr2mhnyreluzt36ms"
397 -- > let verKey2 = "script_vkh18srsxr3khll7vl3w9mqfu55n6wzxxlxj7qzr2mhnyrenxv223vj"
398 -- > let scriptStr = "all [" ++ verKey1 ++ ", " ++ verKey2 ++ "]"
399 -- > let (Right script) = scriptFromString scriptStr
400 -- > let infoScriptHash@(ScriptHash bytes) = toScriptHash script
401 -- > decodeUtf8 (encode EBase16 bytes)
402 -- > "a015ae61075e25c3d9250bdcbc35c6557272127927ecf2a2d716e29f"
403 -- > bech32 $ paymentAddress tag (PaymentFromScriptHash infoScriptHash)
404 -- > "addr1wxspttnpqa0zts7ey59ae0p4ce2hyusj0yn7eu4z6utw98c9uxm83"
405 --
406 -- === Generating a 'DelegationAddress'
407 --
408 -- > let (Right tag) = mkNetworkDiscriminant 1
409 -- > let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK)
410 -- > let delegationCredential = DelegationFromExtendedKey $ (toXPub <$> stakeK)
411 -- > bech32 $ delegationAddress tag paymentCredential delegationCredential
412 -- > "addr1qxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdn7nudck0fzve4346yytz3wpwv9yhlxt7jwuc7ytwx2vfkyqmkc5xa"
413 --
414 -- === Generating a 'PointerAddress'
415 --
416 -- > import Cardano.Address ( ChainPointer (..) )
417 -- >
418 -- > let (Right tag) = mkNetworkDiscriminant 1
419 -- > let ptr = ChainPointer 123 1 2
420 -- > let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK)
421 -- > bech32 $ pointerAddress tag paymentCredential ptr
422 -- > "addr1gxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdnmmqypqfcp5um"
423 --
424 -- === Generating a 'DelegationAddress' from using the same script credential in both payment and delegation
425 -- > bech32 $ delegationAddress tag (PaymentFromScriptHash infoScriptHash) (DelegationFromScript infoScriptHash)
426 -- > "addr1xxspttnpqa0zts7ey59ae0p4ce2hyusj0yn7eu4z6utw98aqzkhxzp67yhpajfgtmj7rt3j4wfepy7f8ane294cku20swucnrl"
427
428 -- | Possible errors from inspecting a Shelley, Icarus, or Byron address.
429 --
430 -- @since 3.4.0
431 data ErrInspectAddress
432 = WrongInputSize Int -- ^ Unexpected size
433 | ErrShelley ErrInspectAddressOnlyShelley
434 | ErrIcarus Icarus.ErrInspectAddress
435 | ErrByron Byron.ErrInspectAddress
436 deriving (Generic, Show, Eq)
437 deriving ToJSON via WithErrorMessage ErrInspectAddress
438
439 instance Exception ErrInspectAddress where
440 displayException = prettyErrInspectAddress
441
442 -- | Possible errors from inspecting a Shelley address
443 --
444 -- @since 3.4.0
445 data ErrInspectAddressOnlyShelley
446 = PtrRetrieveError String -- ^ Human readable error of underlying operation
447 | UnknownType Word8 -- ^ Unknown value in address type field
448 deriving (Generic, Eq, Show)
449 deriving ToJSON via WithErrorMessage ErrInspectAddressOnlyShelley
450
451 instance Exception ErrInspectAddressOnlyShelley where
452 displayException = prettyErrInspectAddressOnlyShelley
453
454 -- | Pretty-print an 'ErrInspectAddressOnlyShelley'
455 --
456 -- @since 3.4.0
457 prettyErrInspectAddressOnlyShelley :: ErrInspectAddressOnlyShelley -> String
458 prettyErrInspectAddressOnlyShelley = \case
459 PtrRetrieveError s ->
460 format "Failed to retrieve pointer (underlying errors was: {})" s
461 UnknownType t ->
462 format "Unknown address type {}" t
463
464 -- | Pretty-print an 'ErrInspectAddress'
465 --
466 -- @since 3.0.0
467 prettyErrInspectAddress :: ErrInspectAddress -> String
468 prettyErrInspectAddress = \case
469 WrongInputSize i -> format "Wrong input size of {}" i
470 ErrShelley e -> "Invalid Shelley address: "
471 <> prettyErrInspectAddressOnlyShelley e
472 ErrIcarus e -> "Invalid Icarus address: "
473 <> Icarus.prettyErrInspectAddress e
474 ErrByron e -> "Invalid Byron address: "
475 <> Byron.prettyErrInspectAddress e
476
477 -- Determines whether an 'Address' a Shelley address.
478 --
479 -- Throws 'AddrError' if it's not a valid Shelley address, or a ready-to-print
480 -- string giving details about the 'Address'.
481 --
482 -- @since 2.0.0
483 inspectShelleyAddress
484 :: (Alternative m, MonadThrow m)
485 => Maybe XPub
486 -> Address
487 -> m Json.Value
488 inspectShelleyAddress = inspectAddress
489 {-# DEPRECATED inspectShelleyAddress "use qualified 'inspectAddress' instead." #-}
490
491 -- | Analyze an 'Address' to know whether it's a valid address for the Cardano
492 -- Shelley era. Shelley format addresses, as well as old-style Byron and Icarus
493 -- addresses can be parsed by this function.
494 --
495 -- Returns a JSON value containing details about the 'Address', or throws
496 -- 'ErrInspectAddress' if it's not a valid address.
497 --
498 -- @since 3.0.0
499 inspectAddress
500 :: (Alternative m, MonadThrow m)
501 => Maybe XPub
502 -> Address
503 -> m Json.Value
504 inspectAddress mRootPub addr = either throwM (pure . toJSON) $
505 eitherInspectAddress mRootPub addr
506
507 -- | Determines whether an 'Address' is a valid address for the Cardano Shelley
508 -- era. Shelley format addresses, as well as old-style Byron and Icarus
509 -- addresses can be parsed by this function.
510 --
511 -- Returns either details about the 'Address', or 'ErrInspectAddress' if it's
512 -- not a valid address.
513 --
514 -- @since 3.4.0
515 eitherInspectAddress
516 :: Maybe XPub
517 -> Address
518 -> Either ErrInspectAddress InspectAddress
519 eitherInspectAddress mRootPub addr = unpackAddress addr >>= parseInfo
520 where
521 parseInfo :: AddressParts -> Either ErrInspectAddress InspectAddress
522 parseInfo parts = case addrType parts of
523 -- 1000: byron address
524 0b10000000 ->
525 (bimap ErrIcarus InspectAddressIcarus (Icarus.eitherInspectAddress addr))
526 `orElse`
527 (bimap ErrByron InspectAddressByron (Byron.eitherInspectAddress mRootPub addr))
528 -- Anything else: shelley address
529 _ -> bimap ErrShelley InspectAddressShelley (parseAddressInfoShelley parts)
530
531 -- | Returns either details about the 'Address', or
532 -- 'ErrInspectAddressOnlyShelley' if it's not a valid Shelley address.
533 parseAddressInfoShelley :: AddressParts -> Either ErrInspectAddressOnlyShelley AddressInfo
534 parseAddressInfoShelley AddressParts{..} = case addrType of
535 -- 0000: base address: keyhash28,keyhash28
536 0b00000000 | addrRestLength == credentialHashSize + credentialHashSize ->
537 Right addressInfo
538 { infoStakeReference = Just ByValue
539 , infoSpendingKeyHash = Just addrHash1
540 , infoStakeKeyHash = Just addrHash2
541 }
542 -- 0001: base address: scripthash28,keyhash28
543 0b00010000 | addrRestLength == credentialHashSize + credentialHashSize ->
544 Right addressInfo
545 { infoStakeReference = Just ByValue
546 , infoScriptHash = Just addrHash1
547 , infoStakeKeyHash = Just addrHash2
548 }
549 -- 0010: base address: keyhash28,scripthash28
550 0b00100000 | addrRestLength == credentialHashSize + credentialHashSize ->
551 Right addressInfo
552 { infoStakeReference = Just ByValue
553 , infoSpendingKeyHash = Just addrHash1
554 , infoStakeScriptHash = Just addrHash2
555 }
556 -- 0011: base address: scripthash28,scripthash28
557 0b00110000 | addrRestLength == 2 * credentialHashSize ->
558 Right addressInfo
559 { infoStakeReference = Just ByValue
560 , infoScriptHash = Just addrHash1
561 , infoStakeScriptHash = Just addrHash2
562 }
563 -- 0100: pointer address: keyhash28, 3 variable length uint
564 0b01000000 | addrRestLength > credentialHashSize -> do
565 ptr <- getPtr addrHash2
566 pure addressInfo
567 { infoStakeReference = Just $ ByPointer ptr
568 , infoSpendingKeyHash = Just addrHash1
569 }
570 -- 0101: pointer address: scripthash28, 3 variable length uint
571 0b01010000 | addrRestLength > credentialHashSize -> do
572 ptr <- getPtr addrHash2
573 pure addressInfo
574 { infoStakeReference = Just $ ByPointer ptr
575 , infoScriptHash = Just addrHash1
576 }
577 -- 0110: enterprise address: keyhash28
578 0b01100000 | addrRestLength == credentialHashSize ->
579 Right addressInfo
580 { infoStakeReference = Nothing
581 , infoSpendingKeyHash = Just addrHash1
582 }
583 -- 0111: enterprise address: scripthash28
584 0b01110000 | addrRestLength == credentialHashSize ->
585 Right addressInfo
586 { infoStakeReference = Nothing
587 , infoScriptHash = Just addrHash1
588 }
589 -- 1110: reward account: keyhash28
590 0b11100000 | addrRestLength == credentialHashSize ->
591 Right addressInfo
592 { infoStakeReference = Just ByValue
593 , infoStakeKeyHash = Just addrHash1
594 }
595 -- 1111: reward account: scripthash28
596 0b11110000 | addrRestLength == credentialHashSize ->
597 Right addressInfo
598 { infoStakeReference = Just ByValue
599 , infoScriptHash = Just addrHash1
600 }
601 unknown -> Left (UnknownType unknown)
602
603 where
604 addressInfo = AddressInfo
605 { infoNetworkTag = NetworkTag $ fromIntegral addrNetwork
606 , infoStakeReference = Nothing
607 , infoSpendingKeyHash = Nothing
608 , infoStakeKeyHash = Nothing
609 , infoScriptHash = Nothing
610 , infoStakeScriptHash = Nothing
611 , infoAddressType = shiftR (addrType .&. 0b11110000) 4
612 }
613
614 getPtr :: ByteString -> Either ErrInspectAddressOnlyShelley ChainPointer
615 getPtr source = case runGetOrFail get (BL.fromStrict source) of
616 Right ("", _, a) -> Right a
617 Right _ -> err "Unconsumed bytes after pointer"
618 Left (_, _, e) -> err e
619 where
620 get = ChainPointer
621 <$> getVariableLengthNat
622 <*> getVariableLengthNat
623 <*> getVariableLengthNat
624 err = Left . PtrRetrieveError
625
626 -- | The result of 'eitherInspectAddress'.
627 --
628 -- @since 3.4.0
629 data InspectAddress
630 = InspectAddressShelley AddressInfo
631 | InspectAddressIcarus Icarus.AddressInfo
632 | InspectAddressByron Byron.AddressInfo
633 deriving (Generic, Show, Eq)
634
635 instance ToJSON InspectAddress where
636 toJSON addr = combine (styleProp <> missingProp) (toJSON addr')
637 where
638 addr' = case addr of
639 InspectAddressShelley s -> toJSON s
640 InspectAddressIcarus i -> toJSON i
641 InspectAddressByron b -> toJSON b
642
643 styleProp = "address_style" .= Json.String styleName
644 styleName = case addr of
645 InspectAddressShelley _ -> "Shelley"
646 InspectAddressIcarus _ -> "Icarus"
647 InspectAddressByron _ -> "Byron"
648 missingProp = case addr of
649 InspectAddressShelley _ -> mempty
650 InspectAddressIcarus _ -> noStakeRef
651 InspectAddressByron _ -> noStakeRef
652 noStakeRef = "stake_reference" .= Json.String "none"
653
654 combine extra = \case
655 Json.Object props -> Json.Object (extra <> props)
656 otherValue -> otherValue -- not expected to happen
657
658 -- | An inspected Shelley address.
659 --
660 -- @since 3.4.0
661 data AddressInfo = AddressInfo
662 { infoStakeReference :: !(Maybe ReferenceInfo)
663 , infoSpendingKeyHash :: !(Maybe ByteString)
664 , infoStakeKeyHash :: !(Maybe ByteString)
665 , infoScriptHash :: !(Maybe ByteString)
666 , infoStakeScriptHash :: !(Maybe ByteString)
667 , infoNetworkTag :: !NetworkTag
668 , infoAddressType :: !Word8
669 } deriving (Generic, Show, Eq)
670
671 -- | Info from 'Address' about how delegation keys are located.
672 --
673 -- @since 3.6.1
674 data ReferenceInfo
675 = ByValue
676 | ByPointer ChainPointer
677 deriving (Generic, Show, Eq)
678
679 instance ToJSON AddressInfo where
680 toJSON AddressInfo{..} = Json.object $
681 [ "network_tag" .= infoNetworkTag
682 , "stake_reference" .= Json.String (maybe "none" refName infoStakeReference)
683 , "address_type" .= toJSON @Word8 infoAddressType
684 ]
685 ++ maybe [] (\ptr -> ["pointer" .= ptr]) (infoStakeReference >>= getPointer)
686 ++ jsonHash "spending_key_hash" CIP5.addr_vkh infoSpendingKeyHash
687 ++ jsonHash "stake_key_hash" CIP5.stake_vkh infoStakeKeyHash
688 ++ jsonHash "spending_shared_hash" CIP5.addr_shared_vkh infoScriptHash
689 ++ jsonHash "stake_shared_hash" CIP5.stake_shared_vkh infoScriptHash
690 ++ jsonHash "stake_script_hash" CIP5.stake_vkh infoStakeScriptHash
691 where
692 getPointer ByValue = Nothing
693 getPointer (ByPointer ptr) = Just ptr
694
695 jsonHash _ _ Nothing = []
696 jsonHash key hrp (Just bs) =
697 [ key .= base16 bs , (key <> "_bech32") .= bech32With hrp bs ]
698
699 base16 = T.unpack . T.decodeUtf8 . encode EBase16
700 bech32With hrp = T.decodeUtf8 . encode (EBech32 hrp)
701
702 refName ByValue = "by value"
703 refName (ByPointer _) = "by pointer"
704
705 -- | Structure containing the result of 'unpackAddress', the constituent parts
706 -- of an address. Internal to this module.
707 data AddressParts = AddressParts
708 { addrType :: Word8
709 , addrNetwork :: Word8
710 , addrHash1 :: ByteString
711 , addrHash2 :: ByteString
712 , addrRestLength :: Int
713 } deriving (Show)
714
715 -- | Split fields out of a Shelley encoded address.
716 unpackAddress :: Address -> Either ErrInspectAddress AddressParts
717 unpackAddress (unAddress -> bytes)
718 | BS.length bytes >= 1 + credentialHashSize = Right AddressParts{..}
719 | otherwise = Left $ WrongInputSize $ BS.length bytes
720 where
721 (fstByte, rest) = first BS.head $ BS.splitAt 1 bytes
722 addrType = fstByte .&. 0b11110000
723 addrNetwork = fstByte .&. 0b00001111
724 (addrHash1, addrHash2) = BS.splitAt credentialHashSize rest
725 addrRestLength = BS.length rest
726
727 -- | Shelley offers several ways to identify ownership of entities on chain.
728 --
729 -- This data-family has two instances, depending on whether the key is used for
730 -- payment or for delegation.
731 --
732 -- @since 3.0.0
733 data family Credential (purpose :: Depth)
734
735 data instance Credential 'PaymentK where
736 PaymentFromKey :: Shelley 'PaymentK Pub -> Credential 'PaymentK
737 PaymentFromExtendedKey :: Shelley 'PaymentK XPub -> Credential 'PaymentK
738 PaymentFromKeyHash :: KeyHash -> Credential 'PaymentK
739 PaymentFromScript :: Script KeyHash -> Credential 'PaymentK
740 PaymentFromScriptHash :: ScriptHash -> Credential 'PaymentK
741 deriving Show
742
743 data instance Credential 'DelegationK where
744 DelegationFromKey :: Shelley 'DelegationK Pub -> Credential 'DelegationK
745 DelegationFromExtendedKey :: Shelley 'DelegationK XPub -> Credential 'DelegationK
746 DelegationFromKeyHash :: KeyHash -> Credential 'DelegationK
747 DelegationFromScript :: Script KeyHash -> Credential 'DelegationK
748 DelegationFromScriptHash :: ScriptHash -> Credential 'DelegationK
749 DelegationFromPointer :: ChainPointer -> Credential 'DelegationK
750 deriving Show
751
752 -- Re-export from 'Cardano.Address' to have it documented specialized in Haddock.
753 --
754 -- | Convert a payment credential (key or script) to a payment 'Address' valid
755 -- for the given network discrimination.
756 --
757 -- @since 2.0.0
758 paymentAddress
759 :: NetworkDiscriminant Shelley
760 -> Credential 'PaymentK
761 -> Address
762 paymentAddress discrimination = \case
763 PaymentFromKey keyPub ->
764 constructPayload
765 (EnterpriseAddress CredentialFromKey)
766 discrimination
767 (hashCredential . pubToBytes . getKey $ keyPub)
768 PaymentFromExtendedKey keyXPub ->
769 constructPayload
770 (EnterpriseAddress CredentialFromKey)
771 discrimination
772 (hashCredential . xpubPublicKey . getKey $ keyXPub)
773 PaymentFromKeyHash (KeyHash Payment verKeyHash) ->
774 constructPayload
775 (EnterpriseAddress CredentialFromKey)
776 discrimination
777 verKeyHash
778 PaymentFromKeyHash (KeyHash keyrole _) ->
779 error $ "Payment credential should be built from key hash having payment"
780 <> " role. Key hash with " <> show keyrole <> " was used."
781 PaymentFromScript script ->
782 let (ScriptHash bytes) = toScriptHash script
783 in constructPayload
784 (EnterpriseAddress CredentialFromScript)
785 discrimination
786 bytes
787 PaymentFromScriptHash (ScriptHash bytes) ->
788 constructPayload
789 (EnterpriseAddress CredentialFromScript)
790 discrimination
791 bytes
792
793 -- | Convert a payment credential (key or script) and a delegation credential (key or script)
794 -- to a delegation 'Address' valid for the given network discrimination.
795 -- Funds sent to this address will be delegated according to the delegation settings
796 -- attached to the delegation key.
797 --
798 -- @since 2.0.0
799 delegationAddress
800 :: NetworkDiscriminant Shelley
801 -> Credential 'PaymentK
802 -> Credential 'DelegationK
803 -> Address
804 delegationAddress discrimination paymentCredential stakeCredential =
805 unsafeFromRight $ extendAddress
806 (paymentAddress discrimination paymentCredential)
807 stakeCredential
808
809 -- | Convert a payment credential (key or script) and pointer to delegation certificate in blockchain to a
810 -- pointer 'Address' valid for the given network discrimination.
811 --
812 -- @since 3.0.0
813 pointerAddress
814 :: NetworkDiscriminant Shelley
815 -> Credential 'PaymentK
816 -> ChainPointer
817 -> Address
818 pointerAddress discrimination credential pointer =
819 unsafeFromRight $ extendAddress
820 (paymentAddress discrimination credential)
821 (DelegationFromPointer pointer)
822
823 -- | Convert a delegation credential (key or script) to a stake Address (aka reward account address)
824 -- for the given network discrimination.
825 --
826 -- @since 3.0.0
827 stakeAddress
828 :: NetworkDiscriminant Shelley
829 -> Credential 'DelegationK
830 -> Either ErrInvalidStakeAddress Address
831 stakeAddress discrimination = \case
832 DelegationFromKey keyPub ->
833 Right $ constructPayload
834 (RewardAccount CredentialFromKey)
835 discrimination
836 (hashCredential . pubToBytes . getKey $ keyPub)
837
838 DelegationFromExtendedKey keyXPub ->
839 Right $ constructPayload
840 (RewardAccount CredentialFromKey)
841 discrimination
842 (hashCredential . xpubPublicKey . getKey $ keyXPub)
843
844 DelegationFromKeyHash (KeyHash Delegation verKeyHash) ->
845 Right $ constructPayload
846 (RewardAccount CredentialFromKey)
847 discrimination
848 verKeyHash
849
850 DelegationFromKeyHash (KeyHash keyrole _) ->
851 Left $ ErrStakeAddressFromKeyHash keyrole
852
853 DelegationFromScript script ->
854 let (ScriptHash bytes) = toScriptHash script
855 in Right $ constructPayload
856 (RewardAccount CredentialFromScript)
857 discrimination
858 bytes
859
860 DelegationFromScriptHash (ScriptHash bytes) ->
861 Right $ constructPayload
862 (RewardAccount CredentialFromScript)
863 discrimination
864 bytes
865
866 DelegationFromPointer{} ->
867 Left ErrStakeAddressFromPointer
868
869 -- | Stake addresses can only be constructed from key or script hash. Trying to
870 -- create one from a pointer will result in the following error.
871 --
872 -- @since 3.0.0
873 data ErrInvalidStakeAddress
874 = ErrStakeAddressFromPointer
875 | ErrStakeAddressFromKeyHash KeyRole
876 deriving (Generic, Show, Eq)
877
878 -- | Extend an existing payment 'Address' to make it a delegation address.
879 --
880 -- @since 2.0.0
881 extendAddress
882 :: Address
883 -> Credential 'DelegationK
884 -> Either ErrExtendAddress Address
885 extendAddress addr infoStakeReference = do
886 when (isNothing (inspectAddress Nothing addr)) $
887 Left $ ErrInvalidAddressStyle "Given address isn't a Shelley address"
888
889 let bytes = unAddress addr
890 let (fstByte, rest) = first BS.head $ BS.splitAt 1 bytes
891
892 let paymentFirstByte = fstByte .&. 0b11110000
893 let extendableTypes = addressType <$>
894 [ EnterpriseAddress CredentialFromKey
895 , EnterpriseAddress CredentialFromScript
896 ]
897 unless (paymentFirstByte `elem` extendableTypes) $ do
898 Left $ ErrInvalidAddressType "Only payment addresses can be extended"
899
900 case infoStakeReference of
901 -- base address: keyhash28,keyhash28 : 00000000 -> 0
902 -- base address: scripthash28,keyhash28 : 00010000 -> 16
903 DelegationFromKey delegationKey -> do
904 pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
905 -- 0b01100000 .&. 0b00011111 = 0
906 -- 0b01110000 .&. 0b00011111 = 16
907 putWord8 $ fstByte .&. 0b00011111
908 putByteString rest
909 putByteString . hashCredential . pubToBytes . getKey $ delegationKey
910
911 -- base address: keyhash28,keyhash28 : 00000000 -> 0
912 -- base address: scripthash28,keyhash28 : 00010000 -> 16
913 DelegationFromExtendedKey delegationKey -> do
914 pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
915 -- 0b01100000 .&. 0b00011111 = 0
916 -- 0b01110000 .&. 0b00011111 = 16
917 putWord8 $ fstByte .&. 0b00011111
918 putByteString rest
919 putByteString . hashCredential . xpubPublicKey . getKey $ delegationKey
920 DelegationFromKeyHash (KeyHash Delegation keyhash) -> do
921 pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
922 -- 0b01100000 .&. 0b00011111 = 0
923 -- 0b01110000 .&. 0b00011111 = 16
924 putWord8 $ fstByte .&. 0b00011111
925 putByteString rest
926 putByteString keyhash
927 DelegationFromKeyHash (KeyHash keyrole _) -> do
928 Left $ ErrInvalidKeyHashType $
929 "Delegation part can only be constructed from delegation key hash. "
930 <> "Key hash of " <> show keyrole <> " was used."
931
932 -- base address: keyhash28,scripthash28 : 00100000 -> 32
933 -- base address: scripthash28,scripthash28 : 00110000 -> 48
934 DelegationFromScript script -> do
935 pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
936 -- 0b01100000 .&. 0b00111111 = 32
937 -- 0b01110000 .&. 0b00111111 = 48
938 putWord8 $ fstByte .&. 0b00111111
939 putByteString rest
940 putByteString $ unScriptHash $ toScriptHash script
941
942 -- base address: keyhash28,scripthash28 : 00100000 -> 32
943 -- base address: scripthash28,scripthash28 : 00110000 -> 48
944 DelegationFromScriptHash (ScriptHash scriptBytes) -> do
945 pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
946 -- 0b01100000 .&. 0b00111111 = 32
947 -- 0b01110000 .&. 0b00111111 = 48
948 putWord8 $ fstByte .&. 0b00111111
949 putByteString rest
950 putByteString scriptBytes
951
952 -- pointer address: keyhash28, 3 variable length uint : 01000000 -> 64
953 -- pointer address: scripthash28, 3 variable length uint : 01010000 -> 80
954 DelegationFromPointer pointer -> do
955 pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
956 -- 0b01100000 .&. 0b01011111 = 64
957 -- 0b01110000 .&. 0b01011111 = 80
958 putWord8 $ fstByte .&. 0b01011111
959 putByteString rest
960 putPointer pointer
961 where
962 putPointer (ChainPointer a b c) = do
963 putVariableLengthNat a
964 putVariableLengthNat b
965 putVariableLengthNat c
966
967 -- | Captures error occuring when trying to extend an invalid address.
968 --
969 -- @since 2.0.0
970 data ErrExtendAddress
971 = ErrInvalidAddressStyle String
972 | ErrInvalidAddressType String
973 | ErrInvalidKeyHashType String
974 deriving (Show)
975
976 --
977 -- Network Discriminant
978 --
979
980 instance HasNetworkDiscriminant Shelley where
981 type NetworkDiscriminant Shelley = NetworkTag
982 addressDiscrimination _ = RequiresNetworkTag
983 networkTag = id
984
985 -- | Error reported from trying to create a network discriminant from number
986 --
987 -- @since 2.0.0
988 newtype MkNetworkDiscriminantError
989 = ErrWrongNetworkTag Integer
990 -- ^ Wrong network tag.
991 deriving (Eq, Show)
992
993 instance Buildable MkNetworkDiscriminantError where
994 build (ErrWrongNetworkTag i) = "Invalid network tag "+|i|+". Must be between [0, 15]"
995
996 -- | Construct 'NetworkDiscriminant' for Cardano 'Shelley' from a number.
997 -- If the number is invalid, ie., not between 0 and 15, then
998 -- 'MkNetworkDiscriminantError' is thrown.
999 --
1000 -- @since 2.0.0
1001 mkNetworkDiscriminant
1002 :: Integer
1003 -> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley)
1004 mkNetworkDiscriminant nTag
1005 | nTag < 16 = Right $ NetworkTag $ fromIntegral nTag
1006 | otherwise = Left $ ErrWrongNetworkTag nTag
1007
1008 -- | Retrieve the network discriminant of a given 'Address'.
1009 -- If the 'Address' is malformed or, not a shelley address, returns Nothing.
1010 --
1011 -- @since 2.0.0
1012 inspectNetworkDiscriminant
1013 :: Address
1014 -> Maybe (NetworkDiscriminant Shelley)
1015 inspectNetworkDiscriminant addr = case eitherInspectAddress Nothing addr of
1016 Right (InspectAddressShelley info) -> Just (infoNetworkTag info)
1017 _ -> Nothing
1018
1019 -- | 'NetworkDicriminant' for Cardano MainNet & Shelley
1020 --
1021 -- @since 2.0.0
1022 shelleyMainnet :: NetworkDiscriminant Shelley
1023 shelleyMainnet = NetworkTag 1
1024
1025 -- | 'NetworkDicriminant' for Cardano Testnet & Shelley
1026 --
1027 -- @since 2.0.0
1028 shelleyTestnet :: NetworkDiscriminant Shelley
1029 shelleyTestnet = NetworkTag 0
1030
1031 --
1032 -- Unsafe
1033 --
1034
1035 -- | Unsafe backdoor for constructing an 'Shelley' key from a raw 'XPrv'. this is
1036 -- unsafe because it lets the caller choose the actually derivation 'depth'.
1037 --
1038 -- This can be useful however when serializing / deserializing such a type, or to
1039 -- speed up test code (and avoid having to do needless derivations from a master
1040 -- key down to an address key for instance).
1041 --
1042 -- @since 2.0.0
1043 liftXPrv :: XPrv -> Shelley depth XPrv
1044 liftXPrv = Shelley
1045
1046 -- | Unsafe backdoor for constructing an 'Shelley' key from a raw 'XPub'. this is
1047 -- unsafe because it lets the caller choose the actually derivation 'depth'.
1048 --
1049 -- This can be useful however when serializing / deserializing such a type, or to
1050 -- speed up test code (and avoid having to do needless derivations from a master
1051 -- key down to an address key for instance).
1052 --
1053 -- @since 2.0.0
1054 liftXPub :: XPub -> Shelley depth XPub
1055 liftXPub = Shelley
1056
1057 -- | Unsafe backdoor for constructing an 'Shelley' key from a raw 'Pub'. this is
1058 -- unsafe because it lets the caller choose the actually derivation 'depth'.
1059 --
1060 -- This can be useful however when serializing / deserializing such a type, or to
1061 -- speed up test code (and avoid having to do needless derivations from a master
1062 -- key down to an address key for instance).
1063 --
1064 -- @since 3.14.0
1065 liftPub :: Pub -> Shelley depth Pub
1066 liftPub = Shelley
1067
1068 -- Use with care when it is _safe_.
1069 unsafeFromRight :: Either a c -> c
1070 unsafeFromRight =
1071 either (error "impossible: internally generated invalid address") id
1072
1073 --
1074 -- Internal
1075 --
1076
1077 -- Purpose is a constant set to 1852' (or 0x8000073c) following the BIP-44
1078 -- extension for Cardano:
1079 --
1080 -- https://github.com/input-output-hk/implementation-decisions/blob/e2d1bed5e617f0907bc5e12cf1c3f3302a4a7c42/text/1852-hd-chimeric.md
1081 --
1082 -- It indicates that the subtree of this node is used according to this
1083 -- specification.
1084 --
1085 -- Hardened derivation is used at this level.
1086 purposeIndex :: Word32
1087 purposeIndex = 0x8000073c
1088
1089 -- Policy purpose is a constant set to 1855' (or 0x8000073c) following the CIP-1855
1090 -- https://github.com/cardano-foundation/CIPs/tree/master/CIP-1855
1091 --
1092 -- It indicates that the subtree of this node is used according to this
1093 -- specification.
1094 --
1095 -- Hardened derivation is used at this level.
1096 policyPurposeIndex :: Word32
1097 policyPurposeIndex = 0x8000073f
1098
1099
1100 -- One master node (seed) can be used for unlimited number of independent
1101 -- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the
1102 -- same space for various cryptocoins has some disadvantages.
1103 --
1104 -- This level creates a separate subtree for every cryptocoin, avoiding reusing
1105 -- addresses across cryptocoins and improving privacy issues.
1106 --
1107 -- Coin type is a constant, set for each cryptocoin. For Cardano this constant
1108 -- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada
1109 -- Lovelace.
1110 --
1111 -- Hardened derivation is used at this level.
1112 coinTypeIndex :: Word32
1113 coinTypeIndex = 0x80000717
1114
1115 -- The minimum seed length for 'genMasterKeyFromMnemonic'.
1116 minSeedLengthBytes :: Int
1117 minSeedLengthBytes = 16
1118
1119 -- A sum-type for constructing addresses payment part.
1120 data CredentialType = CredentialFromKey | CredentialFromScript
1121 deriving (Show, Eq)
1122
1123 -- Different types of Shelley addresses.
1124 data AddressType
1125 = BaseAddress CredentialType CredentialType
1126 | PointerAddress CredentialType
1127 | EnterpriseAddress CredentialType
1128 | RewardAccount CredentialType
1129 | ByronAddress
1130 deriving (Show, Eq)
1131
1132 addressType :: AddressType -> Word8
1133 addressType = \case
1134 ByronAddress -> 0b10000000
1135 BaseAddress CredentialFromKey CredentialFromKey -> 0b00000000
1136 BaseAddress CredentialFromScript CredentialFromKey -> 0b00010000
1137 BaseAddress CredentialFromKey CredentialFromScript -> 0b00100000
1138 BaseAddress CredentialFromScript CredentialFromScript -> 0b00110000
1139 PointerAddress CredentialFromKey -> 0b01000000
1140 PointerAddress CredentialFromScript -> 0b01010000
1141 EnterpriseAddress CredentialFromKey -> 0b01100000
1142 EnterpriseAddress CredentialFromScript -> 0b01110000
1143 RewardAccount CredentialFromKey -> 0b11100000
1144 RewardAccount CredentialFromScript -> 0b11110000
1145
1146 -- Helper to constructs appropriate address headers. Rest of the payload is left
1147 -- to the caller as a raw 'ByteString'.
1148 constructPayload
1149 :: AddressType
1150 -> NetworkDiscriminant Shelley
1151 -> ByteString
1152 -> Address
1153 constructPayload addrType discrimination bytes = unsafeMkAddress $
1154 invariantSize expectedLength $ BL.toStrict $ runPut $ do
1155 putWord8 firstByte
1156 putByteString bytes
1157 where
1158 firstByte =
1159 let netTagLimit = 16
1160 in addressType addrType + invariantNetworkTag netTagLimit (networkTag @Shelley discrimination)
1161 expectedLength =
1162 let headerSizeBytes = 1
1163 in headerSizeBytes + credentialHashSize
1164
1165 --Shelley specific derivation and generation
1166 genMasterKeyFromMnemonicShelley
1167 :: BA.ByteArrayAccess sndFactor
1168 => SomeMnemonic
1169 -> sndFactor
1170 -> XPrv
1171 genMasterKeyFromMnemonicShelley fstFactor =
1172 generateNew seedValidated
1173 where
1174 seed = someMnemonicToBytes fstFactor
1175 seedValidated = assert
1176 (BA.length seed >= minSeedLengthBytes && BA.length seed <= 255)
1177 seed
1178
1179 deriveAccountPrivateKeyShelley
1180 :: XPrv
1181 -> Index derivationType depth
1182 -> Word32
1183 -> XPrv
1184 deriveAccountPrivateKeyShelley rootXPrv accIx purpose =
1185 let
1186 Just purposeIx =
1187 indexFromWord32 @(Index 'Hardened _) purpose
1188 Just coinTypeIx =
1189 indexFromWord32 @(Index 'Hardened _) coinTypeIndex
1190 purposeXPrv = -- lvl1 derivation; hardened derivation of purpose'
1191 deriveXPrv DerivationScheme2 rootXPrv purposeIx
1192 coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type'
1193 deriveXPrv DerivationScheme2 purposeXPrv coinTypeIx
1194 acctXPrv = -- lvl3 derivation; hardened derivation of account' index
1195 deriveXPrv DerivationScheme2 coinTypeXPrv accIx
1196 in
1197 acctXPrv
1198
1199 deriveAddressPrivateKeyShelley
1200 :: XPrv
1201 -> Role
1202 -> Index derivationType depth
1203 -> XPrv
1204 deriveAddressPrivateKeyShelley accXPrv role addrIx =
1205 let
1206 changeXPrv = -- lvl4 derivation; soft derivation of change chain
1207 deriveXPrv DerivationScheme2 accXPrv (roleToIndex role)
1208 addrXPrv = -- lvl5 derivation; soft derivation of address index
1209 deriveXPrv DerivationScheme2 changeXPrv addrIx
1210 in
1211 addrXPrv
1212
1213 deriveAddressPublicKeyShelley
1214 :: XPub
1215 -> Role
1216 -> Index derivationType depth
1217 -> XPub
1218 deriveAddressPublicKeyShelley accXPub role addrIx =
1219 fromMaybe errWrongIndex $ do
1220 changeXPub <- -- lvl4 derivation in bip44 is derivation of change chain
1221 deriveXPub DerivationScheme2 accXPub (roleToIndex role)
1222 -- lvl5 derivation in bip44 is derivation of address chain
1223 deriveXPub DerivationScheme2 changeXPub addrIx
1224 where
1225 errWrongIndex = error $
1226 "deriveAddressPublicKey failed: was given an hardened (or too big) \
1227 \index for soft path derivation ( " ++ show addrIx ++ "). This is \
1228 \either a programmer error, or, we may have reached the maximum \
1229 \number of addresses for a given wallet."