{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE UndecidableInstances  #-}

-- |
-- Module      :  Network.Ethereum.Contract.Event.Common
-- Copyright   :  FOAM team <http://foam.space> 2018
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Common event manipulation functions.
--

module Network.Ethereum.Contract.Event.Common  where

import           Control.Concurrent         (threadDelay)
import           Control.Exception          (Exception, throwIO)
import           Control.Monad.IO.Class     (liftIO)
import           Data.Either                (lefts, rights)

import           Data.Solidity.Event        (DecodeEvent (..))
import qualified Network.Ethereum.Api.Eth   as Eth
import           Network.Ethereum.Api.Types (Change (..), DefaultBlock (..),
                                             Filter (..), Quantity)
import           Network.JsonRpc.TinyClient (JsonRpc (..))

-- | Event callback control response
data EventAction = ContinueEvent
    | TerminateEvent
    deriving (Int -> EventAction -> ShowS
[EventAction] -> ShowS
EventAction -> String
(Int -> EventAction -> ShowS)
-> (EventAction -> String)
-> ([EventAction] -> ShowS)
-> Show EventAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventAction] -> ShowS
$cshowList :: [EventAction] -> ShowS
show :: EventAction -> String
$cshow :: EventAction -> String
showsPrec :: Int -> EventAction -> ShowS
$cshowsPrec :: Int -> EventAction -> ShowS
Show, EventAction -> EventAction -> Bool
(EventAction -> EventAction -> Bool)
-> (EventAction -> EventAction -> Bool) -> Eq EventAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventAction -> EventAction -> Bool
$c/= :: EventAction -> EventAction -> Bool
== :: EventAction -> EventAction -> Bool
$c== :: EventAction -> EventAction -> Bool
Eq)


data FilterChange a = FilterChange
    { FilterChange a -> Change
filterChangeRawChange :: Change
    , FilterChange a -> a
filterChangeEvent     :: a
    }

data EventParseFailure = EventParseFailure String
    deriving (Int -> EventParseFailure -> ShowS
[EventParseFailure] -> ShowS
EventParseFailure -> String
(Int -> EventParseFailure -> ShowS)
-> (EventParseFailure -> String)
-> ([EventParseFailure] -> ShowS)
-> Show EventParseFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventParseFailure] -> ShowS
$cshowList :: [EventParseFailure] -> ShowS
show :: EventParseFailure -> String
$cshow :: EventParseFailure -> String
showsPrec :: Int -> EventParseFailure -> ShowS
$cshowsPrec :: Int -> EventParseFailure -> ShowS
Show)

instance Exception EventParseFailure

mkFilterChanges :: DecodeEvent i ni e
                => [Change]
                -> IO [FilterChange e]
mkFilterChanges :: [Change] -> IO [FilterChange e]
mkFilterChanges [Change]
changes =
  let eChanges :: [Either String (FilterChange e)]
eChanges = (Change -> Either String (FilterChange e))
-> [Change] -> [Either String (FilterChange e)]
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Change
c@Change{[HexString]
Maybe HexString
Maybe Quantity
HexString
Address
changeTopics :: Change -> [HexString]
changeData :: Change -> HexString
changeAddress :: Change -> Address
changeBlockNumber :: Change -> Maybe Quantity
changeBlockHash :: Change -> Maybe HexString
changeTransactionHash :: Change -> Maybe HexString
changeTransactionIndex :: Change -> Maybe Quantity
changeLogIndex :: Change -> Maybe Quantity
changeTopics :: [HexString]
changeData :: HexString
changeAddress :: Address
changeBlockNumber :: Maybe Quantity
changeBlockHash :: Maybe HexString
changeTransactionHash :: Maybe HexString
changeTransactionIndex :: Maybe Quantity
changeLogIndex :: Maybe Quantity
..} -> Change -> e -> FilterChange e
forall a. Change -> a -> FilterChange a
FilterChange Change
c (e -> FilterChange e)
-> Either String e -> Either String (FilterChange e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HexString] -> HexString -> Either String e
forall k k1 (i :: k) (ni :: k1) e ba.
(DecodeEvent i ni e, ByteArrayAccess ba) =>
[ba] -> ba -> Either String e
decodeEvent [HexString]
changeTopics HexString
changeData) [Change]
changes
      ls :: [String]
ls = [Either String (FilterChange e)] -> [String]
forall a b. [Either a b] -> [a]
lefts [Either String (FilterChange e)]
eChanges
      rs :: [FilterChange e]
rs = [Either String (FilterChange e)] -> [FilterChange e]
forall a b. [Either a b] -> [b]
rights [Either String (FilterChange e)]
eChanges
  in if [String]
ls [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then EventParseFailure -> IO [FilterChange e]
forall e a. Exception e => e -> IO a
throwIO (String -> EventParseFailure
EventParseFailure (String -> EventParseFailure) -> String -> EventParseFailure
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Show a => a -> String
show [String]
ls) else [FilterChange e] -> IO [FilterChange e]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilterChange e]
rs


data FilterStreamState e = FilterStreamState
    { FilterStreamState e -> Quantity
fssCurrentBlock  :: Quantity
    , FilterStreamState e -> Filter e
fssInitialFilter :: Filter e
    , FilterStreamState e -> Integer
fssWindowSize    :: Integer
    }


-- | Coerce a 'DefaultBlock' into a numerical block number.
mkBlockNumber :: JsonRpc m => DefaultBlock -> m Quantity
mkBlockNumber :: DefaultBlock -> m Quantity
mkBlockNumber DefaultBlock
bm = case DefaultBlock
bm of
  BlockWithNumber Quantity
bn -> Quantity -> m Quantity
forall (m :: * -> *) a. Monad m => a -> m a
return Quantity
bn
  DefaultBlock
Earliest           -> Quantity -> m Quantity
forall (m :: * -> *) a. Monad m => a -> m a
return Quantity
0
  DefaultBlock
_                  -> m Quantity
forall (m :: * -> *). JsonRpc m => m Quantity
Eth.blockNumber


pollTillBlockProgress :: JsonRpc m => Quantity -> m Quantity
pollTillBlockProgress :: Quantity -> m Quantity
pollTillBlockProgress Quantity
currentBlock = do
  Quantity
bn <- m Quantity
forall (m :: * -> *). JsonRpc m => m Quantity
Eth.blockNumber
  if Quantity
currentBlock Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
>= Quantity
bn
    then do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
3000000
      Quantity -> m Quantity
forall (m :: * -> *). JsonRpc m => Quantity -> m Quantity
pollTillBlockProgress Quantity
currentBlock
       else Quantity -> m Quantity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Quantity
bn