{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      :  Data.Solidity.Prim.List
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  noportable
--
-- Ethereum Abi dynamic and static size vectors based on linked lists.
--

module Data.Solidity.Prim.List
    (
    -- * Fixed size linked list
      ListN
    ) where

import           Basement.Nat           (NatWithinBound)
import           Basement.Sized.List    (ListN, toListN_, unListN)
import qualified Basement.Sized.List    as SL (init, map, mapM, mapM_,
                                               replicateM, scanl')
import           Basement.Types.Word256 (Word256)
import           Control.Monad          (forM, replicateM)
import qualified Data.ByteString        as B
import           Data.List              (scanl')
import           Data.Proxy             (Proxy (..))
import           Data.Serialize.Get     (lookAhead, skip)
import           Data.Serialize.Put     (putByteString, runPut)
import           GHC.Exts               (IsList (..))
import           GHC.TypeLits           (KnownNat, natVal, type (+), type (<=))

import           Data.Solidity.Abi      (AbiGet (..), AbiPut (..), AbiType (..))
import           Data.Solidity.Prim.Int (getWord256, putWord256)

instance AbiType [a] where
    isDynamic :: Proxy [a] -> Bool
isDynamic Proxy [a]
_ = Bool
True

instance AbiPut a => AbiPut [a] where
    abiPut :: Putter [a]
abiPut [a]
l = do Putter Word256
putWord256 Putter Word256 -> Putter Word256
forall a b. (a -> b) -> a -> b
$ Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l)
                  if Proxy a -> Bool
forall a. AbiType a => Proxy a -> Bool
isDynamic (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) then do
                      let encs :: [ByteString]
encs = (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (PutM () -> ByteString
runPut (PutM () -> ByteString) -> (a -> PutM ()) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PutM ()
forall a. AbiPut a => Putter a
abiPut) [a]
l
                          lengths :: [Word256]
lengths = (ByteString -> Word256) -> [ByteString] -> [Word256]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word256) (Int -> Word256) -> (ByteString -> Int) -> ByteString -> Word256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) [ByteString]
encs
                          offsets :: [Word256]
offsets = [Word256] -> [Word256]
forall a. HasCallStack => [a] -> [a]
init ([Word256] -> [Word256]) -> [Word256] -> [Word256]
forall a b. (a -> b) -> a -> b
$ (Word256 -> Word256 -> Word256)
-> Word256 -> [Word256] -> [Word256]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Word256 -> Word256 -> Word256
forall a. Num a => a -> a -> a
(+) (Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
0x20 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l)) [Word256]
lengths
                      Putter Word256 -> [Word256] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Putter Word256
putWord256 [Word256]
offsets
                      (ByteString -> PutM ()) -> [ByteString] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> PutM ()
putByteString [ByteString]
encs
                    else
                      (a -> PutM ()) -> Putter [a]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> PutM ()
forall a. AbiPut a => Putter a
abiPut [a]
l

instance AbiGet a => AbiGet [a] where
    abiGet :: Get [a]
abiGet = do Int
len <- Word256 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word256 -> Int) -> Get Word256 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word256
getWord256
                if Proxy a -> Bool
forall a. AbiType a => Proxy a -> Bool
isDynamic (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) then do
                    [Word256]
offsets <- Int -> Get Word256 -> Get [Word256]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Get Word256
getWord256
                    let currentOffset :: Int
currentOffset = Int
0x20 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len
                    [Word256] -> (Word256 -> Get a) -> Get [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Word256]
offsets ((Word256 -> Get a) -> Get [a]) -> (Word256 -> Get a) -> Get [a]
forall a b. (a -> b) -> a -> b
$ \Word256
dataOffset -> Get a -> Get a
forall a. Get a -> Get a
lookAhead (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ do
                        Int -> Get ()
skip (Word256 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word256
dataOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentOffset)
                        Get a
forall a. AbiGet a => Get a
abiGet
                  else
                    Int -> Get a -> Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Get a
forall a. AbiGet a => Get a
abiGet

instance (AbiType a, KnownNat n) => AbiType (ListN n a) where
    isDynamic :: Proxy (ListN n a) -> Bool
isDynamic Proxy (ListN n a)
_ = Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Proxy a -> Bool
forall a. AbiType a => Proxy a -> Bool
isDynamic (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (AbiPut a, KnownNat n, 1 <= n+1) => AbiPut (ListN n a) where
    abiPut :: Putter (ListN n a)
abiPut ListN n a
l = if Proxy a -> Bool
forall a. AbiType a => Proxy a -> Bool
isDynamic (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) then do
                   let encs :: ListN n ByteString
encs = (a -> ByteString) -> ListN n a -> ListN n ByteString
forall a b (n :: Nat). (a -> b) -> ListN n a -> ListN n b
SL.map (PutM () -> ByteString
runPut (PutM () -> ByteString) -> (a -> PutM ()) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PutM ()
forall a. AbiPut a => Putter a
abiPut) ListN n a
l
                       lengths :: ListN n Word256
lengths = (ByteString -> Word256) -> ListN n ByteString -> ListN n Word256
forall a b (n :: Nat). (a -> b) -> ListN n a -> ListN n b
SL.map ((Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word256) (Int -> Word256) -> (ByteString -> Int) -> ByteString -> Word256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length) ListN n ByteString
encs
                       len :: Integer
len = Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
                       offsets :: ListN ((n + 1) - 1) Word256
offsets = ListN (n + 1) Word256 -> ListN ((n + 1) - 1) Word256
forall (n :: Nat) a. (1 <= n) => ListN n a -> ListN (n - 1) a
SL.init (ListN (n + 1) Word256 -> ListN ((n + 1) - 1) Word256)
-> ListN (n + 1) Word256 -> ListN ((n + 1) - 1) Word256
forall a b. (a -> b) -> a -> b
$ (Word256 -> Word256 -> Word256)
-> Word256 -> ListN n Word256 -> ListN (n + 1) Word256
forall b a (n :: Nat).
(b -> a -> b) -> b -> ListN n a -> ListN (n + 1) b
SL.scanl' Word256 -> Word256 -> Word256
forall a. Num a => a -> a -> a
(+) (Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
0x20 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
len)) ListN n Word256
lengths
                   Putter Word256 -> ListN ((n + 1) - 1) Word256 -> PutM ()
forall (m :: * -> *) a b (n :: Nat).
Monad m =>
(a -> m b) -> ListN n a -> m ()
SL.mapM_ Putter Word256
putWord256 ListN ((n + 1) - 1) Word256
offsets
                   (ByteString -> PutM ()) -> ListN n ByteString -> PutM ()
forall (m :: * -> *) a b (n :: Nat).
Monad m =>
(a -> m b) -> ListN n a -> m ()
SL.mapM_ ByteString -> PutM ()
putByteString ListN n ByteString
encs
               else
                   (a -> PutM ()) -> Putter (ListN n a)
forall (m :: * -> *) a b (n :: Nat).
Monad m =>
(a -> m b) -> ListN n a -> m ()
SL.mapM_ a -> PutM ()
forall a. AbiPut a => Putter a
abiPut ListN n a
l

instance (NatWithinBound Int n, KnownNat n, AbiGet a) => AbiGet (ListN n a) where
    abiGet :: Get (ListN n a)
abiGet = do let len :: Int
len = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n))
                if Proxy a -> Bool
forall a. AbiType a => Proxy a -> Bool
isDynamic (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) then do
                    ListN n Word256
offsets <- Get Word256 -> Get (ListN n Word256)
forall (n :: Nat) (m :: * -> *) a.
(NatWithinBound Int n, Monad m, KnownNat n) =>
m a -> m (ListN n a)
SL.replicateM Get Word256
getWord256
                    let currentOffset :: Int
currentOffset = Int
0x20 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len
                    ((Word256 -> Get a) -> ListN n Word256 -> Get (ListN n a))
-> ListN n Word256 -> (Word256 -> Get a) -> Get (ListN n a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Word256 -> Get a) -> ListN n Word256 -> Get (ListN n a)
forall (m :: * -> *) a b (n :: Nat).
Monad m =>
(a -> m b) -> ListN n a -> m (ListN n b)
SL.mapM ListN n Word256
offsets ((Word256 -> Get a) -> Get (ListN n a))
-> (Word256 -> Get a) -> Get (ListN n a)
forall a b. (a -> b) -> a -> b
$ \Word256
dataOffset -> Get a -> Get a
forall a. Get a -> Get a
lookAhead (Get a -> Get a) -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ do
                        Int -> Get ()
skip (Word256 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word256
dataOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentOffset)
                        Get a
forall a. AbiGet a => Get a
abiGet
                  else
                    Get a -> Get (ListN n a)
forall (n :: Nat) (m :: * -> *) a.
(NatWithinBound Int n, Monad m, KnownNat n) =>
m a -> m (ListN n a)
SL.replicateM Get a
forall a. AbiGet a => Get a
abiGet

instance (NatWithinBound Int n, KnownNat n) => IsList (ListN n a) where
    type Item (ListN n a) = a
    fromList :: [Item (ListN n a)] -> ListN n a
fromList = [a] -> ListN n a
[Item (ListN n a)] -> ListN n a
forall (n :: Nat) a.
(HasCallStack, NatWithinBound Int n, KnownNat n) =>
[a] -> ListN n a
toListN_
    toList :: ListN n a -> [Item (ListN n a)]
toList   = ListN n a -> [a]
ListN n a -> [Item (ListN n a)]
forall (n :: Nat) a. ListN n a -> [a]
unListN