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

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

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.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
  { OperationsBatch a
-> BatchingM
     (Either TransactionData OriginationData)
     (Either () Address)
     BatchedOperationError
     a
unOperationsBatch
      :: BatchingM
          (Either TransactionData OriginationData)
          (Either () Address)
          BatchedOperationError
          a
  } deriving newtype (a -> OperationsBatch b -> OperationsBatch a
(a -> b) -> OperationsBatch a -> OperationsBatch b
(forall a b. (a -> b) -> OperationsBatch a -> OperationsBatch b)
-> (forall a b. a -> OperationsBatch b -> OperationsBatch a)
-> Functor OperationsBatch
forall a b. a -> OperationsBatch b -> OperationsBatch a
forall a b. (a -> b) -> OperationsBatch a -> OperationsBatch b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OperationsBatch b -> OperationsBatch a
$c<$ :: forall a b. a -> OperationsBatch b -> OperationsBatch a
fmap :: (a -> b) -> OperationsBatch a -> OperationsBatch b
$cfmap :: forall a b. (a -> b) -> OperationsBatch a -> OperationsBatch b
Functor, Functor OperationsBatch
a -> OperationsBatch a
Functor OperationsBatch
-> (forall a. a -> OperationsBatch a)
-> (forall a b.
    OperationsBatch (a -> b) -> OperationsBatch a -> OperationsBatch b)
-> (forall a b c.
    (a -> b -> c)
    -> OperationsBatch a -> OperationsBatch b -> OperationsBatch c)
-> (forall a b.
    OperationsBatch a -> OperationsBatch b -> OperationsBatch b)
-> (forall a b.
    OperationsBatch a -> OperationsBatch b -> OperationsBatch a)
-> Applicative OperationsBatch
OperationsBatch a -> OperationsBatch b -> OperationsBatch b
OperationsBatch a -> OperationsBatch b -> OperationsBatch a
OperationsBatch (a -> b) -> OperationsBatch a -> OperationsBatch b
(a -> b -> c)
-> OperationsBatch a -> OperationsBatch b -> OperationsBatch c
forall a. a -> OperationsBatch a
forall a b.
OperationsBatch a -> OperationsBatch b -> OperationsBatch a
forall a b.
OperationsBatch a -> OperationsBatch b -> OperationsBatch b
forall a b.
OperationsBatch (a -> b) -> OperationsBatch a -> OperationsBatch b
forall a b c.
(a -> b -> c)
-> OperationsBatch a -> OperationsBatch b -> OperationsBatch c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: OperationsBatch a -> OperationsBatch b -> OperationsBatch a
$c<* :: forall a b.
OperationsBatch a -> OperationsBatch b -> OperationsBatch a
*> :: OperationsBatch a -> OperationsBatch b -> OperationsBatch b
$c*> :: forall a b.
OperationsBatch a -> OperationsBatch b -> OperationsBatch b
liftA2 :: (a -> b -> c)
-> OperationsBatch a -> OperationsBatch b -> OperationsBatch c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> OperationsBatch a -> OperationsBatch b -> OperationsBatch c
<*> :: OperationsBatch (a -> b) -> OperationsBatch a -> OperationsBatch b
$c<*> :: forall a b.
OperationsBatch (a -> b) -> OperationsBatch a -> OperationsBatch b
pure :: a -> OperationsBatch a
$cpure :: forall a. a -> OperationsBatch a
$cp1Applicative :: Functor OperationsBatch
Applicative)

data BatchedOperationError
  = UnexpectedOperationResult

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

-- | Perform transaction within a batch.
runTransactionM :: TransactionData -> OperationsBatch ()
runTransactionM :: TransactionData -> OperationsBatch ()
runTransactionM TransactionData
td = BatchingM
  (Either TransactionData OriginationData)
  (Either () Address)
  BatchedOperationError
  ()
-> OperationsBatch ()
forall a.
BatchingM
  (Either TransactionData OriginationData)
  (Either () Address)
  BatchedOperationError
  a
-> OperationsBatch a
OperationsBatch (BatchingM
   (Either TransactionData OriginationData)
   (Either () Address)
   BatchedOperationError
   ()
 -> OperationsBatch ())
-> BatchingM
     (Either TransactionData OriginationData)
     (Either () Address)
     BatchedOperationError
     ()
-> OperationsBatch ()
forall a b. (a -> b) -> a -> b
$
  TransactionData -> Either TransactionData OriginationData
forall a b. a -> Either a b
Left TransactionData
td Either TransactionData OriginationData
-> (Either () Address -> Either BatchedOperationError ())
-> BatchingM
     (Either TransactionData OriginationData)
     (Either () Address)
     BatchedOperationError
     ()
forall i o e a. i -> (o -> Either e a) -> BatchingM i o e a
`submitThenParse` \case
    Left () -> Either BatchedOperationError ()
forall (f :: * -> *). Applicative f => f ()
pass
    Right Address
_ -> BatchedOperationError -> Either BatchedOperationError ()
forall a b. a -> Either a b
Left BatchedOperationError
UnexpectedOperationResult

-- | Perform origination within a batch.
originateContractM :: OriginationData -> OperationsBatch Address
originateContractM :: OriginationData -> OperationsBatch Address
originateContractM OriginationData
od = BatchingM
  (Either TransactionData OriginationData)
  (Either () Address)
  BatchedOperationError
  Address
-> OperationsBatch Address
forall a.
BatchingM
  (Either TransactionData OriginationData)
  (Either () Address)
  BatchedOperationError
  a
-> OperationsBatch a
OperationsBatch (BatchingM
   (Either TransactionData OriginationData)
   (Either () Address)
   BatchedOperationError
   Address
 -> OperationsBatch Address)
-> BatchingM
     (Either TransactionData OriginationData)
     (Either () Address)
     BatchedOperationError
     Address
-> OperationsBatch Address
forall a b. (a -> b) -> a -> b
$
  OriginationData -> Either TransactionData OriginationData
forall a b. b -> Either a b
Right OriginationData
od Either TransactionData OriginationData
-> (Either () Address -> Either BatchedOperationError Address)
-> BatchingM
     (Either TransactionData OriginationData)
     (Either () Address)
     BatchedOperationError
     Address
forall i o e a. i -> (o -> Either e a) -> BatchingM i o e a
`submitThenParse` \case
    Left ()
_ -> BatchedOperationError -> Either BatchedOperationError Address
forall a b. a -> Either a b
Left BatchedOperationError
UnexpectedOperationResult
    Right Address
addr -> Address -> Either BatchedOperationError Address
forall (m :: * -> *) a. Monad m => a -> m a
return Address
addr

-- | Execute a batch.
runOperationsBatch
  :: ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => AddressOrAlias
  -> OperationsBatch a
  -> m (Maybe OperationHash, a)
runOperationsBatch :: AddressOrAlias -> OperationsBatch a -> m (Maybe OperationHash, a)
runOperationsBatch AddressOrAlias
sender (OperationsBatch BatchingM
  (Either TransactionData OriginationData)
  (Either () Address)
  BatchedOperationError
  a
batch) =
  ([Either TransactionData OriginationData]
 -> m (Maybe OperationHash, [Either () Address]))
-> BatchingM
     (Either TransactionData OriginationData)
     (Either () Address)
     BatchedOperationError
     a
-> m (Maybe OperationHash, a)
forall (m :: * -> *) e i r o a.
(Functor m, Buildable e) =>
([i] -> m (r, [o])) -> BatchingM i o e a -> m (r, a)
unsafeRunBatching (AddressOrAlias
-> [Either TransactionData OriginationData]
-> m (Maybe OperationHash, [Either () Address])
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
AddressOrAlias
-> [Either TransactionData OriginationData]
-> m (Maybe OperationHash, [Either () Address])
runOperations AddressOrAlias
sender) BatchingM
  (Either TransactionData OriginationData)
  (Either () Address)
  BatchedOperationError
  a
batch