module Codec.Borsh.Encoding (
    -- * Encoder definition
    Encoder (..)
    -- * Encoders for non-composite types mandated by the Borsh spec
  , encodeU8
  , encodeU16
  , encodeU32
  , encodeU64
  , encodeU128
  , encodeI8
  , encodeI16
  , encodeI32
  , encodeI64
  , encodeI128
  , encodeF32
  , encodeF64
  , encodeString
  -- * Encoders for composite types mandated by the Borsh spec
  , encodeArray
  , encodeVec
  , encodeOption
  , encodeHashSet
  , encodeHashMap
  , encodeStruct
  , encodeEnum
  -- * Encoders for Haskell types not mandated by the Borsh spec
  , 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)

{-------------------------------------------------------------------------------
  Encoder definition
-------------------------------------------------------------------------------}

-- | Encoder
--
-- An encoder describes how to serialise a given value in BORSH format.
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

{-------------------------------------------------------------------------------
  Encoders for non-composite types mandated by the Borsh spec
-------------------------------------------------------------------------------}

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)

-- Encoding 'Text'
--
-- Borsh requires the length of the utf8-encoded string before the string, but
-- unfortunately we have no easy way to compute this without encoding the entire
-- string. This means that we are not streaming here: the entire utf8 encoding
-- is constructed in memory.
--
-- With text version 2.0 we can use @lengthWord8@ but that is not available most
-- of the time.
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

{-------------------------------------------------------------------------------
  Encoders for composite types mandated by the Borsh spec
-------------------------------------------------------------------------------}

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)

{-------------------------------------------------------------------------------
  Encoders for Haskell types not mandated by the Borsh spec
-------------------------------------------------------------------------------}

-- ByteStrings

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

-- Char, Bool

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