{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
module Data.Solidity.Abi.Generic () where
import qualified Data.ByteString.Lazy as LBS
import Data.Int (Int64)
import qualified Data.List as L
import Data.Proxy (Proxy (..))
import Data.Serialize (Get, Put)
import Data.Serialize.Get (bytesRead, lookAheadE, skip)
import Data.Serialize.Put (runPutLazy)
import Generics.SOP (I (..), NP (..), NS (..), SOP (..))
import Data.Solidity.Abi (AbiGet (..), AbiPut (..), AbiType (..),
GenericAbiGet (..), GenericAbiPut (..))
import Data.Solidity.Prim.Int (getWord256, putWord256)
data EncodedValue = EncodedValue
{ EncodedValue -> Int64
evOrder :: Int64
, EncodedValue -> Bool
evIsDynamic :: Bool
, EncodedValue -> Put
evEncoding :: Put
, EncodedValue -> Int64
evEncodingLengthInBytes :: Int64
}
instance Eq EncodedValue where
EncodedValue
ev1 == :: EncodedValue -> EncodedValue -> Bool
== EncodedValue
ev2 = EncodedValue -> Int64
evOrder EncodedValue
ev1 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== EncodedValue -> Int64
evOrder EncodedValue
ev2
instance Ord EncodedValue where
compare :: EncodedValue -> EncodedValue -> Ordering
compare EncodedValue
ev1 EncodedValue
ev2 = EncodedValue -> Int64
evOrder EncodedValue
ev1 Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` EncodedValue -> Int64
evOrder EncodedValue
ev2
combineEncodedValues :: [EncodedValue] -> Put
combineEncodedValues :: [EncodedValue] -> Put
combineEncodedValues [EncodedValue]
encodings =
let sortedEncodings :: [EncodedValue]
sortedEncodings = [EncodedValue] -> [EncodedValue]
forall a. Ord a => [a] -> [a]
L.sort [EncodedValue]
encodings
wordLengthInBytes :: Int64
wordLengthInBytes :: Int64
wordLengthInBytes = Int64
32
headsOffsetInBytes :: Int64
headsOffsetInBytes :: Int64
headsOffsetInBytes = (Int64 -> Int64 -> Int64) -> Int64 -> [Int64] -> Int64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(+) Int64
0 ([Int64] -> Int64) -> [Int64] -> Int64
forall a b. (a -> b) -> a -> b
$ (EncodedValue -> Int64) -> [EncodedValue] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map (\EncodedValue{Bool
Int64
Put
evOrder :: EncodedValue -> Int64
evIsDynamic :: EncodedValue -> Bool
evEncoding :: EncodedValue -> Put
evEncodingLengthInBytes :: EncodedValue -> Int64
evOrder :: Int64
evIsDynamic :: Bool
evEncoding :: Put
evEncodingLengthInBytes :: Int64
..} -> if Bool
evIsDynamic then Int64
wordLengthInBytes else Int64
evEncodingLengthInBytes) [EncodedValue]
encodings
heads :: Put
heads = (Put, Int64) -> Put
forall a b. (a, b) -> a
fst ((Put, Int64) -> Put) -> (Put, Int64) -> Put
forall a b. (a -> b) -> a -> b
$ ((Put, Int64) -> EncodedValue -> (Put, Int64))
-> (Put, Int64) -> [EncodedValue] -> (Put, Int64)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
(\(Put
accumulator, Int64
lengthOfPreviousDynamicValues) EncodedValue{Bool
Int64
Put
evOrder :: EncodedValue -> Int64
evIsDynamic :: EncodedValue -> Bool
evEncoding :: EncodedValue -> Put
evEncodingLengthInBytes :: EncodedValue -> Int64
evOrder :: Int64
evIsDynamic :: Bool
evEncoding :: Put
evEncodingLengthInBytes :: Int64
..} -> if Bool
evIsDynamic
then ( Put
accumulator Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Putter Word256
putWord256 (Int64 -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word256) -> Int64 -> Word256
forall a b. (a -> b) -> a -> b
$ Int64
headsOffsetInBytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
lengthOfPreviousDynamicValues)
, Int64
lengthOfPreviousDynamicValues Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
evEncodingLengthInBytes
)
else ( Put
accumulator Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Put
evEncoding
, Int64
lengthOfPreviousDynamicValues
)
)
(Put
forall a. Monoid a => a
mempty, Int64
0)
[EncodedValue]
sortedEncodings
tails :: Put
tails = (EncodedValue -> Put) -> [EncodedValue] -> Put
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
(\EncodedValue{Bool
Int64
Put
evOrder :: EncodedValue -> Int64
evIsDynamic :: EncodedValue -> Bool
evEncoding :: EncodedValue -> Put
evEncodingLengthInBytes :: EncodedValue -> Int64
evOrder :: Int64
evIsDynamic :: Bool
evEncoding :: Put
evEncodingLengthInBytes :: Int64
..} -> if Bool
evIsDynamic
then Put
evEncoding
else Put
forall a. Monoid a => a
mempty
)
[EncodedValue]
sortedEncodings
in Put
heads Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Put
tails
where
mkEncodedValue :: (AbiType a, AbiPut a) => [EncodedValue] -> a -> Bool -> EncodedValue
mkEncodedValue :: forall a.
(AbiType a, AbiPut a) =>
[EncodedValue] -> a -> Bool -> EncodedValue
mkEncodedValue [EncodedValue]
otherEncodedArray a
a Bool
aIsDynamic =
let encoding :: Put
encoding = Putter a
forall a. AbiPut a => Putter a
abiPut a
a
in EncodedValue
{ evEncoding :: Put
evEncoding = Put
encoding
, evOrder :: Int64
evOrder = Integer -> Int64
forall a. Num a => Integer -> a
fromInteger (Integer -> Int64)
-> ([EncodedValue] -> Integer) -> [EncodedValue] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer)
-> ([EncodedValue] -> Int) -> [EncodedValue] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EncodedValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([EncodedValue] -> Int64) -> [EncodedValue] -> Int64
forall a b. (a -> b) -> a -> b
$ [EncodedValue]
otherEncodedArray
, evIsDynamic :: Bool
evIsDynamic = Bool
aIsDynamic
, evEncodingLengthInBytes :: Int64
evEncodingLengthInBytes = Put -> Int64
lengthInBytes Put
encoding
}
where
lengthInBytes :: Put -> Int64
lengthInBytes :: Put -> Int64
lengthInBytes Put
e = ByteString -> Int64
LBS.length (ByteString -> Int64) -> (Put -> ByteString) -> Put -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutLazy (Put -> Int64) -> Put -> Int64
forall a b. (a -> b) -> a -> b
$ Put
e
class AbiData a where
_serialize :: [EncodedValue] -> a -> [EncodedValue]
instance AbiData (NP f '[]) where
_serialize :: [EncodedValue] -> NP f '[] -> [EncodedValue]
_serialize [EncodedValue]
encoded NP f '[]
_ = [EncodedValue]
encoded
instance (AbiType b, AbiPut b, AbiData (NP I as)) => AbiData (NP I (b : as)) where
_serialize :: [EncodedValue] -> NP I (b : as) -> [EncodedValue]
_serialize [EncodedValue]
encoded (I x
b :* NP I xs
a) = [EncodedValue] -> NP I xs -> [EncodedValue]
forall a. AbiData a => [EncodedValue] -> a -> [EncodedValue]
_serialize ([EncodedValue] -> x -> Bool -> EncodedValue
forall a.
(AbiType a, AbiPut a) =>
[EncodedValue] -> a -> Bool -> EncodedValue
mkEncodedValue [EncodedValue]
encoded x
b (Proxy b -> Bool
forall a. AbiType a => Proxy a -> Bool
isDynamic (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)) EncodedValue -> [EncodedValue] -> [EncodedValue]
forall a. a -> [a] -> [a]
: [EncodedValue]
encoded) NP I xs
a
instance AbiData (NP f as) => GenericAbiPut (SOP f '[as]) where
gAbiPut :: Putter (SOP f '[as])
gAbiPut (SOP (Z NP f x
a)) = [EncodedValue] -> Put
combineEncodedValues ([EncodedValue] -> Put) -> [EncodedValue] -> Put
forall a b. (a -> b) -> a -> b
$ [EncodedValue] -> NP f x -> [EncodedValue]
forall a. AbiData a => [EncodedValue] -> a -> [EncodedValue]
_serialize [] NP f x
a
gAbiPut SOP f '[as]
_ = [Char] -> Put
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible branch"
instance GenericAbiGet (NP f '[]) where
gAbiGet :: Get (NP f '[])
gAbiGet = NP f '[] -> Get (NP f '[])
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return NP f '[]
forall {k} (a :: k -> *). NP a '[]
Nil
instance (AbiGet a, GenericAbiGet (NP I as)) => GenericAbiGet (NP I (a : as)) where
gAbiGet :: Get (NP I (a : as))
gAbiGet = I a -> NP I as -> NP I (a : as)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (I a -> NP I as -> NP I (a : as))
-> Get (I a) -> Get (NP I as -> NP I (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> I a
forall a. a -> I a
I (a -> I a) -> Get a -> Get (I a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall a. AbiGet a => Get a
factorParser) Get (NP I as -> NP I (a : as))
-> Get (NP I as) -> Get (NP I (a : as))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (NP I as)
forall a. GenericAbiGet a => Get a
gAbiGet
instance GenericAbiGet (NP f as) => GenericAbiGet (SOP f '[as]) where
gAbiGet :: Get (SOP f '[as])
gAbiGet = NS (NP f) '[as] -> SOP f '[as]
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (NS (NP f) '[as] -> SOP f '[as])
-> (NP f as -> NS (NP f) '[as]) -> NP f as -> SOP f '[as]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP f as -> NS (NP f) '[as]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (NP f as -> SOP f '[as]) -> Get (NP f as) -> Get (SOP f '[as])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (NP f as)
forall a. GenericAbiGet a => Get a
gAbiGet
factorParser :: forall a . AbiGet a => Get a
factorParser :: forall a. AbiGet a => Get a
factorParser
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Proxy a -> Bool
forall a. AbiType a => Proxy a -> Bool
isDynamic (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) = Get a
forall a. AbiGet a => Get a
abiGet
| Bool
otherwise = do
Int
dataOffset <- 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
Int
currentOffset <- Get Int
bytesRead
Left a
x <- Get (Either a Any) -> Get (Either a Any)
forall a b. Get (Either a b) -> Get (Either a b)
lookAheadE (Get (Either a Any) -> Get (Either a Any))
-> Get (Either a Any) -> Get (Either a Any)
forall a b. (a -> b) -> a -> b
$ do
Int -> Get ()
skip (Int
dataOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentOffset)
a -> Either a Any
forall a b. a -> Either a b
Left (a -> Either a Any) -> Get a -> Get (Either a Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall a. AbiGet a => Get a
abiGet
a -> Get a
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x