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

-- |
-- 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).
--
-- The format described in the decoders below are the one used in the Byron era
-- of Cardano and will endure in the first stages of Shelley. They are also used
-- by components like the Rust <https://github.com/input-output-hk/cardano-http-bridge cardano-http-bridge>.

module Cardano.Byron.Codec.Cbor
    (
    -- * Decoding
      decodeAddressDerivationPath
    , decodeAddressPayload
    , decodeAllAttributes
    , decodeDerivationPathAttr
    , decodeTx

    -- * Encoding
    , encodeAddress
    , encodeAttributes
    , encodeDerivationPathAttr
    , encodeProtocolMagicAttr
    , encodeTx

    -- * Helpers
    , deserialiseCbor
    , decodeListIndef
    , decodeNestedBytes
    ) where

import Prelude

import Cardano.Address.Derivation
    ( XPub, xpubToBytes )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..), DerivationType (..), Index (..) )
import Cardano.Wallet.Primitive.Passphrase
    ( Passphrase (..) )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.ProtocolMagic
    ( ProtocolMagic (..) )
import Cardano.Wallet.Primitive.Types.Tx
    ( TxIn (..), TxOut (..), unsafeCoinToTxOutCoinValue )
import Control.Monad
    ( replicateM, when )
import Crypto.Error
    ( CryptoError (..), CryptoFailable (..) )
import Crypto.Hash
    ( hash )
import Crypto.Hash.Algorithms
    ( Blake2b_224, SHA3_256 )
import Data.ByteString
    ( ByteString )
import Data.Digest.CRC32
    ( crc32 )
import Data.Either.Extra
    ( eitherToMaybe )
import Data.Word
    ( Word8 )

import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
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   |
                                     +----------------------------------+

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

decodeAddress :: CBOR.Decoder s Address
decodeAddress :: Decoder s Address
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
    -- 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.
    --
    -- NOTE 2:
    -- We may want to check the CRC at this level as-well... maybe not.
    Address -> Decoder s Address
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> Decoder s Address) -> Address -> Decoder s Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
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
_ <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32 -- CRC
    ByteString -> Decoder s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes

decodeAddressDerivationPath
    :: Passphrase "addr-derivation-payload"
    -> CBOR.Decoder s (Maybe
        ( Index 'WholeDomain 'AccountK
        , Index 'WholeDomain 'AddressK
        ))
decodeAddressDerivationPath :: Passphrase "addr-derivation-payload"
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
decodeAddressDerivationPath Passphrase "addr-derivation-payload"
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 (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
path <- Decoder s [(Word8, ByteString)]
forall s. Decoder s [(Word8, ByteString)]
decodeAllAttributes Decoder s [(Word8, ByteString)]
-> ([(Word8, ByteString)]
    -> Decoder
         s
         (Maybe
            (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)))
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Passphrase "addr-derivation-payload"
-> [(Word8, ByteString)]
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
forall s.
Passphrase "addr-derivation-payload"
-> [(Word8, ByteString)]
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
decodeDerivationPathAttr Passphrase "addr-derivation-payload"
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
$
        String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"decodeAddressDerivationPath: type is not 0 (public key), it is "
            , Word8 -> String
forall a. Show a => a -> String
show Word8
addrType
            ]
    Maybe (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
path

decodeEmptyAttributes :: CBOR.Decoder s ((), CBOR.Encoding)
decodeEmptyAttributes :: Decoder s ((), Encoding)
decodeEmptyAttributes = do
    Int
_ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLenCanonical -- Empty map of attributes
    ((), Encoding) -> Decoder s ((), Encoding)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), Word -> Encoding
CBOR.encodeMapLen Word
0)

-- | 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
    :: Passphrase "addr-derivation-payload"
    -> [(Word8, ByteString)]
    -> CBOR.Decoder s (Maybe
        ( Index 'WholeDomain 'AccountK
        , Index 'WholeDomain 'AddressK
        ))
decodeDerivationPathAttr :: Passphrase "addr-derivation-payload"
-> [(Word8, ByteString)]
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
decodeDerivationPathAttr Passphrase "addr-derivation-payload"
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 -> do
            (forall s.
 Decoder
   s
   (Maybe
      (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)))
-> ByteString
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
forall (m :: * -> *) r.
MonadFail m =>
(forall s. Decoder s r) -> ByteString -> m r
decodeNestedBytes forall s.
Decoder
  s
  (Maybe
     (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
decoder ByteString
payload
        Maybe ByteString
Nothing -> String
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Decoder
      s
      (Maybe
         (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)))
-> String
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"decodeDerivationPathAttr: Missing attribute "
            , Word8 -> String
forall a. Show a => a -> String
show Word8
derPathTag
            ]
  where
    derPathTag :: Word8
derPathTag = Word8
1
    decoder :: CBOR.Decoder s (Maybe
        ( Index 'WholeDomain 'AccountK
        , Index 'WholeDomain 'AddressK
        ))
    decoder :: Decoder
  s
  (Maybe
     (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
decoder = do
        ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
        case Passphrase "addr-derivation-payload"
-> ByteString -> CryptoFailable ByteString
decryptDerivationPath Passphrase "addr-derivation-payload"
pwd ByteString
bytes of
            CryptoPassed ByteString
plaintext ->
                (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
-> Maybe
     (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
forall a. a -> Maybe a
Just ((Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
 -> Maybe
      (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
-> Decoder
     s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s.
 Decoder
   s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
-> ByteString
-> Decoder
     s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
forall (m :: * -> *) r.
MonadFail m =>
(forall s. Decoder s r) -> ByteString -> m r
decodeNestedBytes forall s.
Decoder
  s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
decodeDerivationPath ByteString
plaintext
            CryptoFailed CryptoError
_ ->
                Maybe (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
-> Decoder
     s
     (Maybe
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
forall a. Maybe a
Nothing

-- Opposite of 'encodeDerivationPath'.
decodeDerivationPath
    :: CBOR.Decoder s
        ( Index 'WholeDomain 'AccountK
        , Index 'WholeDomain 'AddressK
        )
decodeDerivationPath :: Decoder
  s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
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] ->
            (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
-> Decoder
     s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Index 'WholeDomain 'AccountK
forall a. Enum a => Int -> a
toEnum (Int -> Index 'WholeDomain 'AccountK)
-> Int -> Index 'WholeDomain 'AccountK
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
acctIx, Int -> Index 'WholeDomain 'AddressK
forall a. Enum a => Int -> a
toEnum (Int -> Index 'WholeDomain 'AddressK)
-> Int -> Index 'WholeDomain 'AddressK
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
addrIx)
        [Word32]
_ ->
            String
-> Decoder
     s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> Decoder
      s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK))
-> String
-> Decoder
     s (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"decodeDerivationPath: invalid derivation path payload: "
                , String
"expected two indexes but got: "
                , [Word32] -> String
forall a. Show a => a -> String
show [Word32]
ixs
                ]

decodeTx :: CBOR.Decoder s ([TxIn], [TxOut])
decodeTx :: Decoder s ([TxIn], [TxOut])
decodeTx = do
    ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
3
    [TxIn]
ins <- Decoder s TxIn -> Decoder s [TxIn]
forall s a. Decoder s a -> Decoder s [a]
decodeListIndef Decoder s TxIn
forall s. Decoder s TxIn
decodeTxIn
    [TxOut]
outs <- Decoder s TxOut -> Decoder s [TxOut]
forall s a. Decoder s a -> Decoder s [a]
decodeListIndef Decoder s TxOut
forall s. Decoder s TxOut
decodeTxOut
    ((), Encoding)
_ <- Decoder s ((), Encoding)
forall s. Decoder s ((), Encoding)
decodeEmptyAttributes
    ([TxIn], [TxOut]) -> Decoder s ([TxIn], [TxOut])
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxIn]
ins, [TxOut]
outs)

{- HLINT ignore decodeTxIn "Use <$>" -}
decodeTxIn :: CBOR.Decoder s TxIn
decodeTxIn :: Decoder s TxIn
decodeTxIn = do
    ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
2
    Word8
t <- Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8
    case Word8
t of
        Word8
0 -> do
            Word
_tag <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeTag
            ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
            case (forall s. Decoder s TxIn)
-> ByteString -> Either DeserialiseFailure (ByteString, TxIn)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes forall s. Decoder s TxIn
decodeTxIn' (ByteString -> ByteString
BL.fromStrict ByteString
bytes) of
                Left DeserialiseFailure
err -> String -> Decoder s TxIn
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s TxIn) -> String -> Decoder s TxIn
forall a b. (a -> b) -> a -> b
$ DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
err
                Right (ByteString
_, TxIn
input) -> TxIn -> Decoder s TxIn
forall (m :: * -> *) a. Monad m => a -> m a
return TxIn
input
        Word8
_ -> String -> Decoder s TxIn
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s TxIn) -> String -> Decoder s TxIn
forall a b. (a -> b) -> a -> b
$ String
"decodeTxIn: unknown tx input constructor: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
t
  where
    decodeTxIn' :: CBOR.Decoder s TxIn
    decodeTxIn' :: Decoder s TxIn
decodeTxIn' = do
        ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
2
        Hash "Tx"
tx <- ByteString -> Hash "Tx"
forall (tag :: Symbol). ByteString -> Hash tag
Hash (ByteString -> Hash "Tx")
-> Decoder s ByteString -> Decoder s (Hash "Tx")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
        Hash "Tx" -> Word32 -> TxIn
TxIn Hash "Tx"
tx (Word32 -> TxIn) -> Decoder s Word32 -> Decoder s TxIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32

{- HLINT ignore decodeTxOut "Use <$>" -}
decodeTxOut :: CBOR.Decoder s TxOut
decodeTxOut :: Decoder s TxOut
decodeTxOut = do
    ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
2
    Address
addr <- Decoder s Address
forall s. Decoder s Address
decodeAddress
    Address -> TokenBundle -> TxOut
TxOut Address
addr (TokenBundle -> TxOut)
-> (Word64 -> TokenBundle) -> Word64 -> TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> TokenBundle
TokenBundle.fromCoin (Coin -> TokenBundle) -> (Word64 -> Coin) -> Word64 -> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Coin
Coin.fromWord64 (Word64 -> TxOut) -> Decoder s Word64 -> Decoder s TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
CBOR.decodeWord64

-- * 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
xpub [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 (XPub -> ByteString
xpubToBytes XPub
xpub)
    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 :: ProtocolMagic -> CBOR.Encoding
encodeProtocolMagicAttr :: ProtocolMagic -> Encoding
encodeProtocolMagicAttr ProtocolMagic
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
$ ProtocolMagic -> Encoding
encodeProtocolMagic ProtocolMagic
pm)

-- This is the opposite of 'decodeDerivationPathAttr'.
--
-- NOTE: The caller must ensure that the passphrase length is 32 bytes.
encodeDerivationPathAttr
    :: Passphrase "addr-derivation-payload"
    -> Index 'WholeDomain 'AccountK
    -> Index 'WholeDomain 'AddressK
    -> CBOR.Encoding
encodeDerivationPathAttr :: Passphrase "addr-derivation-payload"
-> Index 'WholeDomain 'AccountK
-> Index 'WholeDomain 'AddressK
-> Encoding
encodeDerivationPathAttr Passphrase "addr-derivation-payload"
pwd Index 'WholeDomain 'AccountK
acctIx Index 'WholeDomain 'AddressK
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 (Passphrase "addr-derivation-payload" -> Encoding -> ByteString
encryptDerivationPath Passphrase "addr-derivation-payload"
pwd Encoding
path)
  where
    path :: Encoding
path = Index 'WholeDomain 'AccountK
-> Index 'WholeDomain 'AddressK -> Encoding
encodeDerivationPath Index 'WholeDomain 'AccountK
acctIx Index 'WholeDomain 'AddressK
addrIx

encodeDerivationPath
    :: Index 'WholeDomain 'AccountK
    -> Index 'WholeDomain 'AddressK
    -> CBOR.Encoding
encodeDerivationPath :: Index 'WholeDomain 'AccountK
-> Index 'WholeDomain 'AddressK -> Encoding
encodeDerivationPath (Index Word32
acctIx) (Index 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

encodeTx :: ([TxIn], [TxOut]) -> CBOR.Encoding
encodeTx :: ([TxIn], [TxOut]) -> Encoding
encodeTx ([TxIn]
inps, [TxOut]
outs) = 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
<> Encoding
CBOR.encodeListLenIndef
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat (TxIn -> Encoding
encodeTxIn (TxIn -> Encoding) -> [TxIn] -> [Encoding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxIn]
inps)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeListLenIndef
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat (TxOut -> Encoding
encodeTxOut (TxOut -> Encoding) -> [TxOut] -> [Encoding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut]
outs)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
encodeTxAttributes

encodeTxAttributes :: CBOR.Encoding
encodeTxAttributes :: Encoding
encodeTxAttributes = Encoding
forall a. Monoid a => a
mempty
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeMapLen Word
0

encodeProtocolMagic :: ProtocolMagic -> CBOR.Encoding
encodeProtocolMagic :: ProtocolMagic -> Encoding
encodeProtocolMagic (ProtocolMagic Int32
i) = Int32 -> Encoding
CBOR.encodeInt32 Int32
i

encodeTxIn :: TxIn -> CBOR.Encoding
encodeTxIn :: TxIn -> Encoding
encodeTxIn (TxIn (Hash ByteString
txid) Word32
ix) = 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
<> Word8 -> Encoding
CBOR.encodeWord8 Word8
0
    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
bytes
  where
    bytes :: ByteString
bytes = 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
<> ByteString -> Encoding
CBOR.encodeBytes ByteString
txid
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 Word32
ix

encodeTxOut :: TxOut -> CBOR.Encoding
encodeTxOut :: TxOut -> Encoding
encodeTxOut (TxOut (Address ByteString
addr) TokenBundle
tb) = 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
<> ByteString -> Encoding
encodeAddressPayload ByteString
payload
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
CBOR.encodeWord64 (HasCallStack => Coin -> Word64
Coin -> Word64
unsafeCoinToTxOutCoinValue (Coin -> Word64) -> Coin -> Word64
forall a b. (a -> b) -> a -> b
$ TokenBundle -> Coin
TokenBundle.getCoin TokenBundle
tb)
  where
    invariant :: ByteString
invariant =
        String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"encodeTxOut: unable to decode address payload: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
addr
    payload :: ByteString
payload =
        (DeserialiseFailure -> ByteString)
-> ((ByteString, ByteString) -> ByteString)
-> Either DeserialiseFailure (ByteString, ByteString)
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> DeserialiseFailure -> ByteString
forall a b. a -> b -> a
const ByteString
invariant) (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Either DeserialiseFailure (ByteString, ByteString) -> ByteString)
-> Either DeserialiseFailure (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (forall s. Decoder s ByteString)
-> ByteString -> Either DeserialiseFailure (ByteString, ByteString)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes
            forall s. Decoder s ByteString
decodeAddressPayload
            (ByteString -> ByteString
BL.fromStrict ByteString
addr)

{-------------------------------------------------------------------------------
                    HD payload encryption and authentication
-------------------------------------------------------------------------------}

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

-- | ChaCha20/Poly1305 encrypting and signing the HD payload of addresses.
--
-- NOTE: The caller must ensure that the passphrase length is 32 bytes.
encryptDerivationPath
    :: Passphrase "addr-derivation-payload"
       -- ^ Symmetric key / passphrase, 32-byte long
    -> CBOR.Encoding
        -- ^ Payload to be encrypted
    -> ByteString
        -- ^ Ciphertext with a 128-bit crypto-tag appended.
encryptDerivationPath :: Passphrase "addr-derivation-payload" -> Encoding -> ByteString
encryptDerivationPath Passphrase "addr-derivation-payload"
passphrase 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 (Passphrase "addr-derivation-payload" -> ScrubbedBytes
forall (purpose :: Symbol). Passphrase purpose -> ScrubbedBytes
unPassphrase Passphrase "addr-derivation-payload"
passphrase) 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 -> String -> p
forall a. HasCallStack => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"encodeAddressKey: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CryptoError -> String
forall a. Show a => a -> String
show CryptoError
err

-- | ChaCha20/Poly1305 decrypting and authenticating the HD payload of
-- addresses.
decryptDerivationPath
    :: Passphrase "addr-derivation-payload"
       -- ^ Symmetric key / passphrase, 32-byte long
    -> ByteString
        -- ^ Payload to be decrypted
    -> CryptoFailable ByteString
decryptDerivationPath :: Passphrase "addr-derivation-payload"
-> ByteString -> CryptoFailable ByteString
decryptDerivationPath Passphrase "addr-derivation-payload"
passphrase 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 (Passphrase "addr-derivation-payload" -> ScrubbedBytes
forall (purpose :: Symbol). Passphrase purpose -> ScrubbedBytes
unPassphrase Passphrase "addr-derivation-payload"
passphrase) 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

{-------------------------------------------------------------------------------
                                Helpers
-------------------------------------------------------------------------------}

-- | 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)
_ ->
            String -> m r
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Leftovers when decoding nested bytes"
        Either DeserialiseFailure (ByteString, r)
_ ->
            String -> m r
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not decode nested bytes"

-- | Shortcut for deserialising a strict 'Bytestring' with the given decoder.
deserialiseCbor
    :: (forall s. CBOR.Decoder s a)
    -> ByteString
    -> Maybe a
deserialiseCbor :: (forall s. Decoder s a) -> ByteString -> Maybe a
deserialiseCbor forall s. Decoder s a
dec =
    ((ByteString, a) -> a) -> Maybe (ByteString, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, a) -> a
forall a b. (a, b) -> b
snd (Maybe (ByteString, a) -> Maybe a)
-> (ByteString -> Maybe (ByteString, a)) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either DeserialiseFailure (ByteString, a) -> Maybe (ByteString, a)
forall a b. Either a b -> Maybe b
eitherToMaybe (Either DeserialiseFailure (ByteString, a)
 -> Maybe (ByteString, a))
-> (ByteString -> Either DeserialiseFailure (ByteString, a))
-> ByteString
-> Maybe (ByteString, 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