never executed always true always false
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE LambdaCase #-}
4 {-# LANGUAGE OverloadedStrings #-}
5 {-# LANGUAGE RankNTypes #-}
6 {-# LANGUAGE TypeApplications #-}
7 {-# LANGUAGE TypeFamilies #-}
8
9 {-# OPTIONS_HADDOCK hide #-}
10
11 -- |
12 -- Copyright: © 2018-2020 IOHK
13 -- License: Apache-2.0
14 --
15 -- These are (partial) CBOR decoders for Byron binary types. Note that we
16 -- ignore most of the block's and header's content and only retrieve the pieces
17 -- of information relevant to us, wallet (we do assume a trusted node and
18 -- therefore, we needn't to care about verifying signatures and blocks
19 -- themselves).
20
21 module Cardano.Codec.Cbor
22 ( -- * Encoders
23 encodeAddress
24 , encodeAttributes
25 , encodeDerivationPathAttr
26 , encodeProtocolMagicAttr
27
28 -- * Decoders
29 , decodeAddress
30 , decodeAddressDerivationPath
31 , decodeAddressPayload
32 , decodeAllAttributes
33 , decodeDerivationPathAttr
34 , decodeProtocolMagicAttr
35 , deserialiseCbor
36 , unsafeDeserialiseCbor
37
38 -- * Reexports from CBOR
39 , CBOR.encodeBytes
40 , CBOR.toStrictByteString
41 , CBOR.toLazyByteString
42 ) where
43
44 import Prelude
45
46 import Cardano.Crypto.Wallet
47 ( ChainCode (..), XPub (..) )
48 import Control.Monad
49 ( replicateM, when )
50 import Crypto.Error
51 ( CryptoError (..), CryptoFailable (..) )
52 import Crypto.Hash
53 ( hash )
54 import Crypto.Hash.Algorithms
55 ( Blake2b_224, SHA3_256 )
56 import Data.ByteArray
57 ( ScrubbedBytes )
58 import Data.ByteString
59 ( ByteString )
60 import Data.Digest.CRC32
61 ( crc32 )
62 import Data.List
63 ( find )
64 import Data.Word
65 ( Word32, Word8 )
66 import GHC.Stack
67 ( HasCallStack )
68
69 import qualified Codec.CBOR.Decoding as CBOR
70 import qualified Codec.CBOR.Encoding as CBOR
71 import qualified Codec.CBOR.Read as CBOR
72 import qualified Codec.CBOR.Write as CBOR
73 import qualified Crypto.Cipher.ChaChaPoly1305 as Poly
74 import qualified Data.ByteArray as BA
75 import qualified Data.ByteString as BS
76 import qualified Data.ByteString.Lazy as BL
77
78 {-------------------------------------------------------------------------------
79 Byron Address Binary Format
80
81 In the composition of a Cardano address, the following functions concern the
82 "Derivation Path" box.
83
84 +-------------------------------------------------------------------------------+
85 | |
86 | CBOR-Serialized Object with CRC¹ |
87 | |
88 +-------------------------------------------------------------------------------+
89 |
90 |
91 v
92 +-------------------------------------------------------------------------------+
93 | Address Root | Address Attributes | AddrType |
94 | | | |
95 | Hash (224 bits) | Der. Path² + Stake + NM | PubKey | (Script) | Redeem |
96 | | (open for extension) | (open for extension) |
97 +-------------------------------------------------------------------------------+
98 | |
99 | | +----------------------------------+
100 v | | Derivation Path |
101 +---------------------------+ |---->| |
102 | SHA3-256 | | | ChaChaPoly⁴ AccountIx/AddressIx |
103 | |> Blake2b 224 | | +----------------------------------+
104 | |> CBOR | |
105 | | |
106 | -AddrType | | +----------------------------------+
107 | -ASD³ (~AddrType+PubKey) | | | Stake Distribution |
108 | -Address Attributes | | | |
109 +---------------------------+ |---->| BootstrapEra | (Single | Multi) |
110 | +----------------------------------+
111 |
112 |
113 | +----------------------------------+
114 | | Network Magic |
115 |---->| |
116 | Addr Discr: MainNet vs TestNet |
117 +----------------------------------+
118
119 -------------------------------------------------------------------------------}
120
121 -- * Encoding
122
123 -- | Encode a public key to a corresponding Cardano Address. The encoding of the
124 -- attributes part of an address is left out to the caller; This allows for
125 -- distinguishing between Sequential and Random addresses (the former doesn't
126 -- have any attributes to encode).
127 --
128 -- @
129 -- -- Old / Random Addresses
130 -- let encodeAddrAttributes = mempty
131 -- <> CBOR.encodeMapLen 1
132 -- <> CBOR.encodeWord8 1
133 -- <> encodeDerivationPath (hdPassphrase rootXPub) accIx addrIx
134 -- let addr = encodeAddress xpub encodeAddrAttributes
135 --
136 -- -- New / Sequential Addresses
137 -- let encodeAddrAttributes = mempty <> CBOR.encodeMapLen 0
138 -- let addr = encodeAddress xpub encodeAddrAttributes
139 -- @
140 --
141 -- Note that we are passing the behavior to encode attributes as a parameter
142 -- here and do not handle multiple cases in 'encodeAddress' itself for multiple
143 -- reasons:
144 --
145 -- - Inversion of control gives us a nicer implementation overall
146 --
147 -- - Encoding attributes for Random addresses requires more context than just
148 -- the public key (like the wallet root id and some extra logic for encoding
149 -- passphrases). This is just scheme-specific and is better left out of this
150 -- particular function
151 encodeAddress :: XPub -> [CBOR.Encoding] -> CBOR.Encoding
152 encodeAddress (XPub pub (ChainCode cc)) attrs =
153 encodeAddressPayload payload
154 where
155 blake2b224 = hash @_ @Blake2b_224
156 sha3256 = hash @_ @SHA3_256
157 payload = CBOR.toStrictByteString $ mempty
158 <> CBOR.encodeListLen 3
159 <> CBOR.encodeBytes root
160 <> encodeAttributes attrs
161 <> CBOR.encodeWord8 0 -- Address Type, 0 = Public Key
162 root = BA.convert $ blake2b224 $ sha3256 $ CBOR.toStrictByteString $ mempty
163 <> CBOR.encodeListLen 3
164 <> CBOR.encodeWord8 0 -- Address Type, 0 = Public Key
165 <> encodeSpendingData
166 <> encodeAttributes attrs
167 encodeXPub =
168 CBOR.encodeBytes (pub <> cc)
169 encodeSpendingData = CBOR.encodeListLen 2
170 <> CBOR.encodeWord8 0
171 <> encodeXPub
172
173 encodeAddressPayload :: ByteString -> CBOR.Encoding
174 encodeAddressPayload payload = mempty
175 <> CBOR.encodeListLen 2
176 <> CBOR.encodeTag 24 -- Hard-Coded Tag value in cardano-sl
177 <> CBOR.encodeBytes payload
178 <> CBOR.encodeWord32 (crc32 payload)
179
180 encodeAttributes :: [CBOR.Encoding] -> CBOR.Encoding
181 encodeAttributes attrs = CBOR.encodeMapLen l <> mconcat attrs
182 where
183 l = fromIntegral (length attrs)
184
185 encodeProtocolMagicAttr :: Word32 -> CBOR.Encoding
186 encodeProtocolMagicAttr pm = mempty
187 <> CBOR.encodeWord 2 -- Tag for 'ProtocolMagic' attribute
188 <> CBOR.encodeBytes (CBOR.toStrictByteString $ CBOR.encodeWord32 pm)
189
190 -- This is the opposite of 'decodeDerivationPathAttr'.
191 --
192 -- NOTE: The caller must ensure that the passphrase length is 32 bytes.
193 encodeDerivationPathAttr
194 :: ScrubbedBytes
195 -> Word32
196 -> Word32
197 -> CBOR.Encoding
198 encodeDerivationPathAttr pwd acctIx addrIx = mempty
199 <> CBOR.encodeWord8 1 -- Tag for 'DerivationPath' attribute
200 <> CBOR.encodeBytes (encryptDerivationPath pwd path)
201 where
202 path = encodeDerivationPath acctIx addrIx
203
204 encodeDerivationPath
205 :: Word32
206 -> Word32
207 -> CBOR.Encoding
208 encodeDerivationPath acctIx addrIx = mempty
209 <> CBOR.encodeListLenIndef
210 <> CBOR.encodeWord32 acctIx
211 <> CBOR.encodeWord32 addrIx
212 <> CBOR.encodeBreak
213
214 -- | ChaCha20/Poly1305 encrypting and signing the HD payload of addresses.
215 --
216 -- NOTE: The caller must ensure that the passphrase length is 32 bytes.
217 encryptDerivationPath
218 :: ScrubbedBytes
219 -- ^ Symmetric key / passphrase, 32-byte long
220 -> CBOR.Encoding
221 -- ^ Payload to be encrypted
222 -> ByteString
223 -- ^ Ciphertext with a 128-bit crypto-tag appended.
224 encryptDerivationPath pwd payload = unsafeSerialize $ do
225 nonce <- Poly.nonce12 cardanoNonce
226 st1 <- Poly.finalizeAAD <$> Poly.initialize pwd nonce
227 let (out, st2) = Poly.encrypt (CBOR.toStrictByteString payload) st1
228 return $ out <> BA.convert (Poly.finalize st2)
229 where
230 unsafeSerialize :: CryptoFailable ByteString -> ByteString
231 unsafeSerialize =
232 CBOR.toStrictByteString . CBOR.encodeBytes . useInvariant
233
234 -- Encryption will fail if the key is the wrong size, but that won't happen
235 -- if the key was created with 'generateKeyFromSeed'.
236 useInvariant = \case
237 CryptoPassed res -> res
238 CryptoFailed err -> error $ "encodeAddressKey: " ++ show err
239
240 -- | Hard-coded nonce from the legacy code-base.
241 cardanoNonce :: ByteString
242 cardanoNonce = "serokellfore"
243
244 decodeAddress :: CBOR.Decoder s ByteString
245 decodeAddress = do
246 _ <- CBOR.decodeListLenCanonicalOf 2
247 -- CRC Protection Wrapper
248 tag <- CBOR.decodeTag
249 -- Mysterious hard-coded tag cardano-sl seems to so much like
250 bytes <- CBOR.decodeBytes
251 -- Addr Root + Attributes + Type
252 crc <- CBOR.decodeWord32 -- CRC
253
254 when (crc /= crc32 bytes) $ fail "non-matching crc32."
255
256 -- NOTE 1:
257 -- Treating addresses as a blob here, so we just re-encode them as such
258 -- Ultimately for us, addresses are nothing more than a bunch of bytes that
259 -- we display in a Base58 format when we have to.
260 return $ CBOR.toStrictByteString $ mempty
261 <> CBOR.encodeListLen 2
262 <> CBOR.encodeTag tag
263 <> CBOR.encodeBytes bytes
264 <> CBOR.encodeWord32 crc
265
266 decodeAddressPayload :: CBOR.Decoder s ByteString
267 decodeAddressPayload = do
268 _ <- CBOR.decodeListLenCanonicalOf 2
269 _ <- CBOR.decodeTag
270 bytes <- CBOR.decodeBytes
271 crc <- CBOR.decodeWord32
272 when (crc /= crc32 bytes) $ fail "non-matching crc32."
273 return bytes
274
275 decodeAddressDerivationPath
276 :: ScrubbedBytes
277 -> CBOR.Decoder s (Maybe (Word32, Word32))
278 decodeAddressDerivationPath pwd = do
279 _ <- CBOR.decodeListLenCanonicalOf 3
280 _ <- CBOR.decodeBytes
281 path <- decodeAllAttributes >>= decodeDerivationPathAttr pwd
282 addrType <- CBOR.decodeWord8 -- Type
283 when (addrType /= 0) $
284 fail $ mconcat
285 [ "decodeAddressDerivationPath: type is not 0 (public key), it is "
286 , show addrType
287 ]
288 pure path
289
290 decodeProtocolMagicAttr
291 :: CBOR.Decoder s (Maybe Word32)
292 decodeProtocolMagicAttr = do
293 _ <- CBOR.decodeListLenCanonicalOf 3
294 _ <- CBOR.decodeBytes
295 attrs <- decodeAllAttributes
296 case find ((== 2) . fst) attrs of
297 Nothing -> pure Nothing
298 Just (_, bytes) -> case deserialiseCbor CBOR.decodeWord32 bytes of
299 Left _ -> fail "unable to decode attribute into protocol magic"
300 Right pm -> pure (Just pm)
301
302 -- | The attributes are pairs of numeric tags and bytes, where the bytes will be
303 -- CBOR-encoded stuff. This decoder does not enforce "canonicity" of entries.
304 decodeAllAttributes
305 :: CBOR.Decoder s [(Word8, ByteString)]
306 decodeAllAttributes = do
307 n <- CBOR.decodeMapLenCanonical -- Address Attributes length
308 replicateM n decodeAttr
309 where
310 decodeAttr = (,) <$> CBOR.decodeWord8 <*> CBOR.decodeBytes
311
312 decodeDerivationPathAttr
313 :: ScrubbedBytes
314 -> [(Word8, ByteString)]
315 -> CBOR.Decoder s (Maybe (Word32, Word32))
316 decodeDerivationPathAttr pwd attrs = do
317 case lookup derPathTag attrs of
318 Just payload -> decodeNestedBytes decoder payload
319 Nothing -> fail $ mconcat
320 [ "decodeDerivationPathAttr: Missing attribute "
321 , show derPathTag
322 ]
323 where
324 derPathTag = 1
325 decoder :: CBOR.Decoder s (Maybe (Word32, Word32))
326 decoder = do
327 bytes <- CBOR.decodeBytes
328 case decryptDerivationPath pwd bytes of
329 CryptoPassed plaintext ->
330 Just <$> decodeNestedBytes decodeDerivationPath plaintext
331 CryptoFailed _ ->
332 pure Nothing
333
334 -- | ChaCha20/Poly1305 decrypting and authenticating the HD payload of
335 -- addresses.
336 decryptDerivationPath
337 :: ScrubbedBytes
338 -- ^ Symmetric key / passphrase, 32-byte long
339 -> ByteString
340 -- ^ Payload to be decrypted
341 -> CryptoFailable ByteString
342 decryptDerivationPath pwd bytes = do
343 let (payload, tag) = BS.splitAt (BS.length bytes - 16) bytes
344 nonce <- Poly.nonce12 cardanoNonce
345 st1 <- Poly.finalizeAAD <$> Poly.initialize pwd nonce
346 let (out, st2) = Poly.decrypt payload st1
347 when (BA.convert (Poly.finalize st2) /= tag) $
348 CryptoFailed CryptoError_MacKeyInvalid
349 return out
350
351 -- Opposite of 'encodeDerivationPath'.
352 decodeDerivationPath
353 :: CBOR.Decoder s (Word32, Word32)
354 decodeDerivationPath = do
355 ixs <- decodeListIndef CBOR.decodeWord32
356 case ixs of
357 [acctIx, addrIx] ->
358 pure (acctIx, addrIx)
359 _ ->
360 fail $ mconcat
361 [ "decodeDerivationPath: invalid derivation path payload: "
362 , "expected two indexes but got: "
363 , show ixs
364 ]
365 -- | Decode an arbitrary long list. CBOR introduce a "break" character to
366 -- mark the end of the list, so we simply decode each item until we encounter
367 -- a break character.
368 --
369 -- @
370 -- myDecoder :: CBOR.Decoder s [MyType]
371 -- myDecoder = decodeListIndef decodeOne
372 -- where
373 -- decodeOne :: CBOR.Decoder s MyType
374 -- @
375 decodeListIndef :: forall s a. CBOR.Decoder s a -> CBOR.Decoder s [a]
376 decodeListIndef decodeOne = do
377 _ <- CBOR.decodeListLenIndef
378 CBOR.decodeSequenceLenIndef (flip (:)) [] reverse decodeOne
379
380 -- | Byron CBOR encodings often have CBOR nested in CBOR. This helps decoding
381 -- a particular 'ByteString' that represents a CBOR object.
382 decodeNestedBytes
383 :: MonadFail m
384 => (forall s. CBOR.Decoder s r)
385 -> ByteString
386 -> m r
387 decodeNestedBytes dec bytes =
388 case CBOR.deserialiseFromBytes dec (BL.fromStrict bytes) of
389 Right ("", res) ->
390 pure res
391 Right _ ->
392 fail "Leftovers when decoding nested bytes"
393 _ ->
394 fail "Could not decode nested bytes"
395
396 -- | Shortcut for deserialising a strict 'Bytestring' with the given decoder.
397 deserialiseCbor
398 :: (forall s. CBOR.Decoder s a)
399 -> ByteString
400 -> Either CBOR.DeserialiseFailure a
401 deserialiseCbor dec =
402 fmap snd . CBOR.deserialiseFromBytes dec . BL.fromStrict
403
404 -- | CBOR deserialise without error handling - handy for prototypes or testing.
405 unsafeDeserialiseCbor
406 :: HasCallStack
407 => (forall s. CBOR.Decoder s a)
408 -> BL.ByteString
409 -> a
410 unsafeDeserialiseCbor decoder bytes = either
411 (\e -> error $ "unsafeSerializeCbor: " <> show e)
412 snd
413 (CBOR.deserialiseFromBytes decoder bytes)