module Codec.Borsh.Encoding (
Encoder (..)
, encodeU8
, encodeU16
, encodeU32
, encodeU64
, encodeU128
, encodeI8
, encodeI16
, encodeI32
, encodeI64
, encodeI128
, encodeF32
, encodeF64
, encodeString
, encodeArray
, encodeVec
, encodeOption
, encodeHashSet
, encodeHashMap
, encodeStruct
, encodeEnum
, encodeLazyByteString
, encodeStrictByteString
, encodeChar
, encodeBool
) where
import Data.Char (ord)
import Data.ByteString.Builder (Builder)
import Data.Foldable (toList)
import Data.Functor.Contravariant
import Data.Int
import Data.Map (Map)
import Data.Set (Set)
import Data.SOP
import Data.Text (Text)
import Data.WideWord.Word128
import Data.WideWord.Int128
import Data.Word
import qualified Data.ByteString as S
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text.Encoding as Text
import Data.FixedSizeArray (FixedSizeArray)
import Codec.Borsh.Internal.Util.ByteString
import Codec.Borsh.Internal.Util.SOP (indices)
newtype Encoder a = Encoder {
forall a. Encoder a -> a -> Builder
runEncoder :: a -> Builder
}
instance Contravariant Encoder where
contramap :: forall a' a. (a' -> a) -> Encoder a -> Encoder a'
contramap a' -> a
f (Encoder a -> Builder
e) = forall a. (a -> Builder) -> Encoder a
Encoder (a -> Builder
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)
liftEncoder :: Encoder a -> (I -.-> K Builder) a
liftEncoder :: forall a. Encoder a -> (-.->) I (K Builder) a
liftEncoder (Encoder a -> Builder
e) = forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn forall a b. (a -> b) -> a -> b
$ forall k a (b :: k). a -> K a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. I a -> a
unI
encodeU8 :: Encoder Word8
encodeU16 :: Encoder Word16
encodeU32 :: Encoder Word32
encodeU64 :: Encoder Word64
encodeI8 :: Encoder Int8
encodeI16 :: Encoder Int16
encodeI32 :: Encoder Int32
encodeI64 :: Encoder Int64
encodeF32 :: Encoder Float
encodeF64 :: Encoder Double
encodeU8 :: Encoder Word8
encodeU8 = forall a. (a -> Builder) -> Encoder a
Encoder Word8 -> Builder
B.word8
encodeU16 :: Encoder Word16
encodeU16 = forall a. (a -> Builder) -> Encoder a
Encoder Word16 -> Builder
B.word16LE
encodeU32 :: Encoder Word32
encodeU32 = forall a. (a -> Builder) -> Encoder a
Encoder Word32 -> Builder
B.word32LE
encodeU64 :: Encoder Word64
encodeU64 = forall a. (a -> Builder) -> Encoder a
Encoder Word64 -> Builder
B.word64LE
encodeI8 :: Encoder Int8
encodeI8 = forall a. (a -> Builder) -> Encoder a
Encoder Int8 -> Builder
B.int8
encodeI16 :: Encoder Int16
encodeI16 = forall a. (a -> Builder) -> Encoder a
Encoder Int16 -> Builder
B.int16LE
encodeI32 :: Encoder Int32
encodeI32 = forall a. (a -> Builder) -> Encoder a
Encoder Int32 -> Builder
B.int32LE
encodeI64 :: Encoder Int64
encodeI64 = forall a. (a -> Builder) -> Encoder a
Encoder Int64 -> Builder
B.int64LE
encodeF32 :: Encoder Float
encodeF32 = forall a. (a -> Builder) -> Encoder a
Encoder Float -> Builder
B.floatLE
encodeF64 :: Encoder Double
encodeF64 = forall a. (a -> Builder) -> Encoder a
Encoder Double -> Builder
B.doubleLE
encodeU128 :: Encoder Word128
encodeU128 :: Encoder Word128
encodeU128 = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$
\Word128
w128 -> Word64 -> Builder
B.word64LE (Word128 -> Word64
word128Lo64 Word128
w128) forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
B.word64LE (Word128 -> Word64
word128Hi64 Word128
w128)
encodeI128 :: Encoder Int128
encodeI128 :: Encoder Int128
encodeI128 = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$
\Int128
i128 -> Word64 -> Builder
B.word64LE (Int128 -> Word64
int128Lo64 Int128
i128) forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
B.word64LE (Int128 -> Word64
int128Hi64 Int128
i128)
encodeString :: Encoder Text
encodeString :: Encoder Text
encodeString = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \Text
txt ->
Word32 -> Builder
B.word32LE (ByteString -> Word32
lengthLazy forall a b. (a -> b) -> a -> b
$ Text -> ByteString
utf8 Text
txt) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.lazyByteString (Text -> ByteString
utf8 Text
txt)
where
utf8 :: Text -> L.ByteString
utf8 :: Text -> ByteString
utf8 Text
txt = Builder -> ByteString
B.toLazyByteString forall a b. (a -> b) -> a -> b
$ Text -> Builder
Text.encodeUtf8Builder Text
txt
encodeArray :: Encoder a -> Encoder (FixedSizeArray n a)
encodeArray :: forall a (n :: Nat). Encoder a -> Encoder (FixedSizeArray n a)
encodeArray Encoder a
e = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Encoder a -> a -> Builder
runEncoder Encoder a
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
encodeVec :: Encoder a -> Encoder [a]
encodeVec :: forall a. Encoder a -> Encoder [a]
encodeVec Encoder a
e = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \[a]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall a. Encoder a -> a -> Builder
runEncoder Encoder Word32
encodeU32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Encoder a -> a -> Builder
runEncoder Encoder a
e) [a]
xs
encodeOption :: Encoder a -> Encoder (Maybe a)
encodeOption :: forall a. Encoder a -> Encoder (Maybe a)
encodeOption Encoder a
e = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \case
Maybe a
Nothing -> forall a. Encoder a -> a -> Builder
runEncoder Encoder Word8
encodeU8 Word8
0
Just a
x -> forall a. Encoder a -> a -> Builder
runEncoder Encoder Word8
encodeU8 Word8
1 forall a. Semigroup a => a -> a -> a
<> forall a. Encoder a -> a -> Builder
runEncoder Encoder a
e a
x
encodeHashSet :: Encoder a -> Encoder (Set a)
encodeHashSet :: forall a. Encoder a -> Encoder (Set a)
encodeHashSet Encoder a
e = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \Set a
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall a. Encoder a -> a -> Builder
runEncoder Encoder Word32
encodeU32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Int
Set.size Set a
xs)
forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Encoder a -> a -> Builder
runEncoder Encoder a
e) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set a
xs)
encodeHashMap :: Encoder k -> Encoder a -> Encoder (Map k a)
encodeHashMap :: forall k a. Encoder k -> Encoder a -> Encoder (Map k a)
encodeHashMap Encoder k
ek Encoder a
ev = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \Map k a
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
forall a. Encoder a -> a -> Builder
runEncoder Encoder Word32
encodeU32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Int
Map.size Map k a
xs)
forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map (k, a) -> Builder
ePair forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map k a
xs)
where
ePair :: (k, a) -> Builder
ePair (k
k,a
v) = forall a. Encoder a -> a -> Builder
runEncoder Encoder k
ek k
k forall a. Semigroup a => a -> a -> a
<> forall a. Encoder a -> a -> Builder
runEncoder Encoder a
ev a
v
encodeStruct :: SListI xs => NP Encoder xs -> Encoder (NP I xs)
encodeStruct :: forall (xs :: [*]). SListI xs => NP Encoder xs -> Encoder (NP I xs)
encodeStruct NP Encoder xs
es = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$
forall a. Monoid a => [a] -> a
mconcat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
hap (forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
(f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hliftA forall a. Encoder a -> (-.->) I (K Builder) a
liftEncoder NP Encoder xs
es)
encodeEnum :: All SListI xss => POP Encoder xss -> Encoder (SOP I xss)
encodeEnum :: forall (xss :: [[*]]).
All SListI xss =>
POP Encoder xss -> Encoder (SOP I xss)
encodeEnum POP Encoder xss
es = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith (forall {k} (t :: k). Proxy t
Proxy @SListI) forall (xs :: [*]).
SListI xs =>
K Word8 xs -> NP (K Builder) xs -> K Builder xs
aux forall k (xs :: [k]). SListI xs => NP (K Word8) xs
indices
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
(xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
hap (forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
(f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hliftA forall a. Encoder a -> (-.->) I (K Builder) a
liftEncoder POP Encoder xss
es)
where
aux :: SListI xs => K Word8 xs -> NP (K Builder) xs -> K Builder xs
aux :: forall (xs :: [*]).
SListI xs =>
K Word8 xs -> NP (K Builder) xs -> K Builder xs
aux (K Word8
ix) NP (K Builder) xs
xs = forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$ forall a. Encoder a -> a -> Builder
runEncoder Encoder Word8
encodeU8 Word8
ix forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse NP (K Builder) xs
xs)
encodeLazyByteString :: Encoder L.ByteString
encodeLazyByteString :: Encoder ByteString
encodeLazyByteString = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
forall a. Encoder a -> a -> Builder
runEncoder Encoder Word32
encodeU32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
bs)
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.lazyByteString ByteString
bs
encodeStrictByteString :: Encoder S.ByteString
encodeStrictByteString :: Encoder ByteString
encodeStrictByteString = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
forall a. Encoder a -> a -> Builder
runEncoder Encoder Word32
encodeU32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs)
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
bs
encodeChar :: Encoder Char
encodeChar :: Encoder Char
encodeChar = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ forall a. Encoder a -> a -> Builder
runEncoder Encoder Word32
encodeU32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
encodeBool :: Encoder Bool
encodeBool :: Encoder Bool
encodeBool = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ forall a. Encoder a -> a -> Builder
runEncoder Encoder Word8
encodeU8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum