{-# 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.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)
import Data.Int128
import Data.Word128 (Word128)

{-------------------------------------------------------------------------------
  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