Full.hs

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

{-# 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 qualified as TezosClient
import Morley.Client.TezosClient.Types
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
  importKey = failOnTimeout ... TezosClient.importKey
  resolveAddressMaybe = retryOnceOnTimeout ... TezosClient.resolveAddressMaybe
  getAlias = retryOnceOnTimeout ... TezosClient.getAlias
  getPublicKey = retryOnceOnTimeout ... TezosClient.getPublicKey
  getSecretKey = retryOnceOnTimeout ... TezosClient.getSecretKey
  -- 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
  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