Full.hs

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

-- | Implementation of full-featured Morley client.

module Morley.Client.Full
  ( MorleyClientEnv(..)
  , MorleyClientConfig (..)
  , MorleyClientM
  , runMorleyClientM
  , mkMorleyClientEnv
  , mkLogAction
  -- * Lens
  , mceTezosClientL
  , mceLogActionL
  , mceSecretKeyL
  , mceClientEnvL
  , mccEndpointUrlL
  , mccTezosClientPathL
  , mccMbTezosClientDataDirL
  , mccVerbosityL
  , mccSecretKeyL
  ) where

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

import Morley.Client.App
import Morley.Client.Init
import Morley.Client.Logging (ClientLogAction)
import Morley.Client.RPC.Class
import Morley.Client.RPC.HttpClient
import Morley.Client.TezosClient.Class
import Morley.Client.TezosClient.Impl (getTezosClientConfig)
import Morley.Client.TezosClient.Impl qualified as TezosClient
import Morley.Client.TezosClient.Types
import Morley.Client.Types
import Morley.Tezos.Crypto (Signature(..))
import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519
import Morley.Util.Lens (makeLensesWith, postfixLFields)


-- | Runtime environment for morley client.
data MorleyClientEnv = MorleyClientEnv
  { mceTezosClient :: TezosClientEnv
  -- ^ Environment for @octez-client@.
  , mceLogAction :: ClientLogAction MorleyClientM
  -- ^ Action used to log messages.
  , mceSecretKey :: Maybe Ed25519.SecretKey
  -- ^ Pass if you want to sign operations manually or leave it
  -- to @octez-client@.
  , mceClientEnv :: ClientEnv
  -- ^ Environment necessary to make HTTP calls.
  }

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

makeLensesWith postfixLFields ''MorleyClientEnv

instance HasTezosClientEnv MorleyClientEnv where
  tezosClientEnvL = mceTezosClientL

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

instance HasTezosClient MorleyClientM where
  signBytes (AddressWithAlias _ 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
  getAliasesAndAddresses = retryOnceOnTimeout ... TezosClient.getAliasesAndAddresses
  genKey alias = flip AddressWithAlias alias <$> TezosClient.genKey alias
  genFreshKey alias = flip AddressWithAlias alias <$> TezosClient.genFreshKey alias
  getKeyPassword (AddressWithAlias _ alias) = retryOnceOnTimeout $ TezosClient.getKeyPassword alias
  getPublicKey (AddressWithAlias _ alias) = TezosClient.getPublicKey alias

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
  getTicketBalanceAtBlock = getTicketBalanceAtBlockImpl
  getAllTicketBalancesAtBlock = getAllTicketBalancesAtBlockImpl


-- | Construct 'MorleyClientEnv'.
--
-- * @octez-client@ path is taken from 'MorleyClientConfig', but can be
-- overridden using @MORLEY_TEZOS_CLIENT@ environment variable.
-- * Node data is taken from @octez-client@ config and can be overridden
-- by 'MorleyClientConfig'.
-- * The rest is taken from 'MorleyClientConfig' as is.
mkMorleyClientEnv :: MorleyClientConfig -> IO MorleyClientEnv
mkMorleyClientEnv MorleyClientConfig{..} = do
  envTezosClientPath <- lookupEnv "MORLEY_TEZOS_CLIENT"
  let tezosClientPath = fromMaybe mccTezosClientPath envTezosClientPath
  TezosClientConfig {..} <- getTezosClientConfig tezosClientPath mccMbTezosClientDataDir
  let
    endpointUrl = fromMaybe tcEndpointUrl mccEndpointUrl
    tezosClientEnv = TezosClientEnv
      { tceEndpointUrl = endpointUrl
      , tceTezosClientPath = tezosClientPath
      , tceMbTezosClientDataDir = mccMbTezosClientDataDir
      }

  clientEnv <- newClientEnv endpointUrl
  pure MorleyClientEnv
    { mceTezosClient = tezosClientEnv
    , mceLogAction = mkLogAction mccVerbosity
    , mceSecretKey = mccSecretKey
    , mceClientEnv = clientEnv
    }