{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module PlutusCore.Data (Data (..)) where
import Codec.CBOR.Decoding (Decoder)
import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding (Encoding)
import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Magic qualified as CBOR
import Codec.Serialise (Serialise (decode, encode))
import Codec.Serialise.Decoding (decodeSequenceLenIndef, decodeSequenceLenN)
import Control.DeepSeq (NFData)
import Control.Monad (unless)
import Data.Bits (shiftR)
import Data.ByteString qualified as BS
import Data.ByteString.Base64 qualified as Base64
import Data.ByteString.Lazy qualified as BSL
import Data.Data qualified
import Data.Hashable
import Data.Text.Encoding qualified as Text
import Data.Word (Word64, Word8)
import GHC.Generics
import NoThunks.Class
import Prelude
import Prettyprinter
data Data =
Constr Integer [Data]
| Map [(Data, Data)]
| List [Data]
| I Integer
| B BS.ByteString
deriving stock (Int -> Data -> ShowS
[Data] -> ShowS
Data -> String
(Int -> Data -> ShowS)
-> (Data -> String) -> ([Data] -> ShowS) -> Show Data
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Data -> ShowS
showsPrec :: Int -> Data -> ShowS
$cshow :: Data -> String
show :: Data -> String
$cshowList :: [Data] -> ShowS
showList :: [Data] -> ShowS
Show, ReadPrec [Data]
ReadPrec Data
Int -> ReadS Data
ReadS [Data]
(Int -> ReadS Data)
-> ReadS [Data] -> ReadPrec Data -> ReadPrec [Data] -> Read Data
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Data
readsPrec :: Int -> ReadS Data
$creadList :: ReadS [Data]
readList :: ReadS [Data]
$creadPrec :: ReadPrec Data
readPrec :: ReadPrec Data
$creadListPrec :: ReadPrec [Data]
readListPrec :: ReadPrec [Data]
Read, Data -> Data -> Bool
(Data -> Data -> Bool) -> (Data -> Data -> Bool) -> Eq Data
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Data -> Data -> Bool
== :: Data -> Data -> Bool
$c/= :: Data -> Data -> Bool
/= :: Data -> Data -> Bool
Eq, Eq Data
Eq Data =>
(Data -> Data -> Ordering)
-> (Data -> Data -> Bool)
-> (Data -> Data -> Bool)
-> (Data -> Data -> Bool)
-> (Data -> Data -> Bool)
-> (Data -> Data -> Data)
-> (Data -> Data -> Data)
-> Ord Data
Data -> Data -> Bool
Data -> Data -> Ordering
Data -> Data -> Data
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
$ccompare :: Data -> Data -> Ordering
compare :: Data -> Data -> Ordering
$c< :: Data -> Data -> Bool
< :: Data -> Data -> Bool
$c<= :: Data -> Data -> Bool
<= :: Data -> Data -> Bool
$c> :: Data -> Data -> Bool
> :: Data -> Data -> Bool
$c>= :: Data -> Data -> Bool
>= :: Data -> Data -> Bool
$cmax :: Data -> Data -> Data
max :: Data -> Data -> Data
$cmin :: Data -> Data -> Data
min :: Data -> Data -> Data
Ord, (forall x. Data -> Rep Data x)
-> (forall x. Rep Data x -> Data) -> Generic Data
forall x. Rep Data x -> Data
forall x. Data -> Rep Data x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Data -> Rep Data x
from :: forall x. Data -> Rep Data x
$cto :: forall x. Rep Data x -> Data
to :: forall x. Rep Data x -> Data
Generic, Typeable Data
Typeable Data =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Data -> c Data)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Data)
-> (Data -> Constr)
-> (Data -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Data))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Data))
-> ((forall b. Data b => b -> b) -> Data -> Data)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Data -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Data -> r)
-> (forall u. (forall d. Data d => d -> u) -> Data -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Data -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Data -> m Data)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Data -> m Data)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Data -> m Data)
-> Data Data
Data -> Constr
Data -> DataType
(forall b. Data b => b -> b) -> Data -> Data
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Data -> u
forall u. (forall d. Data d => d -> u) -> Data -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Data -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Data -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Data -> m Data
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Data -> m Data
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Data
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Data -> c Data
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Data)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Data)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Data -> c Data
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Data -> c Data
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Data
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Data
$ctoConstr :: Data -> Constr
toConstr :: Data -> Constr
$cdataTypeOf :: Data -> DataType
dataTypeOf :: Data -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Data)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Data)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Data)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Data)
$cgmapT :: (forall b. Data b => b -> b) -> Data -> Data
gmapT :: (forall b. Data b => b -> b) -> Data -> Data
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Data -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Data -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Data -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Data -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Data -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Data -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Data -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Data -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Data -> m Data
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Data -> m Data
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Data -> m Data
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Data -> m Data
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Data -> m Data
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Data -> m Data
Data.Data.Data)
deriving anyclass (Eq Data
Eq Data => (Int -> Data -> Int) -> (Data -> Int) -> Hashable Data
Int -> Data -> Int
Data -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Data -> Int
hashWithSalt :: Int -> Data -> Int
$chash :: Data -> Int
hash :: Data -> Int
Hashable, Data -> ()
(Data -> ()) -> NFData Data
forall a. (a -> ()) -> NFData a
$crnf :: Data -> ()
rnf :: Data -> ()
NFData, Context -> Data -> IO (Maybe ThunkInfo)
Proxy Data -> String
(Context -> Data -> IO (Maybe ThunkInfo))
-> (Context -> Data -> IO (Maybe ThunkInfo))
-> (Proxy Data -> String)
-> NoThunks Data
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Data -> IO (Maybe ThunkInfo)
noThunks :: Context -> Data -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Data -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Data -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Data -> String
showTypeOf :: Proxy Data -> String
NoThunks)
instance Pretty Data where
pretty :: forall ann. Data -> Doc ann
pretty = \case
Constr Integer
_ [Data]
ds -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
angles ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Data -> Doc ann) -> [Data] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Data -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Data -> Doc ann
pretty [Data]
ds)))
Map [(Data, Data)]
entries ->
Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (((Data, Data) -> Doc ann) -> [(Data, Data)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Data
k, Data
v) -> Data -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Data -> Doc ann
pretty Data
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Data -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Data -> Doc ann
pretty Data
v) [(Data, Data)]
entries)))
List [Data]
ds -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Data -> Doc ann) -> [Data] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Data -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Data -> Doc ann
pretty [Data]
ds)))
I Integer
i -> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
B ByteString
b ->
Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
Text.decodeLatin1 (ByteString -> ByteString
Base64.encode ByteString
b))
instance Serialise Data where
encode :: Data -> Encoding
encode = Data -> Encoding
encodeData
decode :: forall s. Decoder s Data
decode = Decoder s Data
forall s. Decoder s Data
decodeData
encodeData :: Data -> Encoding
encodeData :: Data -> Encoding
encodeData = \case
Constr Integer
i [Data]
ds | Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
7 -> Word -> Encoding
CBOR.encodeTag (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
121 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Data] -> Encoding
forall a. Serialise a => a -> Encoding
encode [Data]
ds
Constr Integer
i [Data]
ds | Integer
7 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
128 -> Word -> Encoding
CBOR.encodeTag (Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
1280 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
7))) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Data] -> Encoding
forall a. Serialise a => a -> Encoding
encode [Data]
ds
Constr Integer
i [Data]
ds | Bool
otherwise ->
let tagEncoding :: Encoding
tagEncoding =
if Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @Word64) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Word64)
then Word64 -> Encoding
CBOR.encodeWord64 (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
else Integer -> Encoding
CBOR.encodeInteger Integer
i
in Word -> Encoding
CBOR.encodeTag Word
102 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
<> Encoding
tagEncoding Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Data] -> Encoding
forall a. Serialise a => a -> Encoding
encode [Data]
ds
Map [(Data, Data)]
es ->
Word -> Encoding
CBOR.encodeMapLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Data, Data)]
es) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>
[Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [ Data -> Encoding
forall a. Serialise a => a -> Encoding
encode Data
t Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Data -> Encoding
forall a. Serialise a => a -> Encoding
encode Data
t' | (Data
t, Data
t') <-[(Data, Data)]
es ]
List [Data]
ds -> [Data] -> Encoding
forall a. Serialise a => a -> Encoding
encode [Data]
ds
I Integer
i -> Integer -> Encoding
encodeInteger Integer
i
B ByteString
b -> ByteString -> Encoding
encodeBs ByteString
b
encodeInteger :: Integer -> Encoding
encodeInteger :: Integer -> Encoding
encodeInteger Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 , Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) = Integer -> Encoding
CBOR.encodeInteger Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 , Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) = Integer -> Encoding
CBOR.encodeInteger Integer
i
encodeInteger Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = Word -> Encoding
CBOR.encodeTag Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBs (Integer -> ByteString
integerToBytes Integer
i)
encodeInteger Integer
i | Bool
otherwise = Word -> Encoding
CBOR.encodeTag Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBs (Integer -> ByteString
integerToBytes (-Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
i))
integerToBytes :: Integer -> BS.ByteString
integerToBytes :: Integer -> ByteString
integerToBytes Integer
n0
| Integer
n0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [Word8] -> ByteString
BS.pack [Word8
0]
| Bool
otherwise = [Word8] -> ByteString
BS.pack ([Word8] -> [Word8]
forall a. [a] -> [a]
reverse (Integer -> [Word8]
go Integer
n0))
where
go :: Integer -> [Word8]
go Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = []
| Bool
otherwise = Integer -> Word8
narrow Integer
n Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Integer -> [Word8]
go (Integer
n Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
narrow :: Integer -> Word8
narrow :: Integer -> Word8
narrow = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
encodeBs :: BS.ByteString -> Encoding
encodeBs :: ByteString -> Encoding
encodeBs ByteString
b | ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64 = ByteString -> Encoding
CBOR.encodeBytes ByteString
b
encodeBs ByteString
b = Encoding
CBOR.encodeBytesIndef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Encoding) -> [ByteString] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ByteString -> Encoding
forall a. Serialise a => a -> Encoding
encode (ByteString -> [ByteString]
to64ByteChunks ByteString
b) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak
to64ByteChunks :: BS.ByteString -> [BS.ByteString]
to64ByteChunks :: ByteString -> [ByteString]
to64ByteChunks ByteString
b | ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 =
let (ByteString
chunk, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
64 ByteString
b
in ByteString
chunkByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString]
to64ByteChunks ByteString
rest
to64ByteChunks ByteString
b = [ByteString
b]
decodeData :: Decoder s Data
decodeData :: forall s. Decoder s Data
decodeData = Decoder s TokenType
forall s. Decoder s TokenType
CBOR.peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s Data) -> Decoder s Data
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TokenType
CBOR.TypeUInt -> Integer -> Data
I (Integer -> Data) -> Decoder s Integer -> Decoder s Data
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 -> Data
I (Integer -> Data) -> Decoder s Integer -> Decoder s Data
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 -> Data
I (Integer -> Data) -> Decoder s Integer -> Decoder s Data
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 -> Data
I (Integer -> Data) -> Decoder s Integer -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
CBOR.decodeInteger
TokenType
CBOR.TypeInteger -> Integer -> Data
I (Integer -> Data) -> Decoder s Integer -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
decodeBoundedBigInteger
TokenType
CBOR.TypeBytes -> ByteString -> Data
B (ByteString -> Data) -> Decoder s ByteString -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
decodeBoundedBytes
TokenType
CBOR.TypeBytesIndef -> ByteString -> Data
B (ByteString -> Data)
-> (ByteString -> ByteString) -> ByteString -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> Data) -> Decoder s ByteString -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
decodeBoundedBytesIndef
TokenType
CBOR.TypeListLen -> Decoder s Data
forall s. Decoder s Data
decodeList
TokenType
CBOR.TypeListLen64 -> Decoder s Data
forall s. Decoder s Data
decodeList
TokenType
CBOR.TypeListLenIndef -> Decoder s Data
forall s. Decoder s Data
decodeList
TokenType
CBOR.TypeMapLen -> Decoder s Data
forall s. Decoder s Data
decodeMap
TokenType
CBOR.TypeMapLen64 -> Decoder s Data
forall s. Decoder s Data
decodeMap
TokenType
CBOR.TypeMapLenIndef -> Decoder s Data
forall s. Decoder s Data
decodeMap
TokenType
CBOR.TypeTag -> Decoder s Data
forall s. Decoder s Data
decodeConstr
TokenType
CBOR.TypeTag64 -> Decoder s Data
forall s. Decoder s Data
decodeConstr
TokenType
t -> String -> Decoder s Data
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unrecognized value of type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TokenType -> String
forall a. Show a => a -> String
show TokenType
t)
decodeBoundedBigInteger :: Decoder s Integer
decodeBoundedBigInteger :: forall s. Decoder s Integer
decodeBoundedBigInteger = do
Word
tag <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeTag
ByteString
bs <- Decoder s TokenType
forall s. Decoder s TokenType
CBOR.peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s ByteString) -> Decoder s ByteString
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TokenType
CBOR.TypeBytes -> Decoder s ByteString
forall s. Decoder s ByteString
decodeBoundedBytes
TokenType
CBOR.TypeBytesIndef -> ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> Decoder s ByteString -> Decoder s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
decodeBoundedBytesIndef
TokenType
t -> String -> Decoder s ByteString
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Bignum must contain a byte string, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TokenType -> String
forall a. Show a => a -> String
show TokenType
t)
case Word
tag of
Word
2 -> Integer -> Decoder s Integer
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Decoder s Integer) -> Integer -> Decoder s Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer
CBOR.uintegerFromBytes ByteString
bs
Word
3 -> Integer -> Decoder s Integer
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Decoder s Integer) -> Integer -> Decoder s Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer
CBOR.nintegerFromBytes ByteString
bs
Word
t -> String -> Decoder s Integer
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Bignum tag must be one of 2 or 3, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
t)
decodeBoundedBytesIndef :: Decoder s BSL.ByteString
decodeBoundedBytesIndef :: forall s. Decoder s ByteString
decodeBoundedBytesIndef = Decoder s ()
forall s. Decoder s ()
CBOR.decodeBytesIndef Decoder s () -> Decoder s ByteString -> Decoder s ByteString
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Decoder s ByteString
forall s. [ByteString] -> Decoder s ByteString
decodeBoundedBytesIndefLen []
decodeBoundedBytesIndefLen :: [BS.ByteString] -> Decoder s BSL.ByteString
decodeBoundedBytesIndefLen :: forall s. [ByteString] -> Decoder s ByteString
decodeBoundedBytesIndefLen [ByteString]
acc = do
Bool
stop <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBreakOr
if Bool
stop then ByteString -> Decoder s ByteString
forall a. a -> Decoder s a
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
BSL.fromChunks ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)
else do !ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBoundedBytes
[ByteString] -> Decoder s ByteString
forall s. [ByteString] -> Decoder s ByteString
decodeBoundedBytesIndefLen (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc)
decodeBoundedBytes :: Decoder s BS.ByteString
decodeBoundedBytes :: forall s. Decoder s ByteString
decodeBoundedBytes = do
ByteString
b <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ByteString exceeds 64 bytes"
ByteString -> Decoder s ByteString
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
b
decodeList :: Decoder s Data
decodeList :: forall s. Decoder s Data
decodeList = [Data] -> Data
List ([Data] -> Data) -> Decoder s [Data] -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Data -> Decoder s [Data]
forall s x. Decoder s x -> Decoder s [x]
decodeListOf Decoder s Data
forall s. Decoder s Data
decodeData
decodeListOf :: Decoder s x -> Decoder s [x]
decodeListOf :: forall s x. Decoder s x -> Decoder s [x]
decodeListOf Decoder s x
decoder = Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
CBOR.decodeListLenOrIndef Decoder s (Maybe Int)
-> (Maybe Int -> Decoder s [x]) -> Decoder s [x]
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Int
Nothing -> ([x] -> x -> [x])
-> [x] -> ([x] -> [x]) -> Decoder s x -> Decoder s [x]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
decodeSequenceLenIndef ((x -> [x] -> [x]) -> [x] -> x -> [x]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [x] -> [x]
forall a. [a] -> [a]
reverse Decoder s x
decoder
Just Int
n -> ([x] -> x -> [x])
-> [x] -> ([x] -> [x]) -> Int -> Decoder s x -> Decoder s [x]
forall r a r' s.
(r -> a -> r)
-> r -> (r -> r') -> Int -> Decoder s a -> Decoder s r'
decodeSequenceLenN ((x -> [x] -> [x]) -> [x] -> x -> [x]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [x] -> [x]
forall a. [a] -> [a]
reverse Int
n Decoder s x
decoder
decodeMap :: Decoder s Data
decodeMap :: forall s. Decoder s Data
decodeMap = Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
CBOR.decodeMapLenOrIndef Decoder s (Maybe Int)
-> (Maybe Int -> Decoder s Data) -> Decoder s Data
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Int
Nothing -> [(Data, Data)] -> Data
Map ([(Data, Data)] -> Data)
-> Decoder s [(Data, Data)] -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Data, Data)] -> (Data, Data) -> [(Data, Data)])
-> [(Data, Data)]
-> ([(Data, Data)] -> [(Data, Data)])
-> Decoder s (Data, Data)
-> Decoder s [(Data, Data)]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
decodeSequenceLenIndef (((Data, Data) -> [(Data, Data)] -> [(Data, Data)])
-> [(Data, Data)] -> (Data, Data) -> [(Data, Data)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [(Data, Data)] -> [(Data, Data)]
forall a. [a] -> [a]
reverse Decoder s (Data, Data)
forall {s}. Decoder s (Data, Data)
decodePair
Just Int
n -> [(Data, Data)] -> Data
Map ([(Data, Data)] -> Data)
-> Decoder s [(Data, Data)] -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Data, Data)] -> (Data, Data) -> [(Data, Data)])
-> [(Data, Data)]
-> ([(Data, Data)] -> [(Data, Data)])
-> Int
-> Decoder s (Data, Data)
-> Decoder s [(Data, Data)]
forall r a r' s.
(r -> a -> r)
-> r -> (r -> r') -> Int -> Decoder s a -> Decoder s r'
decodeSequenceLenN (((Data, Data) -> [(Data, Data)] -> [(Data, Data)])
-> [(Data, Data)] -> (Data, Data) -> [(Data, Data)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [(Data, Data)] -> [(Data, Data)]
forall a. [a] -> [a]
reverse Int
n Decoder s (Data, Data)
forall {s}. Decoder s (Data, Data)
decodePair
where
decodePair :: Decoder s (Data, Data)
decodePair = (,) (Data -> Data -> (Data, Data))
-> Decoder s Data -> Decoder s (Data -> (Data, Data))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Data
forall s. Decoder s Data
decodeData Decoder s (Data -> (Data, Data))
-> Decoder s Data -> Decoder s (Data, Data)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Data
forall s. Decoder s Data
decodeData
decodeConstr :: Decoder s Data
decodeConstr :: forall s. Decoder s Data
decodeConstr = Decoder s Word64
forall s. Decoder s Word64
CBOR.decodeTag64 Decoder s Word64 -> (Word64 -> Decoder s Data) -> Decoder s Data
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word64
102 -> Decoder s Data
forall s. Decoder s Data
decodeConstrExtended
Word64
t | Word64
121 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
t Bool -> Bool -> Bool
&& Word64
t Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
128 ->
Integer -> [Data] -> Data
Constr (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
121) ([Data] -> Data) -> Decoder s [Data] -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Data -> Decoder s [Data]
forall s x. Decoder s x -> Decoder s [x]
decodeListOf Decoder s Data
forall s. Decoder s Data
decodeData
Word64
t | Word64
1280 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
t Bool -> Bool -> Bool
&& Word64
t Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
1401 ->
Integer -> [Data] -> Data
Constr ((Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1280) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7) ([Data] -> Data) -> Decoder s [Data] -> Decoder s Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Data -> Decoder s [Data]
forall s x. Decoder s x -> Decoder s [x]
decodeListOf Decoder s Data
forall s. Decoder s Data
decodeData
Word64
t -> String -> Decoder s Data
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unrecognized tag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
t)
where
decodeConstrExtended :: Decoder s Data
decodeConstrExtended = do
Maybe Int
len <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
CBOR.decodeListLenOrIndef
Word64
i <- Decoder s Word64
forall s. Decoder s Word64
CBOR.decodeWord64
[Data]
args <- Decoder s Data -> Decoder s [Data]
forall s x. Decoder s x -> Decoder s [x]
decodeListOf Decoder s Data
forall s. Decoder s Data
decodeData
case Maybe Int
len of
Maybe Int
Nothing -> do
Bool
done <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBreakOr
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
done (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected exactly two elements"
Just Int
n -> Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected exactly two elements"
Data -> Decoder s Data
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data -> Decoder s Data) -> Data -> Decoder s Data
forall a b. (a -> b) -> a -> b
$ Integer -> [Data] -> Data
Constr (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i) [Data]
args