Batched.hs

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

-- | Primitives for running batched operations with a neat interface.
module Morley.Client.Action.Batched
  ( OperationsBatch (..)
  , originateContractM
  , runTransactionM
  , revealKeyM
  , delegateM
  , runOperationsBatch
  ) where

import Control.Lens (Prism')
import Fmt (Buildable(..))

import Morley.Client.Action.Common
import Morley.Client.Action.Operation
import Morley.Client.Logging
import Morley.Client.RPC.Class
import Morley.Client.RPC.Types
import Morley.Client.TezosClient
import Morley.Client.Types
import Morley.Tezos.Address
import Morley.Util.Batching

{- | Where the batched operations occur.

Example:

@
runOperationsBatch mySender $ do
  addr <- originateContractM ...
  runTransactionM ...
  return addr
@

Note that this is not a 'Monad', rather an 'Applicative' - use
@-XApplicativeDo@ extension for nicer experience.
-}
newtype OperationsBatch a = OperationsBatch
  { unOperationsBatch
      :: BatchingM
          (OperationInfo ClientInput)
          (OperationInfo Result)
          BatchedOperationError
          a
  } deriving newtype (Functor, Applicative)

data BatchedOperationError
  = UnexpectedOperationResult

instance Buildable BatchedOperationError where
  build = \case
    UnexpectedOperationResult ->
      "Got unexpected operation type within result of batched operation"

-- | A helper to run some operation.
--
-- It accepts
runOperationM
  :: (inp -> OperationInfo ClientInput)
  -> (Prism' (OperationInfo Result) out)
  -> inp
  -> OperationsBatch out
runOperationM wrapInp unwrapOut inp = OperationsBatch $
  wrapInp inp `submitThenParse`
    maybeToRight UnexpectedOperationResult . (^? unwrapOut)

-- | Perform transaction within a batch.
runTransactionM :: TransactionData -> OperationsBatch [WithSource EventOperation]
runTransactionM = runOperationM OpTransfer _OpTransfer

-- | Perform origination within a batch.
originateContractM :: OriginationData -> OperationsBatch ContractAddress
originateContractM = runOperationM OpOriginate _OpOriginate

-- | Perform key revealing within a batch.
revealKeyM :: RevealData -> OperationsBatch ()
revealKeyM = runOperationM OpReveal _OpReveal

-- | Perform delegation within a batch.
delegateM :: DelegationData -> OperationsBatch ()
delegateM = runOperationM OpDelegation _OpDelegation

-- | Execute a batch.
runOperationsBatch
  :: ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => ImplicitAddressWithAlias
  -> OperationsBatch a
  -> m (Maybe OperationHash, a)
runOperationsBatch sender (OperationsBatch batch) =
  unsafeRunBatching (runOperations sender) batch