{-# LANGUAGE UndecidableInstances #-}

module Tendermint.SDK.BaseApp.Transaction.Types
  ( module Tendermint.SDK.BaseApp.Transaction.Types
  -- * Re-Exports
  , Tx(..)
  ) where

import           Control.Lens                             (lens)
import           Data.ByteString                          (ByteString)
import           Data.IORef                               (IORef, newIORef)
import qualified Tendermint.SDK.BaseApp.Events            as E
import qualified Tendermint.SDK.BaseApp.Gas               as G
import           Tendermint.SDK.BaseApp.Router            (HasPath (..))
import qualified Tendermint.SDK.BaseApp.Transaction.Cache as Cache
import           Tendermint.SDK.Types.Transaction         (Tx (..))
import           Tendermint.SDK.Types.TxResult            (TxResult)

--------------------------------------------------------------------------------
-- Router Types and Combinators
--------------------------------------------------------------------------------

data msg :~> a

data TypedMessage msg

data Return a

data EmptyTxServer = EmptyTxServer

--------------------------------------------------------------------------------
-- RouteContext and Singletons
--------------------------------------------------------------------------------

data RouteContext = CheckTx | DeliverTx deriving (RouteContext -> RouteContext -> Bool
(RouteContext -> RouteContext -> Bool)
-> (RouteContext -> RouteContext -> Bool) -> Eq RouteContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RouteContext -> RouteContext -> Bool
$c/= :: RouteContext -> RouteContext -> Bool
== :: RouteContext -> RouteContext -> Bool
$c== :: RouteContext -> RouteContext -> Bool
Eq, Int -> RouteContext -> ShowS
[RouteContext] -> ShowS
RouteContext -> String
(Int -> RouteContext -> ShowS)
-> (RouteContext -> String)
-> ([RouteContext] -> ShowS)
-> Show RouteContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RouteContext] -> ShowS
$cshowList :: [RouteContext] -> ShowS
show :: RouteContext -> String
$cshow :: RouteContext -> String
showsPrec :: Int -> RouteContext -> ShowS
$cshowsPrec :: Int -> RouteContext -> ShowS
Show)

--------------------------------------------------------------------------------
-- Transaction Application types
--------------------------------------------------------------------------------

data RoutingTx msg where
  RoutingTx :: Tx alg msg -> RoutingTx msg

instance Functor RoutingTx where
  fmap :: (a -> b) -> RoutingTx a -> RoutingTx b
fmap f :: a -> b
f (RoutingTx tx :: Tx alg a
tx) = Tx alg b -> RoutingTx b
forall k (alg :: k) msg. Tx alg msg -> RoutingTx msg
RoutingTx (Tx alg b -> RoutingTx b) -> Tx alg b -> RoutingTx b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Tx alg a -> Tx alg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Tx alg a
tx

instance HasPath (RoutingTx msg) where
  path :: (Text -> f Text) -> RoutingTx msg -> f (RoutingTx msg)
path = (RoutingTx msg -> Text)
-> (RoutingTx msg -> Text -> RoutingTx msg)
-> Lens' (RoutingTx msg) Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(RoutingTx tx :: Tx alg msg
tx) -> Tx alg msg -> Text
forall k (alg :: k) msg. Tx alg msg -> Text
txRoute Tx alg msg
tx)
    (\(RoutingTx tx :: Tx alg msg
tx) r :: Text
r -> Tx alg msg -> RoutingTx msg
forall k (alg :: k) msg. Tx alg msg -> RoutingTx msg
RoutingTx Tx alg msg
tx {txRoute :: Text
txRoute = Text
r})

data TransactionContext = TransactionContext
  { TransactionContext -> IORef GasAmount
gasRemaining  :: IORef G.GasAmount
  , TransactionContext -> Bool
txRequiresGas :: Bool
  , TransactionContext -> IORef Cache
storeCache    :: IORef Cache.Cache
  , TransactionContext -> IORef [Event]
events        :: IORef [E.Event]
  }

newTransactionContext
  :: Bool
  -> RoutingTx msg
  -> IO TransactionContext
newTransactionContext :: Bool -> RoutingTx msg -> IO TransactionContext
newTransactionContext txRequiresGas :: Bool
txRequiresGas (RoutingTx Tx{Int64
txGas :: forall k (alg :: k) msg. Tx alg msg -> Int64
txGas :: Int64
txGas}) = do
  IORef GasAmount
initialGas <- GasAmount -> IO (IORef GasAmount)
forall a. a -> IO (IORef a)
newIORef (GasAmount -> IO (IORef GasAmount))
-> GasAmount -> IO (IORef GasAmount)
forall a b. (a -> b) -> a -> b
$ Int64 -> GasAmount
G.GasAmount Int64
txGas
  IORef Cache
initialCache <- Cache -> IO (IORef Cache)
forall a. a -> IO (IORef a)
newIORef Cache
Cache.emptyCache
  IORef [Event]
es <- [Event] -> IO (IORef [Event])
forall a. a -> IO (IORef a)
newIORef []
  TransactionContext -> IO TransactionContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransactionContext :: IORef GasAmount
-> Bool -> IORef Cache -> IORef [Event] -> TransactionContext
TransactionContext
    { gasRemaining :: IORef GasAmount
gasRemaining = IORef GasAmount
initialGas
    , Bool
txRequiresGas :: Bool
txRequiresGas :: Bool
txRequiresGas
    , storeCache :: IORef Cache
storeCache = IORef Cache
initialCache
    , events :: IORef [Event]
events = IORef [Event]
es
    }

type TransactionApplication m =
  RoutingTx ByteString -> m (TxResult, Maybe Cache.Cache)