{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_HADDOCK hide #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- These are (partial) CBOR decoders for Byron binary types. Note that we
-- ignore most of the block's and header's content and only retrieve the pieces
-- of information relevant to us, wallet (we do assume a trusted node and
-- therefore, we needn't to care about verifying signatures and blocks
-- themselves).

module Cardano.Codec.Cbor
    ( -- * Encoders
      encodeAddress
    , encodeAttributes
    , encodeDerivationPathAttr
    , encodeProtocolMagicAttr

     -- * Decoders
    , decodeAddress
    , decodeAddressDerivationPath
    , decodeAddressPayload
    , decodeAllAttributes
    , decodeDerivationPathAttr
    , decodeProtocolMagicAttr
    , deserialiseCbor
    , unsafeDeserialiseCbor

     -- * Reexports from CBOR
    , CBOR.encodeBytes
    , CBOR.toStrictByteString
    , CBOR.toLazyByteString
    ) where

import Prelude

import Cardano.Crypto.Wallet
    ( ChainCode (..), XPub (..) )
import Control.Monad
    ( replicateM, when )
import Crypto.Error
    ( CryptoError (..), CryptoFailable (..) )
import Crypto.Hash
    ( hash )
import Crypto.Hash.Algorithms
    ( Blake2b_224, SHA3_256 )
import Data.ByteArray
    ( ScrubbedBytes )
import Data.ByteString
    ( ByteString )
import Data.Digest.CRC32
    ( crc32 )
import Data.List
    ( find )
import Data.Word
    ( Word32, Word8 )
import GHC.Stack
    ( HasCallStack )

import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import qualified Codec.CBOR.Read as CBOR
import qualified Codec.CBOR.Write as CBOR
import qualified Crypto.Cipher.ChaChaPoly1305 as Poly
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL

{-------------------------------------------------------------------------------
                       Byron Address Binary Format

In the composition of a Cardano address, the following functions concern the
"Derivation Path" box.

+-------------------------------------------------------------------------------+
|                                                                               |
|                        CBOR-Serialized Object with CRC¹                       |
|                                                                               |
+-------------------------------------------------------------------------------+
                                        |
                                        |
                                        v
+-------------------------------------------------------------------------------+
|     Address Root    |     Address Attributes    |           AddrType          |
|                     |                           |                             |
|   Hash (224 bits)   |  Der. Path² + Stake + NM  |  PubKey | (Script) | Redeem |
|                     |    (open for extension)   |     (open for extension)    |
+-------------------------------------------------------------------------------+
             |                 |
             |                 |     +----------------------------------+
             v                 |     |        Derivation Path           |
+---------------------------+  |---->|                                  |
| SHA3-256                  |  |     | ChaChaPoly⁴ AccountIx/AddressIx  |
|   |> Blake2b 224          |  |     +----------------------------------+
|   |> CBOR                 |  |
|                           |  |
|  -AddrType                |  |     +----------------------------------+
|  -ASD³ (~AddrType+PubKey) |  |     |       Stake Distribution         |
|  -Address Attributes      |  |     |                                  |
+---------------------------+  |---->|  BootstrapEra | (Single | Multi) |
                               |     +----------------------------------+
                               |
                               |
                               |     +----------------------------------+
                               |     |          Network Magic           |
                               |---->|                                  |
                                     | Addr Discr: MainNet vs TestNet   |
                                     +----------------------------------+

-------------------------------------------------------------------------------}

-- * Encoding

-- | Encode a public key to a corresponding Cardano Address. The encoding of the
-- attributes part of an address is left out to the caller; This allows for
-- distinguishing between Sequential and Random addresses (the former doesn't
-- have any attributes to encode).
--
-- @
-- -- Old / Random Addresses
-- let encodeAddrAttributes = mempty
--      <> CBOR.encodeMapLen 1
--      <> CBOR.encodeWord8 1
--      <> encodeDerivationPath (hdPassphrase rootXPub) accIx addrIx
-- let addr = encodeAddress xpub encodeAddrAttributes
--
-- -- New / Sequential Addresses
-- let encodeAddrAttributes = mempty <> CBOR.encodeMapLen 0
-- let addr = encodeAddress xpub encodeAddrAttributes
-- @
--
-- Note that we are passing the behavior to encode attributes as a parameter
-- here and do not handle multiple cases in 'encodeAddress' itself for multiple
-- reasons:
--
-- - Inversion of control gives us a nicer implementation overall
--
-- - Encoding attributes for Random addresses requires more context than just
--   the public key (like the wallet root id and some extra logic for encoding
--   passphrases). This is just scheme-specific and is better left out of this
--   particular function
encodeAddress :: XPub -> [CBOR.Encoding] -> CBOR.Encoding
encodeAddress :: XPub -> [Encoding] -> Encoding
encodeAddress (XPub ByteString
pub (ChainCode ByteString
cc)) [Encoding]
attrs =
    ByteString -> Encoding
encodeAddressPayload ByteString
payload
  where
    blake2b224 :: Digest SHA3_256 -> Digest Blake2b_224
blake2b224 = (ByteArrayAccess (Digest SHA3_256), HashAlgorithm Blake2b_224) =>
Digest SHA3_256 -> Digest Blake2b_224
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @_ @Blake2b_224
    sha3256 :: ByteString -> Digest SHA3_256
sha3256 = (ByteArrayAccess ByteString, HashAlgorithm SHA3_256) =>
ByteString -> Digest SHA3_256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @_ @SHA3_256
    payload :: ByteString
payload = Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Encoding
forall a. Monoid a => a
mempty
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes ByteString
root
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
encodeAttributes [Encoding]
attrs
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
0 -- Address Type, 0 = Public Key
    root :: ByteString
root = Digest Blake2b_224 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest Blake2b_224 -> ByteString)
-> Digest Blake2b_224 -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA3_256 -> Digest Blake2b_224
blake2b224 (Digest SHA3_256 -> Digest Blake2b_224)
-> Digest SHA3_256 -> Digest Blake2b_224
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA3_256
sha3256 (ByteString -> Digest SHA3_256) -> ByteString -> Digest SHA3_256
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Encoding
forall a. Monoid a => a
mempty
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
0 -- Address Type, 0 = Public Key
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
encodeSpendingData
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
encodeAttributes [Encoding]
attrs
    encodeXPub :: Encoding
encodeXPub =
        ByteString -> Encoding
CBOR.encodeBytes (ByteString
pub ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cc)
    encodeSpendingData :: Encoding
encodeSpendingData = Word -> Encoding
CBOR.encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
0
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
encodeXPub

encodeAddressPayload :: ByteString -> CBOR.Encoding
encodeAddressPayload :: ByteString -> Encoding
encodeAddressPayload ByteString
payload = Encoding
forall a. Monoid a => a
mempty
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen Word
2
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeTag Word
24 -- Hard-Coded Tag value in cardano-sl
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes ByteString
payload
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 (ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 ByteString
payload)

encodeAttributes :: [CBOR.Encoding] -> CBOR.Encoding
encodeAttributes :: [Encoding] -> Encoding
encodeAttributes [Encoding]
attrs = Word -> Encoding
CBOR.encodeMapLen Word
l Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [Encoding]
attrs
  where
    l :: Word
l = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Encoding] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Encoding]
attrs)

encodeProtocolMagicAttr :: Word32 -> CBOR.Encoding
encodeProtocolMagicAttr :: Word32 -> Encoding
encodeProtocolMagicAttr Word32
pm = Encoding
forall a. Monoid a => a
mempty
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
2 -- Tag for 'ProtocolMagic' attribute
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes (Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Encoding
CBOR.encodeWord32 Word32
pm)

-- This is the opposite of 'decodeDerivationPathAttr'.
--
-- NOTE: The caller must ensure that the passphrase length is 32 bytes.
encodeDerivationPathAttr
    :: ScrubbedBytes
    -> Word32
    -> Word32
    -> CBOR.Encoding
encodeDerivationPathAttr :: ScrubbedBytes -> Word32 -> Word32 -> Encoding
encodeDerivationPathAttr ScrubbedBytes
pwd Word32
acctIx Word32
addrIx = Encoding
forall a. Monoid a => a
mempty
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
1 -- Tag for 'DerivationPath' attribute
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes (ScrubbedBytes -> Encoding -> ByteString
encryptDerivationPath ScrubbedBytes
pwd Encoding
path)
  where
    path :: Encoding
path = Word32 -> Word32 -> Encoding
encodeDerivationPath Word32
acctIx Word32
addrIx

encodeDerivationPath
    :: Word32
    -> Word32
    -> CBOR.Encoding
encodeDerivationPath :: Word32 -> Word32 -> Encoding
encodeDerivationPath Word32
acctIx Word32
addrIx = Encoding
forall a. Monoid a => a
mempty
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeListLenIndef
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 Word32
acctIx
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 Word32
addrIx
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak

-- | ChaCha20/Poly1305 encrypting and signing the HD payload of addresses.
--
-- NOTE: The caller must ensure that the passphrase length is 32 bytes.
encryptDerivationPath
    :: ScrubbedBytes
       -- ^ Symmetric key / passphrase, 32-byte long
    -> CBOR.Encoding
        -- ^ Payload to be encrypted
    -> ByteString
        -- ^ Ciphertext with a 128-bit crypto-tag appended.
encryptDerivationPath :: ScrubbedBytes -> Encoding -> ByteString
encryptDerivationPath ScrubbedBytes
pwd Encoding
payload = CryptoFailable ByteString -> ByteString
unsafeSerialize (CryptoFailable ByteString -> ByteString)
-> CryptoFailable ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    Nonce
nonce <- ByteString -> CryptoFailable Nonce
forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
Poly.nonce12 ByteString
cardanoNonce
    State
st1 <- State -> State
Poly.finalizeAAD (State -> State) -> CryptoFailable State -> CryptoFailable State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScrubbedBytes -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
Poly.initialize ScrubbedBytes
pwd Nonce
nonce
    let (ByteString
out, State
st2) = ByteString -> State -> (ByteString, State)
forall ba. ByteArray ba => ba -> State -> (ba, State)
Poly.encrypt (Encoding -> ByteString
CBOR.toStrictByteString Encoding
payload) State
st1
    ByteString -> CryptoFailable ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> CryptoFailable ByteString)
-> ByteString -> CryptoFailable ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
out ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (State -> Auth
Poly.finalize State
st2)
  where
    unsafeSerialize :: CryptoFailable ByteString -> ByteString
    unsafeSerialize :: CryptoFailable ByteString -> ByteString
unsafeSerialize =
        Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString)
-> (CryptoFailable ByteString -> Encoding)
-> CryptoFailable ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
CBOR.encodeBytes (ByteString -> Encoding)
-> (CryptoFailable ByteString -> ByteString)
-> CryptoFailable ByteString
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable ByteString -> ByteString
forall p. CryptoFailable p -> p
useInvariant

    -- Encryption will fail if the key is the wrong size, but that won't happen
    -- if the key was created with 'generateKeyFromSeed'.
    useInvariant :: CryptoFailable p -> p
useInvariant = \case
        CryptoPassed p
res -> p
res
        CryptoFailed CryptoError
err -> [Char] -> p
forall a. HasCallStack => [Char] -> a
error ([Char] -> p) -> [Char] -> p
forall a b. (a -> b) -> a -> b
$ [Char]
"encodeAddressKey: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err

-- | Hard-coded nonce from the legacy code-base.
cardanoNonce :: ByteString
cardanoNonce :: ByteString
cardanoNonce = ByteString
"serokellfore"

decodeAddress :: CBOR.Decoder s ByteString
decodeAddress :: Decoder s ByteString
decodeAddress = do
    ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
2
        -- CRC Protection Wrapper
    Word
tag <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeTag
        -- Mysterious hard-coded tag cardano-sl seems to so much like
    ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
        -- Addr Root + Attributes + Type
    Word32
crc <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32 -- CRC

    Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
crc Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 ByteString
bytes) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"non-matching crc32."

    -- NOTE 1:
    -- Treating addresses as a blob here, so we just re-encode them as such
    -- Ultimately for us, addresses are nothing more than a bunch of bytes that
    -- we display in a Base58 format when we have to.
    ByteString -> Decoder s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Decoder s ByteString)
-> ByteString -> Decoder s ByteString
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Encoding
forall a. Monoid a => a
mempty
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeTag Word
tag
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes ByteString
bytes
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 Word32
crc

decodeAddressPayload :: CBOR.Decoder s ByteString
decodeAddressPayload :: Decoder s ByteString
decodeAddressPayload = do
    ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
2
    Word
_ <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeTag
    ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
    Word32
crc <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
    Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
crc Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 ByteString
bytes) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"non-matching crc32."
    ByteString -> Decoder s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes

decodeAddressDerivationPath
    :: ScrubbedBytes
    -> CBOR.Decoder s (Maybe (Word32, Word32))
decodeAddressDerivationPath :: ScrubbedBytes -> Decoder s (Maybe (Word32, Word32))
decodeAddressDerivationPath ScrubbedBytes
pwd = do
    ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
3
    ByteString
_ <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
    Maybe (Word32, Word32)
path <- Decoder s [(Word8, ByteString)]
forall s. Decoder s [(Word8, ByteString)]
decodeAllAttributes Decoder s [(Word8, ByteString)]
-> ([(Word8, ByteString)] -> Decoder s (Maybe (Word32, Word32)))
-> Decoder s (Maybe (Word32, Word32))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScrubbedBytes
-> [(Word8, ByteString)] -> Decoder s (Maybe (Word32, Word32))
forall s.
ScrubbedBytes
-> [(Word8, ByteString)] -> Decoder s (Maybe (Word32, Word32))
decodeDerivationPathAttr ScrubbedBytes
pwd
    Word8
addrType <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8 -- Type
    Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
addrType Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Decoder s ()) -> [Char] -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
            [ [Char]
"decodeAddressDerivationPath: type is not 0 (public key), it is "
            , Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
addrType
            ]
    Maybe (Word32, Word32) -> Decoder s (Maybe (Word32, Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Word32, Word32)
path

decodeProtocolMagicAttr
    :: CBOR.Decoder s (Maybe Word32)
decodeProtocolMagicAttr :: Decoder s (Maybe Word32)
decodeProtocolMagicAttr = do
    ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
3
    ByteString
_ <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
    [(Word8, ByteString)]
attrs <- Decoder s [(Word8, ByteString)]
forall s. Decoder s [(Word8, ByteString)]
decodeAllAttributes
    case ((Word8, ByteString) -> Bool)
-> [(Word8, ByteString)] -> Maybe (Word8, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2) (Word8 -> Bool)
-> ((Word8, ByteString) -> Word8) -> (Word8, ByteString) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, ByteString) -> Word8
forall a b. (a, b) -> a
fst) [(Word8, ByteString)]
attrs of
        Maybe (Word8, ByteString)
Nothing -> Maybe Word32 -> Decoder s (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
forall a. Maybe a
Nothing
        Just (Word8
_, ByteString
bytes) -> case (forall s. Decoder s Word32)
-> ByteString -> Either DeserialiseFailure Word32
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure a
deserialiseCbor forall s. Decoder s Word32
CBOR.decodeWord32 ByteString
bytes of
            Left DeserialiseFailure
_ -> [Char] -> Decoder s (Maybe Word32)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"unable to decode attribute into protocol magic"
            Right Word32
pm -> Maybe Word32 -> Decoder s (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
pm)

-- | The attributes are pairs of numeric tags and bytes, where the bytes will be
-- CBOR-encoded stuff. This decoder does not enforce "canonicity" of entries.
decodeAllAttributes
    :: CBOR.Decoder s [(Word8, ByteString)]
decodeAllAttributes :: Decoder s [(Word8, ByteString)]
decodeAllAttributes = do
    Int
n <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLenCanonical -- Address Attributes length
    Int
-> Decoder s (Word8, ByteString) -> Decoder s [(Word8, ByteString)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Decoder s (Word8, ByteString)
forall s. Decoder s (Word8, ByteString)
decodeAttr
  where
    decodeAttr :: Decoder s (Word8, ByteString)
decodeAttr = (,) (Word8 -> ByteString -> (Word8, ByteString))
-> Decoder s Word8 -> Decoder s (ByteString -> (Word8, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8 Decoder s (ByteString -> (Word8, ByteString))
-> Decoder s ByteString -> Decoder s (Word8, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes

decodeDerivationPathAttr
    :: ScrubbedBytes
    -> [(Word8, ByteString)]
    -> CBOR.Decoder s (Maybe (Word32, Word32))
decodeDerivationPathAttr :: ScrubbedBytes
-> [(Word8, ByteString)] -> Decoder s (Maybe (Word32, Word32))
decodeDerivationPathAttr ScrubbedBytes
pwd [(Word8, ByteString)]
attrs = do
    case Word8 -> [(Word8, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
derPathTag [(Word8, ByteString)]
attrs of
        Just ByteString
payload -> (forall s. Decoder s (Maybe (Word32, Word32)))
-> ByteString -> Decoder s (Maybe (Word32, Word32))
forall (m :: * -> *) r.
MonadFail m =>
(forall s. Decoder s r) -> ByteString -> m r
decodeNestedBytes forall s. Decoder s (Maybe (Word32, Word32))
decoder ByteString
payload
        Maybe ByteString
Nothing -> [Char] -> Decoder s (Maybe (Word32, Word32))
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Decoder s (Maybe (Word32, Word32)))
-> [Char] -> Decoder s (Maybe (Word32, Word32))
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
            [ [Char]
"decodeDerivationPathAttr: Missing attribute "
            , Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
derPathTag
            ]
  where
    derPathTag :: Word8
derPathTag = Word8
1
    decoder :: CBOR.Decoder s (Maybe (Word32, Word32))
    decoder :: Decoder s (Maybe (Word32, Word32))
decoder = do
        ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
        case ScrubbedBytes -> ByteString -> CryptoFailable ByteString
decryptDerivationPath ScrubbedBytes
pwd ByteString
bytes of
            CryptoPassed ByteString
plaintext ->
                (Word32, Word32) -> Maybe (Word32, Word32)
forall a. a -> Maybe a
Just ((Word32, Word32) -> Maybe (Word32, Word32))
-> Decoder s (Word32, Word32) -> Decoder s (Maybe (Word32, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Decoder s (Word32, Word32))
-> ByteString -> Decoder s (Word32, Word32)
forall (m :: * -> *) r.
MonadFail m =>
(forall s. Decoder s r) -> ByteString -> m r
decodeNestedBytes forall s. Decoder s (Word32, Word32)
decodeDerivationPath ByteString
plaintext
            CryptoFailed CryptoError
_ ->
                Maybe (Word32, Word32) -> Decoder s (Maybe (Word32, Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Word32, Word32)
forall a. Maybe a
Nothing

-- | ChaCha20/Poly1305 decrypting and authenticating the HD payload of
-- addresses.
decryptDerivationPath
    :: ScrubbedBytes
       -- ^ Symmetric key / passphrase, 32-byte long
    -> ByteString
        -- ^ Payload to be decrypted
    -> CryptoFailable ByteString
decryptDerivationPath :: ScrubbedBytes -> ByteString -> CryptoFailable ByteString
decryptDerivationPath ScrubbedBytes
pwd ByteString
bytes = do
    let (ByteString
payload, ByteString
tag) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16) ByteString
bytes
    Nonce
nonce <- ByteString -> CryptoFailable Nonce
forall iv. ByteArrayAccess iv => iv -> CryptoFailable Nonce
Poly.nonce12 ByteString
cardanoNonce
    State
st1 <- State -> State
Poly.finalizeAAD (State -> State) -> CryptoFailable State -> CryptoFailable State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScrubbedBytes -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
Poly.initialize ScrubbedBytes
pwd Nonce
nonce
    let (ByteString
out, State
st2) = ByteString -> State -> (ByteString, State)
forall ba. ByteArray ba => ba -> State -> (ba, State)
Poly.decrypt ByteString
payload State
st1
    Bool -> CryptoFailable () -> CryptoFailable ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Auth -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (State -> Auth
Poly.finalize State
st2) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
tag) (CryptoFailable () -> CryptoFailable ())
-> CryptoFailable () -> CryptoFailable ()
forall a b. (a -> b) -> a -> b
$
        CryptoError -> CryptoFailable ()
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_MacKeyInvalid
    ByteString -> CryptoFailable ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
out

-- Opposite of 'encodeDerivationPath'.
decodeDerivationPath
    :: CBOR.Decoder s (Word32, Word32)
decodeDerivationPath :: Decoder s (Word32, Word32)
decodeDerivationPath = do
    [Word32]
ixs <- Decoder s Word32 -> Decoder s [Word32]
forall s a. Decoder s a -> Decoder s [a]
decodeListIndef Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
    case [Word32]
ixs of
        [Word32
acctIx, Word32
addrIx] ->
            (Word32, Word32) -> Decoder s (Word32, Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
acctIx, Word32
addrIx)
        [Word32]
_ ->
            [Char] -> Decoder s (Word32, Word32)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Decoder s (Word32, Word32))
-> [Char] -> Decoder s (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
                [ [Char]
"decodeDerivationPath: invalid derivation path payload: "
                , [Char]
"expected two indexes but got: "
                , [Word32] -> [Char]
forall a. Show a => a -> [Char]
show [Word32]
ixs
                ]
-- | Decode an arbitrary long list. CBOR introduce a "break" character to
-- mark the end of the list, so we simply decode each item until we encounter
-- a break character.
--
-- @
--     myDecoder :: CBOR.Decoder s [MyType]
--     myDecoder = decodeListIndef decodeOne
--       where
--         decodeOne :: CBOR.Decoder s MyType
-- @
decodeListIndef :: forall s a. CBOR.Decoder s a -> CBOR.Decoder s [a]
decodeListIndef :: Decoder s a -> Decoder s [a]
decodeListIndef Decoder s a
decodeOne = do
    ()
_ <- Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
    ([a] -> a -> [a])
-> [a] -> ([a] -> [a]) -> Decoder s a -> Decoder s [a]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a] -> [a]
forall a. [a] -> [a]
reverse Decoder s a
decodeOne

-- | Byron CBOR encodings often have CBOR nested in CBOR. This helps decoding
-- a particular 'ByteString' that represents a CBOR object.
decodeNestedBytes
    :: MonadFail m
    => (forall s. CBOR.Decoder s r)
    -> ByteString
    -> m r
decodeNestedBytes :: (forall s. Decoder s r) -> ByteString -> m r
decodeNestedBytes forall s. Decoder s r
dec ByteString
bytes =
    case (forall s. Decoder s r)
-> ByteString -> Either DeserialiseFailure (ByteString, r)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes forall s. Decoder s r
dec (ByteString -> ByteString
BL.fromStrict ByteString
bytes) of
        Right (ByteString
"", r
res) ->
            r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
res
        Right (ByteString, r)
_ ->
            [Char] -> m r
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Leftovers when decoding nested bytes"
        Either DeserialiseFailure (ByteString, r)
_ ->
            [Char] -> m r
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Could not decode nested bytes"

-- | Shortcut for deserialising a strict 'Bytestring' with the given decoder.
deserialiseCbor
    :: (forall s. CBOR.Decoder s a)
    -> ByteString
    -> Either CBOR.DeserialiseFailure a
deserialiseCbor :: (forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure a
deserialiseCbor forall s. Decoder s a
dec =
  ((ByteString, a) -> a)
-> Either DeserialiseFailure (ByteString, a)
-> Either DeserialiseFailure a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, a) -> a
forall a b. (a, b) -> b
snd (Either DeserialiseFailure (ByteString, a)
 -> Either DeserialiseFailure a)
-> (ByteString -> Either DeserialiseFailure (ByteString, a))
-> ByteString
-> Either DeserialiseFailure a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes forall s. Decoder s a
dec (ByteString -> Either DeserialiseFailure (ByteString, a))
-> (ByteString -> ByteString)
-> ByteString
-> Either DeserialiseFailure (ByteString, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict

-- | CBOR deserialise without error handling - handy for prototypes or testing.
unsafeDeserialiseCbor
    :: HasCallStack
    => (forall s. CBOR.Decoder s a)
    -> BL.ByteString
    -> a
unsafeDeserialiseCbor :: (forall s. Decoder s a) -> ByteString -> a
unsafeDeserialiseCbor forall s. Decoder s a
decoder ByteString
bytes = (DeserialiseFailure -> a)
-> ((ByteString, a) -> a)
-> Either DeserialiseFailure (ByteString, a)
-> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\DeserialiseFailure
e -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"unsafeSerializeCbor: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> DeserialiseFailure -> [Char]
forall a. Show a => a -> [Char]
show DeserialiseFailure
e)
    (ByteString, a) -> a
forall a b. (a, b) -> b
snd
    ((forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes forall s. Decoder s a
decoder ByteString
bytes)