{-# LANGUAGE PolyKinds #-}

module Codec.Borsh.Class (
    -- * Serialisation
    ToBorsh(..)
  , FromBorsh(..)
    -- ** Deriving-via support
  , Struct(..)
    -- * Size information
  , KnownSize(..)
  , Size(..)
  , BorshSize(..)
  , BorshSizeSum(..)
    -- * Derived functionality
  , serialiseBorsh
  , deserialiseBorsh
  ) where

import Data.Functor.Contravariant
import Data.Int
import Data.Kind
import Data.Map (Map)
import Data.Proxy
import Data.Set (Set)
import Data.Text (Text)
import Data.WideWord.Int128
import Data.WideWord.Word128
import Data.Word
import Generics.SOP
import GHC.TypeNats

import qualified Data.ByteString         as S
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy    as L

import Codec.Borsh.Decoding
import Codec.Borsh.Encoding
import Codec.Borsh.Incremental
import Data.FixedSizeArray (FixedSizeArray)

{-------------------------------------------------------------------------------
  Size information

  We do not try to compute the size at the type-level (we don't need to and
  this would get messy), but we /do/ record at the type level whether the
  size is statically known or not.
-------------------------------------------------------------------------------}

data KnownSize = HasKnownSize | HasVariableSize

-- | The statically known size of encodings of values of a particular type.
data Size (a :: KnownSize) where
  SizeKnown    :: Int -> Size 'HasKnownSize
  SizeVariable :: Size 'HasVariableSize

deriving instance Show (Size a)
deriving instance Eq   (Size a)

class BorshSize (a :: Type) where
  type StaticBorshSize a :: KnownSize
  type StaticBorshSize a = SumKnownSize (Code a)

  -- | Size of the Borsh encoding, if known ahead of time
  --
  -- See 'encodeBorsh' for discussion of the generic instance.
  borshSize :: Proxy a -> Size (StaticBorshSize a)

  default borshSize ::
       ( StaticBorshSize a ~ SumKnownSize (Code a)
       , BorshSizeSum (Code a)
       )
    => Proxy a -> Size (StaticBorshSize a)
  borshSize Proxy a
_ = forall (xss :: [[*]]).
BorshSizeSum xss =>
Proxy xss -> Size (SumKnownSize xss)
borshSizeSum (forall {k} (t :: k). Proxy t
Proxy @(Code a))

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

class BorshSize a => ToBorsh a where
  -- | Encoder to Borsh
  --
  -- NOTE: The default generic encoder uses the Borsh encoding for enums,
  -- and will therefore use constructor tag; see 'Struct' for detailed
  -- discussion. Since the spec mandates the presence of that constructor tag,
  -- the generic encoder/decoder does not apply to types without constructors.
  encodeBorsh :: Encoder a

  default encodeBorsh ::
       (Generic a, BorshSizeSum (Code a), All2 ToBorsh (Code a))
    => Encoder a
  encodeBorsh = forall a. (a -> Builder) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ forall a. Encoder a -> a -> Builder
runEncoder forall a. ToBorsh a => Encoder a
encodeBorsh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Generic a => a -> Rep a
from

class BorshSize a => FromBorsh a where
  -- | Decode from Borsh
  --
  -- See 'encodeBorsh' for discussion of the generic instance.
  decodeBorsh :: Decoder s a

  default decodeBorsh ::
       (Generic a, BorshSizeSum (Code a), All2 FromBorsh (Code a))
    => Decoder s a
  decodeBorsh = forall a. Generic a => Rep a -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromBorsh a => Decoder s a
decodeBorsh

{-------------------------------------------------------------------------------
  Structs
-------------------------------------------------------------------------------}

-- | Deriving-via support for structs
--
-- The Borsh spec <https://borsh.io/> mandates that enums have a tag indicating
-- the constructor, even when there is only a single constructor in the enum.
-- In Rust this makes more sense than in Haskell, since in Rust enums and
-- structs are introduced through different keywords. In Haskell, of course,
-- the only difference between them is that a struct is an enum with a single
-- constructor.
--
-- The default generic encoder en decoder you get in 'ToBorsh' and 'FromBorsh'
-- will therefore add the tag, independent of the number of constructors. If
-- you want the encoding of a struct, without the tag, you need to use deriving
-- via:
--
-- > data MyStruct = ..
-- >   deriving (BorshSize, ToBorsh, FromBorsh) via Struct MyStruct
--
-- NOTE: Doing so may have consequences for forwards compatibility: if a tag
-- is present, additional constructors can be added without invalidating the
-- encoding of existing constructors.
newtype Struct a = Struct { forall a. Struct a -> a
getStruct :: a }

instance (IsProductType a xs, All BorshSize xs) => BorshSize (Struct a) where
  type StaticBorshSize (Struct a) = ProdKnownSize (ProductCode a)
  borshSize :: Proxy (Struct a) -> Size (StaticBorshSize (Struct a))
borshSize Proxy (Struct a)
_ = forall (xs :: [*]).
All BorshSize xs =>
Proxy xs -> Size (ProdKnownSize xs)
sizeOfProd (forall {k} (t :: k). Proxy t
Proxy @(ProductCode a))

instance ( IsProductType a xs
         , All BorshSize xs
         , All ToBorsh xs
         ) => ToBorsh (Struct a) where
  encodeBorsh :: Encoder (Struct a)
encodeBorsh = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall a (xs :: [*]). IsProductType a xs => a -> NP I xs
productTypeFrom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Struct a -> a
getStruct) forall a. ToBorsh a => Encoder a
encodeBorsh

instance ( IsProductType a xs
         , All BorshSize xs
         , All FromBorsh xs
         ) => FromBorsh (Struct a) where
  decodeBorsh :: forall s. Decoder s (Struct a)
decodeBorsh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Struct a
Struct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (xs :: [*]). IsProductType a xs => NP I xs -> a
productTypeTo) forall a s. FromBorsh a => Decoder s a
decodeBorsh

{-------------------------------------------------------------------------------
  Derived functionality
-------------------------------------------------------------------------------}

serialiseBorsh :: ToBorsh a => a -> L.ByteString
serialiseBorsh :: forall a. ToBorsh a => a -> ByteString
serialiseBorsh = Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoder a -> a -> Builder
runEncoder forall a. ToBorsh a => Encoder a
encodeBorsh

deserialiseBorsh :: FromBorsh a => L.ByteString -> Either DeserialiseFailure a
deserialiseBorsh :: forall a. FromBorsh a => ByteString -> Either DeserialiseFailure a
deserialiseBorsh ByteString
bs =
    forall {a} {b} {c}. (a, b, c) -> c
aux forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(forall s. Decoder s a)
-> ByteString
-> Either DeserialiseFailure (ByteString, ByteOffset, a)
deserialiseByteString forall a s. FromBorsh a => Decoder s a
decodeBorsh ByteString
bs
  where
    aux :: (a, b, c) -> c
aux (a
_leftover, b
_offset, c
a) = c
a

{-------------------------------------------------------------------------------
  Sizes
-------------------------------------------------------------------------------}

instance BorshSize Word8 where
  type StaticBorshSize Word8 = 'HasKnownSize
  borshSize :: Proxy Word8 -> Size (StaticBorshSize Word8)
borshSize Proxy Word8
_ = Int -> Size 'HasKnownSize
SizeKnown Int
1

instance BorshSize Word16 where
  type StaticBorshSize Word16 = 'HasKnownSize
  borshSize :: Proxy Word16 -> Size (StaticBorshSize Word16)
borshSize Proxy Word16
_ = Int -> Size 'HasKnownSize
SizeKnown Int
2

instance BorshSize Word32 where
  type StaticBorshSize Word32 = 'HasKnownSize
  borshSize :: Proxy ByteOffset -> Size (StaticBorshSize ByteOffset)
borshSize Proxy ByteOffset
_ = Int -> Size 'HasKnownSize
SizeKnown Int
4

instance BorshSize Word64 where
  type StaticBorshSize Word64 = 'HasKnownSize
  borshSize :: Proxy Word64 -> Size (StaticBorshSize Word64)
borshSize Proxy Word64
_ = Int -> Size 'HasKnownSize
SizeKnown Int
8

instance BorshSize Word128 where
  type StaticBorshSize Word128 = 'HasKnownSize
  borshSize :: Proxy Word128 -> Size (StaticBorshSize Word128)
borshSize Proxy Word128
_ = Int -> Size 'HasKnownSize
SizeKnown Int
16

instance BorshSize Int8 where
  type StaticBorshSize Int8 = 'HasKnownSize
  borshSize :: Proxy Int8 -> Size (StaticBorshSize Int8)
borshSize Proxy Int8
_ = Int -> Size 'HasKnownSize
SizeKnown Int
1

instance BorshSize Int16 where
  type StaticBorshSize Int16 = 'HasKnownSize
  borshSize :: Proxy Int16 -> Size (StaticBorshSize Int16)
borshSize Proxy Int16
_ = Int -> Size 'HasKnownSize
SizeKnown Int
2

instance BorshSize Int32 where
  type StaticBorshSize Int32 = 'HasKnownSize
  borshSize :: Proxy Int32 -> Size (StaticBorshSize Int32)
borshSize Proxy Int32
_ = Int -> Size 'HasKnownSize
SizeKnown Int
4

instance BorshSize Int64 where
  type StaticBorshSize Int64 = 'HasKnownSize
  borshSize :: Proxy Int64 -> Size (StaticBorshSize Int64)
borshSize Proxy Int64
_ = Int -> Size 'HasKnownSize
SizeKnown Int
8

instance BorshSize Int128 where
  type StaticBorshSize Int128 = 'HasKnownSize
  borshSize :: Proxy Int128 -> Size (StaticBorshSize Int128)
borshSize Proxy Int128
_ = Int -> Size 'HasKnownSize
SizeKnown Int
16

instance BorshSize Float where
  type StaticBorshSize Float = 'HasKnownSize
  borshSize :: Proxy Float -> Size (StaticBorshSize Float)
borshSize Proxy Float
_ = Int -> Size 'HasKnownSize
SizeKnown Int
4

instance BorshSize Double where
  type StaticBorshSize Double = 'HasKnownSize
  borshSize :: Proxy Double -> Size (StaticBorshSize Double)
borshSize Proxy Double
_ = Int -> Size 'HasKnownSize
SizeKnown Int
8

instance (KnownNat n, BorshSize a) => BorshSize (FixedSizeArray n a) where
  type StaticBorshSize (FixedSizeArray n a) = StaticBorshSize a

  borshSize :: Proxy (FixedSizeArray n a)
-> Size (StaticBorshSize (FixedSizeArray n a))
borshSize Proxy (FixedSizeArray n a)
_ =
      case forall a. BorshSize a => Proxy a -> Size (StaticBorshSize a)
borshSize (forall {k} (t :: k). Proxy t
Proxy @a) of
        Size (StaticBorshSize a)
SizeVariable -> Size 'HasVariableSize
SizeVariable
        SizeKnown Int
n  -> Int -> Size 'HasKnownSize
SizeKnown (Int
n forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall {k} (t :: k). Proxy t
Proxy @n)))

instance BorshSize Text where
  type StaticBorshSize Text = 'HasVariableSize
  borshSize :: Proxy Text -> Size (StaticBorshSize Text)
borshSize Proxy Text
_ = Size 'HasVariableSize
SizeVariable

instance BorshSize [a] where
  -- Use generic defaults

instance BorshSize (Maybe a) where
  -- Use generic defaults

instance BorshSize (Set a) where
  type StaticBorshSize (Set a) = 'HasVariableSize
  borshSize :: Proxy (Set a) -> Size (StaticBorshSize (Set a))
borshSize Proxy (Set a)
_ = Size 'HasVariableSize
SizeVariable

instance BorshSize (Map k a) where
  type StaticBorshSize (Map k a) = 'HasVariableSize
  borshSize :: Proxy (Map k a) -> Size (StaticBorshSize (Map k a))
borshSize Proxy (Map k a)
_ = Size 'HasVariableSize
SizeVariable

instance All BorshSize xs => BorshSize (NP I xs) where
  type StaticBorshSize (NP I xs) = ProdKnownSize xs
  borshSize :: Proxy (NP I xs) -> Size (StaticBorshSize (NP I xs))
borshSize Proxy (NP I xs)
_ = forall (xs :: [*]).
All BorshSize xs =>
Proxy xs -> Size (ProdKnownSize xs)
sizeOfProd (forall {k} (t :: k). Proxy t
Proxy @xs)

instance BorshSizeSum xss => BorshSize (SOP I xss) where
  type StaticBorshSize (SOP I xss) = SumKnownSize xss
  borshSize :: Proxy (SOP I xss) -> Size (StaticBorshSize (SOP I xss))
borshSize Proxy (SOP I xss)
_ = forall (xss :: [[*]]).
BorshSizeSum xss =>
Proxy xss -> Size (SumKnownSize xss)
borshSizeSum (forall {k} (t :: k). Proxy t
Proxy @xss)

{-------------------------------------------------------------------------------
  ToBorsh instances
-------------------------------------------------------------------------------}

instance ToBorsh Word8   where encodeBorsh :: Encoder Word8
encodeBorsh = Encoder Word8
encodeU8
instance ToBorsh Word16  where encodeBorsh :: Encoder Word16
encodeBorsh = Encoder Word16
encodeU16
instance ToBorsh Word32  where encodeBorsh :: Encoder ByteOffset
encodeBorsh = Encoder ByteOffset
encodeU32
instance ToBorsh Word64  where encodeBorsh :: Encoder Word64
encodeBorsh = Encoder Word64
encodeU64
instance ToBorsh Word128 where encodeBorsh :: Encoder Word128
encodeBorsh = Encoder Word128
encodeU128
instance ToBorsh Int8    where encodeBorsh :: Encoder Int8
encodeBorsh = Encoder Int8
encodeI8
instance ToBorsh Int16   where encodeBorsh :: Encoder Int16
encodeBorsh = Encoder Int16
encodeI16
instance ToBorsh Int32   where encodeBorsh :: Encoder Int32
encodeBorsh = Encoder Int32
encodeI32
instance ToBorsh Int64   where encodeBorsh :: Encoder Int64
encodeBorsh = Encoder Int64
encodeI64
instance ToBorsh Int128  where encodeBorsh :: Encoder Int128
encodeBorsh = Encoder Int128
encodeI128
instance ToBorsh Float   where encodeBorsh :: Encoder Float
encodeBorsh = Encoder Float
encodeF32
instance ToBorsh Double  where encodeBorsh :: Encoder Double
encodeBorsh = Encoder Double
encodeF64
instance ToBorsh Text    where encodeBorsh :: Encoder Text
encodeBorsh = Encoder Text
encodeString

instance (KnownNat n, ToBorsh a) => ToBorsh (FixedSizeArray n a) where
  encodeBorsh :: Encoder (FixedSizeArray n a)
encodeBorsh = forall a (n :: Nat). Encoder a -> Encoder (FixedSizeArray n a)
encodeArray forall a. ToBorsh a => Encoder a
encodeBorsh

instance ToBorsh a => ToBorsh [a] where
  encodeBorsh :: Encoder [a]
encodeBorsh = forall a. Encoder a -> Encoder [a]
encodeVec forall a. ToBorsh a => Encoder a
encodeBorsh

instance ToBorsh a => ToBorsh (Maybe a) where
  encodeBorsh :: Encoder (Maybe a)
encodeBorsh = forall a. Encoder a -> Encoder (Maybe a)
encodeOption forall a. ToBorsh a => Encoder a
encodeBorsh

instance ToBorsh a => ToBorsh (Set a) where
  encodeBorsh :: Encoder (Set a)
encodeBorsh = forall a. Encoder a -> Encoder (Set a)
encodeHashSet forall a. ToBorsh a => Encoder a
encodeBorsh

instance (ToBorsh k, ToBorsh a) => ToBorsh (Map k a) where
  encodeBorsh :: Encoder (Map k a)
encodeBorsh = forall k a. Encoder k -> Encoder a -> Encoder (Map k a)
encodeHashMap forall a. ToBorsh a => Encoder a
encodeBorsh forall a. ToBorsh a => Encoder a
encodeBorsh

instance (All BorshSize xs, All ToBorsh xs) => ToBorsh (NP I xs) where
  encodeBorsh :: Encoder (NP I xs)
encodeBorsh = forall (xs :: [*]). SListI xs => NP Encoder xs -> Encoder (NP I xs)
encodeStruct forall a b. (a -> b) -> a -> b
$ forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (forall {k} (t :: k). Proxy t
Proxy @ToBorsh) forall a. ToBorsh a => Encoder a
encodeBorsh

instance ( BorshSizeSum xss
         , All2 ToBorsh xss
         , All SListI xss
         ) => ToBorsh (SOP I xss) where
  encodeBorsh :: Encoder (SOP I xss)
encodeBorsh = forall (xss :: [[*]]).
All SListI xss =>
POP Encoder xss -> Encoder (SOP I xss)
encodeEnum forall a b. (a -> b) -> a -> b
$ forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (forall {k} (t :: k). Proxy t
Proxy @ToBorsh) forall a. ToBorsh a => Encoder a
encodeBorsh

{-------------------------------------------------------------------------------
  FromBorsh instances
-------------------------------------------------------------------------------}

instance FromBorsh Word8   where decodeBorsh :: forall s. Decoder s Word8
decodeBorsh = forall s. Decoder s Word8
decodeU8
instance FromBorsh Word16  where decodeBorsh :: forall s. Decoder s Word16
decodeBorsh = forall s. Decoder s Word16
decodeU16
instance FromBorsh Word32  where decodeBorsh :: forall s. Decoder s ByteOffset
decodeBorsh = forall s. Decoder s ByteOffset
decodeU32
instance FromBorsh Word64  where decodeBorsh :: forall s. Decoder s Word64
decodeBorsh = forall s. Decoder s Word64
decodeU64
instance FromBorsh Word128 where decodeBorsh :: forall s. Decoder s Word128
decodeBorsh = forall s. Decoder s Word128
decodeU128
instance FromBorsh Int8    where decodeBorsh :: forall s. Decoder s Int8
decodeBorsh = forall s. Decoder s Int8
decodeI8
instance FromBorsh Int16   where decodeBorsh :: forall s. Decoder s Int16
decodeBorsh = forall s. Decoder s Int16
decodeI16
instance FromBorsh Int32   where decodeBorsh :: forall s. Decoder s Int32
decodeBorsh = forall s. Decoder s Int32
decodeI32
instance FromBorsh Int64   where decodeBorsh :: forall s. Decoder s Int64
decodeBorsh = forall s. Decoder s Int64
decodeI64
instance FromBorsh Int128  where decodeBorsh :: forall s. Decoder s Int128
decodeBorsh = forall s. Decoder s Int128
decodeI128
instance FromBorsh Float   where decodeBorsh :: forall s. Decoder s Float
decodeBorsh = forall s. Decoder s Float
decodeF32
instance FromBorsh Double  where decodeBorsh :: forall s. Decoder s Double
decodeBorsh = forall s. Decoder s Double
decodeF64
instance FromBorsh Text    where decodeBorsh :: forall s. Decoder s Text
decodeBorsh = forall s. Decoder s Text
decodeString

instance FromBorsh a => FromBorsh [a] where
  decodeBorsh :: forall s. Decoder s [a]
decodeBorsh = forall s a. Decoder s a -> Decoder s [a]
decodeVec forall a s. FromBorsh a => Decoder s a
decodeBorsh

instance (FromBorsh a, KnownNat n) => FromBorsh (FixedSizeArray n a) where
  decodeBorsh :: forall s. Decoder s (FixedSizeArray n a)
decodeBorsh = forall (n :: Nat) s a.
KnownNat n =>
Decoder s a -> Decoder s (FixedSizeArray n a)
decodeArray forall a s. FromBorsh a => Decoder s a
decodeBorsh

instance FromBorsh a => FromBorsh (Maybe a) where
  decodeBorsh :: forall s. Decoder s (Maybe a)
decodeBorsh = forall s a. Decoder s a -> Decoder s (Maybe a)
decodeOption forall a s. FromBorsh a => Decoder s a
decodeBorsh

instance (FromBorsh a, Ord a) => FromBorsh (Set a) where
  decodeBorsh :: forall s. Decoder s (Set a)
decodeBorsh = forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeHashSet forall a s. FromBorsh a => Decoder s a
decodeBorsh

instance
     (FromBorsh k, FromBorsh a, Ord k)
  => FromBorsh (Map k a) where
  decodeBorsh :: forall s. Decoder s (Map k a)
decodeBorsh = forall k s a.
Ord k =>
Decoder s k -> Decoder s a -> Decoder s (Map k a)
decodeHashMap forall a s. FromBorsh a => Decoder s a
decodeBorsh forall a s. FromBorsh a => Decoder s a
decodeBorsh

instance (All BorshSize xs, All FromBorsh xs) => FromBorsh (NP I xs) where
  decodeBorsh :: forall s. Decoder s (NP I xs)
decodeBorsh = forall (xs :: [*]) s.
All Top xs =>
NP (Decoder s) xs -> Decoder s (NP I xs)
decodeStruct forall a b. (a -> b) -> a -> b
$ forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (forall {k} (t :: k). Proxy t
Proxy @FromBorsh) forall a s. FromBorsh a => Decoder s a
decodeBorsh

instance ( BorshSizeSum xss
         , All SListI xss
         , All2 FromBorsh xss
         ) => FromBorsh (SOP I xss) where
  decodeBorsh :: forall s. Decoder s (SOP I xss)
decodeBorsh = forall s (xss :: [[*]]).
All SListI xss =>
POP (Decoder s) xss -> Decoder s (SOP I xss)
decodeEnum forall a b. (a -> b) -> a -> b
$ forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (forall {k} (t :: k). Proxy t
Proxy @FromBorsh) forall a s. FromBorsh a => Decoder s a
decodeBorsh

{-------------------------------------------------------------------------------
  Instances for tuples
-------------------------------------------------------------------------------}

-- size 0

deriving via Struct () instance BorshSize ()
deriving via Struct () instance ToBorsh   ()
deriving via Struct () instance FromBorsh ()

-- size 2

deriving via Struct (a, b)
         instance
              ( BorshSize a
              , BorshSize b
              )
           => BorshSize (a, b)
deriving via Struct (a, b)
         instance
              ( ToBorsh a
              , ToBorsh b
              )
           => ToBorsh (a, b)
deriving via Struct (a, b)
         instance
              ( FromBorsh a
              , FromBorsh b
              )
           => FromBorsh (a, b)

-- size 3

deriving via Struct (a, b, c)
         instance
              ( BorshSize a
              , BorshSize b
              , BorshSize c
              )
           => BorshSize (a, b, c)
deriving via Struct (a, b, c)
         instance
              ( ToBorsh a
              , ToBorsh b
              , ToBorsh c
              )
           => ToBorsh (a, b, c)
deriving via Struct (a, b, c)
         instance
              ( FromBorsh a
              , FromBorsh b
              , FromBorsh c
              )
           => FromBorsh (a, b, c)

-- size 4

deriving via Struct (a, b, c, d)
         instance
              ( BorshSize a
              , BorshSize b
              , BorshSize c
              , BorshSize d
              )
           => BorshSize (a, b, c, d)
deriving via Struct (a, b, c, d)
         instance
              ( ToBorsh a
              , ToBorsh b
              , ToBorsh c
              , ToBorsh d
              )
           => ToBorsh (a, b, c, d)
deriving via Struct (a, b, c, d)
         instance
              ( FromBorsh a
              , FromBorsh b
              , FromBorsh c
              , FromBorsh d
              )
           => FromBorsh (a, b, c, d)

-- size 5

deriving via Struct (a, b, c, d, e)
         instance
              ( BorshSize a
              , BorshSize b
              , BorshSize c
              , BorshSize d
              , BorshSize e
              )
           => BorshSize (a, b, c, d, e)
deriving via Struct (a, b, c, d, e)
         instance
              ( ToBorsh a
              , ToBorsh b
              , ToBorsh c
              , ToBorsh d
              , ToBorsh e
              )
           => ToBorsh (a, b, c, d, e)
deriving via Struct (a, b, c, d, e)
         instance
              ( FromBorsh a
              , FromBorsh b
              , FromBorsh c
              , FromBorsh d
              , FromBorsh e
              )
           => FromBorsh (a, b, c, d, e)

-- size 6

deriving via Struct (a, b, c, d, e, f)
         instance
              ( BorshSize a
              , BorshSize b
              , BorshSize c
              , BorshSize d
              , BorshSize e
              , BorshSize f
              )
           => BorshSize (a, b, c, d, e, f)
deriving via Struct (a, b, c, d, e, f)
         instance
              ( ToBorsh a
              , ToBorsh b
              , ToBorsh c
              , ToBorsh d
              , ToBorsh e
              , ToBorsh f
              )
           => ToBorsh (a, b, c, d, e, f)
deriving via Struct (a, b, c, d, e, f)
         instance
              ( FromBorsh a
              , FromBorsh b
              , FromBorsh c
              , FromBorsh d
              , FromBorsh e
              , FromBorsh f
              )
           => FromBorsh (a, b, c, d, e, f)

-- size 7

deriving via Struct (a, b, c, d, e, f, g)
         instance
              ( BorshSize a
              , BorshSize b
              , BorshSize c
              , BorshSize d
              , BorshSize e
              , BorshSize f
              , BorshSize g
              )
           => BorshSize (a, b, c, d, e, f, g)
deriving via Struct (a, b, c, d, e, f, g)
         instance
              ( ToBorsh a
              , ToBorsh b
              , ToBorsh c
              , ToBorsh d
              , ToBorsh e
              , ToBorsh f
              , ToBorsh g
              )
           => ToBorsh (a, b, c, d, e, f, g)
deriving via Struct (a, b, c, d, e, f, g)
         instance
              ( FromBorsh a
              , FromBorsh b
              , FromBorsh c
              , FromBorsh d
              , FromBorsh e
              , FromBorsh f
              , FromBorsh g
              )
           => FromBorsh (a, b, c, d, e, f, g)

-- size 8

deriving via Struct (a, b, c, d, e, f, g, h)
         instance
              ( BorshSize a
              , BorshSize b
              , BorshSize c
              , BorshSize d
              , BorshSize e
              , BorshSize f
              , BorshSize g
              , BorshSize h
              )
           => BorshSize (a, b, c, d, e, f, g, h)
deriving via Struct (a, b, c, d, e, f, g, h)
         instance
              ( ToBorsh a
              , ToBorsh b
              , ToBorsh c
              , ToBorsh d
              , ToBorsh e
              , ToBorsh f
              , ToBorsh g
              , ToBorsh h
              )
           => ToBorsh (a, b, c, d, e, f, g, h)
deriving via Struct (a, b, c, d, e, f, g, h)
         instance
              ( FromBorsh a
              , FromBorsh b
              , FromBorsh c
              , FromBorsh d
              , FromBorsh e
              , FromBorsh f
              , FromBorsh g
              , FromBorsh h
              )
           => FromBorsh (a, b, c, d, e, f, g, h)

-- size 9

deriving via Struct (a, b, c, d, e, f, g, h, i)
         instance
              ( BorshSize a
              , BorshSize b
              , BorshSize c
              , BorshSize d
              , BorshSize e
              , BorshSize f
              , BorshSize g
              , BorshSize h
              , BorshSize i
              )
           => BorshSize (a, b, c, d, e, f, g, h, i)
deriving via Struct (a, b, c, d, e, f, g, h, i)
         instance
              ( ToBorsh a
              , ToBorsh b
              , ToBorsh c
              , ToBorsh d
              , ToBorsh e
              , ToBorsh f
              , ToBorsh g
              , ToBorsh h
              , ToBorsh i
              )
           => ToBorsh (a, b, c, d, e, f, g, h, i)
deriving via Struct (a, b, c, d, e, f, g, h, i)
         instance
              ( FromBorsh a
              , FromBorsh b
              , FromBorsh c
              , FromBorsh d
              , FromBorsh e
              , FromBorsh f
              , FromBorsh g
              , FromBorsh h
              , FromBorsh i
              )
           => FromBorsh (a, b, c, d, e, f, g, h, i)

-- size 10

deriving via Struct (a, b, c, d, e, f, g, h, i, j)
         instance
              ( BorshSize a
              , BorshSize b
              , BorshSize c
              , BorshSize d
              , BorshSize e
              , BorshSize f
              , BorshSize g
              , BorshSize h
              , BorshSize i
              , BorshSize j
              )
           => BorshSize (a, b, c, d, e, f, g, h, i, j)
deriving via Struct (a, b, c, d, e, f, g, h, i, j)
         instance
              ( ToBorsh a
              , ToBorsh b
              , ToBorsh c
              , ToBorsh d
              , ToBorsh e
              , ToBorsh f
              , ToBorsh g
              , ToBorsh h
              , ToBorsh i
              , ToBorsh j
              )
           => ToBorsh (a, b, c, d, e, f, g, h, i, j)
deriving via Struct (a, b, c, d, e, f, g, h, i, j)
         instance
              ( FromBorsh a
              , FromBorsh b
              , FromBorsh c
              , FromBorsh d
              , FromBorsh e
              , FromBorsh f
              , FromBorsh g
              , FromBorsh h
              , FromBorsh i
              , FromBorsh j
              )
           => FromBorsh (a, b, c, d, e, f, g, h, i, j)

{-------------------------------------------------------------------------------
  Instances for other common Haskell types
-------------------------------------------------------------------------------}

-- Lazy ByteString

instance BorshSize L.ByteString where
  type StaticBorshSize L.ByteString = 'HasVariableSize
  borshSize :: Proxy ByteString -> Size (StaticBorshSize ByteString)
borshSize Proxy ByteString
_ = Size 'HasVariableSize
SizeVariable

instance ToBorsh L.ByteString where
  encodeBorsh :: Encoder ByteString
encodeBorsh = Encoder ByteString
encodeLazyByteString

instance FromBorsh L.ByteString where
  decodeBorsh :: forall s. Decoder s ByteString
decodeBorsh = forall s. Decoder s ByteString
decodeLazyByteString

-- Strict ByteString

instance BorshSize S.ByteString where
  type StaticBorshSize S.ByteString = 'HasVariableSize
  borshSize :: Proxy ByteString -> Size (StaticBorshSize ByteString)
borshSize Proxy ByteString
_ = Size 'HasVariableSize
SizeVariable

instance ToBorsh S.ByteString where
  encodeBorsh :: Encoder ByteString
encodeBorsh = Encoder ByteString
encodeStrictByteString

instance FromBorsh S.ByteString where
  decodeBorsh :: forall s. Decoder s ByteString
decodeBorsh = forall s. Decoder s ByteString
decodeStrictByteString

-- Char

instance BorshSize Char where
  type StaticBorshSize Char = 'HasKnownSize
  borshSize :: Proxy Char -> Size (StaticBorshSize Char)
borshSize Proxy Char
_ = Int -> Size 'HasKnownSize
SizeKnown Int
4

instance ToBorsh Char where
  encodeBorsh :: Encoder Char
encodeBorsh = Encoder Char
encodeChar

instance FromBorsh Char where
  decodeBorsh :: forall s. Decoder s Char
decodeBorsh = forall s. Decoder s Char
decodeChar

-- Bool

instance BorshSize Bool where
  type StaticBorshSize Bool = 'HasKnownSize
  borshSize :: Proxy Bool -> Size (StaticBorshSize Bool)
borshSize Proxy Bool
_ = Int -> Size 'HasKnownSize
SizeKnown Int
1

instance ToBorsh Bool where
  encodeBorsh :: Encoder Bool
encodeBorsh = Encoder Bool
encodeBool

instance FromBorsh Bool where
  decodeBorsh :: forall s. Decoder s Bool
decodeBorsh = forall s. Decoder s Bool
decodeBool

-- Either

deriving instance BorshSize (Either a b)
deriving instance (ToBorsh   a, ToBorsh   b) => ToBorsh   (Either a b)
deriving instance (FromBorsh a, FromBorsh b) => FromBorsh (Either a b)

{-------------------------------------------------------------------------------
  Internal auxiliary: size of products and sums-of-products
-------------------------------------------------------------------------------}

-- | A product of types has known size if all types in the products do
type family ProdKnownSize (xs :: [Type]) :: KnownSize where
  ProdKnownSize '[]       = 'HasKnownSize
  ProdKnownSize (x ': xs) = ProdKnownAux (StaticBorshSize x) xs

-- | Auxiliary to 'ProdKnownSize'
--
-- Defined in such a way that we know the result is of variable size as soon
-- as we encounter the first type of variable size (independent of the tail).
type family ProdKnownAux (x :: KnownSize) (xs :: [Type]) :: KnownSize where
  ProdKnownAux 'HasKnownSize    xs = ProdKnownSize xs
  ProdKnownAux 'HasVariableSize xs = 'HasVariableSize

-- | A sum of products has known size if it has at most one constructor,
-- and all arguments of that constructor have known size
type family SumKnownSize (xs :: [[Type]]) :: KnownSize where
  SumKnownSize '[]   = 'HasKnownSize
  SumKnownSize '[xs] = ProdKnownSize xs
  SumKnownSize _     = 'HasVariableSize

-- | Type-level composition of 'Size' and 'StaticBorshSize'
newtype SoK (a :: Type) = SoK (Size (StaticBorshSize a))

constrSoK :: forall a. BorshSize a => SoK a
constrSoK :: forall a. BorshSize a => SoK a
constrSoK = forall a. Size (StaticBorshSize a) -> SoK a
SoK forall a b. (a -> b) -> a -> b
$ forall a. BorshSize a => Proxy a -> Size (StaticBorshSize a)
borshSize (forall {k} (t :: k). Proxy t
Proxy @a)

sizeOfProd :: forall xs. All BorshSize xs => Proxy xs -> Size (ProdKnownSize xs)
sizeOfProd :: forall (xs :: [*]).
All BorshSize xs =>
Proxy xs -> Size (ProdKnownSize xs)
sizeOfProd Proxy xs
_ =
      forall (xs' :: [*]). NP SoK xs' -> Size (ProdKnownSize xs')
go (forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
hcpure (forall {k} (t :: k). Proxy t
Proxy @BorshSize) forall a. BorshSize a => SoK a
constrSoK :: NP SoK xs)
    where
      go :: forall xs'. NP SoK xs' -> Size (ProdKnownSize xs')
      go :: forall (xs' :: [*]). NP SoK xs' -> Size (ProdKnownSize xs')
go NP SoK xs'
Nil           = Int -> Size 'HasKnownSize
SizeKnown Int
0
      go (SoK Size (StaticBorshSize x)
s :* NP SoK xs
ss) =
          case (Size (StaticBorshSize x)
s, forall (xs' :: [*]). NP SoK xs' -> Size (ProdKnownSize xs')
go NP SoK xs
ss) of
            (SizeKnown Int
sz , SizeKnown Int
sz') -> Int -> Size 'HasKnownSize
SizeKnown (Int
sz forall a. Num a => a -> a -> a
+ Int
sz')
            (SizeKnown Int
_  , Size (ProdKnownSize xs)
SizeVariable ) -> Size 'HasVariableSize
SizeVariable
            (Size (StaticBorshSize x)
SizeVariable , Size (ProdKnownSize xs)
_            ) -> Size 'HasVariableSize
SizeVariable

-- | Auxiliary class to @BorshSize@ describing the conditions under which the
-- size of the encoding of a value of a sum-type is known.
class BorshSizeSum (xss :: [[Type]]) where
  borshSizeSum :: Proxy xss -> Size (SumKnownSize xss)

instance BorshSizeSum '[] where
  -- In a way the size of the @Void@ type is meaningless, because there /are/
  -- no elements of @Void@, and hence there /is/ no encoding.
  -- TODO: Should we return undefined here..?
  borshSizeSum :: Proxy '[] -> Size (SumKnownSize '[])
borshSizeSum Proxy '[]
_ = Int -> Size 'HasKnownSize
SizeKnown Int
0

instance All BorshSize xs => BorshSizeSum '[xs] where
  borshSizeSum :: Proxy '[xs] -> Size (SumKnownSize '[xs])
borshSizeSum Proxy '[xs]
_ =
    -- This assumes the presence of the constructor tag
    -- (see detailed discussion in 'Struct')
    case forall (xs :: [*]).
All BorshSize xs =>
Proxy xs -> Size (ProdKnownSize xs)
sizeOfProd (forall {k} (t :: k). Proxy t
Proxy @xs) of
      SizeKnown Int
sz -> Int -> Size 'HasKnownSize
SizeKnown (Int
sz forall a. Num a => a -> a -> a
+ Int
1)
      Size (ProdKnownSize xs)
SizeVariable -> Size 'HasVariableSize
SizeVariable

instance BorshSizeSum (xs ': ys ': zss) where
  borshSizeSum :: Proxy (xs : ys : zss) -> Size (SumKnownSize (xs : ys : zss))
borshSizeSum Proxy (xs : ys : zss)
_ = Size 'HasVariableSize
SizeVariable