module Tendermint.SDK.BaseApp.Store.IAVLStore
  (
  -- * Environment
    IAVLVersions(..)
  , initIAVLVersions
  -- * Eval
  , evalStoreEffs
  -- * Re-Exports
  , GrpcClient
  , GrpcConfig(..)
  , initGrpcClient
  ) where

import           Control.Lens                          ((&), (.~), (^.))
import           Control.Monad                         (void)
import           Control.Monad.IO.Class
import           Data.ByteArray.Base64String           (fromBytes)
import           Data.IORef                            (IORef, newIORef,
                                                        readIORef, writeIORef)
import           Data.ProtoLens.Message                (defMessage)
import           Data.Text                             (pack)
import qualified Database.IAVL.RPC                     as IAVL
import           Database.IAVL.RPC.Types               (GrpcConfig (..),
                                                        initGrpcClient)
import           Network.GRPC.Client                   (RawReply)
import           Network.GRPC.Client.Helpers           (GrpcClient)
import           Network.HTTP2.Client                  (ClientIO,
                                                        TooMuchConcurrency,
                                                        runClientIO)
import           Polysemy                              (Embed, Member, Members,
                                                        Sem, interpret)
import           Polysemy.Error                        (Error)
import           Polysemy.Reader                       (Reader, ask)
import           Polysemy.Tagged                       (untag)
import qualified Proto.Iavl.Api_Fields                 as Api
import           Tendermint.SDK.BaseApp.Errors         (AppError, SDKError (..))
import           Tendermint.SDK.BaseApp.Store.RawStore (CommitBlock (..),
                                                        CommitResponse (..),
                                                        ReadStore (..),
                                                        StoreEffs,
                                                        Transaction (..),
                                                        Version (..),
                                                        WriteStore (..),
                                                        makeKeyBytes)
import           Tendermint.SDK.Types.Effects          ((:&))

data IAVLVersions = IAVLVersions
  { IAVLVersions -> IORef Version
latest    :: IORef Version
  , IAVLVersions -> IORef Version
committed :: IORef Version
  }

initIAVLVersions :: IO IAVLVersions
initIAVLVersions :: IO IAVLVersions
initIAVLVersions = IORef Version -> IORef Version -> IAVLVersions
IAVLVersions (IORef Version -> IORef Version -> IAVLVersions)
-> IO (IORef Version) -> IO (IORef Version -> IAVLVersions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> IO (IORef Version)
forall a. a -> IO (IORef a)
newIORef Version
Latest IO (IORef Version -> IAVLVersions)
-> IO (IORef Version) -> IO IAVLVersions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Version -> IO (IORef Version)
forall a. a -> IO (IORef a)
newIORef Version
Genesis

evalWrite
  :: Member (Embed IO) r
  => GrpcClient
  -> forall a. Sem (WriteStore ': r) a -> Sem r a
evalWrite :: GrpcClient -> forall a. Sem (WriteStore : r) a -> Sem r a
evalWrite gc :: GrpcClient
gc m :: Sem (WriteStore : r) a
m =
  (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 k v -> do
        let setReq :: SetRequest
setReq = SetRequest
forall msg. Message msg => msg
defMessage SetRequest -> (SetRequest -> SetRequest) -> SetRequest
forall a b. a -> (a -> b) -> b
& LensLike' Identity SetRequest ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "key" a) =>
LensLike' f s a
Api.key LensLike' Identity SetRequest ByteString
-> ByteString -> SetRequest -> SetRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StoreKey -> ByteString
makeKeyBytes StoreKey
k
                                SetRequest -> (SetRequest -> SetRequest) -> SetRequest
forall a b. a -> (a -> b) -> b
& LensLike' Identity SetRequest ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "value" a) =>
LensLike' f s a
Api.value LensLike' Identity SetRequest ByteString
-> ByteString -> SetRequest -> SetRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
v
        Sem r SetResponse -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r SetResponse -> Sem r ())
-> (ClientIO (Either TooMuchConcurrency (RawReply SetResponse))
    -> Sem r SetResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply SetResponse))
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO SetResponse -> Sem r SetResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SetResponse -> Sem r SetResponse)
-> (ClientIO (Either TooMuchConcurrency (RawReply SetResponse))
    -> IO SetResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply SetResponse))
-> Sem r SetResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO (Either TooMuchConcurrency (RawReply SetResponse))
-> IO SetResponse
forall a. ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc (ClientIO (Either TooMuchConcurrency (RawReply SetResponse))
 -> Sem r x)
-> ClientIO (Either TooMuchConcurrency (RawReply SetResponse))
-> Sem r x
forall a b. (a -> b) -> a -> b
$ GrpcClient
-> SetRequest
-> ClientIO (Either TooMuchConcurrency (RawReply SetResponse))
IAVL.set GrpcClient
gc SetRequest
setReq
      StoreDelete k ->
        let remReq :: RemoveRequest
remReq = RemoveRequest
forall msg. Message msg => msg
defMessage RemoveRequest -> (RemoveRequest -> RemoveRequest) -> RemoveRequest
forall a b. a -> (a -> b) -> b
& LensLike' Identity RemoveRequest ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "key" a) =>
LensLike' f s a
Api.key LensLike' Identity RemoveRequest ByteString
-> ByteString -> RemoveRequest -> RemoveRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StoreKey -> ByteString
makeKeyBytes StoreKey
k
        in Sem r RemoveResponse -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r RemoveResponse -> Sem r ())
-> (ClientIO (Either TooMuchConcurrency (RawReply RemoveResponse))
    -> Sem r RemoveResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply RemoveResponse))
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO RemoveResponse -> Sem r RemoveResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RemoveResponse -> Sem r RemoveResponse)
-> (ClientIO (Either TooMuchConcurrency (RawReply RemoveResponse))
    -> IO RemoveResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply RemoveResponse))
-> Sem r RemoveResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO (Either TooMuchConcurrency (RawReply RemoveResponse))
-> IO RemoveResponse
forall a. ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc (ClientIO (Either TooMuchConcurrency (RawReply RemoveResponse))
 -> Sem r x)
-> ClientIO (Either TooMuchConcurrency (RawReply RemoveResponse))
-> Sem r x
forall a b. (a -> b) -> a -> b
$ GrpcClient
-> RemoveRequest
-> ClientIO (Either TooMuchConcurrency (RawReply RemoveResponse))
IAVL.remove GrpcClient
gc RemoveRequest
remReq
    ) Sem (WriteStore : r) a
m

evalRead
  :: Member (Embed IO) r
  => GrpcClient
  -> IORef Version
  -> forall a. Sem (ReadStore ': r) a -> Sem r a
evalRead :: GrpcClient
-> IORef Version -> forall a. Sem (ReadStore : r) a -> Sem r a
evalRead gc :: GrpcClient
gc iavlVersion :: IORef Version
iavlVersion m :: Sem (ReadStore : r) a
m = do
  (forall x (m :: * -> *). ReadStore m x -> Sem r x)
-> Sem (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
    (\case
      StoreGet k -> do
        Version
version <- IO Version -> Sem r Version
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Version -> Sem r Version) -> IO Version -> Sem r Version
forall a b. (a -> b) -> a -> b
$ IORef Version -> IO Version
forall a. IORef a -> IO a
readIORef IORef Version
iavlVersion
        case Version
version of
          Latest -> do
            let getReq :: GetRequest
getReq = GetRequest
forall msg. Message msg => msg
defMessage GetRequest -> (GetRequest -> GetRequest) -> GetRequest
forall a b. a -> (a -> b) -> b
& LensLike' Identity GetRequest ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "key" a) =>
LensLike' f s a
Api.key LensLike' Identity GetRequest ByteString
-> ByteString -> GetRequest -> GetRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StoreKey -> ByteString
makeKeyBytes StoreKey
k
            GetResponse
res <- IO GetResponse -> Sem r GetResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GetResponse -> Sem r GetResponse)
-> (ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
    -> IO GetResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
-> Sem r GetResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
-> IO GetResponse
forall a. ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc (ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
 -> Sem r GetResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
-> Sem r GetResponse
forall a b. (a -> b) -> a -> b
$ GrpcClient
-> GetRequest
-> ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
IAVL.get GrpcClient
gc GetRequest
getReq
            case GetResponse
res GetResponse
-> Getting ByteString GetResponse ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString GetResponse ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "value" a) =>
LensLike' f s a
Api.value of
              ""  -> Maybe ByteString -> Sem r (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
              val :: ByteString
val -> Maybe ByteString -> Sem r x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> Sem r x) -> Maybe ByteString -> Sem r x
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
val
          Version v :: Natural
v -> do
            let getVerReq :: GetVersionedRequest
getVerReq = GetVersionedRequest
forall msg. Message msg => msg
defMessage GetVersionedRequest
-> (GetVersionedRequest -> GetVersionedRequest)
-> GetVersionedRequest
forall a b. a -> (a -> b) -> b
& LensLike' Identity GetVersionedRequest ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "key" a) =>
LensLike' f s a
Api.key LensLike' Identity GetVersionedRequest ByteString
-> ByteString -> GetVersionedRequest -> GetVersionedRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StoreKey -> ByteString
makeKeyBytes StoreKey
k
                                       GetVersionedRequest
-> (GetVersionedRequest -> GetVersionedRequest)
-> GetVersionedRequest
forall a b. a -> (a -> b) -> b
& LensLike' Identity GetVersionedRequest Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "version" a) =>
LensLike' f s a
Api.version LensLike' Identity GetVersionedRequest Int64
-> Int64 -> GetVersionedRequest -> GetVersionedRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Int64
forall a. Num a => Integer -> a
fromInteger (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
v)
            GetResponse
res <- IO GetResponse -> Sem r GetResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GetResponse -> Sem r GetResponse)
-> (ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
    -> IO GetResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
-> Sem r GetResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
-> IO GetResponse
forall a. ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc (ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
 -> Sem r GetResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
-> Sem r GetResponse
forall a b. (a -> b) -> a -> b
$ GrpcClient
-> GetVersionedRequest
-> ClientIO (Either TooMuchConcurrency (RawReply GetResponse))
IAVL.getVersioned GrpcClient
gc GetVersionedRequest
getVerReq
            case GetResponse
res GetResponse
-> Getting ByteString GetResponse ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString GetResponse ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "value" a) =>
LensLike' f s a
Api.value of
              ""  -> Maybe ByteString -> Sem r (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
              val :: ByteString
val -> Maybe ByteString -> Sem r x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> Sem r x) -> Maybe ByteString -> Sem r x
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
val
          Genesis -> Maybe ByteString -> Sem r (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
      StoreProve _ -> Maybe ByteString -> Sem r (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
    ) Sem (ReadStore : r) a
m

evalTransaction
  :: Members [Embed IO, Error AppError] r
  => GrpcClient
  -> forall a. Sem (Transaction ': r) a -> Sem r a
evalTransaction :: GrpcClient -> forall a. Sem (Transaction : r) a -> Sem r a
evalTransaction gc :: GrpcClient
gc m :: Sem (Transaction : r) a
m = do
  (forall x (m :: * -> *). Transaction m x -> Sem r x)
-> Sem (Transaction : 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
      -- NOTICE :: Currently unnecessary with the DB commit/version implementation.
      BeginTransaction -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Rollback -> Sem r Empty -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Empty -> Sem r ())
-> (ClientIO (Either TooMuchConcurrency (RawReply Empty))
    -> Sem r Empty)
-> ClientIO (Either TooMuchConcurrency (RawReply Empty))
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Empty -> Sem r Empty
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Empty -> Sem r Empty)
-> (ClientIO (Either TooMuchConcurrency (RawReply Empty))
    -> IO Empty)
-> ClientIO (Either TooMuchConcurrency (RawReply Empty))
-> Sem r Empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO (Either TooMuchConcurrency (RawReply Empty)) -> IO Empty
forall a. ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc (ClientIO (Either TooMuchConcurrency (RawReply Empty)) -> Sem r x)
-> ClientIO (Either TooMuchConcurrency (RawReply Empty)) -> Sem r x
forall a b. (a -> b) -> a -> b
$ GrpcClient -> ClientIO (Either TooMuchConcurrency (RawReply Empty))
IAVL.rollback GrpcClient
gc
      Commit -> do
        SaveVersionResponse
resp <- IO SaveVersionResponse -> Sem r SaveVersionResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SaveVersionResponse -> Sem r SaveVersionResponse)
-> (ClientIO
      (Either TooMuchConcurrency (RawReply SaveVersionResponse))
    -> IO SaveVersionResponse)
-> ClientIO
     (Either TooMuchConcurrency (RawReply SaveVersionResponse))
-> Sem r SaveVersionResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO (Either TooMuchConcurrency (RawReply SaveVersionResponse))
-> IO SaveVersionResponse
forall a. ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc (ClientIO
   (Either TooMuchConcurrency (RawReply SaveVersionResponse))
 -> Sem r SaveVersionResponse)
-> ClientIO
     (Either TooMuchConcurrency (RawReply SaveVersionResponse))
-> Sem r SaveVersionResponse
forall a b. (a -> b) -> a -> b
$ GrpcClient
-> ClientIO
     (Either TooMuchConcurrency (RawReply SaveVersionResponse))
IAVL.saveVersion GrpcClient
gc
        CommitResponse -> Sem r x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommitResponse -> Sem r x) -> CommitResponse -> Sem r x
forall a b. (a -> b) -> a -> b
$ CommitResponse :: Base64String -> Natural -> CommitResponse
CommitResponse
          { rootHash :: Base64String
rootHash = ByteString -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
fromBytes (SaveVersionResponse
resp SaveVersionResponse
-> Getting ByteString SaveVersionResponse ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString SaveVersionResponse ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "rootHash" a) =>
LensLike' f s a
Api.rootHash)
          , newVersion :: Natural
newVersion = Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> (Int64 -> Integer) -> Int64 -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Natural) -> Int64 -> Natural
forall a b. (a -> b) -> a -> b
$ SaveVersionResponse
resp SaveVersionResponse
-> Getting Int64 SaveVersionResponse Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 SaveVersionResponse Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "version" a) =>
LensLike' f s a
Api.version
          }
    ) Sem (Transaction : r) a
m

evalCommitBlock
  :: Members [Embed IO, Error AppError] r
  => GrpcClient
  -> IAVLVersions
  -> forall a. Sem (CommitBlock ': r) a -> Sem r a
evalCommitBlock :: GrpcClient
-> IAVLVersions -> forall a. Sem (CommitBlock : r) a -> Sem r a
evalCommitBlock gc :: GrpcClient
gc IAVLVersions{IORef Version
committed :: IORef Version
committed :: IAVLVersions -> IORef Version
committed} = do
  (forall x (m :: * -> *). CommitBlock m x -> Sem r x)
-> Sem (CommitBlock : 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
      CommitBlock -> do
        VersionResponse
versionResp <- IO VersionResponse -> Sem r VersionResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VersionResponse -> Sem r VersionResponse)
-> (ClientIO (Either TooMuchConcurrency (RawReply VersionResponse))
    -> IO VersionResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply VersionResponse))
-> Sem r VersionResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO (Either TooMuchConcurrency (RawReply VersionResponse))
-> IO VersionResponse
forall a. ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc (ClientIO (Either TooMuchConcurrency (RawReply VersionResponse))
 -> Sem r VersionResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply VersionResponse))
-> Sem r VersionResponse
forall a b. (a -> b) -> a -> b
$ GrpcClient
-> ClientIO (Either TooMuchConcurrency (RawReply VersionResponse))
IAVL.version GrpcClient
gc
        let version :: Version
version = Natural -> Version
Version (Natural -> Version) -> (Int64 -> Natural) -> Int64 -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> (Int64 -> Integer) -> Int64 -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Version) -> Int64 -> Version
forall a b. (a -> b) -> a -> b
$ VersionResponse
versionResp VersionResponse -> Getting Int64 VersionResponse Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 VersionResponse Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "version" a) =>
LensLike' f s a
Api.version
        IO () -> Sem r ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ IORef Version -> Version -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Version
committed Version
version
        HashResponse
hashResp <- IO HashResponse -> Sem r HashResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HashResponse -> Sem r HashResponse)
-> (ClientIO (Either TooMuchConcurrency (RawReply HashResponse))
    -> IO HashResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply HashResponse))
-> Sem r HashResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientIO (Either TooMuchConcurrency (RawReply HashResponse))
-> IO HashResponse
forall a. ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc (ClientIO (Either TooMuchConcurrency (RawReply HashResponse))
 -> Sem r HashResponse)
-> ClientIO (Either TooMuchConcurrency (RawReply HashResponse))
-> Sem r HashResponse
forall a b. (a -> b) -> a -> b
$ GrpcClient
-> ClientIO (Either TooMuchConcurrency (RawReply HashResponse))
IAVL.hash GrpcClient
gc
        Base64String -> Sem r Base64String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base64String -> Sem r Base64String)
-> (ByteString -> Base64String) -> ByteString -> Sem r Base64String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
fromBytes (ByteString -> Sem r x) -> ByteString -> Sem r x
forall a b. (a -> b) -> a -> b
$ HashResponse
hashResp HashResponse
-> Getting ByteString HashResponse ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString HashResponse ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "rootHash" a) =>
LensLike' f s a
Api.rootHash
    )

evalStoreEffs
  :: Members [Embed IO, Reader IAVLVersions, Error AppError, Reader GrpcClient] r
  => forall a.
     Sem (StoreEffs :& r) a
  -> Sem r a
evalStoreEffs :: forall a. Sem (StoreEffs :& r) a -> Sem r a
evalStoreEffs action :: Sem (StoreEffs :& r) a
action = do
  vs :: IAVLVersions
vs@IAVLVersions{..} <- Sem r IAVLVersions
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
ask
  GrpcClient
grpc <- Sem r GrpcClient
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
ask
  GrpcClient
-> IAVLVersions -> forall a. Sem (CommitBlock : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Members '[Embed IO, Error AppError] r =>
GrpcClient
-> IAVLVersions -> forall a. Sem (CommitBlock : r) a -> Sem r a
evalCommitBlock GrpcClient
grpc IAVLVersions
vs (Sem (CommitBlock : r) a -> Sem r a)
-> (Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : r)
      a
    -> Sem (CommitBlock : r) a)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    GrpcClient
-> forall a.
   Sem (Transaction : CommitBlock : r) a -> Sem (CommitBlock : r) a
forall (r :: [(* -> *) -> * -> *]).
Members '[Embed IO, Error AppError] r =>
GrpcClient -> forall a. Sem (Transaction : r) a -> Sem r a
evalTransaction GrpcClient
grpc (Sem (Transaction : CommitBlock : r) a -> Sem (CommitBlock : r) a)
-> (Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : r)
      a
    -> Sem (Transaction : CommitBlock : r) a)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
-> Sem (CommitBlock : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    GrpcClient
-> forall a.
   Sem (WriteStore : Transaction : CommitBlock : r) a
   -> Sem (Transaction : CommitBlock : r) a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
GrpcClient -> forall a. Sem (WriteStore : r) a -> Sem r a
evalWrite GrpcClient
grpc (Sem (WriteStore : Transaction : CommitBlock : r) a
 -> Sem (Transaction : CommitBlock : r) a)
-> (Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : r)
      a
    -> Sem (WriteStore : Transaction : CommitBlock : r) a)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
-> Sem (Transaction : CommitBlock : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Sem
  (Tagged 'Consensus WriteStore : Transaction : CommitBlock : r) a
-> Sem (WriteStore : Transaction : CommitBlock : r) a
forall k1 (k2 :: k1) (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
untag (Sem
   (Tagged 'Consensus WriteStore : Transaction : CommitBlock : r) a
 -> Sem (WriteStore : Transaction : CommitBlock : r) a)
-> (Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : r)
      a
    -> Sem
         (Tagged 'Consensus WriteStore : Transaction : CommitBlock : r) a)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
-> Sem (WriteStore : Transaction : CommitBlock : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    GrpcClient
-> IORef Version
-> forall a.
   Sem
     (ReadStore
        : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
     a
   -> Sem
        (Tagged 'Consensus WriteStore : Transaction : CommitBlock : r) a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
GrpcClient
-> IORef Version -> forall a. Sem (ReadStore : r) a -> Sem r a
evalRead GrpcClient
grpc IORef Version
committed (Sem
   (ReadStore
      : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
   a
 -> Sem
      (Tagged 'Consensus WriteStore : Transaction : CommitBlock : r) a)
-> (Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : r)
      a
    -> Sem
         (ReadStore
            : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
         a)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
-> Sem
     (Tagged 'Consensus WriteStore : Transaction : CommitBlock : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Sem
  (Tagged 'QueryAndMempool ReadStore
     : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
  a
-> Sem
     (ReadStore
        : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
     a
forall k1 (k2 :: k1) (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
untag (Sem
   (Tagged 'QueryAndMempool ReadStore
      : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
   a
 -> Sem
      (ReadStore
         : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
      a)
-> (Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : r)
      a
    -> Sem
         (Tagged 'QueryAndMempool ReadStore
            : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
         a)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
-> Sem
     (ReadStore
        : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    GrpcClient
-> IORef Version
-> forall a.
   Sem
     (ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
   -> Sem
        (Tagged 'QueryAndMempool ReadStore
           : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
        a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
GrpcClient
-> IORef Version -> forall a. Sem (ReadStore : r) a -> Sem r a
evalRead GrpcClient
grpc IORef Version
latest (Sem
   (ReadStore
      : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
      : Transaction : CommitBlock : r)
   a
 -> Sem
      (Tagged 'QueryAndMempool ReadStore
         : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
      a)
-> (Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : r)
      a
    -> Sem
         (ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : r)
         a)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
-> Sem
     (Tagged 'QueryAndMempool ReadStore
        : Tagged 'Consensus WriteStore : Transaction : CommitBlock : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : r)
  a
-> Sem
     (ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
forall k1 (k2 :: k1) (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
untag (Sem
   (Tagged 'Consensus ReadStore
      : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
      : Transaction : CommitBlock : r)
   a
 -> Sem r a)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : r)
     a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : r)
  a
Sem (StoreEffs :& r) a
action

runGrpc
  :: ClientIO (Either TooMuchConcurrency (RawReply a))
  -> IO a
runGrpc :: ClientIO (Either TooMuchConcurrency (RawReply a)) -> IO a
runGrpc f :: ClientIO (Either TooMuchConcurrency (RawReply a))
f = ClientIO (Either TooMuchConcurrency (RawReply a))
-> IO (Either ClientError (Either TooMuchConcurrency (RawReply a)))
forall a. ClientIO a -> IO (Either ClientError a)
runClientIO ClientIO (Either TooMuchConcurrency (RawReply a))
f IO (Either ClientError (Either TooMuchConcurrency (RawReply a)))
-> (Either ClientError (Either TooMuchConcurrency (RawReply a))
    -> IO a)
-> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right (Right (Right (_, _, Right res :: a
res))) -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$  a
res
  Right (Right (Right (_, _, Left err :: String
err))) -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> (SDKError -> String) -> SDKError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDKError -> String
forall a. Show a => a -> String
show (SDKError -> IO a) -> SDKError -> IO a
forall a b. (a -> b) -> a -> b
$ Text -> SDKError
GrpcError (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
err)
  Right (Right (Left err :: ErrorCode
err)) -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> (SDKError -> String) -> SDKError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDKError -> String
forall a. Show a => a -> String
show (SDKError -> IO a) -> SDKError -> IO a
forall a b. (a -> b) -> a -> b
$ Text -> SDKError
GrpcError (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ErrorCode -> String
forall a. Show a => a -> String
show ErrorCode
err)
  Right (Left err :: TooMuchConcurrency
err) -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> (SDKError -> String) -> SDKError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDKError -> String
forall a. Show a => a -> String
show (SDKError -> IO a) -> SDKError -> IO a
forall a b. (a -> b) -> a -> b
$ Text -> SDKError
GrpcError (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TooMuchConcurrency -> String
forall a. Show a => a -> String
show TooMuchConcurrency
err)
  Left err :: ClientError
err -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> (SDKError -> String) -> SDKError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDKError -> String
forall a. Show a => a -> String
show (SDKError -> IO a) -> SDKError -> IO a
forall a b. (a -> b) -> a -> b
$ Text -> SDKError
GrpcError (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ClientError -> String
forall a. Show a => a -> String
show ClientError
err)