packages feed

morley-client-0.2.1: src/Morley/Client/Full.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Implementation of full-featured Morley client.

module Morley.Client.Full
  ( MorleyClientEnv
  , MorleyClientM
  , runMorleyClientM
  ) where

import Colog (HasLog(..), Message)
import Network.HTTP.Types (Status(..))
import Servant.Client.Core (Request, Response, RunClient(..))
import UnliftIO (MonadUnliftIO)

import Morley.Client.App
import Morley.Client.Env (MorleyClientEnv'(..))
import Morley.Client.RPC.Class
import Morley.Client.TezosClient.Class
import Morley.Client.TezosClient.Impl qualified as TezosClient
import Morley.Tezos.Crypto (Signature(..))
import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519

type MorleyClientEnv = MorleyClientEnv' MorleyClientM

newtype MorleyClientM a = MorleyClientM
  { unMorleyClientM :: ReaderT MorleyClientEnv IO a }
  deriving newtype
    ( Functor, Applicative, Monad, MonadReader MorleyClientEnv
    , MonadIO, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO
    )

-- | Run 'MorleyClientM' action within given t'MorleyClientEnv'. Retry action
-- in case of invalid counter error.
runMorleyClientM :: MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM env client = runReaderT (unMorleyClientM client) env

instance HasLog MorleyClientEnv Message MorleyClientM where
  getLogAction = mceLogAction
  setLogAction action mce = mce { mceLogAction = action }

instance HasTezosClient MorleyClientM where
  signBytes senderAlias mbPassword opHash = retryOnceOnTimeout $ do
    env <- ask
    case mceSecretKey env of
      Just sk -> pure . SignatureEd25519 $ Ed25519.sign sk opHash
      Nothing -> TezosClient.signBytes senderAlias mbPassword opHash
  rememberContract = failOnTimeout ... TezosClient.rememberContract
  resolveAddressMaybe = retryOnceOnTimeout ... TezosClient.resolveAddressMaybe
  getAlias = retryOnceOnTimeout ... TezosClient.getAlias
  genFreshKey = retryOnceOnTimeout ... TezosClient.genFreshKey
  genKey = failOnTimeout ... TezosClient.genKey
  -- Key revealing cannot be safely retried, so we're not trying to recover it
  -- from @ECONNRESET@.
  revealKey = failOnTimeout ... TezosClient.revealKey
  registerDelegate = failOnTimeout ... TezosClient.registerDelegate
  getKeyPassword = retryOnceOnTimeout . TezosClient.getKeyPassword

instance RunClient MorleyClientM where
  runRequestAcceptStatus :: Maybe [Status] -> Request -> MorleyClientM Response
  runRequestAcceptStatus statuses req = do
    env <- mceClientEnv <$> ask
    runRequestAcceptStatusImpl env statuses req
  throwClientError = throwClientErrorImpl

instance HasTezosRpc MorleyClientM where
  getBlockHash = getBlockHashImpl
  getCounterAtBlock = getCounterImpl
  getBlockHeader = getBlockHeaderImpl
  getBlockConstants = getBlockConstantsImpl
  getBlockOperations = getBlockOperationsImpl
  getScriptSizeAtBlock = getScriptSizeAtBlockImpl
  getBlockOperationHashes = getBlockOperationHashesImpl
  getProtocolParametersAtBlock = getProtocolParametersImpl
  runOperationAtBlock = runOperationImpl
  preApplyOperationsAtBlock = preApplyOperationsImpl
  forgeOperationAtBlock = forgeOperationImpl
  injectOperation = injectOperationImpl
  getContractScriptAtBlock = getContractScriptImpl
  getContractStorageAtBlock = getContractStorageAtBlockImpl
  getContractBigMapAtBlock = getContractBigMapImpl
  getBigMapValueAtBlock = getBigMapValueAtBlockImpl
  getBigMapValuesAtBlock = getBigMapValuesAtBlockImpl
  getBalanceAtBlock = getBalanceImpl
  getDelegateAtBlock = getDelegateImpl
  runCodeAtBlock = runCodeImpl
  getChainId = getChainIdImpl
  getManagerKeyAtBlock = getManagerKeyImpl
  waitForOperation = (asks mceClientEnv >>=) . waitForOperationImpl