module Morley.Client.App
(
runRequestAcceptStatusImpl
, throwClientErrorImpl
, getBlockHashImpl
, getCounterImpl
, getBlockHeaderImpl
, getBlockConstantsImpl
, getBlockOperationsImpl
, getProtocolParametersImpl
, runOperationImpl
, preApplyOperationsImpl
, forgeOperationImpl
, injectOperationImpl
, getContractScriptImpl
, getContractStorageAtBlockImpl
, getContractBigMapImpl
, getBigMapValueAtBlockImpl
, getBigMapValuesAtBlockImpl
, getBalanceImpl
, getManagerKeyImpl
, runCodeImpl
, getChainIdImpl
, getDelegateImpl
, 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(..), Builder, 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 System.Random (randomRIO)
import UnliftIO (MonadUnliftIO)
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, unTezosMutez)
import Morley.Tezos.Address (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 ::
(WithClientLog env m, MonadIO m, MonadThrow m) =>
ClientEnv -> Maybe [Status] -> Request -> m Response
runRequestAcceptStatusImpl :: 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
forall (m :: * -> *) a. MonadThrow m => ClientError -> m a
throwClientErrorImpl Response -> m Response
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 (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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response -> m ()
forall env (m :: * -> *). WithClientLog env m => Response -> m ()
logResponse Response
response
throwClientErrorImpl :: forall m a . MonadThrow m => ClientError -> m a
throwClientErrorImpl :: 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) ->
LByteString -> m a
handleInternalError (Response -> LByteString
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 :: LByteString -> m a
handleInternalError LByteString
body = case LByteString -> Maybe [InternalError]
forall a. FromJSON a => LByteString -> Maybe a
Aeson.decode @[InternalError] LByteString
body of
Maybe [InternalError]
Nothing -> case LByteString -> Maybe [RunError]
forall a. FromJSON a => LByteString -> Maybe a
Aeson.decode @[RunError] LByteString
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 Text
getBlockHashImpl :: BlockId -> m Text
getBlockHashImpl = m Text -> m Text
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m Text -> m Text) -> (BlockId -> m Text) -> BlockId -> m Text
forall a b c. SuperComposition a b c => a -> b -> 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 -> Address -> m TezosInt64
getCounterImpl :: BlockId -> Address -> m TezosInt64
getCounterImpl = m TezosInt64 -> m TezosInt64
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m TezosInt64 -> m TezosInt64)
-> (BlockId -> Address -> m TezosInt64)
-> BlockId
-> Address
-> m TezosInt64
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> Address -> m TezosInt64
forall (m :: * -> *).
NodeMethods m -> BlockId -> Address -> 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 :: 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 :: 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
getProtocolParametersImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m ProtocolParameters
getProtocolParametersImpl :: 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 :: 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 :: 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 :: 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 :: 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 -> Address -> m OriginationScript
getContractScriptImpl :: BlockId -> Address -> m OriginationScript
getContractScriptImpl = m OriginationScript -> m OriginationScript
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m OriginationScript -> m OriginationScript)
-> (BlockId -> Address -> m OriginationScript)
-> BlockId
-> Address
-> m OriginationScript
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> Address -> m OriginationScript
forall (m :: * -> *).
NodeMethods m -> BlockId -> Address -> m OriginationScript
API.getScript NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getContractStorageAtBlockImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> m Expression
getContractStorageAtBlockImpl :: BlockId -> Address -> m Expression
getContractStorageAtBlockImpl =
m Expression -> m Expression
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (m Expression -> m Expression)
-> (BlockId -> Address -> m Expression)
-> BlockId
-> Address
-> m Expression
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> Address -> m Expression
forall (m :: * -> *).
NodeMethods m -> BlockId -> Address -> m Expression
API.getStorageAtBlock NodeMethods m
forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
API.nodeMethods
getContractBigMapImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> GetBigMap -> m GetBigMapResult
getContractBigMapImpl :: BlockId -> Address -> 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 -> Address -> GetBigMap -> m GetBigMapResult)
-> BlockId
-> Address
-> GetBigMap
-> m GetBigMapResult
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m
-> BlockId -> Address -> GetBigMap -> m GetBigMapResult
forall (m :: * -> *).
NodeMethods m
-> BlockId -> Address -> GetBigMap -> m GetBigMapResult
API.getBigMap 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 :: 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 :: 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 :: 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 (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
getDelegateImpl ::
(RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> m (Maybe KeyHash)
getDelegateImpl :: BlockId -> Address -> 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 -> Address -> m (Maybe KeyHash))
-> BlockId
-> Address
-> m (Maybe KeyHash)
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> Address -> m (Maybe KeyHash)
forall (m :: * -> *).
NodeMethods m -> BlockId -> Address -> 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 -> Address -> m (Maybe PublicKey)
getManagerKeyImpl :: BlockId -> Address -> 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 -> Address -> m (Maybe PublicKey))
-> BlockId
-> Address
-> m (Maybe PublicKey)
forall a b c. SuperComposition a b c => a -> b -> c
... NodeMethods m -> BlockId -> Address -> m (Maybe PublicKey)
forall (m :: * -> *).
NodeMethods m -> BlockId -> Address -> 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 :: 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 :: 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
fromBS :: ConvertUtf8 Text bs => bs -> Text
fromBS :: bs -> Text
fromBS = bs -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
ppRequestBody :: RequestBody -> Builder
ppRequestBody :: RequestBody -> Builder
ppRequestBody = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder)
-> (RequestBody -> Text) -> RequestBody -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
\case
RequestBodyLBS LByteString
lbs -> LByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS LByteString
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 -> Builder
ppRequest :: Request -> Builder
ppRequest Request {Maybe (RequestBody, MediaType)
ByteString
Builder
Seq QueryItem
Seq Header
Seq MediaType
HttpVersion
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
requestMethod :: ByteString
requestHttpVersion :: HttpVersion
requestHeaders :: Seq Header
requestAccept :: Seq MediaType
requestBody :: Maybe (RequestBody, MediaType)
requestQueryString :: Seq QueryItem
requestPath :: Builder
..} =
ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS ByteString
requestMethod Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| LByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS (Builder -> LByteString
Binary.toLazyByteString Builder
requestPath)
Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> 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 -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
Builder
-> ((RequestBody, MediaType) -> Builder)
-> Maybe (RequestBody, MediaType)
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
"\n" (Builder -> Builder)
-> ((RequestBody, MediaType) -> Builder)
-> (RequestBody, MediaType)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestBody -> Builder
ppRequestBody (RequestBody -> Builder)
-> ((RequestBody, MediaType) -> RequestBody)
-> (RequestBody, MediaType)
-> Builder
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 :: 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
$ Builder
"RPC request: " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Request -> Builder
ppRequest Request
req Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
ppResponse :: Response -> Builder
ppResponse :: Response -> Builder
ppResponse Response {LByteString
Seq Header
HttpVersion
Status
responseHttpVersion :: forall a. ResponseF a -> HttpVersion
responseHeaders :: forall a. ResponseF a -> Seq Header
responseBody :: LByteString
responseHttpVersion :: HttpVersion
responseHeaders :: Seq Header
responseStatusCode :: Status
responseBody :: forall a. ResponseF a -> a
responseStatusCode :: forall a. ResponseF a -> Status
..} =
Status -> Int
statusCode Status
responseStatusCode Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
ByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS (Status -> ByteString
statusMessage Status
responseStatusCode) Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
LByteString -> Text
forall bs. ConvertUtf8 Text bs => bs -> Text
fromBS LByteString
responseBody Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
logResponse :: WithClientLog env m => Response -> m ()
logResponse :: 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
$ Builder
"RPC response: " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Response -> Builder
ppResponse Response
resp Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
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
showList :: [TimeoutError] -> ShowS
$cshowList :: [TimeoutError] -> ShowS
show :: TimeoutError -> String
$cshow :: TimeoutError -> String
showsPrec :: Int -> TimeoutError -> ShowS
$cshowsPrec :: Int -> TimeoutError -> ShowS
Show
instance Buildable TimeoutError where
build :: TimeoutError -> Builder
build TimeoutError
TimeoutError =
Builder
"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, FromBuilder b) => a -> b
pretty
retryOnTimeout :: (MonadUnliftIO m, MonadThrow m) => Bool -> m a -> m a
retryOnTimeout :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
res
failOnTimeout :: (MonadUnliftIO m, MonadThrow m) => m a -> m a
failOnTimeout :: 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 :: 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 :: m ()
waitBeforeRetry = do
Int
i <- IO Int -> m Int
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. [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 t. Container t => t -> Int
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
TezosNat
TezosMutez
ppCostPerByte :: ProtocolParameters -> TezosMutez
ppMinimalBlockDelay :: ProtocolParameters -> TezosNat
ppHardStorageLimitPerOperation :: ProtocolParameters -> TezosInt64
ppHardGasLimitPerOperation :: ProtocolParameters -> TezosInt64
ppOriginationSize :: ProtocolParameters -> Int
ppCostPerByte :: TezosMutez
ppMinimalBlockDelay :: TezosNat
ppHardStorageLimitPerOperation :: TezosInt64
ppHardGasLimitPerOperation :: TezosInt64
ppOriginationSize :: Int
..} <- m ProtocolParameters
forall (m :: * -> *). HasTezosRpc m => m ProtocolParameters
getProtocolParameters
IO () -> m ()
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
* TezosNat -> Int
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @TezosNat @Int TezosNat
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 :: 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