{-# OPTIONS_GHC -fno-specialize #-}
{-# OPTIONS_HADDOCK prune #-}
module Plutus.Codec.CBOR.Encoding (
Encoding,
encodingToBuiltinByteString,
encodeBool,
encodeInteger,
encodeByteString,
encodeString,
encodeNull,
encodeMaybe,
encodeListLen,
encodeList,
encodeMapLen,
encodeMap,
encodeBreak,
encodeBeginList,
encodeListIndef,
encodeBeginMap,
encodeMapIndef,
encodeTag,
unsafeEncodeRaw,
) where
import PlutusTx.Prelude
import PlutusTx.AssocMap (Map)
import PlutusTx.AssocMap qualified as Map
import PlutusTx.Builtins (subtractInteger)
newtype Encoding = Encoding (BuiltinByteString -> BuiltinByteString)
instance Semigroup Encoding where
(Encoding BuiltinByteString -> BuiltinByteString
a) <> :: Encoding -> Encoding -> Encoding
<> (Encoding BuiltinByteString -> BuiltinByteString
b) = (BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (BuiltinByteString -> BuiltinByteString
a (BuiltinByteString -> BuiltinByteString)
-> (BuiltinByteString -> BuiltinByteString)
-> BuiltinByteString
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> BuiltinByteString
b)
instance Monoid Encoding where
mempty :: Encoding
mempty = (BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding BuiltinByteString -> BuiltinByteString
forall a. a -> a
id
encodingToBuiltinByteString :: Encoding -> BuiltinByteString
encodingToBuiltinByteString :: Encoding -> BuiltinByteString
encodingToBuiltinByteString (Encoding BuiltinByteString -> BuiltinByteString
runEncoder) =
BuiltinByteString -> BuiltinByteString
runEncoder BuiltinByteString
emptyByteString
{-# INLINEABLE encodingToBuiltinByteString #-}
encodeBool :: Bool -> Encoding
encodeBool :: Bool -> Encoding
encodeBool = \case
Bool
False ->
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned8 Integer
244)
Bool
True ->
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned8 Integer
245)
{-# INLINEABLE encodeBool #-}
encodeInteger :: Integer -> Encoding
encodeInteger :: Integer -> Encoding
encodeInteger Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 =
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned Integer
1 (Integer -> Integer -> Integer
subtractInteger Integer
0 Integer
n Integer -> Integer -> Integer
forall a. AdditiveGroup a => a -> a -> a
- Integer
1))
| Bool
otherwise =
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned Integer
0 Integer
n)
{-# INLINEABLE encodeInteger #-}
encodeByteString :: BuiltinByteString -> Encoding
encodeByteString :: BuiltinByteString -> Encoding
encodeByteString BuiltinByteString
bytes =
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned Integer
2 (BuiltinByteString -> Integer
lengthOfByteString BuiltinByteString
bytes) (BuiltinByteString -> BuiltinByteString)
-> (BuiltinByteString -> BuiltinByteString)
-> BuiltinByteString
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> BuiltinByteString -> BuiltinByteString
appendByteString BuiltinByteString
bytes)
{-# INLINEABLE encodeByteString #-}
encodeString :: BuiltinString -> Encoding
encodeString :: BuiltinString -> Encoding
encodeString (BuiltinString -> BuiltinByteString
encodeUtf8 -> BuiltinByteString
bytes) =
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned Integer
3 (BuiltinByteString -> Integer
lengthOfByteString BuiltinByteString
bytes) (BuiltinByteString -> BuiltinByteString)
-> (BuiltinByteString -> BuiltinByteString)
-> BuiltinByteString
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> BuiltinByteString -> BuiltinByteString
appendByteString BuiltinByteString
bytes)
{-# INLINEABLE encodeString #-}
encodeNull :: Encoding
encodeNull :: Encoding
encodeNull =
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> BuiltinByteString -> BuiltinByteString
consByteString Integer
246)
{-# INLINEABLE encodeNull #-}
encodeBreak :: Encoding
encodeBreak :: Encoding
encodeBreak = (BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> BuiltinByteString -> BuiltinByteString
consByteString Integer
0xFF)
{-# INLINEABLE encodeBreak #-}
encodeListLen :: Integer -> Encoding
encodeListLen :: Integer -> Encoding
encodeListLen = (BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding ((BuiltinByteString -> BuiltinByteString) -> Encoding)
-> (Integer -> BuiltinByteString -> BuiltinByteString)
-> Integer
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned Integer
4
{-# INLINEABLE encodeListLen #-}
encodeBeginList :: Encoding
encodeBeginList :: Encoding
encodeBeginList = (BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType Integer
4 Integer
31)
{-# INLINEABLE encodeBeginList #-}
encodeList :: (a -> Encoding) -> [a] -> Encoding
encodeList :: forall a. (a -> Encoding) -> [a] -> Encoding
encodeList a -> Encoding
encodeElem =
Integer -> Encoding -> [a] -> Encoding
step Integer
0 Encoding
forall a. Monoid a => a
mempty
where
step :: Integer -> Encoding -> [a] -> Encoding
step Integer
n Encoding
bs = \case
[] -> Integer -> Encoding
encodeListLen Integer
n Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
bs
(a
e : [a]
q) -> Integer -> Encoding -> [a] -> Encoding
step (Integer
n Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
1) (Encoding
bs Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
encodeElem a
e) [a]
q
{-# INLINEABLE encodeList #-}
encodeListIndef :: (a -> Encoding) -> [a] -> Encoding
encodeListIndef :: forall a. (a -> Encoding) -> [a] -> Encoding
encodeListIndef a -> Encoding
encodeElem [a]
es =
Encoding
encodeBeginList Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [a] -> Encoding
step [a]
es
where
step :: [a] -> Encoding
step = \case
[] -> Encoding
encodeBreak
(a
e : [a]
q) -> a -> Encoding
encodeElem a
e Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [a] -> Encoding
step [a]
q
{-# INLINEABLE encodeListIndef #-}
encodeMapLen :: Integer -> Encoding
encodeMapLen :: Integer -> Encoding
encodeMapLen = (BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding ((BuiltinByteString -> BuiltinByteString) -> Encoding)
-> (Integer -> BuiltinByteString -> BuiltinByteString)
-> Integer
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned Integer
5
{-# INLINEABLE encodeMapLen #-}
encodeBeginMap :: Encoding
encodeBeginMap :: Encoding
encodeBeginMap = (BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding (Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType Integer
5 Integer
31)
{-# INLINEABLE encodeBeginMap #-}
encodeMap :: (k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap :: forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap k -> Encoding
encodeKey v -> Encoding
encodeValue =
Integer -> Encoding -> [(k, v)] -> Encoding
step Integer
0 Encoding
forall a. Monoid a => a
mempty ([(k, v)] -> Encoding)
-> (Map k v -> [(k, v)]) -> Map k v -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k v. Map k v -> [(k, v)]
Map.toList
where
step :: Integer -> Encoding -> [(k, v)] -> Encoding
step Integer
n Encoding
bs = \case
[] -> Integer -> Encoding
encodeMapLen Integer
n Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
bs
((k
k, v
v) : [(k, v)]
q) -> Integer -> Encoding -> [(k, v)] -> Encoding
step (Integer
n Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
1) (Encoding
bs Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> k -> Encoding
encodeKey k
k Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> v -> Encoding
encodeValue v
v) [(k, v)]
q
{-# INLINEABLE encodeMap #-}
encodeMapIndef :: (k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMapIndef :: forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMapIndef k -> Encoding
encodeKey v -> Encoding
encodeValue Map k v
m =
Encoding
encodeBeginMap Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [(k, v)] -> Encoding
step (Map k v -> [(k, v)]
forall k v. Map k v -> [(k, v)]
Map.toList Map k v
m)
where
step :: [(k, v)] -> Encoding
step = \case
[] -> Encoding
encodeBreak
((k
k, v
v) : [(k, v)]
q) -> k -> Encoding
encodeKey k
k Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> v -> Encoding
encodeValue v
v Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [(k, v)] -> Encoding
step [(k, v)]
q
{-# INLINEABLE encodeMapIndef #-}
encodeMaybe :: (a -> Encoding) -> Maybe a -> Encoding
encodeMaybe :: forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeMaybe a -> Encoding
encode = \case
Maybe a
Nothing -> (BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding BuiltinByteString -> BuiltinByteString
forall a. a -> a
id
Just a
a -> a -> Encoding
encode a
a
{-# INLINEABLE encodeMaybe #-}
encodeTag :: Integer -> Encoding
encodeTag :: Integer -> Encoding
encodeTag =
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding ((BuiltinByteString -> BuiltinByteString) -> Encoding)
-> (Integer -> BuiltinByteString -> BuiltinByteString)
-> Integer
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned Integer
6
unsafeEncodeRaw :: BuiltinByteString -> Encoding
unsafeEncodeRaw :: BuiltinByteString -> Encoding
unsafeEncodeRaw =
(BuiltinByteString -> BuiltinByteString) -> Encoding
Encoding ((BuiltinByteString -> BuiltinByteString) -> Encoding)
-> (BuiltinByteString -> BuiltinByteString -> BuiltinByteString)
-> BuiltinByteString
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> BuiltinByteString -> BuiltinByteString
appendByteString
{-# INLINEABLE unsafeEncodeRaw #-}
withMajorType :: Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType :: Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType Integer
major Integer
n =
Integer -> BuiltinByteString -> BuiltinByteString
consByteString (Integer
32 Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
* Integer
major Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
n)
{-# INLINEABLE withMajorType #-}
encodeUnsigned :: Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned :: Integer -> Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned Integer
major Integer
n BuiltinByteString
next
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
24 =
Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType Integer
major Integer
n BuiltinByteString
next
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
256 =
Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType Integer
major Integer
24 (Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned8 Integer
n BuiltinByteString
next)
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
65536 =
Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType Integer
major Integer
25 (Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned16 Integer
n BuiltinByteString
next)
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
4294967296 =
Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType Integer
major Integer
26 (Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned32 Integer
n BuiltinByteString
next)
| Bool
otherwise =
Integer -> Integer -> BuiltinByteString -> BuiltinByteString
withMajorType Integer
major Integer
27 (Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned64 Integer
n BuiltinByteString
next)
{-# INLINEABLE encodeUnsigned #-}
encodeUnsigned8 :: Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned8 :: Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned8 = Integer -> BuiltinByteString -> BuiltinByteString
consByteString
{-# INLINEABLE encodeUnsigned8 #-}
encodeUnsigned16 :: Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned16 :: Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned16 Integer
n =
Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned8 (Integer -> Integer -> Integer
quotient Integer
n Integer
256) (BuiltinByteString -> BuiltinByteString)
-> (BuiltinByteString -> BuiltinByteString)
-> BuiltinByteString
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned8 (Integer -> Integer -> Integer
remainder Integer
n Integer
256)
{-# INLINEABLE encodeUnsigned16 #-}
encodeUnsigned32 :: Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned32 :: Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned32 Integer
n =
Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned16 (Integer -> Integer -> Integer
quotient Integer
n Integer
65536) (BuiltinByteString -> BuiltinByteString)
-> (BuiltinByteString -> BuiltinByteString)
-> BuiltinByteString
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned16 (Integer -> Integer -> Integer
remainder Integer
n Integer
65536)
{-# INLINEABLE encodeUnsigned32 #-}
encodeUnsigned64 :: Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned64 :: Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned64 Integer
n =
Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned32 (Integer -> Integer -> Integer
quotient Integer
n Integer
4294967296) (BuiltinByteString -> BuiltinByteString)
-> (BuiltinByteString -> BuiltinByteString)
-> BuiltinByteString
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BuiltinByteString -> BuiltinByteString
encodeUnsigned32 (Integer -> Integer -> Integer
remainder Integer
n Integer
4294967296)
{-# INLINEABLE encodeUnsigned64 #-}