Full.hs

-- SPDX-FileCopyrightText: 2021 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# LANGUAGE InstanceSigs #-}

-- | 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 (TezosClientError(..))
import qualified Morley.Client.TezosClient.Impl as TezosClient
import Morley.Client.TezosClient.Types
import Morley.Tezos.Crypto (Signature(..))
import qualified Morley.Tezos.Crypto.Ed25519 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 (retryInvalidCounter 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
  waitForOperation = retryOnceOnTimeout ... TezosClient.waitForOperationInclusion
  rememberContract = failOnTimeout ... TezosClient.rememberContract
  importKey = failOnTimeout ... TezosClient.importKey
  resolveAddressMaybe = retryOnceOnTimeout ... TezosClient.resolveAddressMaybe
  getAlias = retryOnceOnTimeout ... TezosClient.getAlias
  getPublicKey = retryOnceOnTimeout ... TezosClient.getPublicKey
  -- This function doesn't perform any chain related operations with tezos-client,
  -- so @ECONNRESET@ cannot appear here
  getTezosClientConfig = do
    path <- tceTezosClientPath <$> view tezosClientEnvL
    mbDataDir <- tceMbTezosClientDataDir <$> view tezosClientEnvL
    liftIO $ TezosClient.getTezosClientConfig path mbDataDir
  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
  calcTransferFee = retryOnceOnTimeout ... TezosClient.calcTransferFee
  calcOriginationFee = retryOnceOnTimeout ... TezosClient.calcOriginationFee
  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
  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

-- | Helper function that retries 'MorleyClientM' action in case of counter error.
retryInvalidCounter :: forall a. MorleyClientM a -> MorleyClientM a
retryInvalidCounter action = do
  action `catch` handleInvalidCounterRpc retryAction
         `catch` handleTezosClientError
  where
    handleTezosClientError :: TezosClientError -> MorleyClientM a
    handleTezosClientError = \case
      CounterIsAlreadyUsed _ _ -> retryAction
      anotherErr -> throwM anotherErr

    retryAction = waitBeforeRetry >> retryInvalidCounter action