{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK hide #-}
module Cardano.Codec.Cbor
(
encodeAddress
, encodeAttributes
, encodeDerivationPathAttr
, encodeProtocolMagicAttr
, decodeAddress
, decodeAddressDerivationPath
, decodeAddressPayload
, decodeAllAttributes
, decodeDerivationPathAttr
, decodeProtocolMagicAttr
, deserialiseCbor
, unsafeDeserialiseCbor
, 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
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
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
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
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
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)
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
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
encryptDerivationPath
:: ScrubbedBytes
-> CBOR.Encoding
-> ByteString
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
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
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
Word
tag <- 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 -> 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
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)
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
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
decryptDerivationPath
:: ScrubbedBytes
-> ByteString
-> 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
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
]
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
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"
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
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)