module Tendermint.SDK.BaseApp.Transaction.Effect
  ( TxEffs
  , runTx
  , eval
  , evalReadOnly
  ) where

import           Control.Lens                             ((&), (.~))
import           Control.Monad.IO.Class                   (liftIO)
import           Data.ByteArray.Base64String              (fromBytes)
import           Data.Default.Class                       (def)
import           Data.IORef                               (IORef, readIORef,
                                                           writeIORef)
import           Data.Proxy
import           Polysemy                                 (Embed, Member,
                                                           Members, Sem,
                                                           interpret,
                                                           raiseUnder, rewrite)
import           Polysemy.Error                           (Error, runError)
import           Polysemy.Internal                        (send)
import           Polysemy.Output                          (Output, ignoreOutput,
                                                           runOutputMonoidIORef)
import qualified Polysemy.State                           as State
import           Polysemy.Tagged                          (Tagged (..))
import           Tendermint.SDK.BaseApp.Errors            (AppError,
                                                           txResultAppError)
import qualified Tendermint.SDK.BaseApp.Events            as E
import qualified Tendermint.SDK.BaseApp.Gas               as G
import           Tendermint.SDK.BaseApp.Store.RawStore    (ReadStore (..),
                                                           WriteStore (..))
import qualified Tendermint.SDK.BaseApp.Transaction.Cache as Cache
import           Tendermint.SDK.BaseApp.Transaction.Types
import           Tendermint.SDK.Codec                     (HasCodec (..))
import           Tendermint.SDK.Types.Effects             ((:&))
import           Tendermint.SDK.Types.TxResult            (TxResult,
                                                           txResultData,
                                                           txResultEvents,
                                                           txResultGasUsed,
                                                           txResultGasWanted)

type TxEffs =
    [ Output E.Event
    , G.GasMeter
    , WriteStore
    , ReadStore
    , Error AppError
    ]

eval
  :: forall r scope a.
     Members [Embed IO, Tagged scope ReadStore] r
  => Proxy scope
  -> TransactionContext
  -> Sem (TxEffs :& r) a
  -> Sem r (Either AppError a)
eval :: Proxy scope
-> TransactionContext
-> Sem (TxEffs :& r) a
-> Sem r (Either AppError a)
eval ps :: Proxy scope
ps TransactionContext{..} = do
  Sem (Error AppError : r) a -> Sem r (Either AppError a)
forall e (r :: [(* -> *) -> * -> *]) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError (Sem (Error AppError : r) a -> Sem r (Either AppError a))
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem (Error AppError : r) a)
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem r (Either AppError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Proxy scope
-> IORef Cache
-> Sem (Tagged Cache ReadStore : Error AppError : r) a
-> Sem (Error AppError : r) a
forall k (scope :: k) (r :: [(* -> *) -> * -> *]) a.
Members '[Embed IO, Tagged scope ReadStore] r =>
Proxy scope
-> IORef Cache -> Sem (Tagged Cache ReadStore : r) a -> Sem r a
evalCachedReadStore Proxy scope
ps IORef Cache
storeCache (Sem (Tagged Cache ReadStore : Error AppError : r) a
 -> Sem (Error AppError : r) a)
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem (Tagged Cache ReadStore : Error AppError : r) a)
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem (Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall (m :: * -> *) x.
 ReadStore m x -> Tagged Cache ReadStore m x)
-> Sem (ReadStore : Error AppError : r) a
-> Sem (Tagged Cache ReadStore : Error AppError : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *) x. e1 m x -> e2 m x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
rewrite (forall k k1 k2 (k3 :: k) (e :: k1 -> k2 -> *) (m :: k1) (a :: k2).
e m a -> Tagged k3 e m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
e m a -> Tagged Cache e m a
Tagged @Cache.Cache) (Sem (ReadStore : Error AppError : r) a
 -> Sem (Tagged Cache ReadStore : Error AppError : r) a)
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem (ReadStore : Error AppError : r) a)
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem (Tagged Cache ReadStore : Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    IORef Cache
-> Sem (Tagged Cache WriteStore : ReadStore : Error AppError : r) a
-> Sem (ReadStore : Error AppError : r) a
forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IORef Cache -> Sem (Tagged Cache WriteStore : r) a -> Sem r a
evalCachedWriteStore IORef Cache
storeCache (Sem (Tagged Cache WriteStore : ReadStore : Error AppError : r) a
 -> Sem (ReadStore : Error AppError : r) a)
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem
         (Tagged Cache WriteStore : ReadStore : Error AppError : r) a)
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem (ReadStore : Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall (m :: * -> *) x.
 WriteStore m x -> Tagged Cache WriteStore m x)
-> Sem (WriteStore : ReadStore : Error AppError : r) a
-> Sem (Tagged Cache WriteStore : ReadStore : Error AppError : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *) x. e1 m x -> e2 m x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
rewrite (forall k k1 k2 (k3 :: k) (e :: k1 -> k2 -> *) (m :: k1) (a :: k2).
e m a -> Tagged k3 e m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
e m a -> Tagged Cache e m a
Tagged @Cache.Cache) (Sem (WriteStore : ReadStore : Error AppError : r) a
 -> Sem
      (Tagged Cache WriteStore : ReadStore : Error AppError : r) a)
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem (WriteStore : ReadStore : Error AppError : r) a)
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem (Tagged Cache WriteStore : ReadStore : Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
-> Sem (WriteStore : ReadStore : Error AppError : r) a
runGas (Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
 -> Sem (WriteStore : ReadStore : Error AppError : r) a)
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a)
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem (WriteStore : ReadStore : Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    IORef [Event]
-> (Event -> [Event])
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
forall o m (r :: [(* -> *) -> * -> *]) a.
(Monoid m, Member (Embed IO) r) =>
IORef m -> (o -> m) -> Sem (Output o : r) a -> Sem r a
runOutputMonoidIORef IORef [Event]
events (forall a. Applicative [] => a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure @[])
  where
    runGas :: Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
-> Sem (WriteStore : ReadStore : Error AppError : r) a
runGas =
      if Bool
txRequiresGas
        then IORef GasAmount
-> Sem
     (State GasAmount : WriteStore : ReadStore : Error AppError : r) a
-> Sem (WriteStore : ReadStore : Error AppError : r) a
forall s (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IORef s -> Sem (State s : r) a -> Sem r a
State.runStateIORef IORef GasAmount
gasRemaining (Sem
   (State GasAmount : WriteStore : ReadStore : Error AppError : r) a
 -> Sem (WriteStore : ReadStore : Error AppError : r) a)
-> (Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
    -> Sem
         (State GasAmount : WriteStore : ReadStore : Error AppError : r) a)
-> Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
-> Sem (WriteStore : ReadStore : Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               Sem
  (GasMeter
     : State GasAmount : WriteStore : ReadStore : Error AppError : r)
  a
-> Sem
     (State GasAmount : WriteStore : ReadStore : Error AppError : r) a
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error AppError, State GasAmount] r =>
Sem (GasMeter : r) a -> Sem r a
G.eval (Sem
   (GasMeter
      : State GasAmount : WriteStore : ReadStore : Error AppError : r)
   a
 -> Sem
      (State GasAmount : WriteStore : ReadStore : Error AppError : r) a)
-> (Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
    -> Sem
         (GasMeter
            : State GasAmount : WriteStore : ReadStore : Error AppError : r)
         a)
-> Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
-> Sem
     (State GasAmount : WriteStore : ReadStore : Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               forall (e1 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : State GasAmount : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder @(State.State G.GasAmount)
        else Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
-> Sem (WriteStore : ReadStore : Error AppError : r) a
forall (r :: [(* -> *) -> * -> *]) a.
Sem (GasMeter : r) a -> Sem r a
G.doNothing

evalReadOnly
  :: forall r.
     forall a.
     Sem (TxEffs :& r) a
  -> Sem (ReadStore ': Error AppError ': r) a
evalReadOnly :: Sem (TxEffs :& r) a -> Sem (ReadStore : Error AppError : r) a
evalReadOnly =
    Sem (WriteStore : ReadStore : Error AppError : r) a
-> Sem (ReadStore : Error AppError : r) a
forall (r :: [(* -> *) -> * -> *]) a.
Sem (WriteStore : r) a -> Sem r a
writeNothing (Sem (WriteStore : ReadStore : Error AppError : r) a
 -> Sem (ReadStore : Error AppError : r) a)
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem (WriteStore : ReadStore : Error AppError : r) a)
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem (ReadStore : Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
-> Sem (WriteStore : ReadStore : Error AppError : r) a
forall (r :: [(* -> *) -> * -> *]) a.
Sem (GasMeter : r) a -> Sem r a
G.doNothing (Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
 -> Sem (WriteStore : ReadStore : Error AppError : r) a)
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a)
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem (WriteStore : ReadStore : Error AppError : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Sem
  (Output Event
     : GasMeter : WriteStore : ReadStore : Error AppError : r)
  a
-> Sem (GasMeter : WriteStore : ReadStore : Error AppError : r) a
forall o (r :: [(* -> *) -> * -> *]) a.
Sem (Output o : r) a -> Sem r a
ignoreOutput
  where
    writeNothing :: Sem (WriteStore : r) a -> Sem r a
writeNothing = (forall x (m :: * -> *). WriteStore m x -> Sem r x)
-> Sem (WriteStore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\case
      StorePut _ _ -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      StoreDelete _ -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      )

runTx
  :: Members [Embed IO, Tagged scope ReadStore] r
  => HasCodec a
  => Proxy scope
  -> TransactionContext
  -> Sem (TxEffs :& r) a
  -> Sem r (Maybe (a, Cache.Cache), TxResult)
runTx :: Proxy scope
-> TransactionContext
-> Sem (TxEffs :& r) a
-> Sem r (Maybe (a, Cache), TxResult)
runTx ps :: Proxy scope
ps ctx :: TransactionContext
ctx@TransactionContext{..} tx :: Sem (TxEffs :& r) a
tx = do
  GasAmount
initialGas <- IO GasAmount -> Sem r GasAmount
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GasAmount -> Sem r GasAmount)
-> IO GasAmount -> Sem r GasAmount
forall a b. (a -> b) -> a -> b
$ IORef GasAmount -> IO GasAmount
forall a. IORef a -> IO a
readIORef IORef GasAmount
gasRemaining
  Either AppError a
eRes <- Proxy scope
-> TransactionContext
-> Sem (TxEffs :& r) a
-> Sem r (Either AppError a)
forall k (r :: [(* -> *) -> * -> *]) (scope :: k) a.
Members '[Embed IO, Tagged scope ReadStore] r =>
Proxy scope
-> TransactionContext
-> Sem (TxEffs :& r) a
-> Sem r (Either AppError a)
eval Proxy scope
ps TransactionContext
ctx Sem (TxEffs :& r) a
tx
  GasAmount
finalGas <- IO GasAmount -> Sem r GasAmount
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GasAmount -> Sem r GasAmount)
-> IO GasAmount -> Sem r GasAmount
forall a b. (a -> b) -> a -> b
$ IORef GasAmount -> IO GasAmount
forall a. IORef a -> IO a
readIORef IORef GasAmount
gasRemaining
  let gasUsed :: GasAmount
gasUsed = GasAmount
initialGas GasAmount -> GasAmount -> GasAmount
forall a. Num a => a -> a -> a
- GasAmount
finalGas
      baseResponse :: TxResult
baseResponse =
        TxResult
forall a. Default a => a
def TxResult -> (TxResult -> TxResult) -> TxResult
forall a b. a -> (a -> b) -> b
& (Int64 -> Identity Int64) -> TxResult -> Identity TxResult
Lens' TxResult Int64
txResultGasWanted ((Int64 -> Identity Int64) -> TxResult -> Identity TxResult)
-> Int64 -> TxResult -> TxResult
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GasAmount -> Int64
G.unGasAmount GasAmount
initialGas
            TxResult -> (TxResult -> TxResult) -> TxResult
forall a b. a -> (a -> b) -> b
& (Int64 -> Identity Int64) -> TxResult -> Identity TxResult
Lens' TxResult Int64
txResultGasUsed ((Int64 -> Identity Int64) -> TxResult -> Identity TxResult)
-> Int64 -> TxResult -> TxResult
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GasAmount -> Int64
G.unGasAmount GasAmount
gasUsed
  case Either AppError a
eRes of
    Left e :: AppError
e -> (Maybe (a, Cache), TxResult) -> Sem r (Maybe (a, Cache), TxResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, Cache)
forall a. Maybe a
Nothing, TxResult
baseResponse TxResult -> (TxResult -> TxResult) -> TxResult
forall a b. a -> (a -> b) -> b
& (AppError -> Identity AppError) -> TxResult -> Identity TxResult
Lens' TxResult AppError
txResultAppError ((AppError -> Identity AppError) -> TxResult -> Identity TxResult)
-> AppError -> TxResult -> TxResult
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppError
e)
    Right a :: a
a -> do
        [Event]
es <- IO [Event] -> Sem r [Event]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Event] -> Sem r [Event]) -> IO [Event] -> Sem r [Event]
forall a b. (a -> b) -> a -> b
$ IORef [Event] -> IO [Event]
forall a. IORef a -> IO a
readIORef IORef [Event]
events
        Cache
c <- IO Cache -> Sem r Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cache -> Sem r Cache) -> IO Cache -> Sem r Cache
forall a b. (a -> b) -> a -> b
$ IORef Cache -> IO Cache
forall a. IORef a -> IO a
readIORef IORef Cache
storeCache
        (Maybe (a, Cache), TxResult) -> Sem r (Maybe (a, Cache), TxResult)
forall (m :: * -> *) a. Monad m => a -> m a
return ( (a, Cache) -> Maybe (a, Cache)
forall a. a -> Maybe a
Just (a
a,Cache
c)
               , TxResult
baseResponse TxResult -> (TxResult -> TxResult) -> TxResult
forall a b. a -> (a -> b) -> b
& ([Event] -> Identity [Event]) -> TxResult -> Identity TxResult
Lens' TxResult [Event]
txResultEvents (([Event] -> Identity [Event]) -> TxResult -> Identity TxResult)
-> [Event] -> TxResult -> TxResult
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Event]
es
                              TxResult -> (TxResult -> TxResult) -> TxResult
forall a b. a -> (a -> b) -> b
& (Base64String -> Identity Base64String)
-> TxResult -> Identity TxResult
Lens' TxResult Base64String
txResultData ((Base64String -> Identity Base64String)
 -> TxResult -> Identity TxResult)
-> Base64String -> TxResult -> TxResult
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
fromBytes (a -> ByteString
forall a. HasCodec a => a -> ByteString
encode a
a)
               )

evalCachedReadStore
  :: Members [Embed IO, Tagged scope ReadStore] r
  => Proxy scope
  -> IORef Cache.Cache
  -> Sem (Tagged Cache.Cache ReadStore ': r) a
  -> Sem r a
evalCachedReadStore :: Proxy scope
-> IORef Cache -> Sem (Tagged Cache ReadStore : r) a -> Sem r a
evalCachedReadStore (Proxy scope
_ :: Proxy scope) c :: IORef Cache
c m :: Sem (Tagged Cache ReadStore : r) a
m = do
  (forall x (m :: * -> *). Tagged Cache ReadStore m x -> Sem r x)
-> Sem (Tagged Cache ReadStore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret
    (\(Tagged action) -> case ReadStore m x
action of
      StoreGet k :: StoreKey
k -> do
        Cache
cache <- IO Cache -> Sem r Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cache -> Sem r Cache) -> IO Cache -> Sem r Cache
forall a b. (a -> b) -> a -> b
$ IORef Cache -> IO Cache
forall a. IORef a -> IO a
readIORef IORef Cache
c
        case StoreKey -> Cache -> Either Deleted (Maybe ByteString)
Cache.get StoreKey
k Cache
cache of
          Left Cache.Deleted -> Maybe ByteString -> Sem r (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
          Right (Just v :: ByteString
v)     -> Maybe ByteString -> Sem r (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v)
          Right Nothing      -> Tagged scope ReadStore (Sem r) (Maybe ByteString)
-> Sem r (Maybe ByteString)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
e (Sem r) a -> Sem r a
send (ReadStore (Sem r) (Maybe ByteString)
-> Tagged scope ReadStore (Sem r) (Maybe ByteString)
forall k k1 k2 (k3 :: k) (e :: k1 -> k2 -> *) (m :: k1) (a :: k2).
e m a -> Tagged k3 e m a
Tagged @scope (StoreKey -> ReadStore (Sem r) (Maybe ByteString)
forall k (m :: k). StoreKey -> ReadStore m (Maybe ByteString)
StoreGet StoreKey
k))
      StoreProve _ -> Maybe ByteString -> Sem r (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
    ) Sem (Tagged Cache ReadStore : r) a
m

evalCachedWriteStore
  :: Member (Embed IO) r
  => IORef Cache.Cache
  -> Sem (Tagged Cache.Cache WriteStore ': r) a
  -> Sem r a
evalCachedWriteStore :: IORef Cache -> Sem (Tagged Cache WriteStore : r) a -> Sem r a
evalCachedWriteStore c :: IORef Cache
c m :: Sem (Tagged Cache WriteStore : r) a
m = do
  (forall x (m :: * -> *). Tagged Cache WriteStore m x -> Sem r x)
-> Sem (Tagged Cache WriteStore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret
    (IO x -> Sem r x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> Sem r x)
-> (Tagged Cache WriteStore m x -> IO x)
-> Tagged Cache WriteStore m x
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(Tagged action :: WriteStore m x
action) -> case WriteStore m x
action of
      StorePut k :: StoreKey
k v :: ByteString
v  -> do
       Cache
cache <- IO Cache -> IO Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cache -> IO Cache) -> IO Cache -> IO Cache
forall a b. (a -> b) -> a -> b
$ IORef Cache -> IO Cache
forall a. IORef a -> IO a
readIORef IORef Cache
c
       IORef Cache -> Cache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Cache
c (Cache -> IO x) -> Cache -> IO x
forall a b. (a -> b) -> a -> b
$ StoreKey -> ByteString -> Cache -> Cache
Cache.put StoreKey
k ByteString
v Cache
cache
      StoreDelete k :: StoreKey
k -> do
        Cache
cache <- IO Cache -> IO Cache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Cache -> IO Cache) -> IO Cache -> IO Cache
forall a b. (a -> b) -> a -> b
$ IORef Cache -> IO Cache
forall a. IORef a -> IO a
readIORef IORef Cache
c
        IORef Cache -> Cache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Cache
c (Cache -> IO x) -> Cache -> IO x
forall a b. (a -> b) -> a -> b
$ StoreKey -> Cache -> Cache
Cache.delete StoreKey
k Cache
cache
    ) Sem (Tagged Cache WriteStore : r) a
m