{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}

module Shelley.Spec.Ledger.MetaData
  ( MetaDatum (..),
    MetaData (MetaData),
    MetaDataHash (..),
    hashMetaData,
    validMetaData,
  )
where

import Cardano.Binary
  ( Annotator (..),
    DecoderError (..),
    FromCBOR (fromCBOR),
    ToCBOR (toCBOR),
    encodePreEncoded,
    serializeEncoding,
    withSlice,
  )
import Cardano.Ledger.Era (Crypto, Era)
import Cardano.Prelude (cborError)
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Map.Strict (Map)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
import Shelley.Spec.Ledger.Keys (Hash, hashWithSerialiser)
import Shelley.Spec.Ledger.Serialization (mapFromCBOR, mapToCBOR)

-- | A generic metadatum type.
data MetaDatum
  = -- TODO make strict:
    Map [(MetaDatum, MetaDatum)]
  | List [MetaDatum]
  | I !Integer
  | B !BS.ByteString
  | S !T.Text
  deriving stock (Int -> MetaDatum -> ShowS
[MetaDatum] -> ShowS
MetaDatum -> String
(Int -> MetaDatum -> ShowS)
-> (MetaDatum -> String)
-> ([MetaDatum] -> ShowS)
-> Show MetaDatum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaDatum] -> ShowS
$cshowList :: [MetaDatum] -> ShowS
show :: MetaDatum -> String
$cshow :: MetaDatum -> String
showsPrec :: Int -> MetaDatum -> ShowS
$cshowsPrec :: Int -> MetaDatum -> ShowS
Show, MetaDatum -> MetaDatum -> Bool
(MetaDatum -> MetaDatum -> Bool)
-> (MetaDatum -> MetaDatum -> Bool) -> Eq MetaDatum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaDatum -> MetaDatum -> Bool
$c/= :: MetaDatum -> MetaDatum -> Bool
== :: MetaDatum -> MetaDatum -> Bool
$c== :: MetaDatum -> MetaDatum -> Bool
Eq, Eq MetaDatum
Eq MetaDatum
-> (MetaDatum -> MetaDatum -> Ordering)
-> (MetaDatum -> MetaDatum -> Bool)
-> (MetaDatum -> MetaDatum -> Bool)
-> (MetaDatum -> MetaDatum -> Bool)
-> (MetaDatum -> MetaDatum -> Bool)
-> (MetaDatum -> MetaDatum -> MetaDatum)
-> (MetaDatum -> MetaDatum -> MetaDatum)
-> Ord MetaDatum
MetaDatum -> MetaDatum -> Bool
MetaDatum -> MetaDatum -> Ordering
MetaDatum -> MetaDatum -> MetaDatum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MetaDatum -> MetaDatum -> MetaDatum
$cmin :: MetaDatum -> MetaDatum -> MetaDatum
max :: MetaDatum -> MetaDatum -> MetaDatum
$cmax :: MetaDatum -> MetaDatum -> MetaDatum
>= :: MetaDatum -> MetaDatum -> Bool
$c>= :: MetaDatum -> MetaDatum -> Bool
> :: MetaDatum -> MetaDatum -> Bool
$c> :: MetaDatum -> MetaDatum -> Bool
<= :: MetaDatum -> MetaDatum -> Bool
$c<= :: MetaDatum -> MetaDatum -> Bool
< :: MetaDatum -> MetaDatum -> Bool
$c< :: MetaDatum -> MetaDatum -> Bool
compare :: MetaDatum -> MetaDatum -> Ordering
$ccompare :: MetaDatum -> MetaDatum -> Ordering
$cp1Ord :: Eq MetaDatum
Ord, (forall x. MetaDatum -> Rep MetaDatum x)
-> (forall x. Rep MetaDatum x -> MetaDatum) -> Generic MetaDatum
forall x. Rep MetaDatum x -> MetaDatum
forall x. MetaDatum -> Rep MetaDatum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaDatum x -> MetaDatum
$cfrom :: forall x. MetaDatum -> Rep MetaDatum x
Generic)

instance NoThunks MetaDatum

data MetaData = MetaData'
  { MetaData -> Map Word64 MetaDatum
mdMap :: Map Word64 MetaDatum,
    MetaData -> ByteString
mdBytes :: LBS.ByteString
  }
  deriving (MetaData -> MetaData -> Bool
(MetaData -> MetaData -> Bool)
-> (MetaData -> MetaData -> Bool) -> Eq MetaData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaData -> MetaData -> Bool
$c/= :: MetaData -> MetaData -> Bool
== :: MetaData -> MetaData -> Bool
$c== :: MetaData -> MetaData -> Bool
Eq, Int -> MetaData -> ShowS
[MetaData] -> ShowS
MetaData -> String
(Int -> MetaData -> ShowS)
-> (MetaData -> String) -> ([MetaData] -> ShowS) -> Show MetaData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaData] -> ShowS
$cshowList :: [MetaData] -> ShowS
show :: MetaData -> String
$cshow :: MetaData -> String
showsPrec :: Int -> MetaData -> ShowS
$cshowsPrec :: Int -> MetaData -> ShowS
Show, (forall x. MetaData -> Rep MetaData x)
-> (forall x. Rep MetaData x -> MetaData) -> Generic MetaData
forall x. Rep MetaData x -> MetaData
forall x. MetaData -> Rep MetaData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaData x -> MetaData
$cfrom :: forall x. MetaData -> Rep MetaData x
Generic)
  deriving (Context -> MetaData -> IO (Maybe ThunkInfo)
Proxy MetaData -> String
(Context -> MetaData -> IO (Maybe ThunkInfo))
-> (Context -> MetaData -> IO (Maybe ThunkInfo))
-> (Proxy MetaData -> String)
-> NoThunks MetaData
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy MetaData -> String
$cshowTypeOf :: Proxy MetaData -> String
wNoThunks :: Context -> MetaData -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> MetaData -> IO (Maybe ThunkInfo)
noThunks :: Context -> MetaData -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> MetaData -> IO (Maybe ThunkInfo)
NoThunks) via AllowThunksIn '["mdBytes"] MetaData

pattern MetaData :: Map Word64 MetaDatum -> MetaData
pattern $bMetaData :: Map Word64 MetaDatum -> MetaData
$mMetaData :: forall r.
MetaData -> (Map Word64 MetaDatum -> r) -> (Void# -> r) -> r
MetaData m <-
  MetaData' m _
  where
    MetaData Map Word64 MetaDatum
m =
      let bytes :: ByteString
bytes = Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Map Word64 MetaDatum -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map Word64 MetaDatum
m
       in Map Word64 MetaDatum -> ByteString -> MetaData
MetaData' Map Word64 MetaDatum
m ByteString
bytes

{-# COMPLETE MetaData #-}

instance ToCBOR MetaData where
  toCBOR :: MetaData -> Encoding
toCBOR = ByteString -> Encoding
encodePreEncoded (ByteString -> Encoding)
-> (MetaData -> ByteString) -> MetaData -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (MetaData -> ByteString) -> MetaData -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaData -> ByteString
mdBytes

instance FromCBOR (Annotator MetaData) where
  fromCBOR :: Decoder s (Annotator MetaData)
fromCBOR = do
    (Map Word64 MetaDatum
m, Annotator ByteString
bytesAnn) <- Decoder s (Map Word64 MetaDatum)
-> Decoder s (Map Word64 MetaDatum, Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s (Map Word64 MetaDatum)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
    Annotator MetaData -> Decoder s (Annotator MetaData)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator MetaData -> Decoder s (Annotator MetaData))
-> Annotator MetaData -> Decoder s (Annotator MetaData)
forall a b. (a -> b) -> a -> b
$ Map Word64 MetaDatum -> ByteString -> MetaData
MetaData' Map Word64 MetaDatum
m (ByteString -> MetaData)
-> Annotator ByteString -> Annotator MetaData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator ByteString
bytesAnn

instance ToCBOR MetaDatum where
  toCBOR :: MetaDatum -> Encoding
toCBOR = MetaDatum -> Encoding
encodeMetaDatum

instance FromCBOR MetaDatum where
  fromCBOR :: Decoder s MetaDatum
fromCBOR = Decoder s MetaDatum
forall s. Decoder s MetaDatum
decodeMetaDatum

newtype MetaDataHash era = MetaDataHash {MetaDataHash era -> Hash (Crypto era) MetaData
unsafeMetaDataHash :: Hash (Crypto era) MetaData}
  deriving (Int -> MetaDataHash era -> ShowS
[MetaDataHash era] -> ShowS
MetaDataHash era -> String
(Int -> MetaDataHash era -> ShowS)
-> (MetaDataHash era -> String)
-> ([MetaDataHash era] -> ShowS)
-> Show (MetaDataHash era)
forall era. Int -> MetaDataHash era -> ShowS
forall era. [MetaDataHash era] -> ShowS
forall era. MetaDataHash era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaDataHash era] -> ShowS
$cshowList :: forall era. [MetaDataHash era] -> ShowS
show :: MetaDataHash era -> String
$cshow :: forall era. MetaDataHash era -> String
showsPrec :: Int -> MetaDataHash era -> ShowS
$cshowsPrec :: forall era. Int -> MetaDataHash era -> ShowS
Show, MetaDataHash era -> MetaDataHash era -> Bool
(MetaDataHash era -> MetaDataHash era -> Bool)
-> (MetaDataHash era -> MetaDataHash era -> Bool)
-> Eq (MetaDataHash era)
forall era. MetaDataHash era -> MetaDataHash era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaDataHash era -> MetaDataHash era -> Bool
$c/= :: forall era. MetaDataHash era -> MetaDataHash era -> Bool
== :: MetaDataHash era -> MetaDataHash era -> Bool
$c== :: forall era. MetaDataHash era -> MetaDataHash era -> Bool
Eq, Eq (MetaDataHash era)
Eq (MetaDataHash era)
-> (MetaDataHash era -> MetaDataHash era -> Ordering)
-> (MetaDataHash era -> MetaDataHash era -> Bool)
-> (MetaDataHash era -> MetaDataHash era -> Bool)
-> (MetaDataHash era -> MetaDataHash era -> Bool)
-> (MetaDataHash era -> MetaDataHash era -> Bool)
-> (MetaDataHash era -> MetaDataHash era -> MetaDataHash era)
-> (MetaDataHash era -> MetaDataHash era -> MetaDataHash era)
-> Ord (MetaDataHash era)
MetaDataHash era -> MetaDataHash era -> Bool
MetaDataHash era -> MetaDataHash era -> Ordering
MetaDataHash era -> MetaDataHash era -> MetaDataHash era
forall era. Eq (MetaDataHash era)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall era. MetaDataHash era -> MetaDataHash era -> Bool
forall era. MetaDataHash era -> MetaDataHash era -> Ordering
forall era.
MetaDataHash era -> MetaDataHash era -> MetaDataHash era
min :: MetaDataHash era -> MetaDataHash era -> MetaDataHash era
$cmin :: forall era.
MetaDataHash era -> MetaDataHash era -> MetaDataHash era
max :: MetaDataHash era -> MetaDataHash era -> MetaDataHash era
$cmax :: forall era.
MetaDataHash era -> MetaDataHash era -> MetaDataHash era
>= :: MetaDataHash era -> MetaDataHash era -> Bool
$c>= :: forall era. MetaDataHash era -> MetaDataHash era -> Bool
> :: MetaDataHash era -> MetaDataHash era -> Bool
$c> :: forall era. MetaDataHash era -> MetaDataHash era -> Bool
<= :: MetaDataHash era -> MetaDataHash era -> Bool
$c<= :: forall era. MetaDataHash era -> MetaDataHash era -> Bool
< :: MetaDataHash era -> MetaDataHash era -> Bool
$c< :: forall era. MetaDataHash era -> MetaDataHash era -> Bool
compare :: MetaDataHash era -> MetaDataHash era -> Ordering
$ccompare :: forall era. MetaDataHash era -> MetaDataHash era -> Ordering
$cp1Ord :: forall era. Eq (MetaDataHash era)
Ord, Context -> MetaDataHash era -> IO (Maybe ThunkInfo)
Proxy (MetaDataHash era) -> String
(Context -> MetaDataHash era -> IO (Maybe ThunkInfo))
-> (Context -> MetaDataHash era -> IO (Maybe ThunkInfo))
-> (Proxy (MetaDataHash era) -> String)
-> NoThunks (MetaDataHash era)
forall era. Context -> MetaDataHash era -> IO (Maybe ThunkInfo)
forall era. Proxy (MetaDataHash era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (MetaDataHash era) -> String
$cshowTypeOf :: forall era. Proxy (MetaDataHash era) -> String
wNoThunks :: Context -> MetaDataHash era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> MetaDataHash era -> IO (Maybe ThunkInfo)
noThunks :: Context -> MetaDataHash era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> MetaDataHash era -> IO (Maybe ThunkInfo)
NoThunks)

deriving instance Era era => ToCBOR (MetaDataHash era)

deriving instance Era era => FromCBOR (MetaDataHash era)

hashMetaData ::
  Era era =>
  MetaData ->
  MetaDataHash era
hashMetaData :: MetaData -> MetaDataHash era
hashMetaData = Hash (HASH (Crypto era)) MetaData -> MetaDataHash era
forall era. Hash (Crypto era) MetaData -> MetaDataHash era
MetaDataHash (Hash (HASH (Crypto era)) MetaData -> MetaDataHash era)
-> (MetaData -> Hash (HASH (Crypto era)) MetaData)
-> MetaData
-> MetaDataHash era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaData -> Encoding)
-> MetaData -> Hash (HASH (Crypto era)) MetaData
forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
hashWithSerialiser MetaData -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

--------------------------------------------------------------------------------
-- Validation of sizes

validMetaData :: MetaData -> Bool
validMetaData :: MetaData -> Bool
validMetaData (MetaData Map Word64 MetaDatum
m) = (MetaDatum -> Bool) -> Map Word64 MetaDatum -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MetaDatum -> Bool
validMetaDatum Map Word64 MetaDatum
m

validMetaDatum :: MetaDatum -> Bool
-- The integer size/representation checks are enforced in the decoder.
validMetaDatum :: MetaDatum -> Bool
validMetaDatum (I Integer
_) = Bool
True
validMetaDatum (B ByteString
b) = ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
validMetaDatum (S Text
s) = ByteString -> Int
BS.length (Text -> ByteString
T.encodeUtf8 Text
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
validMetaDatum (List [MetaDatum]
xs) = (MetaDatum -> Bool) -> [MetaDatum] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MetaDatum -> Bool
validMetaDatum [MetaDatum]
xs
validMetaDatum (Map [(MetaDatum, MetaDatum)]
kvs) =
  ((MetaDatum, MetaDatum) -> Bool)
-> [(MetaDatum, MetaDatum)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
    ( \(MetaDatum
k, MetaDatum
v) ->
        MetaDatum -> Bool
validMetaDatum MetaDatum
k
          Bool -> Bool -> Bool
&& MetaDatum -> Bool
validMetaDatum MetaDatum
v
    )
    [(MetaDatum, MetaDatum)]
kvs

--------------------------------------------------------------------------------
-- CBOR encoding and decoding

encodeMetaDatum :: MetaDatum -> CBOR.Encoding
encodeMetaDatum :: MetaDatum -> Encoding
encodeMetaDatum (I Integer
n) = Integer -> Encoding
CBOR.encodeInteger Integer
n
encodeMetaDatum (B ByteString
b) = ByteString -> Encoding
CBOR.encodeBytes ByteString
b
encodeMetaDatum (S Text
s) = Text -> Encoding
CBOR.encodeString Text
s
encodeMetaDatum (List [MetaDatum]
xs) =
  Word -> Encoding
CBOR.encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([MetaDatum] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MetaDatum]
xs))
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ MetaDatum -> Encoding
encodeMetaDatum MetaDatum
x
        | MetaDatum
x <- [MetaDatum]
xs
      ]
encodeMetaDatum (Map [(MetaDatum, MetaDatum)]
kvs) =
  Word -> Encoding
CBOR.encodeMapLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(MetaDatum, MetaDatum)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(MetaDatum, MetaDatum)]
kvs))
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ MetaDatum -> Encoding
encodeMetaDatum MetaDatum
k Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MetaDatum -> Encoding
encodeMetaDatum MetaDatum
v
        | (MetaDatum
k, MetaDatum
v) <- [(MetaDatum, MetaDatum)]
kvs
      ]

-- | Decode a transaction matadatum value from its CBOR representation.
--
-- The CDDL for the CBOR is
--
-- > transaction_metadatum =
-- >     int
-- >   / bytes .size (0..64)
-- >   / text .size (0..64)
-- >   / [ * transaction_metadatum ]
-- >   / { * transaction_metadatum => transaction_metadatum }
--
-- We do not require canonical representations, just like everywhere else
-- on the chain. We accept both definte and indefinite representations.
--
-- The byte and string length checks are not enforced in this decoder, but
decodeMetaDatum :: Decoder s MetaDatum
decodeMetaDatum :: Decoder s MetaDatum
decodeMetaDatum = do
  TokenType
tkty <- Decoder s TokenType
forall s. Decoder s TokenType
CBOR.peekTokenType
  case TokenType
tkty of
    -- We support -(2^64-1) .. 2^64-1, but not big integers
    -- not even big integer representation of values within range
    TokenType
CBOR.TypeUInt -> Integer -> MetaDatum
I (Integer -> MetaDatum) -> Decoder s Integer -> Decoder s MetaDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
CBOR.decodeInteger
    TokenType
CBOR.TypeUInt64 -> Integer -> MetaDatum
I (Integer -> MetaDatum) -> Decoder s Integer -> Decoder s MetaDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
CBOR.decodeInteger
    TokenType
CBOR.TypeNInt -> Integer -> MetaDatum
I (Integer -> MetaDatum) -> Decoder s Integer -> Decoder s MetaDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
CBOR.decodeInteger
    TokenType
CBOR.TypeNInt64 -> Integer -> MetaDatum
I (Integer -> MetaDatum) -> Decoder s Integer -> Decoder s MetaDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
CBOR.decodeInteger
    -- Note that we do not enforce byte and string lengths here in the
    -- decoder. We enforce that in the tx validation rules.
    TokenType
CBOR.TypeBytes -> do
      !ByteString
x <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> MetaDatum
B ByteString
x)
    TokenType
CBOR.TypeBytesIndef -> do
      Decoder s ()
forall s. Decoder s ()
CBOR.decodeBytesIndef
      !ByteString
x <- [ByteString] -> Decoder s ByteString
forall s. [ByteString] -> Decoder s ByteString
decodeBytesIndefLen []
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> MetaDatum
B ByteString
x)
    TokenType
CBOR.TypeString -> do
      !Text
x <- Decoder s Text
forall s. Decoder s Text
CBOR.decodeString
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MetaDatum
S Text
x)
    TokenType
CBOR.TypeStringIndef -> do
      Decoder s ()
forall s. Decoder s ()
CBOR.decodeStringIndef
      !Text
x <- [Text] -> Decoder s Text
forall s. [Text] -> Decoder s Text
decodeStringIndefLen []
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MetaDatum
S Text
x)

    -- Why does it work to do the same thing here for 32 and 64bit list len
    -- tokens? On 32bit systems the decodeListLen will fail if the value
    -- really is bigger than maxBound :: Int, and on 64bit systems if a value
    -- that big is provided, then it'll fail when it runs out of input for
    -- such a big list. Hence we can do exactly the same for the 32bit and
    -- 64bit cases.
    TokenType
CBOR.TypeListLen -> do
      Int
n <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
      [MetaDatum]
xs <- Int -> [MetaDatum] -> Decoder s [MetaDatum]
forall s. Int -> [MetaDatum] -> Decoder s [MetaDatum]
decodeListN Int
n []
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaDatum] -> MetaDatum
List [MetaDatum]
xs)
    TokenType
CBOR.TypeListLen64 -> do
      Int
n <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
      [MetaDatum]
xs <- Int -> [MetaDatum] -> Decoder s [MetaDatum]
forall s. Int -> [MetaDatum] -> Decoder s [MetaDatum]
decodeListN Int
n []
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaDatum] -> MetaDatum
List [MetaDatum]
xs)
    TokenType
CBOR.TypeListLenIndef -> do
      Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
      [MetaDatum]
xs <- [MetaDatum] -> Decoder s [MetaDatum]
forall s. [MetaDatum] -> Decoder s [MetaDatum]
decodeListIndefLen []
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaDatum] -> MetaDatum
List [MetaDatum]
xs)

    -- Same logic applies as above for large lists.
    TokenType
CBOR.TypeMapLen -> do
      Int
n <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLen
      [(MetaDatum, MetaDatum)]
xs <- Int
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall s.
Int
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapN Int
n []
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MetaDatum, MetaDatum)] -> MetaDatum
Map [(MetaDatum, MetaDatum)]
xs)
    TokenType
CBOR.TypeMapLen64 -> do
      Int
n <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLen
      [(MetaDatum, MetaDatum)]
xs <- Int
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall s.
Int
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapN Int
n []
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MetaDatum, MetaDatum)] -> MetaDatum
Map [(MetaDatum, MetaDatum)]
xs)
    TokenType
CBOR.TypeMapLenIndef -> do
      Decoder s ()
forall s. Decoder s ()
CBOR.decodeMapLenIndef
      [(MetaDatum, MetaDatum)]
xs <- [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall s.
[(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapIndefLen []
      MetaDatum -> Decoder s MetaDatum
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MetaDatum, MetaDatum)] -> MetaDatum
Map [(MetaDatum, MetaDatum)]
xs)
    TokenType
_ -> Text -> Decoder s MetaDatum
forall s a. Text -> Decoder s a
decodeError (Text
"Unsupported CBOR token type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TokenType -> String
forall a. Show a => a -> String
show TokenType
tkty))
  where
    decodeError :: Text -> Decoder s a
decodeError Text
msg = DecoderError -> Decoder s a
forall e s a. Buildable e => e -> Decoder s a
cborError (Text -> Text -> DecoderError
DecoderErrorCustom Text
"metadata" Text
msg)

decodeBytesIndefLen :: [BS.ByteString] -> CBOR.Decoder s ByteString
decodeBytesIndefLen :: [ByteString] -> Decoder s ByteString
decodeBytesIndefLen [ByteString]
acc = do
  Bool
stop <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBreakOr
  if Bool
stop
    then 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
$! [ByteString] -> ByteString
BS.concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)
    else do
      !ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
      [ByteString] -> Decoder s ByteString
forall s. [ByteString] -> Decoder s ByteString
decodeBytesIndefLen (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc)

decodeStringIndefLen :: [T.Text] -> Decoder s T.Text
decodeStringIndefLen :: [Text] -> Decoder s Text
decodeStringIndefLen [Text]
acc = do
  Bool
stop <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBreakOr
  if Bool
stop
    then Text -> Decoder s Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Decoder s Text) -> Text -> Decoder s Text
forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.concat ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
acc)
    else do
      !Text
str <- Decoder s Text
forall s. Decoder s Text
CBOR.decodeString
      [Text] -> Decoder s Text
forall s. [Text] -> Decoder s Text
decodeStringIndefLen (Text
str Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc)

decodeListN :: Int -> [MetaDatum] -> Decoder s [MetaDatum]
decodeListN :: Int -> [MetaDatum] -> Decoder s [MetaDatum]
decodeListN !Int
n [MetaDatum]
acc =
  case Int
n of
    Int
0 -> [MetaDatum] -> Decoder s [MetaDatum]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaDatum] -> Decoder s [MetaDatum])
-> [MetaDatum] -> Decoder s [MetaDatum]
forall a b. (a -> b) -> a -> b
$! [MetaDatum] -> [MetaDatum]
forall a. [a] -> [a]
reverse [MetaDatum]
acc
    Int
_ -> do
      !MetaDatum
t <- Decoder s MetaDatum
forall s. Decoder s MetaDatum
decodeMetaDatum
      Int -> [MetaDatum] -> Decoder s [MetaDatum]
forall s. Int -> [MetaDatum] -> Decoder s [MetaDatum]
decodeListN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (MetaDatum
t MetaDatum -> [MetaDatum] -> [MetaDatum]
forall a. a -> [a] -> [a]
: [MetaDatum]
acc)

decodeListIndefLen :: [MetaDatum] -> Decoder s [MetaDatum]
decodeListIndefLen :: [MetaDatum] -> Decoder s [MetaDatum]
decodeListIndefLen [MetaDatum]
acc = do
  Bool
stop <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBreakOr
  if Bool
stop
    then [MetaDatum] -> Decoder s [MetaDatum]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MetaDatum] -> Decoder s [MetaDatum])
-> [MetaDatum] -> Decoder s [MetaDatum]
forall a b. (a -> b) -> a -> b
$! [MetaDatum] -> [MetaDatum]
forall a. [a] -> [a]
reverse [MetaDatum]
acc
    else do
      !MetaDatum
tm <- Decoder s MetaDatum
forall s. Decoder s MetaDatum
decodeMetaDatum
      [MetaDatum] -> Decoder s [MetaDatum]
forall s. [MetaDatum] -> Decoder s [MetaDatum]
decodeListIndefLen (MetaDatum
tm MetaDatum -> [MetaDatum] -> [MetaDatum]
forall a. a -> [a] -> [a]
: [MetaDatum]
acc)

decodeMapN :: Int -> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapN :: Int
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapN !Int
n [(MetaDatum, MetaDatum)]
acc =
  case Int
n of
    Int
0 -> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)])
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall a b. (a -> b) -> a -> b
$! [(MetaDatum, MetaDatum)] -> [(MetaDatum, MetaDatum)]
forall a. [a] -> [a]
reverse [(MetaDatum, MetaDatum)]
acc
    Int
_ -> do
      !MetaDatum
tm <- Decoder s MetaDatum
forall s. Decoder s MetaDatum
decodeMetaDatum
      !MetaDatum
tm' <- Decoder s MetaDatum
forall s. Decoder s MetaDatum
decodeMetaDatum
      Int
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall s.
Int
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((MetaDatum
tm, MetaDatum
tm') (MetaDatum, MetaDatum)
-> [(MetaDatum, MetaDatum)] -> [(MetaDatum, MetaDatum)]
forall a. a -> [a] -> [a]
: [(MetaDatum, MetaDatum)]
acc)

decodeMapIndefLen :: [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapIndefLen :: [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapIndefLen [(MetaDatum, MetaDatum)]
acc = do
  Bool
stop <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBreakOr
  if Bool
stop
    then [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)])
-> [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall a b. (a -> b) -> a -> b
$! [(MetaDatum, MetaDatum)] -> [(MetaDatum, MetaDatum)]
forall a. [a] -> [a]
reverse [(MetaDatum, MetaDatum)]
acc
    else do
      !MetaDatum
tm <- Decoder s MetaDatum
forall s. Decoder s MetaDatum
decodeMetaDatum
      !MetaDatum
tm' <- Decoder s MetaDatum
forall s. Decoder s MetaDatum
decodeMetaDatum
      [(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
forall s.
[(MetaDatum, MetaDatum)] -> Decoder s [(MetaDatum, MetaDatum)]
decodeMapIndefLen ((MetaDatum
tm, MetaDatum
tm') (MetaDatum, MetaDatum)
-> [(MetaDatum, MetaDatum)] -> [(MetaDatum, MetaDatum)]
forall a. a -> [a] -> [a]
: [(MetaDatum, MetaDatum)]
acc)