never executed always true always false
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE BinaryLiterals #-}
3 {-# LANGUAGE DataKinds #-}
4 {-# LANGUAGE DeriveFunctor #-}
5 {-# LANGUAGE DeriveGeneric #-}
6 {-# LANGUAGE DerivingStrategies #-}
7 {-# LANGUAGE FlexibleContexts #-}
8 {-# LANGUAGE GADTs #-}
9 {-# LANGUAGE StandaloneDeriving #-}
10 {-# LANGUAGE TypeFamilies #-}
11
12 {-# OPTIONS_HADDOCK prune #-}
13
14 -- |
15 -- Copyright: © 2018-2021 IOHK
16 -- License: Apache-2.0
17
18 module Cardano.Address.Style.Shared
19 ( -- $overview
20
21 -- * Shared
22 Shared
23 , getKey
24 , liftXPrv
25 , liftXPub
26 , sharedWalletId
27
28 -- * Key Derivation
29 -- $keyDerivation
30 , genMasterKeyFromXPrv
31 , genMasterKeyFromMnemonic
32 , deriveAccountPrivateKey
33 , deriveAddressPrivateKey
34 , deriveAddressPublicKey
35 , deriveDelegationPrivateKey
36 , deriveDelegationPublicKey
37 , hashKey
38
39 ) where
40
41 import Prelude
42
43 import Cardano.Address.Derivation
44 ( Depth (..)
45 , DerivationType (..)
46 , Index (..)
47 , XPrv
48 , XPub
49 , hashCredential
50 , hashWalletId
51 , xpubPublicKey
52 )
53 import Cardano.Address.Script
54 ( Cosigner, KeyHash (..), KeyRole, Script )
55 import Cardano.Address.Script.Parser
56 ( scriptToText )
57 import Cardano.Address.Style.Shelley
58 ( Role (..)
59 , deriveAccountPrivateKeyShelley
60 , deriveAddressPrivateKeyShelley
61 , deriveAddressPublicKeyShelley
62 , genMasterKeyFromMnemonicShelley
63 )
64 import Cardano.Mnemonic
65 ( SomeMnemonic )
66 import Control.DeepSeq
67 ( NFData )
68 import Data.ByteArray
69 ( ScrubbedBytes )
70 import Data.ByteString
71 ( ByteString )
72 import Data.Coerce
73 ( coerce )
74 import Data.Word
75 ( Word32 )
76 import GHC.Generics
77 ( Generic )
78
79 import qualified Cardano.Address.Derivation as Internal
80 import qualified Data.ByteString as BS
81 import qualified Data.Text.Encoding as T
82
83
84 -- $overview
85 --
86 -- This module provides an implementation of:
87 --
88 -- - 'Cardano.Address.Derivation.GenMasterKey': for generating Shared master keys from mnemonic sentences
89 -- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical hard derivation of parent to child keys
90 -- - 'Cardano.Address.Derivation.SoftDerivation': for hierarchical soft derivation of parent to child keys
91 --
92 -- - 'paymentAddress': for constructing payment addresses from a address public key or a script
93 -- - 'delegationAddress': for constructing delegation addresses from payment credential (public key or script) and stake credential (public key or script)
94 -- - 'pointerAddress': for constructing delegation addresses from payment credential (public key or script) and chain pointer
95 -- - 'stakeAddress': for constructing reward accounts from stake credential (public key or script)
96
97 -- | A cryptographic key for sequential-scheme address derivation, with
98 -- phantom-types to disambiguate key types. The derivation is mostly like Shelley, except the used purpose index
99 -- (here 1854H rather than Shelley's 1852H)
100 --
101 -- @
102 -- let rootPrivateKey = Shared 'RootK XPrv
103 -- let accountPubKey = Shared 'AccountK XPub
104 -- let addressPubKey = Shared 'PaymentK XPub
105 -- @
106 --
107 -- @since 3.4.0
108 newtype Shared (depth :: Depth) key = Shared
109 { getKey :: key
110 -- ^ Extract the raw 'XPrv' or 'XPub' wrapped by this type.
111 --
112 -- @since 3.4.0
113 }
114 deriving stock (Generic, Show, Eq)
115
116 deriving instance (Functor (Shared depth))
117 instance (NFData key) => NFData (Shared depth key)
118
119 --
120 -- Key Derivation
121 --
122 -- $keyDerivation
123 --
124 -- === Generating a root key from 'SomeMnemonic'
125 -- > :set -XOverloadedStrings
126 -- > :set -XTypeApplications
127 -- > :set -XDataKinds
128 -- > import Cardano.Mnemonic ( mkSomeMnemonic )
129 -- >
130 -- > let (Right mw) = mkSomeMnemonic @'[15] ["network","empty","cause","mean","expire","private","finger","accident","session","problem","absurd","banner","stage","void","what"]
131 -- > let sndFactor = mempty -- Or alternatively, a second factor mnemonic transformed to bytes via someMnemonicToBytes
132 -- > let rootK = genMasterKeyFromMnemonic mw sndFactor :: Shared 'RootK XPrv
133 --
134 -- === Deriving child keys
135 --
136 -- Let's consider the following 3rd, 4th and 5th derivation paths @0'\/0\/14@
137 --
138 -- > let Just accIx = indexFromWord32 0x80000000
139 -- > let acctK = deriveAccountPrivateKey rootK accIx
140 -- >
141 -- > let Just addIx = indexFromWord32 0x00000014
142 -- > let addrK = deriveAddressPrivateKey acctK UTxOExternal addIx
143 --
144 -- > let stakeK = deriveDelegationPrivateKey acctK
145
146 instance Internal.GenMasterKey Shared where
147 type SecondFactor Shared = ScrubbedBytes
148
149 genMasterKeyFromXPrv = liftXPrv
150 genMasterKeyFromMnemonic fstFactor sndFactor =
151 Shared $ genMasterKeyFromMnemonicShelley fstFactor sndFactor
152
153 instance Internal.HardDerivation Shared where
154 type AccountIndexDerivationType Shared = 'Hardened
155 type AddressIndexDerivationType Shared = 'Soft
156 type WithRole Shared = Role
157
158 deriveAccountPrivateKey (Shared rootXPrv) accIx =
159 Shared $ deriveAccountPrivateKeyShelley rootXPrv accIx purposeIndex
160
161 deriveAddressPrivateKey (Shared accXPrv) keyRole addrIx =
162 Shared $ deriveAddressPrivateKeyShelley accXPrv keyRole addrIx
163
164 instance Internal.SoftDerivation Shared where
165 deriveAddressPublicKey (Shared accXPub) keyRole addrIx =
166 Shared $ deriveAddressPublicKeyShelley accXPub keyRole addrIx
167
168 -- | Generate a root key from a corresponding mnemonic.
169 --
170 -- @since 3.4.0
171 genMasterKeyFromMnemonic
172 :: SomeMnemonic
173 -- ^ Some valid mnemonic sentence.
174 -> ScrubbedBytes
175 -- ^ An optional second-factor passphrase (or 'mempty')
176 -> Shared 'RootK XPrv
177 genMasterKeyFromMnemonic = Internal.genMasterKeyFromMnemonic
178
179 -- | Generate a root key from a corresponding root 'XPrv'
180 --
181 -- @since 3.4.0
182 genMasterKeyFromXPrv :: XPrv -> Shared 'RootK XPrv
183 genMasterKeyFromXPrv = Internal.genMasterKeyFromXPrv
184
185 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
186 --
187 -- | Derives an account private key from the given root private key.
188 --
189 -- @since 3.4.0
190 deriveAccountPrivateKey
191 :: Shared 'RootK XPrv
192 -> Index 'Hardened 'AccountK
193 -> Shared 'AccountK XPrv
194 deriveAccountPrivateKey = Internal.deriveAccountPrivateKey
195
196 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
197 --
198 -- | Derives a multisig private key from the given account private key for payment credential.
199 --
200 -- @since 3.4.0
201 deriveAddressPrivateKey
202 :: Shared 'AccountK XPrv
203 -> Role
204 -> Index 'Soft 'PaymentK
205 -> Shared 'ScriptK XPrv
206 deriveAddressPrivateKey = coerce . Internal.deriveAddressPrivateKey
207
208 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
209 --
210 -- | Derives a multisig private key from the given account private key for delegation credential.
211 --
212 -- @since 3.4.0
213 deriveDelegationPrivateKey
214 :: Shared 'AccountK XPrv
215 -> Index 'Soft 'PaymentK
216 -> Shared 'ScriptK XPrv
217 deriveDelegationPrivateKey accPrv = coerce .
218 Internal.deriveAddressPrivateKey accPrv Stake
219
220 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
221 --
222 -- | Derives a multisig public key from the given account public key for payment credential.
223 --
224 -- @since 3.4.0
225 deriveAddressPublicKey
226 :: Shared 'AccountK XPub
227 -> Role
228 -> Index 'Soft 'PaymentK
229 -> Shared 'ScriptK XPub
230 deriveAddressPublicKey = coerce . Internal.deriveAddressPublicKey
231
232 -- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
233 --
234 -- | Derives a multisig public key from the given account public key for delegation credential.
235 --
236 -- @since 3.4.0
237 deriveDelegationPublicKey
238 :: Shared 'AccountK XPub
239 -> Index 'Soft 'PaymentK
240 -> Shared 'ScriptK XPub
241 deriveDelegationPublicKey accPub = coerce .
242 Internal.deriveAddressPublicKey accPub Stake
243
244 --
245 -- Unsafe
246 --
247
248 -- | Unsafe backdoor for constructing an 'Shared' key from a raw 'XPrv'. this is
249 -- unsafe because it lets the caller choose the actually derivation 'depth'.
250 --
251 -- This can be useful however when serializing / deserializing such a type, or to
252 -- speed up test code (and avoid having to do needless derivations from a master
253 -- key down to an address key for instance).
254 --
255 -- @since 3.4.0
256 liftXPrv :: XPrv -> Shared depth XPrv
257 liftXPrv = Shared
258
259 -- | Unsafe backdoor for constructing an 'Shared' key from a raw 'XPub'. this is
260 -- unsafe because it lets the caller choose the actually derivation 'depth'.
261 --
262 -- This can be useful however when serializing / deserializing such a type, or to
263 -- speed up test code (and avoid having to do needless derivations from a master
264 -- key down to an address key for instance).
265 --
266 -- @since 3.4.0
267 liftXPub :: XPub -> Shared depth XPub
268 liftXPub = Shared
269
270
271 -- | Calculates wallet id of shared wallet
272 -- It takes raw bytes of account public kye (64-bytes),
273 -- spending script template, and
274 -- optionally staking script template.
275 --
276 -- @since 3.10.0
277 sharedWalletId
278 :: ByteString
279 -> Script Cosigner
280 -> Maybe (Script Cosigner)
281 -> ByteString
282 sharedWalletId bytes spending stakingM =
283 if BS.length bytes == 64 then
284 hashWalletId $
285 bytes <>
286 serializeScriptTemplate spending <>
287 maybe mempty serializeScriptTemplate stakingM
288 else
289 error "Extended account public key is expected to have 64 bytes."
290 where
291 serializeScriptTemplate = T.encodeUtf8 . scriptToText
292
293 --
294 -- Internal
295 --
296
297 --- | Computes a 28-byte Blake2b224 digest of a Shared 'XPub'.
298 ---
299 --- @since 3.4.0
300 hashKey :: KeyRole -> Shared key XPub -> KeyHash
301 hashKey cred = KeyHash cred . hashCredential . xpubPublicKey . getKey
302
303 -- Purpose is a constant set to 1854' (or 0x8000073e) following the
304 -- CIP-1854 Multi-signatures HD Wallets
305 --
306 -- Hardened derivation is used at this level.
307 purposeIndex :: Word32
308 purposeIndex = 0x8000073e