{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds              #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

-- |
-- Module      :  Data.Solidity.Event
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- This module is internal, the purpose is to define
-- helper classes and functions to assist in event decoding.
-- The user of this library should have no need to use
-- this directly in application code.
--

module Data.Solidity.Event
    (
      DecodeEvent(..)
    , IndexedEvent(..)
    ) where

import           Data.ByteArray               (ByteArrayAccess)
import           Data.Proxy                   (Proxy (..))
import           Generics.SOP                 (Generic, I (..), NP (..),
                                               NS (..), Rep, SOP (..), from, to)

import           Data.Solidity.Abi            (AbiGet)
import           Data.Solidity.Abi.Codec      (decode)
import           Data.Solidity.Event.Internal

-- | Indexed event args come back in as a list of encoded values. 'ArrayParser'
-- | is used to decode these values so that they can be used to reconstruct the
-- | entire decoded event.
class ArrayParser a where
  arrayParser :: ByteArrayAccess ba
              => [ba]
              -> Either String a

instance ArrayParser (NP f '[]) where
  arrayParser :: [ba] -> Either String (NP f '[])
arrayParser [ba]
_ = NP f '[] -> Either String (NP f '[])
forall a b. b -> Either a b
Right NP f '[]
forall k (a :: k -> *). NP a '[]
Nil

instance (ArrayParser (NP I as), AbiGet a)
       => ArrayParser (NP I (a : as)) where
  arrayParser :: [ba] -> Either String (NP I (a : as))
arrayParser [] = String -> Either String (NP I (a : as))
forall a b. a -> Either a b
Left String
"Empty"
  arrayParser (ba
a : [ba]
as) = do
    a
a' <- ba -> Either String a
forall ba a.
(ByteArrayAccess ba, AbiGet a) =>
ba -> Either String a
decode ba
a
    NP I as
as' <- [ba] -> Either String (NP I as)
forall a ba.
(ArrayParser a, ByteArrayAccess ba) =>
[ba] -> Either String a
arrayParser [ba]
as
    NP I (a : as) -> Either String (NP I (a : as))
forall (m :: * -> *) a. Monad m => a -> m a
return (NP I (a : as) -> Either String (NP I (a : as)))
-> NP I (a : as) -> Either String (NP I (a : as))
forall a b. (a -> b) -> a -> b
$ a -> I a
forall a. a -> I a
I a
a' 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)
:* NP I as
as'

instance ArrayParser (NP f as) => ArrayParser (SOP f '[as]) where
  arrayParser :: [ba] -> Either String (SOP f '[as])
arrayParser = (NP f as -> SOP f '[as])
-> Either String (NP f as) -> Either String (SOP f '[as])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) (Either String (NP f as) -> Either String (SOP f '[as]))
-> ([ba] -> Either String (NP f as))
-> [ba]
-> Either String (SOP f '[as])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ba] -> Either String (NP f as)
forall a ba.
(ArrayParser a, ByteArrayAccess ba) =>
[ba] -> Either String a
arrayParser

genericArrayParser :: ( Generic a
                      , Rep a ~ rep
                      , ArrayParser rep
                      , ByteArrayAccess ba
                      )
                   => [ba]
                   -> Either String a
genericArrayParser :: [ba] -> Either String a
genericArrayParser = (SOP I (Code a) -> a)
-> Either String (SOP I (Code a)) -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SOP I (Code a) -> a
forall a. Generic a => Rep a -> a
to (Either String (SOP I (Code a)) -> Either String a)
-> ([ba] -> Either String (SOP I (Code a)))
-> [ba]
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ba] -> Either String (SOP I (Code a))
forall a ba.
(ArrayParser a, ByteArrayAccess ba) =>
[ba] -> Either String a
arrayParser

--------------------------------------------------------------------------------
-- Event Parsing
--------------------------------------------------------------------------------

data Event i ni = Event i ni

-- | 'parseChange' decodes both the indexed and non-indexed event components.
parseChange :: ( Generic i
               , Rep i ~ irep
               , ArrayParser irep
               , AbiGet ni
               , ByteArrayAccess ba
               )
             => [ba]
             -- ^ event change topics
             -> ba
             -- ^ event change data
             -> Bool
             -- ^ is anonymous event
             -> Either String (Event i ni)
parseChange :: [ba] -> ba -> Bool -> Either String (Event i ni)
parseChange [ba]
topics ba
data_ Bool
anonymous =
    i -> ni -> Event i ni
forall i ni. i -> ni -> Event i ni
Event (i -> ni -> Event i ni)
-> Either String i -> Either String (ni -> Event i ni)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ba] -> Either String i
forall a rep ba.
(Generic a, Rep a ~ rep, ArrayParser rep, ByteArrayAccess ba) =>
[ba] -> Either String a
genericArrayParser [ba]
topics' Either String (ni -> Event i ni)
-> Either String ni -> Either String (Event i ni)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ba -> Either String ni
forall ba a.
(ByteArrayAccess ba, AbiGet a) =>
ba -> Either String a
decode ba
data_
  where
    topics' :: [ba]
topics' | Bool
anonymous = [ba]
topics
            | Bool
otherwise = [ba] -> [ba]
forall a. [a] -> [a]
tail [ba]
topics

class IndexedEvent i ni e | e -> i ni where
  isAnonymous :: Proxy e -> Bool

-- | 'CombineChange' is a class which indicates that given event components of types 'i'
-- | and 'ni', we can construct an event of type 'e'. The functional dependency is valid
-- | becasue of how the template haskell generates the event types.
class CombineChange i ni e | e -> i ni where
  combineChange :: i -> ni -> e

instance ( Generic i
         , Rep i ~ irep
         , Generic ni
         , Rep ni ~ nirep
         , Generic e
         , Rep e ~ erep
         , HListRep irep hli
         , HListRep nirep hlni
         , MergeIndexedArguments hli hlni
         , MergeIndexedArguments' hli hlni ~ hle
         , HListRep erep hle
         , IndexedEvent i ni e
         ) => CombineChange i ni e where
  combineChange :: i -> ni -> e
combineChange i
i ni
ni =
    let hli :: HList hli
hli = Rep i -> HList hli
forall a (xs :: [*]). HListRep a xs => a -> HList xs
toHList (Rep i -> HList hli) -> (i -> Rep i) -> i -> HList hli
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Rep i
forall a. Generic a => a -> Rep a
from (i -> HList hli) -> i -> HList hli
forall a b. (a -> b) -> a -> b
$ i
i
        hlni :: HList hlni
hlni = Rep ni -> HList hlni
forall a (xs :: [*]). HListRep a xs => a -> HList xs
toHList (Rep ni -> HList hlni) -> (ni -> Rep ni) -> ni -> HList hlni
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ni -> Rep ni
forall a. Generic a => a -> Rep a
from (ni -> HList hlni) -> ni -> HList hlni
forall a b. (a -> b) -> a -> b
$ ni
ni
        hle :: HList (MergeIndexedArguments' hli hlni)
hle = HList hli -> HList hlni -> HList (MergeIndexedArguments' hli hlni)
forall (as :: [*]) (bs :: [*]).
MergeIndexedArguments as bs =>
HList as -> HList bs -> HList (MergeIndexedArguments' as bs)
mergeIndexedArguments HList hli
hli HList hlni
hlni
    in Rep e -> e
forall a. Generic a => Rep a -> a
to (Rep e -> e) -> (HList hle -> Rep e) -> HList hle -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HList hle -> Rep e
forall a (xs :: [*]). HListRep a xs => HList xs -> a
fromHList (HList hle -> e) -> HList hle -> e
forall a b. (a -> b) -> a -> b
$ HList hle
HList (MergeIndexedArguments' hli hlni)
hle

class DecodeEvent i ni e | e -> i ni where
  decodeEvent :: ByteArrayAccess ba => [ba] -> ba -> Either String e

instance ( IndexedEvent i ni e
         , Generic i
         , Rep i ~ SOP I '[hli]
         , AbiGet ni
         , Generic ni
         , Rep ni ~ SOP I '[hlni]
         , Generic e
         , Rep e ~ SOP I '[hle]
         , CombineChange i ni e
         , ArrayParser (SOP I '[hli])
         ) => DecodeEvent i ni e where
  decodeEvent :: [ba] -> ba -> Either String e
decodeEvent [ba]
topics ba
data_ = do
      let anonymous :: Bool
anonymous = Proxy e -> Bool
forall k k k (i :: k) (ni :: k) (e :: k).
IndexedEvent i ni e =>
Proxy e -> Bool
isAnonymous (Proxy e
forall k (t :: k). Proxy t
Proxy :: Proxy e)
      (Event i
i ni
ni :: Event i ni) <- [ba] -> ba -> Bool -> Either String (Event i ni)
forall i irep ni ba.
(Generic i, Rep i ~ irep, ArrayParser irep, AbiGet ni,
 ByteArrayAccess ba) =>
[ba] -> ba -> Bool -> Either String (Event i ni)
parseChange [ba]
topics ba
data_ Bool
anonymous
      e -> Either String e
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either String e) -> e -> Either String e
forall a b. (a -> b) -> a -> b
$ i -> ni -> e
forall i ni e. CombineChange i ni e => i -> ni -> e
combineChange i
i ni
ni