{-# LANGUAGE TemplateHaskell #-}
module Tendermint.SDK.BaseApp.Gas
  (
  -- * Effect
    GasMeter(..)
  , GasAmount(..)
  , withGas
  -- * Eval
  , eval
  , doNothing
  ) where

import           Data.Int                      (Int64)
import           Polysemy                      (Members, Sem, interpretH,
                                                makeSem, raise, runT)
import           Polysemy.Error                (Error)
import           Polysemy.State                (State, get, put)
import           Tendermint.SDK.BaseApp.Errors (AppError,
                                                SDKError (OutOfGasException),
                                                throwSDKError)

newtype GasAmount = GasAmount { GasAmount -> Int64
unGasAmount :: Int64 } deriving (GasAmount -> GasAmount -> Bool
(GasAmount -> GasAmount -> Bool)
-> (GasAmount -> GasAmount -> Bool) -> Eq GasAmount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GasAmount -> GasAmount -> Bool
$c/= :: GasAmount -> GasAmount -> Bool
== :: GasAmount -> GasAmount -> Bool
$c== :: GasAmount -> GasAmount -> Bool
Eq, Int -> GasAmount -> ShowS
[GasAmount] -> ShowS
GasAmount -> String
(Int -> GasAmount -> ShowS)
-> (GasAmount -> String)
-> ([GasAmount] -> ShowS)
-> Show GasAmount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GasAmount] -> ShowS
$cshowList :: [GasAmount] -> ShowS
show :: GasAmount -> String
$cshow :: GasAmount -> String
showsPrec :: Int -> GasAmount -> ShowS
$cshowsPrec :: Int -> GasAmount -> ShowS
Show, Integer -> GasAmount
GasAmount -> GasAmount
GasAmount -> GasAmount -> GasAmount
(GasAmount -> GasAmount -> GasAmount)
-> (GasAmount -> GasAmount -> GasAmount)
-> (GasAmount -> GasAmount -> GasAmount)
-> (GasAmount -> GasAmount)
-> (GasAmount -> GasAmount)
-> (GasAmount -> GasAmount)
-> (Integer -> GasAmount)
-> Num GasAmount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> GasAmount
$cfromInteger :: Integer -> GasAmount
signum :: GasAmount -> GasAmount
$csignum :: GasAmount -> GasAmount
abs :: GasAmount -> GasAmount
$cabs :: GasAmount -> GasAmount
negate :: GasAmount -> GasAmount
$cnegate :: GasAmount -> GasAmount
* :: GasAmount -> GasAmount -> GasAmount
$c* :: GasAmount -> GasAmount -> GasAmount
- :: GasAmount -> GasAmount -> GasAmount
$c- :: GasAmount -> GasAmount -> GasAmount
+ :: GasAmount -> GasAmount -> GasAmount
$c+ :: GasAmount -> GasAmount -> GasAmount
Num, Eq GasAmount
Eq GasAmount =>
(GasAmount -> GasAmount -> Ordering)
-> (GasAmount -> GasAmount -> Bool)
-> (GasAmount -> GasAmount -> Bool)
-> (GasAmount -> GasAmount -> Bool)
-> (GasAmount -> GasAmount -> Bool)
-> (GasAmount -> GasAmount -> GasAmount)
-> (GasAmount -> GasAmount -> GasAmount)
-> Ord GasAmount
GasAmount -> GasAmount -> Bool
GasAmount -> GasAmount -> Ordering
GasAmount -> GasAmount -> GasAmount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GasAmount -> GasAmount -> GasAmount
$cmin :: GasAmount -> GasAmount -> GasAmount
max :: GasAmount -> GasAmount -> GasAmount
$cmax :: GasAmount -> GasAmount -> GasAmount
>= :: GasAmount -> GasAmount -> Bool
$c>= :: GasAmount -> GasAmount -> Bool
> :: GasAmount -> GasAmount -> Bool
$c> :: GasAmount -> GasAmount -> Bool
<= :: GasAmount -> GasAmount -> Bool
$c<= :: GasAmount -> GasAmount -> Bool
< :: GasAmount -> GasAmount -> Bool
$c< :: GasAmount -> GasAmount -> Bool
compare :: GasAmount -> GasAmount -> Ordering
$ccompare :: GasAmount -> GasAmount -> Ordering
$cp1Ord :: Eq GasAmount
Ord)

data GasMeter m a where
    WithGas :: forall m a. GasAmount -> m a -> GasMeter m a

makeSem ''GasMeter


eval
  :: Members [Error AppError, State GasAmount] r
  => Sem (GasMeter ': r) a
  -> Sem r a
eval :: Sem (GasMeter : r) a -> Sem r a
eval = (forall x (m :: * -> *). GasMeter m x -> Tactical GasMeter m r x)
-> Sem (GasMeter : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> Tactical e m r x)
-> Sem (e : r) a -> Sem r a
interpretH (\case
  WithGas gasCost action -> do
    GasAmount
remainingGas <- Sem (WithTactics GasMeter f m r) GasAmount
forall s (r :: [(* -> *) -> * -> *]).
MemberWithError (State s) r =>
Sem r s
get
    let balanceAfterAction :: GasAmount
balanceAfterAction = GasAmount
remainingGas GasAmount -> GasAmount -> GasAmount
forall a. Num a => a -> a -> a
- GasAmount
gasCost
    if GasAmount
balanceAfterAction GasAmount -> GasAmount -> Bool
forall a. Ord a => a -> a -> Bool
< 0
      then SDKError -> Sem (WithTactics GasMeter f m r) (f x)
forall (r :: [(* -> *) -> * -> *]) a.
Member (Error AppError) r =>
SDKError -> Sem r a
throwSDKError SDKError
OutOfGasException
      else do
        GasAmount -> Sem (WithTactics GasMeter f m r) ()
forall s (r :: [(* -> *) -> * -> *]).
MemberWithError (State s) r =>
s -> Sem r ()
put GasAmount
balanceAfterAction
        Sem (GasMeter : r) (f x)
a <- m x -> Sem (WithTactics GasMeter f m r) (Sem (GasMeter : r) (f x))
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *)
       (r :: [(* -> *) -> * -> *]).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT m x
action
        Sem r (f x) -> Sem (WithTactics GasMeter f m r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f x) -> Sem (WithTactics GasMeter f m r) (f x))
-> Sem r (f x) -> Sem (WithTactics GasMeter f m r) (f x)
forall a b. (a -> b) -> a -> b
$ Sem (GasMeter : r) (f x) -> Sem r (f x)
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error AppError, State GasAmount] r =>
Sem (GasMeter : r) a -> Sem r a
eval Sem (GasMeter : r) (f x)
a
  )

doNothing
  :: forall r.
     forall a.
     Sem (GasMeter ': r) a
  -> Sem r a
doNothing :: Sem (GasMeter : r) a -> Sem r a
doNothing = (forall x (m :: * -> *). GasMeter m x -> Tactical GasMeter m r x)
-> Sem (GasMeter : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> Tactical e m r x)
-> Sem (e : r) a -> Sem r a
interpretH (\case
  WithGas _ action -> do
    Sem (GasMeter : r) (f x)
a <- m x -> Sem (WithTactics GasMeter f m r) (Sem (GasMeter : r) (f x))
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *)
       (r :: [(* -> *) -> * -> *]).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT m x
action
    Sem r (f x) -> Sem (WithTactics GasMeter f m r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f x) -> Sem (WithTactics GasMeter f m r) (f x))
-> Sem r (f x) -> Sem (WithTactics GasMeter f m r) (f x)
forall a b. (a -> b) -> a -> b
$ Sem (GasMeter : r) (f x) -> Sem r (f x)
forall (r :: [(* -> *) -> * -> *]) a.
Sem (GasMeter : r) a -> Sem r a
doNothing Sem (GasMeter : r) (f x)
a
  )