module Morley.Client.App
(
runRequestAcceptStatusImpl
, throwClientErrorImpl
, getBlockHashImpl
, getCounterImpl
, getBlockHeaderImpl
, getBlockConstantsImpl
, getScriptSizeAtBlockImpl
, getBlockOperationsImpl
, getBlockOperationHashesImpl
, getProtocolParametersImpl
, runOperationImpl
, preApplyOperationsImpl
, forgeOperationImpl
, injectOperationImpl
, getContractScriptImpl
, getContractStorageAtBlockImpl
, getContractBigMapImpl
, getBigMapValueAtBlockImpl
, getBigMapValuesAtBlockImpl
, getBalanceImpl
, getManagerKeyImpl
, runCodeImpl
, getChainIdImpl
, getDelegateImpl
, waitForOperationImpl
, getTicketBalanceAtBlockImpl
, getAllTicketBalancesAtBlockImpl
, packDataImpl
, retryOnTimeout
, failOnTimeout
, retryOnceOnTimeout
, waitBeforeRetry
, handleInvalidCounterRpc
) where
import Unsafe qualified (fromIntegral, (!!))
import Control.Concurrent (threadDelay)
import Data.Aeson qualified as Aeson
import Data.Binary.Builder qualified as Binary
import Data.Text (isInfixOf)
import Fmt (Buildable(..), Doc, build, pretty, (+|), (|+))
import Network.HTTP.Types (Status(..), renderQuery)
import Servant.Client (ClientEnv, runClientM)
import Servant.Client.Core
(ClientError(..), Request, RequestBody(..), RequestF(..), Response, ResponseF(..), RunClient)
import Servant.Client.Core.RunClient (runRequest)
import Servant.Client.Streaming (withClientM)
import Servant.Types.SourceT (SourceT(unSourceT), StepT(..))
import System.Random (randomRIO)
import UnliftIO (MonadUnliftIO, withRunInIO)
import UnliftIO.Async (wait, waitEither, withAsync)
import UnliftIO.Timeout (timeout)
import Morley.Client.Logging (WithClientLog, logDebug)
import Morley.Client.RPC
import Morley.Client.RPC.API qualified as API
import Morley.Micheline
(Expression, TezosInt64, TezosNat, toExpression, unStringEncode, unTezosMutez)
import Morley.Michelson.Typed qualified as T
import Morley.Tezos.Address
import Morley.Tezos.Core (ChainId, Mutez, parseChainId)
import Morley.Tezos.Crypto (KeyHash, PublicKey)
import Morley.Util.ByteString (HexJSONByteString)
import Morley.Util.Exception (throwLeft)
runRequestAcceptStatusImpl
:: forall env m. (WithClientLog env m, MonadIO m, MonadThrow m)
=> ClientEnv -> Maybe [Status] -> Request -> m Response
runRequestAcceptStatusImpl :: forall env (m :: * -> *).
(WithClientLog env m, MonadIO m, MonadThrow m) =>
ClientEnv -> Maybe [Status] -> Request -> m Response
runRequestAcceptStatusImpl ClientEnv
env Maybe [Status]
_ Request
req = do
Request -> m ()
forall env (m :: * -> *). WithClientLog env m => Request -> m ()
logRequest Request
req
Response
response <- (ClientError -> m Response)
-> (Response -> m Response)
-> Either ClientError Response
-> m Response
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ClientError -> m Response
logResponseAndThrowError Response -> m Response
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ClientError Response -> m Response)
-> m (Either ClientError Response) -> m Response
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
IO (Either ClientError Response) -> m (Either ClientError Response)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ClientM Response -> ClientEnv -> IO (Either ClientError Response)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Request -> ClientM Response
forall (m :: * -> *). RunClient m => Request -> m Response
runRequest Request
req) ClientEnv
env)
Response
response Response -> m () -> m Response
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response -> m ()
forall env (m :: * -> *). WithClientLog env m => Response -> m ()
logResponse Response
response
where
getResponse :: ClientError -> Maybe Response
getResponse :: ClientError -> Maybe Response
getResponse = \case
FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
response -> Response -> Maybe Response
forall a. a -> Maybe a
Just Response
response
DecodeFailure Text
_ Response
response -> Response -> Maybe Response
forall a. a -> Maybe a
Just Response
response
UnsupportedContentType MediaType
_ Response
response -> Response -> Maybe Response
forall a. a -> Maybe a
Just Response
response
InvalidContentTypeHeader Response
response -> Response -> Maybe Response
forall a. a -> Maybe a
Just Response
response
ConnectionError{} -> Maybe Response
forall a. Maybe a
Nothing
logResponseAndThrowError :: ClientError -> m Response
logResponseAndThrowError :: ClientError -> m Response
logResponseAndThrowError ClientError
err = do
Maybe Response -> (Response -> m ()) -> m ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust (ClientError -> Maybe Response
getResponse ClientError
err) Response -> m ()
forall env (m :: * -> *). WithClientLog env m => Response -> m ()
logResponse
ClientError -> m Response
forall (m :: * -> *) a. MonadThrow m => ClientError -> m a
throwClientErrorImpl ClientError
err
throwClientErrorImpl :: forall m a . MonadThrow m => ClientError -> m a
throwClientErrorImpl :: forall (m :: * -> *) a. MonadThrow m => ClientError -> m a
throwClientErrorImpl ClientError
err = case ClientError
err of
FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
resp
| Int
500 <- Status -> Int
statusCode (Response -> Status
forall a. ResponseF a -> Status
responseStatusCode Response
resp) ->
ByteString -> m a
handleInternalError (Response -> ByteString
forall a. ResponseF a -> a
responseBody Response
resp)
ClientError
_ -> ClientError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientError
err
where
handleInternalError :: LByteString -> m a
handleInternalError :: ByteString -> m a
handleInternalError ByteString
body = case forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode @[InternalError] ByteString
body of
Maybe [InternalError]
Nothing -> case forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode @[RunError] ByteString
body of
Maybe [RunError]
Nothing -> ClientError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientError
err
Just [RunError]
runErrs -> RunCodeErrors -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (RunCodeErrors -> m a) -> RunCodeErrors -> m a
forall a b. (a -> b) -> a -> b
$ [RunError] -> RunCodeErrors
RunCodeErrors [RunError]
runErrs
Just [InternalError
knownErr] -> ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ InternalError -> ClientRpcError
ClientInternalError InternalError
knownErr
Just [InternalError]
errs -> UnexpectedErrors -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnexpectedErrors -> m a) -> UnexpectedErrors -> m a
forall a b. (a -> b) -> a -> b
$ [InternalError] -> UnexpectedErrors
UnexpectedInternalErrors [InternalError]
errs
getBlockHashImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m BlockHash
getBlockHashImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m BlockHash
getBlockHashImpl = m BlockHash -> m BlockHash
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m BlockHash -> m BlockHash)
-> (BlockId -> m BlockHash) -> BlockId -> m BlockHash
forall a b c. SuperComposition a b c => a -> b -> c
... (Text -> BlockHash) -> m Text -> m BlockHash
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BlockHash
BlockHash (m Text -> m BlockHash)
-> (BlockId -> m Text) -> BlockId -> m BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeMethods m -> BlockId -> m Text
forall (m :: * -> *). NodeMethods m -> BlockId -> m Text
API.getBlockHash NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getCounterImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> ImplicitAddress -> m TezosInt64
getCounterImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ImplicitAddress -> m TezosInt64
getCounterImpl = m TezosInt64 -> m TezosInt64
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m TezosInt64 -> m TezosInt64)
-> (BlockId -> ImplicitAddress -> m TezosInt64)
-> BlockId
-> ImplicitAddress
-> m TezosInt64
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> ImplicitAddress -> m TezosInt64
forall (m :: * -> *).
NodeMethods m -> BlockId -> ImplicitAddress -> m TezosInt64
API.getCounter NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getBlockHeaderImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m BlockHeader
= m BlockHeader -> m BlockHeader
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m BlockHeader -> m BlockHeader)
-> (BlockId -> m BlockHeader) -> BlockId -> m BlockHeader
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> m BlockHeader
forall (m :: * -> *). NodeMethods m -> BlockId -> m BlockHeader
API.getBlockHeader NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getBlockConstantsImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m BlockConstants
getBlockConstantsImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m BlockConstants
getBlockConstantsImpl = m BlockConstants -> m BlockConstants
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m BlockConstants -> m BlockConstants)
-> (BlockId -> m BlockConstants) -> BlockId -> m BlockConstants
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> m BlockConstants
forall (m :: * -> *). NodeMethods m -> BlockId -> m BlockConstants
API.getBlockConstants NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getBlockOperationsImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m [[BlockOperation]]
getBlockOperationsImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m [[BlockOperation]]
getBlockOperationsImpl =
m [[BlockOperation]] -> m [[BlockOperation]]
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m [[BlockOperation]] -> m [[BlockOperation]])
-> (BlockId -> m [[BlockOperation]])
-> BlockId
-> m [[BlockOperation]]
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> m [[BlockOperation]]
forall (m :: * -> *).
NodeMethods m -> BlockId -> m [[BlockOperation]]
API.getBlockOperations NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getBlockOperationHashesImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m [[OperationHash]]
getBlockOperationHashesImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m [[OperationHash]]
getBlockOperationHashesImpl =
m [[OperationHash]] -> m [[OperationHash]]
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m [[OperationHash]] -> m [[OperationHash]])
-> (BlockId -> m [[OperationHash]])
-> BlockId
-> m [[OperationHash]]
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> m [[OperationHash]]
forall (m :: * -> *).
NodeMethods m -> BlockId -> m [[OperationHash]]
API.getBlockOperationHashes NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getProtocolParametersImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m ProtocolParameters
getProtocolParametersImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m ProtocolParameters
getProtocolParametersImpl = m ProtocolParameters -> m ProtocolParameters
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m ProtocolParameters -> m ProtocolParameters)
-> (BlockId -> m ProtocolParameters)
-> BlockId
-> m ProtocolParameters
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> m ProtocolParameters
forall (m :: * -> *).
NodeMethods m -> BlockId -> m ProtocolParameters
API.getProtocolParameters NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
runOperationImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> RunOperation -> m RunOperationResult
runOperationImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> RunOperation -> m RunOperationResult
runOperationImpl = m RunOperationResult -> m RunOperationResult
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m RunOperationResult -> m RunOperationResult)
-> (BlockId -> RunOperation -> m RunOperationResult)
-> BlockId
-> RunOperation
-> m RunOperationResult
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> RunOperation -> m RunOperationResult
forall (m :: * -> *).
NodeMethods m -> BlockId -> RunOperation -> m RunOperationResult
API.runOperation NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
preApplyOperationsImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> [PreApplyOperation] -> m [RunOperationResult]
preApplyOperationsImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> [PreApplyOperation] -> m [RunOperationResult]
preApplyOperationsImpl =
m [RunOperationResult] -> m [RunOperationResult]
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m [RunOperationResult] -> m [RunOperationResult])
-> (BlockId -> [PreApplyOperation] -> m [RunOperationResult])
-> BlockId
-> [PreApplyOperation]
-> m [RunOperationResult]
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m
-> BlockId -> [PreApplyOperation] -> m [RunOperationResult]
forall (m :: * -> *).
NodeMethods m
-> BlockId -> [PreApplyOperation] -> m [RunOperationResult]
API.preApplyOperations NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
forgeOperationImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ForgeOperation -> m HexJSONByteString
forgeOperationImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ForgeOperation -> m HexJSONByteString
forgeOperationImpl = m HexJSONByteString -> m HexJSONByteString
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m HexJSONByteString -> m HexJSONByteString)
-> (BlockId -> ForgeOperation -> m HexJSONByteString)
-> BlockId
-> ForgeOperation
-> m HexJSONByteString
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> ForgeOperation -> m HexJSONByteString
forall (m :: * -> *).
NodeMethods m -> BlockId -> ForgeOperation -> m HexJSONByteString
API.forgeOperation NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
injectOperationImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
HexJSONByteString -> m OperationHash
injectOperationImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
HexJSONByteString -> m OperationHash
injectOperationImpl =
m OperationHash -> m OperationHash
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
failOnTimeout (m OperationHash -> m OperationHash)
-> (HexJSONByteString -> m OperationHash)
-> HexJSONByteString
-> m OperationHash
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> HexJSONByteString -> m OperationHash
forall (m :: * -> *).
NodeMethods m -> HexJSONByteString -> m OperationHash
API.injectOperation NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getContractScriptImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> m OriginationScript
getContractScriptImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> m OriginationScript
getContractScriptImpl = m OriginationScript -> m OriginationScript
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m OriginationScript -> m OriginationScript)
-> (BlockId -> ContractAddress -> m OriginationScript)
-> BlockId
-> ContractAddress
-> m OriginationScript
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> ContractAddress -> m OriginationScript
forall (m :: * -> *).
NodeMethods m -> BlockId -> ContractAddress -> m OriginationScript
API.getScript NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getContractStorageAtBlockImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> m Expression
getContractStorageAtBlockImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> m Expression
getContractStorageAtBlockImpl =
m Expression -> m Expression
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m Expression -> m Expression)
-> (BlockId -> ContractAddress -> m Expression)
-> BlockId
-> ContractAddress
-> m Expression
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> ContractAddress -> m Expression
forall (m :: * -> *).
NodeMethods m -> BlockId -> ContractAddress -> m Expression
API.getStorageAtBlock NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getContractBigMapImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
getContractBigMapImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
getContractBigMapImpl = m GetBigMapResult -> m GetBigMapResult
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m GetBigMapResult -> m GetBigMapResult)
-> (BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult)
-> BlockId
-> ContractAddress
-> GetBigMap
-> m GetBigMapResult
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m
-> BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
forall (m :: * -> *).
NodeMethods m
-> BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
API.getBigMap NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getScriptSizeAtBlockImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> CalcSize -> m ScriptSize
getScriptSizeAtBlockImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> CalcSize -> m ScriptSize
getScriptSizeAtBlockImpl = m ScriptSize -> m ScriptSize
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m ScriptSize -> m ScriptSize)
-> (BlockId -> CalcSize -> m ScriptSize)
-> BlockId
-> CalcSize
-> m ScriptSize
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> CalcSize -> m ScriptSize
forall (m :: * -> *).
NodeMethods m -> BlockId -> CalcSize -> m ScriptSize
API.getScriptSizeAtBlock NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getBigMapValueAtBlockImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Natural -> Text -> m Expression
getBigMapValueAtBlockImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Natural -> Text -> m Expression
getBigMapValueAtBlockImpl =
m Expression -> m Expression
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m Expression -> m Expression)
-> (BlockId -> Natural -> Text -> m Expression)
-> BlockId
-> Natural
-> Text
-> m Expression
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> Natural -> Text -> m Expression
forall (m :: * -> *).
NodeMethods m -> BlockId -> Natural -> Text -> m Expression
API.getBigMapValueAtBlock NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getBigMapValuesAtBlockImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValuesAtBlockImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValuesAtBlockImpl =
m Expression -> m Expression
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m Expression -> m Expression)
-> (BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression)
-> BlockId
-> Natural
-> Maybe Natural
-> Maybe Natural
-> m Expression
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m
-> BlockId
-> Natural
-> Maybe Natural
-> Maybe Natural
-> m Expression
forall (m :: * -> *).
NodeMethods m
-> BlockId
-> Natural
-> Maybe Natural
-> Maybe Natural
-> m Expression
API.getBigMapValuesAtBlock NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getBalanceImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> m Mutez
getBalanceImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> m Mutez
getBalanceImpl =
m Mutez -> m Mutez
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m Mutez -> m Mutez)
-> (m TezosMutez -> m Mutez) -> m TezosMutez -> m Mutez
forall a b c. SuperComposition a b c => a -> b -> c
... (TezosMutez -> Mutez) -> m TezosMutez -> m Mutez
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TezosMutez -> Mutez
unTezosMutez (m TezosMutez -> m Mutez)
-> (BlockId -> Address -> m TezosMutez)
-> BlockId
-> Address
-> m Mutez
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> Address -> m TezosMutez
forall (m :: * -> *).
NodeMethods m -> BlockId -> Address -> m TezosMutez
API.getBalance NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getTicketBalanceAtBlockImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> GetTicketBalance -> m Natural
getTicketBalanceAtBlockImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> GetTicketBalance -> m Natural
getTicketBalanceAtBlockImpl =
m Natural -> m Natural
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m Natural -> m Natural)
-> (m (StringEncode Natural) -> m Natural)
-> m (StringEncode Natural)
-> m Natural
forall a b c. SuperComposition a b c => a -> b -> c
... (StringEncode Natural -> Natural)
-> m (StringEncode Natural) -> m Natural
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringEncode Natural -> Natural
forall a. StringEncode a -> a
unStringEncode (m (StringEncode Natural) -> m Natural)
-> (BlockId
-> Address -> GetTicketBalance -> m (StringEncode Natural))
-> BlockId
-> Address
-> GetTicketBalance
-> m Natural
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m
-> BlockId
-> Address
-> GetTicketBalance
-> m (StringEncode Natural)
forall (m :: * -> *).
NodeMethods m
-> BlockId
-> Address
-> GetTicketBalance
-> m (StringEncode Natural)
API.getTicketBalanceAtBlock NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getAllTicketBalancesAtBlockImpl
:: (RunClient m, MonadUnliftIO m, MonadCatch m)
=> BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse]
getAllTicketBalancesAtBlockImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse]
getAllTicketBalancesAtBlockImpl =
m [GetAllTicketBalancesResponse]
-> m [GetAllTicketBalancesResponse]
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m [GetAllTicketBalancesResponse]
-> m [GetAllTicketBalancesResponse])
-> (BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse])
-> BlockId
-> ContractAddress
-> m [GetAllTicketBalancesResponse]
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m
-> BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse]
forall (m :: * -> *).
NodeMethods m
-> BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse]
API.getAllTicketBalancesAtBlock NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getDelegateImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> L1Address -> m (Maybe KeyHash)
getDelegateImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> L1Address -> m (Maybe KeyHash)
getDelegateImpl =
m (Maybe KeyHash) -> m (Maybe KeyHash)
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m (Maybe KeyHash) -> m (Maybe KeyHash))
-> (BlockId -> L1Address -> m (Maybe KeyHash))
-> BlockId
-> L1Address
-> m (Maybe KeyHash)
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> L1Address -> m (Maybe KeyHash)
forall (m :: * -> *).
NodeMethods m -> BlockId -> L1Address -> m (Maybe KeyHash)
API.getDelegate NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getManagerKeyImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> ImplicitAddress -> m (Maybe PublicKey)
getManagerKeyImpl :: forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ImplicitAddress -> m (Maybe PublicKey)
getManagerKeyImpl =
m (Maybe PublicKey) -> m (Maybe PublicKey)
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m (Maybe PublicKey) -> m (Maybe PublicKey))
-> (BlockId -> ImplicitAddress -> m (Maybe PublicKey))
-> BlockId
-> ImplicitAddress
-> m (Maybe PublicKey)
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> ImplicitAddress -> m (Maybe PublicKey)
forall (m :: * -> *).
NodeMethods m -> BlockId -> ImplicitAddress -> m (Maybe PublicKey)
API.getManagerKey NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
runCodeImpl :: (RunClient m, MonadCatch m) => BlockId -> RunCode -> m RunCodeResult
runCodeImpl :: forall (m :: * -> *).
(RunClient m, MonadCatch m) =>
BlockId -> RunCode -> m RunCodeResult
runCodeImpl = NodeMethods m -> BlockId -> RunCode -> m RunCodeResult
forall (m :: * -> *).
NodeMethods m -> BlockId -> RunCode -> m RunCodeResult
API.runCode NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getChainIdImpl :: (RunClient m, MonadCatch m) => m ChainId
getChainIdImpl :: forall (m :: * -> *). (RunClient m, MonadCatch m) => m ChainId
getChainIdImpl = m (Either ParseChainIdError ChainId) -> m ChainId
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft (m (Either ParseChainIdError ChainId) -> m ChainId)
-> m (Either ParseChainIdError ChainId) -> m ChainId
forall a b. (a -> b) -> a -> b
$ Text -> Either ParseChainIdError ChainId
parseChainId (Text -> Either ParseChainIdError ChainId)
-> m Text -> m (Either ParseChainIdError ChainId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeMethods m -> m Text
forall (m :: * -> *). NodeMethods m -> m Text
API.getChainId NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
packDataImpl
:: (T.ForbidOp t, RunClient m, MonadCatch m, MonadUnliftIO m)
=> BlockId -> T.Value t -> T.Notes t -> m Text
packDataImpl :: forall (t :: T) (m :: * -> *).
(ForbidOp t, RunClient m, MonadCatch m, MonadUnliftIO m) =>
BlockId -> Value t -> Notes t -> m Text
packDataImpl BlockId
blkId Value t
val Notes t
notes = m Text -> m Text
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout do
PackDataResult{Text
PackDataResultGas
pdrPacked :: Text
pdrGas :: PackDataResultGas
pdrPacked :: PackDataResult -> Text
pdrGas :: PackDataResult -> PackDataResultGas
..} <- NodeMethods m -> BlockId -> PackData -> m PackDataResult
forall (m :: * -> *).
NodeMethods m -> BlockId -> PackData -> m PackDataResult
API.packData NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods BlockId
blkId PackData
{ pdData :: Expression
pdData = Value t -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value t
val
, pdType :: Expression
pdType = Notes t -> Expression
forall a. ToExpression a => a -> Expression
toExpression Notes t
notes
, pdGas :: Maybe TezosBigNum
pdGas = Maybe TezosBigNum
forall a. Maybe a
Nothing
}
Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
pdrPacked
waitForOperationImpl :: forall m
. (MonadUnliftIO m, HasTezosRpc m)
=> m OperationHash
-> ClientEnv
-> m OperationHash
waitForOperationImpl :: forall (m :: * -> *).
(MonadUnliftIO m, HasTezosRpc m) =>
m OperationHash -> ClientEnv -> m OperationHash
waitForOperationImpl m OperationHash
opHash ClientEnv
env = do
BlockHeader
finalHead <- BlockId -> m BlockHeader
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockHeader
getBlockHeader BlockId
FinalHeadId
OperationHash
hash <- m OperationHash
opHash
let limit :: Word
limit = Word
10
blockout :: m OperationHash
blockout = WaitForOperationError -> m OperationHash
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (WaitForOperationError -> m OperationHash)
-> WaitForOperationError -> m OperationHash
forall a b. (a -> b) -> a -> b
$ Word -> WaitForOperationError
WaitForOperationBlockout Word
limit
handle :: Async (Maybe OperationHash)
-> Maybe OperationHash -> m OperationHash
handle Async (Maybe OperationHash)
other = m OperationHash
-> (OperationHash -> m OperationHash)
-> Maybe OperationHash
-> m OperationHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Async (Maybe OperationHash) -> m (Maybe OperationHash)
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait Async (Maybe OperationHash)
other m (Maybe OperationHash)
-> (Maybe OperationHash -> m OperationHash) -> m OperationHash
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m OperationHash
-> (OperationHash -> m OperationHash)
-> Maybe OperationHash
-> m OperationHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m OperationHash
blockout OperationHash -> m OperationHash
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) OperationHash -> m OperationHash
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
m (Maybe OperationHash)
-> (Async (Maybe OperationHash) -> m OperationHash)
-> m OperationHash
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (Word -> OperationHash -> m (Maybe OperationHash)
searchForwards Word
limit OperationHash
hash) \Async (Maybe OperationHash)
fwd ->
m (Maybe OperationHash)
-> (Async (Maybe OperationHash) -> m OperationHash)
-> m OperationHash
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (OperationHash -> Int64 -> BlockId -> m (Maybe OperationHash)
searchBackwards OperationHash
hash (BlockHeader -> Int64
bhLevel BlockHeader
finalHead) BlockId
HeadId) \Async (Maybe OperationHash)
bwd ->
Async (Maybe OperationHash)
-> Async (Maybe OperationHash)
-> m (Either (Maybe OperationHash) (Maybe OperationHash))
forall (m :: * -> *) a b.
MonadIO m =>
Async a -> Async b -> m (Either a b)
waitEither Async (Maybe OperationHash)
fwd Async (Maybe OperationHash)
bwd m (Either (Maybe OperationHash) (Maybe OperationHash))
-> (Either (Maybe OperationHash) (Maybe OperationHash)
-> m OperationHash)
-> m OperationHash
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Maybe OperationHash
res -> Async (Maybe OperationHash)
-> Maybe OperationHash -> m OperationHash
handle Async (Maybe OperationHash)
bwd Maybe OperationHash
res
Right Maybe OperationHash
res -> Async (Maybe OperationHash)
-> Maybe OperationHash -> m OperationHash
handle Async (Maybe OperationHash)
fwd Maybe OperationHash
res
where
monitorHeads :: Word -> (BlockHeader -> m (MonitorHeadsStep OperationHash)) -> m (Maybe OperationHash)
monitorHeads :: Word
-> (BlockHeader -> m (MonitorHeadsStep OperationHash))
-> m (Maybe OperationHash)
monitorHeads Word
limit BlockHeader -> m (MonitorHeadsStep OperationHash)
test = ((forall a. m a -> IO a) -> IO (Maybe OperationHash))
-> m (Maybe OperationHash)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Maybe OperationHash))
-> m (Maybe OperationHash))
-> ((forall a. m a -> IO a) -> IO (Maybe OperationHash))
-> m (Maybe OperationHash)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
ClientM (Maybe OperationHash)
-> ClientEnv
-> (Either ClientError (Maybe OperationHash)
-> IO (Maybe OperationHash))
-> IO (Maybe OperationHash)
forall a b.
ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
withClientM ((m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash))
-> ClientM (Maybe OperationHash)
client m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
forall a. m a -> IO a
runInIO) ClientEnv
env ((ClientError -> IO (Maybe OperationHash))
-> (Maybe OperationHash -> IO (Maybe OperationHash))
-> Either ClientError (Maybe OperationHash)
-> IO (Maybe OperationHash)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ClientError -> IO (Maybe OperationHash)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Maybe OperationHash -> IO (Maybe OperationHash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
where
client :: (m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash))
-> ClientM (Maybe OperationHash)
client m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
runInIO = do
SourceIO BlockHeader
src <- ClientM (SourceIO BlockHeader)
forall (m :: * -> *).
RunStreamingClient m =>
m (SourceIO BlockHeader)
API.monitorHeads
IO (Maybe OperationHash) -> ClientM (Maybe OperationHash)
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OperationHash) -> ClientM (Maybe OperationHash))
-> IO (Maybe OperationHash) -> ClientM (Maybe OperationHash)
forall a b. (a -> b) -> a -> b
$ SourceIO BlockHeader
-> forall b. (StepT IO BlockHeader -> IO b) -> IO b
forall (m :: * -> *) a.
SourceT m a -> forall b. (StepT m a -> m b) -> m b
unSourceT SourceIO BlockHeader
src ((StepT IO BlockHeader -> IO (Maybe OperationHash))
-> IO (Maybe OperationHash))
-> (StepT IO BlockHeader -> IO (Maybe OperationHash))
-> IO (Maybe OperationHash)
forall a b. (a -> b) -> a -> b
$ Word
-> (m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash))
-> StepT IO BlockHeader
-> IO (Maybe OperationHash)
go Word
limit m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
runInIO
go :: Word
-> (m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash))
-> StepT IO BlockHeader
-> IO (Maybe OperationHash)
go Word
0 m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
_ = IO (Maybe OperationHash)
-> StepT IO BlockHeader -> IO (Maybe OperationHash)
forall a b. a -> b -> a
const (IO (Maybe OperationHash)
-> StepT IO BlockHeader -> IO (Maybe OperationHash))
-> IO (Maybe OperationHash)
-> StepT IO BlockHeader
-> IO (Maybe OperationHash)
forall a b. (a -> b) -> a -> b
$ Maybe OperationHash -> IO (Maybe OperationHash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OperationHash
forall a. Maybe a
Nothing
go Word
n m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
runInIO = \case
StepT IO BlockHeader
Stop -> Maybe OperationHash -> IO (Maybe OperationHash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OperationHash
forall a. Maybe a
Nothing
Error String
str -> WaitForOperationError -> IO (Maybe OperationHash)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (WaitForOperationError -> IO (Maybe OperationHash))
-> WaitForOperationError -> IO (Maybe OperationHash)
forall a b. (a -> b) -> a -> b
$ Text -> WaitForOperationError
WaitForOperationStreamingError (String -> Text
forall a. IsString a => String -> a
fromString String
str)
Skip StepT IO BlockHeader
next -> Word
-> (m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash))
-> StepT IO BlockHeader
-> IO (Maybe OperationHash)
go Word
n m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
runInIO StepT IO BlockHeader
next
Yield BlockHeader
a StepT IO BlockHeader
next -> m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
runInIO (BlockHeader -> m (MonitorHeadsStep OperationHash)
test BlockHeader
a) IO (MonitorHeadsStep OperationHash)
-> (MonitorHeadsStep OperationHash -> IO (Maybe OperationHash))
-> IO (Maybe OperationHash)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MonitorHeadsStep OperationHash
MonitorHeadsContinue -> Word
-> (m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash))
-> StepT IO BlockHeader
-> IO (Maybe OperationHash)
go (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
runInIO StepT IO BlockHeader
next
MonitorHeadsStop OperationHash
res -> Maybe OperationHash -> IO (Maybe OperationHash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OperationHash -> IO (Maybe OperationHash))
-> Maybe OperationHash -> IO (Maybe OperationHash)
forall a b. (a -> b) -> a -> b
$ OperationHash -> Maybe OperationHash
forall a. a -> Maybe a
Just OperationHash
res
Effect IO (StepT IO BlockHeader)
eff -> IO (StepT IO BlockHeader)
eff IO (StepT IO BlockHeader)
-> (StepT IO BlockHeader -> IO (Maybe OperationHash))
-> IO (Maybe OperationHash)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word
-> (m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash))
-> StepT IO BlockHeader
-> IO (Maybe OperationHash)
go Word
n m (MonitorHeadsStep OperationHash)
-> IO (MonitorHeadsStep OperationHash)
runInIO
searchBackwards :: OperationHash -> Int64 -> BlockId -> m (Maybe OperationHash)
searchBackwards :: OperationHash -> Int64 -> BlockId -> m (Maybe OperationHash)
searchBackwards OperationHash
hash Int64
stopAtLevel BlockId
blkHead = do
OperationHash -> BlockId -> m (MonitorHeadsStep OperationHash)
checkBlock OperationHash
hash BlockId
blkHead m (MonitorHeadsStep OperationHash)
-> (MonitorHeadsStep OperationHash -> m (Maybe OperationHash))
-> m (Maybe OperationHash)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MonitorHeadsStep OperationHash
MonitorHeadsContinue -> do
BlockHeader
header <- BlockId -> m BlockHeader
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockHeader
getBlockHeader BlockId
blkHead
if BlockHeader -> Int64
bhLevel BlockHeader
header Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
stopAtLevel
then Maybe OperationHash -> m (Maybe OperationHash)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OperationHash
forall a. Maybe a
Nothing
else OperationHash -> Int64 -> BlockId -> m (Maybe OperationHash)
searchBackwards OperationHash
hash Int64
stopAtLevel (BlockId -> m (Maybe OperationHash))
-> BlockId -> m (Maybe OperationHash)
forall a b. (a -> b) -> a -> b
$ BlockHash -> BlockId
BlockHashId (BlockHash -> BlockId) -> BlockHash -> BlockId
forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
bhPredecessor BlockHeader
header
MonitorHeadsStop OperationHash
res -> Maybe OperationHash -> m (Maybe OperationHash)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OperationHash -> m (Maybe OperationHash))
-> Maybe OperationHash -> m (Maybe OperationHash)
forall a b. (a -> b) -> a -> b
$ OperationHash -> Maybe OperationHash
forall a. a -> Maybe a
Just OperationHash
res
searchForwards :: Word -> OperationHash -> m (Maybe OperationHash)
searchForwards :: Word -> OperationHash -> m (Maybe OperationHash)
searchForwards Word
limit OperationHash
hash = Word
-> (BlockHeader -> m (MonitorHeadsStep OperationHash))
-> m (Maybe OperationHash)
monitorHeads Word
limit (OperationHash -> BlockId -> m (MonitorHeadsStep OperationHash)
checkBlock OperationHash
hash (BlockId -> m (MonitorHeadsStep OperationHash))
-> (BlockHeader -> BlockId)
-> BlockHeader
-> m (MonitorHeadsStep OperationHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> BlockId
BlockHashId (BlockHash -> BlockId)
-> (BlockHeader -> BlockHash) -> BlockHeader -> BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> BlockHash
bhHash)
checkBlock :: OperationHash -> BlockId -> m (MonitorHeadsStep OperationHash)
checkBlock :: OperationHash -> BlockId -> m (MonitorHeadsStep OperationHash)
checkBlock OperationHash
hash BlockId
blkId = do
[OperationHash]
opHashes <- [[OperationHash]] -> [OperationHash]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[OperationHash]] -> [OperationHash])
-> m [[OperationHash]] -> m [OperationHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockId -> m [[OperationHash]]
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> m [[OperationHash]]
getBlockOperationHashes BlockId
blkId
if Element [OperationHash]
OperationHash
hash Element [OperationHash] -> [OperationHash] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`notElem` [OperationHash]
opHashes
then MonitorHeadsStep OperationHash
-> m (MonitorHeadsStep OperationHash)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MonitorHeadsStep OperationHash
forall a. MonitorHeadsStep a
MonitorHeadsContinue
else do
[BlockOperation]
ops <- [[BlockOperation]] -> [BlockOperation]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[BlockOperation]] -> [BlockOperation])
-> m [[BlockOperation]] -> m [BlockOperation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockId -> m [[BlockOperation]]
forall (m :: * -> *).
HasTezosRpc m =>
BlockId -> m [[BlockOperation]]
getBlockOperations BlockId
blkId
case (Element [BlockOperation] -> Bool)
-> [BlockOperation] -> Maybe (Element [BlockOperation])
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\Element [BlockOperation]
op -> BlockOperation -> Text
boHash Element [BlockOperation]
BlockOperation
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== OperationHash -> Text
unOperationHash OperationHash
hash) [BlockOperation]
ops of
Just Element [BlockOperation]
op -> do
[OperationRespWithMeta]
-> (Element [OperationRespWithMeta] -> m ()) -> m ()
forall t (f :: * -> *) b.
(Container t, Applicative f) =>
t -> (Element t -> f b) -> f ()
for_ (BlockOperation -> [OperationRespWithMeta]
boContents Element [BlockOperation]
BlockOperation
op)
\(OperationRespWithMeta{Maybe OperationMetadata
OperationResp WithCommonOperationData
orwmResponse :: OperationResp WithCommonOperationData
orwmMetadata :: Maybe OperationMetadata
orwmResponse :: OperationRespWithMeta -> OperationResp WithCommonOperationData
orwmMetadata :: OperationRespWithMeta -> Maybe OperationMetadata
..}) -> case OperationMetadata -> Maybe OperationResult
unOperationMetadata (OperationMetadata -> Maybe OperationResult)
-> Maybe OperationMetadata -> Maybe OperationResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe OperationMetadata
orwmMetadata of
Just OperationResult
res -> case OperationResult
res of
OperationApplied{} -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
OperationFailed [RunError]
errs -> UnexpectedErrors -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnexpectedErrors -> m ()) -> UnexpectedErrors -> m ()
forall a b. (a -> b) -> a -> b
$ [RunError] -> UnexpectedErrors
UnexpectedRunErrors [RunError]
errs
Maybe OperationResult
Nothing -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
pure $ OperationHash -> MonitorHeadsStep OperationHash
forall a. a -> MonitorHeadsStep a
MonitorHeadsStop OperationHash
hash
Maybe (Element [BlockOperation])
Nothing -> Text -> m (MonitorHeadsStep OperationHash)
forall a. HasCallStack => Text -> a
error Text
"impossible"
fromBS :: ConvertUtf8 Text bs => bs -> Text
fromBS :: forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS = bs -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
ppRequestBody :: RequestBody -> Doc
ppRequestBody :: RequestBody -> Doc
ppRequestBody = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (RequestBody -> Text) -> RequestBody -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
\case
RequestBodyLBS ByteString
lbs -> ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS ByteString
lbs
RequestBodyBS ByteString
bs -> ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS ByteString
bs
RequestBodySource {} -> Text
"<body is not in memory>"
ppRequest :: Request -> Doc
ppRequest :: Request -> Doc
ppRequest Request {Maybe (RequestBody, MediaType)
ByteString
Builder
Seq QueryItem
Seq Header
Seq MediaType
HttpVersion
requestPath :: Builder
requestQueryString :: Seq QueryItem
requestBody :: Maybe (RequestBody, MediaType)
requestAccept :: Seq MediaType
requestHeaders :: Seq Header
requestHttpVersion :: HttpVersion
requestMethod :: ByteString
requestPath :: forall body path. RequestF body path -> path
requestQueryString :: forall body path. RequestF body path -> Seq QueryItem
requestBody :: forall body path. RequestF body path -> Maybe (body, MediaType)
requestAccept :: forall body path. RequestF body path -> Seq MediaType
requestHeaders :: forall body path. RequestF body path -> Seq Header
requestHttpVersion :: forall body path. RequestF body path -> HttpVersion
requestMethod :: forall body path. RequestF body path -> ByteString
..} =
ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS ByteString
requestMethod Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS (Builder -> ByteString
Binary.toLazyByteString Builder
requestPath)
Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS (Bool -> Query -> ByteString
renderQuery Bool
True (Query -> ByteString) -> Query -> ByteString
forall a b. (a -> b) -> a -> b
$ Seq QueryItem -> [Element (Seq QueryItem)]
forall t. Container t => t -> [Element t]
toList Seq QueryItem
requestQueryString) Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+
Doc
-> ((RequestBody, MediaType) -> Doc)
-> Maybe (RequestBody, MediaType)
-> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty (Doc -> Doc -> Doc
forall a. Monoid a => a -> a -> a
mappend Doc
"\n" (Doc -> Doc)
-> ((RequestBody, MediaType) -> Doc)
-> (RequestBody, MediaType)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestBody -> Doc
ppRequestBody (RequestBody -> Doc)
-> ((RequestBody, MediaType) -> RequestBody)
-> (RequestBody, MediaType)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestBody, MediaType) -> RequestBody
forall a b. (a, b) -> a
fst) Maybe (RequestBody, MediaType)
requestBody
logRequest :: WithClientLog env m => Request -> m ()
logRequest :: forall env (m :: * -> *). WithClientLog env m => Request -> m ()
logRequest Request
req = Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Doc
"RPC request: " Doc -> Doc -> Text
forall b. FromDoc b => Doc -> Doc -> b
+| Request -> Doc
ppRequest Request
req Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
ppResponse :: Response -> Doc
ppResponse :: Response -> Doc
ppResponse Response {ByteString
Seq Header
Status
HttpVersion
responseStatusCode :: forall a. ResponseF a -> Status
responseBody :: forall a. ResponseF a -> a
responseStatusCode :: Status
responseHeaders :: Seq Header
responseHttpVersion :: HttpVersion
responseBody :: ByteString
responseHttpVersion :: forall a. ResponseF a -> HttpVersion
responseHeaders :: forall a. ResponseF a -> Seq Header
..} =
Status -> Int
statusCode Status
responseStatusCode Int -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS (Status -> ByteString
statusMessage Status
responseStatusCode) Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS ByteString
responseBody Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
logResponse :: WithClientLog env m => Response -> m ()
logResponse :: forall env (m :: * -> *). WithClientLog env m => Response -> m ()
logResponse Response
resp = Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Doc
"RPC response: " Doc -> Doc -> Text
forall b. FromDoc b => Doc -> Doc -> b
+| Response -> Doc
ppResponse Response
resp Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
data TimeoutError = TimeoutError
deriving stock Int -> TimeoutError -> ShowS
[TimeoutError] -> ShowS
TimeoutError -> String
(Int -> TimeoutError -> ShowS)
-> (TimeoutError -> String)
-> ([TimeoutError] -> ShowS)
-> Show TimeoutError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeoutError -> ShowS
showsPrec :: Int -> TimeoutError -> ShowS
$cshow :: TimeoutError -> String
show :: TimeoutError -> String
$cshowList :: [TimeoutError] -> ShowS
showList :: [TimeoutError] -> ShowS
Show
instance Buildable TimeoutError where
build :: TimeoutError -> Doc
build TimeoutError
TimeoutError =
Doc
"Timeout for action call was reached. Probably, something is wrong with \
\testing environment."
instance Exception TimeoutError where
displayException :: TimeoutError -> String
displayException = TimeoutError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
retryOnTimeout :: (MonadUnliftIO m, MonadThrow m) => Bool -> m a -> m a
retryOnTimeout :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
Bool -> m a -> m a
retryOnTimeout Bool
wasRetried m a
action = do
Maybe a
res <- Int -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
timeoutInterval m a
action
m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (if Bool
wasRetried then TimeoutError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TimeoutError
TimeoutError else Bool -> m a -> m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
Bool -> m a -> m a
retryOnTimeout Bool
True m a
action)
a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
res
failOnTimeout :: (MonadUnliftIO m, MonadThrow m) => m a -> m a
failOnTimeout :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
failOnTimeout = Bool -> m a -> m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
Bool -> m a -> m a
retryOnTimeout Bool
True
retryOnceOnTimeout :: (MonadUnliftIO m, MonadThrow m) => m a -> m a
retryOnceOnTimeout :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout = Bool -> m a -> m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
Bool -> m a -> m a
retryOnTimeout Bool
False
timeoutInterval :: Int
timeoutInterval :: Int
timeoutInterval = Int
120 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1e6
waitBeforeRetry :: (MonadIO m, HasTezosRpc m, WithClientLog env m) => m ()
waitBeforeRetry :: forall (m :: * -> *) env.
(MonadIO m, HasTezosRpc m, WithClientLog env m) =>
m ()
waitBeforeRetry = do
Int
i <- IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$
([Int]
blockAwaitAmounts [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
Unsafe.!!) (Int -> Int) -> IO Int -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, [Int] -> Int
forall i a.
(Integral i, Container a,
DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [Int]
blockAwaitAmounts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Invalid counter error occurred, retrying the request after " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" blocks"
ProtocolParameters {Int
TezosInt64
StringEncode Natural
TezosMutez
ppOriginationSize :: Int
ppHardGasLimitPerOperation :: TezosInt64
ppHardStorageLimitPerOperation :: TezosInt64
ppMinimalBlockDelay :: StringEncode Natural
ppCostPerByte :: TezosMutez
ppHardGasLimitPerBlock :: TezosInt64
ppOriginationSize :: ProtocolParameters -> Int
ppHardGasLimitPerOperation :: ProtocolParameters -> TezosInt64
ppHardStorageLimitPerOperation :: ProtocolParameters -> TezosInt64
ppMinimalBlockDelay :: ProtocolParameters -> StringEncode Natural
ppCostPerByte :: ProtocolParameters -> TezosMutez
ppHardGasLimitPerBlock :: ProtocolParameters -> TezosInt64
..} <- m ProtocolParameters
forall (m :: * -> *). HasTezosRpc m => m ProtocolParameters
getProtocolParameters
IO () -> m ()
forall a. IO a -> m a
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 -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @TezosNat @Int StringEncode Natural
ppMinimalBlockDelay Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1e6
where
blockAwaitAmounts :: [Int]
blockAwaitAmounts :: [Int]
blockAwaitAmounts = [Int
1..Int
5]
handleInvalidCounterRpc :: MonadThrow m => m a -> ClientRpcError -> m a
handleInvalidCounterRpc :: forall (m :: * -> *) a.
MonadThrow m =>
m a -> ClientRpcError -> m a
handleInvalidCounterRpc m a
retryAction = \case
ClientInternalError (CounterInThePast {}) -> m a
retryAction
ClientInternalError (Failure Text
msg)
| Text
"Counter" Text -> Text -> Bool
`isInfixOf` Text
msg Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Text
"already used for contract" Text -> Text -> Bool
`isInfixOf` Text
msg ->
m a
retryAction
ClientRpcError
anotherErr -> ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientRpcError
anotherErr