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

-- | Implementation of generic operations submission.
module Morley.Client.Action.Operation
  ( Result
  , runOperations
  , runOperationsNonEmpty
  -- helpers
  , dryRunOperationsNonEmpty
  ) where

import Control.Lens (has, (%=), (&~))
import Data.List (zipWith4)
import Data.List.NonEmpty qualified as NE
import Data.Singletons (Sing, SingI, sing)
import Data.Text qualified as T
import Fmt (blockListF, blockListF', listF, nameF, pretty, (+|), (|+))

import Morley.Client.Action.Common
import Morley.Client.Logging
import Morley.Client.RPC.Class
import Morley.Client.RPC.Error
import Morley.Client.RPC.Getters
import Morley.Client.RPC.Types
import Morley.Client.TezosClient
import Morley.Client.Types
import Morley.Micheline (StringEncode(..), TezosInt64, TezosMutez(..))
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias (AddressOrAlias(..))
import Morley.Tezos.Core
import Morley.Tezos.Crypto
import Morley.Util.ByteString

-- | Designates output of an operation.
data Result
instance OperationInfoDescriptor Result where
  type TransferInfo Result = ()
  type OriginationInfo Result = Address
  type RevealInfo Result = ()

logOperations
  :: forall (runMode :: RunMode) env m.
     ( WithClientLog env m
     , HasTezosClient m
     , SingI runMode -- We don't ask aliases with 'tezos-client' in 'DryRun' mode
     )
  => AddressOrAlias
  -> NonEmpty (OperationInfo ClientInput)
  -> m ()
logOperations :: forall (runMode :: RunMode) env (m :: * -> *).
(WithClientLog env m, HasTezosClient m, SingI runMode) =>
AddressOrAlias -> NonEmpty (OperationInfo ClientInput) -> m ()
logOperations AddressOrAlias
sender NonEmpty (OperationInfo ClientInput)
ops = do
  let runMode :: Sing runMode
runMode = forall {k} (a :: k). SingI a => Sing a
forall (a :: RunMode). SingI a => Sing a
sing @runMode

      opName :: Builder
opName =
        if | (Element (NonEmpty (OperationInfo ClientInput)) -> Bool)
-> NonEmpty (OperationInfo ClientInput) -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
all (Getting Any (OperationInfo ClientInput) TransactionData
-> OperationInfo ClientInput -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any (OperationInfo ClientInput) TransactionData
forall i. Prism' (OperationInfo i) (TransferInfo i)
_OpTransfer) NonEmpty (OperationInfo ClientInput)
ops -> Builder
"transactions"
           | (Element (NonEmpty (OperationInfo ClientInput)) -> Bool)
-> NonEmpty (OperationInfo ClientInput) -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
all (Getting Any (OperationInfo ClientInput) OriginationData
-> OperationInfo ClientInput -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any (OperationInfo ClientInput) OriginationData
forall i. Prism' (OperationInfo i) (OriginationInfo i)
_OpOriginate) NonEmpty (OperationInfo ClientInput)
ops -> Builder
"originations"
           | (Element (NonEmpty (OperationInfo ClientInput)) -> Bool)
-> NonEmpty (OperationInfo ClientInput) -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
all (Getting Any (OperationInfo ClientInput) RevealData
-> OperationInfo ClientInput -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any (OperationInfo ClientInput) RevealData
forall i. Prism' (OperationInfo i) (RevealInfo i)
_OpReveal) NonEmpty (OperationInfo ClientInput)
ops -> Builder
"reveals"
           | Bool
otherwise -> Builder
"operations"

      buildOp :: (OperationInfo ClientInput, Maybe Alias) -> Builder
buildOp = \case
        (OpTransfer TransferInfo ClientInput
tx, Maybe Alias
mbAlias) ->
          Maybe Alias -> TransactionData -> Builder
buildTxDataWithAlias Maybe Alias
mbAlias TransferInfo ClientInput
TransactionData
tx
        (OpOriginate OriginationInfo ClientInput
orig, Maybe Alias
_) ->
          OriginationData -> Alias
odName OriginationInfo ClientInput
OriginationData
orig Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" (temporary alias)"
        (OpReveal RevealInfo ClientInput
rv, Maybe Alias
mbAlias) ->
          Builder
"Key " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| RevealData -> PublicKey
rdPublicKey RevealInfo ClientInput
RevealData
rv PublicKey -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder -> (Alias -> Builder) -> Maybe Alias -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (\Alias
a -> Builder
" (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias
a Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")") Maybe Alias
mbAlias

  AddressOrAlias
sender' <- case AddressOrAlias
sender of
    addr :: AddressOrAlias
addr@AddressResolved{} -> case Sing runMode
runMode of
      Sing runMode
SingRunResult runMode
SRealRun -> Alias -> AddressOrAlias
AddressAlias (Alias -> AddressOrAlias) -> m Alias -> m AddressOrAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressOrAlias -> m Alias
forall (m :: * -> *). HasTezosClient m => AddressOrAlias -> m Alias
getAlias AddressOrAlias
sender
      Sing runMode
SingRunResult runMode
SDryRun  -> AddressOrAlias -> m AddressOrAlias
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddressOrAlias
addr
    AddressOrAlias
alias -> AddressOrAlias -> m AddressOrAlias
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddressOrAlias
alias

  NonEmpty (Maybe Alias)
aliases <- case Sing runMode
runMode of
    Sing runMode
SingRunResult runMode
SRealRun ->
      NonEmpty (OperationInfo ClientInput)
-> (OperationInfo ClientInput -> m (Maybe Alias))
-> m (NonEmpty (Maybe Alias))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (OperationInfo ClientInput)
ops ((OperationInfo ClientInput -> m (Maybe Alias))
 -> m (NonEmpty (Maybe Alias)))
-> (OperationInfo ClientInput -> m (Maybe Alias))
-> m (NonEmpty (Maybe Alias))
forall a b. (a -> b) -> a -> b
$ \case
        OpTransfer (TransactionData TD (Value t)
tx) ->
          Alias -> Maybe Alias
forall a. a -> Maybe a
Just (Alias -> Maybe Alias) -> m Alias -> m (Maybe Alias)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AddressOrAlias -> m Alias
forall (m :: * -> *). HasTezosClient m => AddressOrAlias -> m Alias
getAlias (AddressOrAlias -> m Alias)
-> (Address -> AddressOrAlias) -> Address -> m Alias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> AddressOrAlias
AddressResolved (Address -> m Alias) -> Address -> m Alias
forall a b. (a -> b) -> a -> b
$ TD (Value t) -> Address
forall t. TD t -> Address
tdReceiver TD (Value t)
tx)
        OpOriginate OriginationInfo ClientInput
_ ->
          Maybe Alias -> m (Maybe Alias)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Alias
forall a. Maybe a
Nothing
        OpReveal RevealInfo ClientInput
r ->
          Alias -> Maybe Alias
forall a. a -> Maybe a
Just (Alias -> Maybe Alias) -> m Alias -> m (Maybe Alias)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AddressOrAlias -> m Alias
forall (m :: * -> *). HasTezosClient m => AddressOrAlias -> m Alias
getAlias (AddressOrAlias -> m Alias)
-> (PublicKey -> AddressOrAlias) -> PublicKey -> m Alias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> AddressOrAlias
AddressResolved (Address -> AddressOrAlias)
-> (PublicKey -> Address) -> PublicKey -> AddressOrAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Address
mkKeyAddress (PublicKey -> m Alias) -> PublicKey -> m Alias
forall a b. (a -> b) -> a -> b
$ RevealData -> PublicKey
rdPublicKey RevealInfo ClientInput
RevealData
r)
    Sing runMode
SingRunResult runMode
SDryRun -> NonEmpty (Maybe Alias) -> m (NonEmpty (Maybe Alias))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (Maybe Alias) -> m (NonEmpty (Maybe Alias)))
-> NonEmpty (Maybe Alias) -> m (NonEmpty (Maybe Alias))
forall a b. (a -> b) -> a -> b
$ NonEmpty (OperationInfo ClientInput)
ops NonEmpty (OperationInfo ClientInput)
-> Maybe Alias -> NonEmpty (Maybe Alias)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Alias
forall a. Maybe a
Nothing

  Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ -- strip trailing newline
    Builder
"Running " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
opName Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
" by " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressOrAlias
sender' AddressOrAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
":\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
    Text
-> ((OperationInfo ClientInput, Maybe Alias) -> Builder)
-> NonEmpty (OperationInfo ClientInput, Maybe Alias)
-> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"-" (OperationInfo ClientInput, Maybe Alias) -> Builder
buildOp (NonEmpty (OperationInfo ClientInput)
ops NonEmpty (OperationInfo ClientInput)
-> NonEmpty (Maybe Alias)
-> NonEmpty (OperationInfo ClientInput, Maybe Alias)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
`NE.zip` NonEmpty (Maybe Alias)
aliases)

-- | Perform sequence of operations.
--
-- Returns operation hash (or @Nothing@ in case empty list was provided) and result of
-- each operation (nothing for transactions and an address for originated contracts
runOperations
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => AddressOrAlias
  -> [OperationInfo ClientInput]
  -> m (Maybe OperationHash, [OperationInfo Result])
runOperations :: forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
AddressOrAlias
-> [OperationInfo ClientInput]
-> m (Maybe OperationHash, [OperationInfo Result])
runOperations AddressOrAlias
sender [OperationInfo ClientInput]
operations = case [OperationInfo ClientInput]
operations of
  [] -> (Maybe OperationHash, [OperationInfo Result])
-> m (Maybe OperationHash, [OperationInfo Result])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe OperationHash
forall a. Maybe a
Nothing, [])
  OperationInfo ClientInput
op : [OperationInfo ClientInput]
ops -> do
    (OperationHash
opHash, NonEmpty (OperationInfo Result)
res) <- AddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (OperationHash, NonEmpty (OperationInfo Result))
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
AddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (OperationHash, NonEmpty (OperationInfo Result))
runOperationsNonEmpty AddressOrAlias
sender (NonEmpty (OperationInfo ClientInput)
 -> m (OperationHash, NonEmpty (OperationInfo Result)))
-> NonEmpty (OperationInfo ClientInput)
-> m (OperationHash, NonEmpty (OperationInfo Result))
forall a b. (a -> b) -> a -> b
$ OperationInfo ClientInput
op OperationInfo ClientInput
-> [OperationInfo ClientInput]
-> NonEmpty (OperationInfo ClientInput)
forall a. a -> [a] -> NonEmpty a
:| [OperationInfo ClientInput]
ops
    (Maybe OperationHash, [OperationInfo Result])
-> m (Maybe OperationHash, [OperationInfo Result])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe OperationHash, [OperationInfo Result])
 -> m (Maybe OperationHash, [OperationInfo Result]))
-> (Maybe OperationHash, [OperationInfo Result])
-> m (Maybe OperationHash, [OperationInfo Result])
forall a b. (a -> b) -> a -> b
$ (OperationHash -> Maybe OperationHash
forall a. a -> Maybe a
Just OperationHash
opHash, NonEmpty (OperationInfo Result)
-> [Element (NonEmpty (OperationInfo Result))]
forall t. Container t => t -> [Element t]
toList NonEmpty (OperationInfo Result)
res)

-- | How many times to retry if an operation fails after injection
injectionRetryCount :: Natural
injectionRetryCount :: Natural
injectionRetryCount = Natural
2

-- | Perform non-empty sequence of operations.
--
-- Returns operation hash and result of each operation
-- (nothing for transactions and an address for originated contracts).
runOperationsNonEmpty
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => AddressOrAlias
  -> NonEmpty (OperationInfo ClientInput)
  -> m (OperationHash, NonEmpty (OperationInfo Result))
runOperationsNonEmpty :: forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
AddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (OperationHash, NonEmpty (OperationInfo Result))
runOperationsNonEmpty AddressOrAlias
sender NonEmpty (OperationInfo ClientInput)
operations =
  forall (runMode :: RunMode) (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
 SingI runMode) =>
Natural
-> AddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (RunResult runMode)
runOperationsNonEmptyHelper @'RealRun Natural
injectionRetryCount AddressOrAlias
sender NonEmpty (OperationInfo ClientInput)
operations

-- | Flag that is used to determine @runOperationsNonEmptyHelper@ behaviour.
data RunMode = DryRun | RealRun

isRealRun :: forall (runMode :: RunMode). (SingI runMode) => Bool
isRealRun :: forall (runMode :: RunMode). SingI runMode => Bool
isRealRun = case forall {k} (a :: k). SingI a => Sing a
forall (a :: RunMode). SingI a => Sing a
sing @runMode of
  Sing runMode
SingRunResult runMode
SRealRun -> Bool
True
  Sing runMode
SingRunResult runMode
SDryRun  -> Bool
False

-- | Type family which is used to determine the output type of the
-- @runOperationsNonEmptyHelper@.
type family RunResult (a :: RunMode) where
  RunResult 'DryRun = NonEmpty (AppliedResult, TezosMutez)
  RunResult 'RealRun = (OperationHash, NonEmpty (OperationInfo Result))

data SingRunResult :: RunMode -> Type where
  SDryRun :: SingRunResult 'DryRun
  SRealRun :: SingRunResult 'RealRun

type instance Sing = SingRunResult

instance SingI 'DryRun where
  sing :: Sing 'DryRun
sing = Sing 'DryRun
SingRunResult 'DryRun
SDryRun

instance SingI 'RealRun where
  sing :: Sing 'RealRun
sing = Sing 'RealRun
SingRunResult 'RealRun
SRealRun

-- | Perform dry-run for sequence of operations.
--
-- Returned @AppliedResult@ contains information about estimated limits,
-- storage changes, etc. Additionally, estimated fees are returned.
dryRunOperationsNonEmpty
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => AddressOrAlias
  -> NonEmpty (OperationInfo ClientInput)
  -> m (NonEmpty (AppliedResult, TezosMutez))
dryRunOperationsNonEmpty :: forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
AddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (NonEmpty (AppliedResult, TezosMutez))
dryRunOperationsNonEmpty AddressOrAlias
sender NonEmpty (OperationInfo ClientInput)
operations =
  forall (runMode :: RunMode) (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
 SingI runMode) =>
Natural
-> AddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (RunResult runMode)
runOperationsNonEmptyHelper @'DryRun Natural
0 AddressOrAlias
sender NonEmpty (OperationInfo ClientInput)
operations

-- | Perform non-empty sequence of operations and either dry-run
-- and return estimated limits and fees or perform operation injection.
-- Behaviour is defined via @RunMode@ flag argument.
runOperationsNonEmptyHelper
  :: forall (runMode :: RunMode) m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     , SingI runMode
     )
  => Natural
  -> AddressOrAlias
  -> NonEmpty (OperationInfo ClientInput)
  -> m (RunResult runMode)
runOperationsNonEmptyHelper :: forall (runMode :: RunMode) (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
 SingI runMode) =>
Natural
-> AddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (RunResult runMode)
runOperationsNonEmptyHelper Natural
retryCount AddressOrAlias
sender NonEmpty (OperationInfo ClientInput)
operations = do
  forall (runMode :: RunMode) env (m :: * -> *).
(WithClientLog env m, HasTezosClient m, SingI runMode) =>
AddressOrAlias -> NonEmpty (OperationInfo ClientInput) -> m ()
logOperations @runMode AddressOrAlias
sender NonEmpty (OperationInfo ClientInput)
operations
  Address
senderAddress <- AddressOrAlias -> m Address
forall (m :: * -> *).
(MonadThrow m, HasTezosClient m) =>
AddressOrAlias -> m Address
resolveAddress AddressOrAlias
sender
  Address -> OperationInfo ClientInput -> m ()
prohibitContractSender Address
senderAddress (OperationInfo ClientInput -> m ())
-> OperationInfo ClientInput -> m ()
forall a b. (a -> b) -> a -> b
$ NonEmpty (OperationInfo ClientInput) -> OperationInfo ClientInput
forall a. NonEmpty a -> a
head NonEmpty (OperationInfo ClientInput)
operations
  Maybe ScrubbedBytes
mbPassword <- Address -> m (Maybe ScrubbedBytes)
forall (m :: * -> *).
HasTezosClient m =>
Address -> m (Maybe ScrubbedBytes)
getKeyPassword Address
senderAddress
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (runMode :: RunMode). SingI runMode => Bool
isRealRun @runMode Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& [OperationInfo ClientInput] -> Bool
forall i. [OperationInfo i] -> Bool
mayNeedSenderRevealing (NonEmpty (OperationInfo ClientInput)
-> [Element (NonEmpty (OperationInfo ClientInput))]
forall t. Container t => t -> [Element t]
toList NonEmpty (OperationInfo ClientInput)
operations)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Address -> Maybe ScrubbedBytes -> m ()
forall env (m :: * -> *).
(WithClientLog env m, HasTezosRpc m, HasTezosClient m) =>
Address -> Maybe ScrubbedBytes -> m ()
revealKeyUnlessRevealed Address
senderAddress Maybe ScrubbedBytes
mbPassword

  ProtocolParameters
pp <- m ProtocolParameters
forall (m :: * -> *). HasTezosRpc m => m ProtocolParameters
getProtocolParameters
  OperationConstants{TezosInt64
FeeConstants
BlockHash
BlockConstants
ocCounter :: OperationConstants -> TezosInt64
ocFeeConstants :: OperationConstants -> FeeConstants
ocBlockConstants :: OperationConstants -> BlockConstants
ocLastBlockHash :: OperationConstants -> BlockHash
ocCounter :: TezosInt64
ocFeeConstants :: FeeConstants
ocBlockConstants :: BlockConstants
ocLastBlockHash :: BlockHash
..} <- Address -> m OperationConstants
forall (m :: * -> *).
HasTezosRpc m =>
Address -> m OperationConstants
preProcessOperation Address
senderAddress

  let convertOps :: TezosInt64
-> OperationInfo ClientInput
-> WithCommonOperationData (OperationInfo RPCInput)
convertOps TezosInt64
i = CommonOperationData
-> OperationInfo RPCInput
-> WithCommonOperationData (OperationInfo RPCInput)
forall a. CommonOperationData -> a -> WithCommonOperationData a
WithCommonOperationData CommonOperationData
commonData (OperationInfo RPCInput
 -> WithCommonOperationData (OperationInfo RPCInput))
-> (OperationInfo ClientInput -> OperationInfo RPCInput)
-> OperationInfo ClientInput
-> WithCommonOperationData (OperationInfo RPCInput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        OpTransfer (TransactionData TD {Maybe Mutez
Address
Mutez
Value t
EpName
tdMbFee :: forall t. TD t -> Maybe Mutez
tdParam :: forall t. TD t -> t
tdEpName :: forall t. TD t -> EpName
tdAmount :: forall t. TD t -> Mutez
tdMbFee :: Maybe Mutez
tdParam :: Value t
tdEpName :: EpName
tdAmount :: Mutez
tdReceiver :: Address
tdReceiver :: forall t. TD t -> Address
..}) ->
          TransferInfo RPCInput -> OperationInfo RPCInput
forall i. TransferInfo i -> OperationInfo i
OpTransfer TransactionOperation :: TezosMutez -> Address -> ParametersInternal -> TransactionOperation
TransactionOperation
          { toDestination :: Address
toDestination = Address
tdReceiver
          , toAmount :: TezosMutez
toAmount = Mutez -> TezosMutez
TezosMutez Mutez
tdAmount
          , toParameters :: ParametersInternal
toParameters = EpName -> Value t -> ParametersInternal
forall (t :: T).
ParameterScope t =>
EpName -> Value t -> ParametersInternal
toParametersInternals EpName
tdEpName Value t
tdParam
          }
        OpOriginate OriginationData{Bool
Maybe Mutez
Mutez
Contract cp st
Value st
Alias
odMbFee :: OriginationData -> Maybe Mutez
odStorage :: ()
odContract :: ()
odBalance :: OriginationData -> Mutez
odReplaceExisting :: OriginationData -> Bool
odMbFee :: Maybe Mutez
odStorage :: Value st
odContract :: Contract cp st
odBalance :: Mutez
odName :: Alias
odReplaceExisting :: Bool
odName :: OriginationData -> Alias
..} ->
          OriginationInfo RPCInput -> OperationInfo RPCInput
forall i. OriginationInfo i -> OperationInfo i
OpOriginate OriginationOperation :: TezosMutez -> OriginationScript -> OriginationOperation
OriginationOperation
          { ooBalance :: TezosMutez
ooBalance = Mutez -> TezosMutez
TezosMutez Mutez
odBalance
          , ooScript :: OriginationScript
ooScript = Contract cp st -> Value st -> OriginationScript
forall (cp :: T) (st :: T).
Contract cp st -> Value st -> OriginationScript
mkOriginationScript Contract cp st
odContract Value st
odStorage
          }
        OpReveal RevealData{Maybe Mutez
PublicKey
rdMbFee :: RevealData -> Maybe Mutez
rdMbFee :: Maybe Mutez
rdPublicKey :: PublicKey
rdPublicKey :: RevealData -> PublicKey
..} ->
          RevealInfo RPCInput -> OperationInfo RPCInput
forall i. RevealInfo i -> OperationInfo i
OpReveal RevealOperation :: PublicKey -> RevealOperation
RevealOperation
          { roPublicKey :: PublicKey
roPublicKey = PublicKey
rdPublicKey
          }
        where
          commonData :: CommonOperationData
commonData = Address -> TezosInt64 -> ProtocolParameters -> CommonOperationData
mkCommonOperationData Address
senderAddress (TezosInt64
ocCounter TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
+ TezosInt64
i) ProtocolParameters
pp

  let opsToRun :: NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
opsToRun = (TezosInt64
 -> OperationInfo ClientInput
 -> WithCommonOperationData (OperationInfo RPCInput))
-> NonEmpty TezosInt64
-> NonEmpty (OperationInfo ClientInput)
-> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith TezosInt64
-> OperationInfo ClientInput
-> WithCommonOperationData (OperationInfo RPCInput)
convertOps (TezosInt64
1 TezosInt64 -> [TezosInt64] -> NonEmpty TezosInt64
forall a. a -> [a] -> NonEmpty a
:| [(TezosInt64
2 :: TezosInt64)..]) NonEmpty (OperationInfo ClientInput)
operations
      mbFees :: NonEmpty (Maybe Mutez)
mbFees = NonEmpty (OperationInfo ClientInput)
operations NonEmpty (OperationInfo ClientInput)
-> (OperationInfo ClientInput -> Maybe Mutez)
-> NonEmpty (Maybe Mutez)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        OpTransfer (TransactionData TD {Maybe Mutez
Address
Mutez
Value t
EpName
tdMbFee :: Maybe Mutez
tdParam :: Value t
tdEpName :: EpName
tdAmount :: Mutez
tdReceiver :: Address
tdMbFee :: forall t. TD t -> Maybe Mutez
tdParam :: forall t. TD t -> t
tdEpName :: forall t. TD t -> EpName
tdAmount :: forall t. TD t -> Mutez
tdReceiver :: forall t. TD t -> Address
..}) -> Maybe Mutez
tdMbFee
        OpOriginate OriginationData{Bool
Maybe Mutez
Mutez
Contract cp st
Value st
Alias
odMbFee :: Maybe Mutez
odStorage :: Value st
odContract :: Contract cp st
odBalance :: Mutez
odName :: Alias
odReplaceExisting :: Bool
odMbFee :: OriginationData -> Maybe Mutez
odStorage :: ()
odContract :: ()
odBalance :: OriginationData -> Mutez
odReplaceExisting :: OriginationData -> Bool
odName :: OriginationData -> Alias
..} -> Maybe Mutez
odMbFee
        OpReveal RevealData{Maybe Mutez
PublicKey
rdMbFee :: Maybe Mutez
rdPublicKey :: PublicKey
rdMbFee :: RevealData -> Maybe Mutez
rdPublicKey :: RevealData -> PublicKey
..} -> Maybe Mutez
rdMbFee

  -- Perform run_operation with dumb signature in order
  -- to estimate gas cost, storage size and paid storage diff
  let runOp :: RunOperation
runOp = RunOperation :: RunOperationInternal -> Text -> RunOperation
RunOperation
        { roOperation :: RunOperationInternal
roOperation = RunOperationInternal :: BlockHash
-> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> Signature
-> RunOperationInternal
RunOperationInternal
          { roiBranch :: BlockHash
roiBranch = BlockHash
ocLastBlockHash
          , roiContents :: NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
roiContents = NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
opsToRun
          , roiSignature :: Signature
roiSignature = Signature
stubSignature
          }
        , roChainId :: Text
roChainId = BlockConstants -> Text
bcChainId BlockConstants
ocBlockConstants
        }
  NonEmpty AppliedResult
results <- Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult)
forall (m :: * -> *).
HasTezosRpc m =>
Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult)
getAppliedResults (RunOperation -> Either RunOperation PreApplyOperation
forall a b. a -> Either a b
Left RunOperation
runOp)

  let -- Learn how to forge given operations
      forgeOp :: NonEmpty OperationInput -> m ByteString
      forgeOp :: NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> m ByteString
forgeOp NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
ops =
        (HexJSONByteString -> ByteString)
-> m HexJSONByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HexJSONByteString -> ByteString
unHexJSONByteString (m HexJSONByteString -> m ByteString)
-> (ForgeOperation -> m HexJSONByteString)
-> ForgeOperation
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForgeOperation -> m HexJSONByteString
forall (m :: * -> *).
HasTezosRpc m =>
ForgeOperation -> m HexJSONByteString
forgeOperation (ForgeOperation -> m ByteString) -> ForgeOperation -> m ByteString
forall a b. (a -> b) -> a -> b
$ ForgeOperation :: BlockHash
-> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> ForgeOperation
ForgeOperation
          { foBranch :: BlockHash
foBranch = BlockHash
ocLastBlockHash
          , foContents :: NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
foContents = NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
ops
          }

  let -- Attach a signature to forged operation + return the signature itself
      signForgedOp :: ByteString -> m (Signature, ByteString)
      signForgedOp :: ByteString -> m (Signature, ByteString)
signForgedOp ByteString
op = do
        Signature
signature' <- AddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature
forall (m :: * -> *).
HasTezosClient m =>
AddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature
signBytes AddressOrAlias
sender Maybe ScrubbedBytes
mbPassword (ByteString -> ByteString
addOperationPrefix ByteString
op)
        return (Signature
signature', ByteString -> Signature -> ByteString
prepareOpForInjection ByteString
op Signature
signature')

  -- Fill in fees
  let
    updateOp :: OperationInput -> Maybe Mutez -> AppliedResult -> Bool -> m (OperationInput, Maybe (Signature, ByteString))
    updateOp :: WithCommonOperationData (OperationInfo RPCInput)
-> Maybe Mutez
-> AppliedResult
-> Bool
-> m (WithCommonOperationData (OperationInfo RPCInput),
      Maybe (Signature, ByteString))
updateOp opToRun :: WithCommonOperationData (OperationInfo RPCInput)
opToRun@(WithCommonOperationData CommonOperationData
_ OperationInfo RPCInput
internalOp) Maybe Mutez
mbFee AppliedResult
ar Bool
isFirst = do
      let gasSafetyGuard :: TezosInt64
gasSafetyGuard = TezosInt64
100
          -- @gasSafetyGuard@ is added to origination operations and transfers to non-implicit
          -- accounts, see https://gitlab.com/tezos/tezos/-/blob/v13.0/src/proto_013_PtJakart/lib_client/injection.ml#L750
          additionalGas :: TezosInt64
additionalGas = case OperationInfo RPCInput
internalOp of
            OpOriginate OriginationInfo RPCInput
_ -> TezosInt64
gasSafetyGuard
            OpTransfer (TransactionOperation {TezosMutez
Address
ParametersInternal
toParameters :: ParametersInternal
toDestination :: Address
toAmount :: TezosMutez
toParameters :: TransactionOperation -> ParametersInternal
toAmount :: TransactionOperation -> TezosMutez
toDestination :: TransactionOperation -> Address
..}) -> case Address
toDestination of
              KeyAddress KeyHash
_ -> TezosInt64
0
              ContractAddress ContractHash
_ -> TezosInt64
gasSafetyGuard
              TransactionRollupAddress TxRollupHash
_ -> TezosInt64
gasSafetyGuard
            OpReveal RevealInfo RPCInput
_ -> TezosInt64
0
      let storageLimit :: TezosInt64
storageLimit = [AppliedResult] -> ProtocolParameters -> TezosInt64
computeStorageLimit [AppliedResult
ar] ProtocolParameters
pp TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
+ TezosInt64
20 -- similarly to tezos-client, we add 20 for safety
      let gasLimit :: TezosInt64
gasLimit = AppliedResult -> TezosInt64
arConsumedGas AppliedResult
ar TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
+ TezosInt64
additionalGas
          updateCommonDataForFee :: Mutez -> CommonOperationData -> CommonOperationData
updateCommonDataForFee Mutez
fee =
            TezosInt64
-> TezosInt64
-> TezosMutez
-> CommonOperationData
-> CommonOperationData
updateCommonData TezosInt64
gasLimit TezosInt64
storageLimit (Mutez -> TezosMutez
TezosMutez Mutez
fee)

      (Mutez
_fee, WithCommonOperationData (OperationInfo RPCInput)
op, Maybe (Signature, ByteString)
mReadySignedOp) <- forall op extra (m :: * -> *).
Monad m =>
(Mutez -> m op) -> (op -> m (Mutez, extra)) -> m (Mutez, op, extra)
convergingFee
        @OperationInput
        @(Maybe (Signature, ByteString))  -- ready operation and its signature
        (\Mutez
fee ->
          WithCommonOperationData (OperationInfo RPCInput)
-> m (WithCommonOperationData (OperationInfo RPCInput))
forall (m :: * -> *) a. Monad m => a -> m a
return (WithCommonOperationData (OperationInfo RPCInput)
 -> m (WithCommonOperationData (OperationInfo RPCInput)))
-> WithCommonOperationData (OperationInfo RPCInput)
-> m (WithCommonOperationData (OperationInfo RPCInput))
forall a b. (a -> b) -> a -> b
$ WithCommonOperationData (OperationInfo RPCInput)
opToRun WithCommonOperationData (OperationInfo RPCInput)
-> State (WithCommonOperationData (OperationInfo RPCInput)) ()
-> WithCommonOperationData (OperationInfo RPCInput)
forall s a. s -> State s a -> s
&~
            (CommonOperationData -> Identity CommonOperationData)
-> WithCommonOperationData (OperationInfo RPCInput)
-> Identity (WithCommonOperationData (OperationInfo RPCInput))
forall a. Lens' (WithCommonOperationData a) CommonOperationData
wcoCommonDataL ((CommonOperationData -> Identity CommonOperationData)
 -> WithCommonOperationData (OperationInfo RPCInput)
 -> Identity (WithCommonOperationData (OperationInfo RPCInput)))
-> (CommonOperationData -> CommonOperationData)
-> State (WithCommonOperationData (OperationInfo RPCInput)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Mutez -> CommonOperationData -> CommonOperationData
updateCommonDataForFee Mutez
fee
          )
        (\WithCommonOperationData (OperationInfo RPCInput)
op -> do
          ByteString
forgedOp <- NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> m ByteString
forgeOp (NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
 -> m ByteString)
-> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> m ByteString
forall a b. (a -> b) -> a -> b
$ OneItem
  (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)))
-> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
forall x. One x => OneItem x -> x
one OneItem
  (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)))
WithCommonOperationData (OperationInfo RPCInput)
op
          -- In the Tezos implementation the first transaction
          -- in the series pays for signature.
          -- Signature of hash should be constant in size,
          -- so we can pass any signature, not necessarily the final one
          (Int
fullForgedOpLength, Maybe (Signature, ByteString)
mExtra) <-
            if Bool
isFirst
              then do
                res :: (Signature, ByteString)
res@(Signature
_signature, ByteString
signedOp) <- ByteString -> m (Signature, ByteString)
signForgedOp ByteString
forgedOp
                (Int, Maybe (Signature, ByteString))
-> m (Int, Maybe (Signature, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
signedOp, (Signature, ByteString) -> Maybe (Signature, ByteString)
forall a. a -> Maybe a
Just (Signature, ByteString)
res)
              else
                -- Forge output automatically includes additional 32-bytes header
                -- which should be ommited for all operations in batch except the first one.
                (Int, Maybe (Signature, ByteString))
-> m (Int, Maybe (Signature, ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Int
forall t. Container t => t -> Int
length ByteString
forgedOp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32, Maybe (Signature, ByteString)
forall a. Maybe a
Nothing)
          (Mutez, Maybe (Signature, ByteString))
-> m (Mutez, Maybe (Signature, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( Mutez -> (Mutez -> Mutez) -> Maybe Mutez -> Mutez
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FeeConstants -> Int -> TezosInt64 -> Mutez
computeFee FeeConstants
ocFeeConstants Int
fullForgedOpLength TezosInt64
gasLimit) Mutez -> Mutez
forall a. a -> a
id Maybe Mutez
mbFee
            , Maybe (Signature, ByteString)
mExtra
            )
          )

      (WithCommonOperationData (OperationInfo RPCInput),
 Maybe (Signature, ByteString))
-> m (WithCommonOperationData (OperationInfo RPCInput),
      Maybe (Signature, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (WithCommonOperationData (OperationInfo RPCInput)
op, Maybe (Signature, ByteString)
mReadySignedOp)

  let
    zipWith4NE
      :: (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
      -> NonEmpty e
    zipWith4NE :: forall a b c d e.
(a -> b -> c -> d -> e)
-> NonEmpty a
-> NonEmpty b
-> NonEmpty c
-> NonEmpty d
-> NonEmpty e
zipWith4NE a -> b -> c -> d -> e
f (a
a :| [a]
as) (b
b :| [b]
bs) (c
c :| [c]
cs) (d
d :| [d]
ds) =
      (a -> b -> c -> d -> e
f a
a b
b c
c d
d) e -> [e] -> NonEmpty e
forall a. a -> [a] -> NonEmpty a
:| (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 a -> b -> c -> d -> e
f [a]
as [b]
bs [c]
cs [d]
ds
  -- These two lists must have the same length here.
  -- @opsToRun@ is constructed directly from @params@.
  -- The length of @results@ is checked in @getAppliedResults@.
  (NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
updOps, NonEmpty (Maybe (Signature, ByteString))
readySignedOps) <- (NonEmpty
   (WithCommonOperationData (OperationInfo RPCInput),
    Maybe (Signature, ByteString))
 -> (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)),
     NonEmpty (Maybe (Signature, ByteString))))
-> m (NonEmpty
        (WithCommonOperationData (OperationInfo RPCInput),
         Maybe (Signature, ByteString)))
-> m (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)),
      NonEmpty (Maybe (Signature, ByteString)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty
  (WithCommonOperationData (OperationInfo RPCInput),
   Maybe (Signature, ByteString))
-> (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)),
    NonEmpty (Maybe (Signature, ByteString)))
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip (m (NonEmpty
      (WithCommonOperationData (OperationInfo RPCInput),
       Maybe (Signature, ByteString)))
 -> m (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)),
       NonEmpty (Maybe (Signature, ByteString))))
-> (NonEmpty
      (m (WithCommonOperationData (OperationInfo RPCInput),
          Maybe (Signature, ByteString)))
    -> m (NonEmpty
            (WithCommonOperationData (OperationInfo RPCInput),
             Maybe (Signature, ByteString))))
-> NonEmpty
     (m (WithCommonOperationData (OperationInfo RPCInput),
         Maybe (Signature, ByteString)))
-> m (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)),
      NonEmpty (Maybe (Signature, ByteString)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty
  (m (WithCommonOperationData (OperationInfo RPCInput),
      Maybe (Signature, ByteString)))
-> m (NonEmpty
        (WithCommonOperationData (OperationInfo RPCInput),
         Maybe (Signature, ByteString)))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (NonEmpty
   (m (WithCommonOperationData (OperationInfo RPCInput),
       Maybe (Signature, ByteString)))
 -> m (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)),
       NonEmpty (Maybe (Signature, ByteString))))
-> NonEmpty
     (m (WithCommonOperationData (OperationInfo RPCInput),
         Maybe (Signature, ByteString)))
-> m (NonEmpty (WithCommonOperationData (OperationInfo RPCInput)),
      NonEmpty (Maybe (Signature, ByteString)))
forall a b. (a -> b) -> a -> b
$
    (WithCommonOperationData (OperationInfo RPCInput)
 -> Maybe Mutez
 -> AppliedResult
 -> Bool
 -> m (WithCommonOperationData (OperationInfo RPCInput),
       Maybe (Signature, ByteString)))
-> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> NonEmpty (Maybe Mutez)
-> NonEmpty AppliedResult
-> NonEmpty Bool
-> NonEmpty
     (m (WithCommonOperationData (OperationInfo RPCInput),
         Maybe (Signature, ByteString)))
forall a b c d e.
(a -> b -> c -> d -> e)
-> NonEmpty a
-> NonEmpty b
-> NonEmpty c
-> NonEmpty d
-> NonEmpty e
zipWith4NE WithCommonOperationData (OperationInfo RPCInput)
-> Maybe Mutez
-> AppliedResult
-> Bool
-> m (WithCommonOperationData (OperationInfo RPCInput),
      Maybe (Signature, ByteString))
updateOp NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
opsToRun NonEmpty (Maybe Mutez)
mbFees NonEmpty AppliedResult
results (Bool
True Bool -> [Bool] -> NonEmpty Bool
forall a. a -> [a] -> NonEmpty a
:| Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)

  -- Forge operation with given limits and get its hexadecimal representation
  (Signature
signature', ByteString
signedOp) <- case NonEmpty (Maybe (Signature, ByteString))
readySignedOps of
    -- Save one forge + sign call pair in case of one operation
    Just (Signature, ByteString)
readyOp :| [] -> (Signature, ByteString) -> m (Signature, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature, ByteString)
readyOp
    -- In case of batch we have to reforge the full operation
    NonEmpty (Maybe (Signature, ByteString))
_ -> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> m ByteString
forgeOp NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
updOps m ByteString
-> (ByteString -> m (Signature, ByteString))
-> m (Signature, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> m (Signature, ByteString)
signForgedOp

  -- Operation still can fail due to insufficient gas or storage limit, so it's required
  -- to preapply it before injecting
  let preApplyOp :: PreApplyOperation
preApplyOp = PreApplyOperation :: Text
-> BlockHash
-> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> Signature
-> PreApplyOperation
PreApplyOperation
        { paoProtocol :: Text
paoProtocol = BlockConstants -> Text
bcProtocol BlockConstants
ocBlockConstants
        , paoBranch :: BlockHash
paoBranch = BlockHash
ocLastBlockHash
        , paoContents :: NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
paoContents = NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
updOps
        , paoSignature :: Signature
paoSignature = Signature
signature'
        }
  NonEmpty AppliedResult
ars2 <- Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult)
forall (m :: * -> *).
HasTezosRpc m =>
Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult)
getAppliedResults (PreApplyOperation -> Either RunOperation PreApplyOperation
forall a b. b -> Either a b
Right PreApplyOperation
preApplyOp)
  case forall {k} (a :: k). SingI a => Sing a
forall (a :: RunMode). SingI a => Sing a
sing @runMode of
    Sing runMode
SingRunResult runMode
SDryRun -> do
      let fees :: NonEmpty TezosMutez
fees = (WithCommonOperationData (OperationInfo RPCInput) -> TezosMutez)
-> NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
-> NonEmpty TezosMutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (CommonOperationData -> TezosMutez
codFee (CommonOperationData -> TezosMutez)
-> (WithCommonOperationData (OperationInfo RPCInput)
    -> CommonOperationData)
-> WithCommonOperationData (OperationInfo RPCInput)
-> TezosMutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithCommonOperationData (OperationInfo RPCInput)
-> CommonOperationData
forall a. WithCommonOperationData a -> CommonOperationData
wcoCommon) NonEmpty (WithCommonOperationData (OperationInfo RPCInput))
updOps
      NonEmpty (AppliedResult, TezosMutez)
-> m (NonEmpty (AppliedResult, TezosMutez))
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (AppliedResult, TezosMutez)
 -> m (NonEmpty (AppliedResult, TezosMutez)))
-> NonEmpty (AppliedResult, TezosMutez)
-> m (NonEmpty (AppliedResult, TezosMutez))
forall a b. (a -> b) -> a -> b
$ NonEmpty AppliedResult
-> NonEmpty TezosMutez -> NonEmpty (AppliedResult, TezosMutez)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty AppliedResult
ars2 NonEmpty TezosMutez
fees
    Sing runMode
SingRunResult runMode
SRealRun -> do
      OperationHash
operationHash <- m OperationHash -> m OperationHash
forall (m :: * -> *).
HasTezosRpc m =>
m OperationHash -> m OperationHash
waitForOperation (m OperationHash -> m OperationHash)
-> m OperationHash -> m OperationHash
forall a b. (a -> b) -> a -> b
$ HexJSONByteString -> m OperationHash
forall (m :: * -> *).
HasTezosRpc m =>
HexJSONByteString -> m OperationHash
injectOperation (ByteString -> HexJSONByteString
HexJSONByteString ByteString
signedOp)
      let contractAddrs :: NonEmpty [Address]
contractAddrs = AppliedResult -> [Address]
arOriginatedContracts (AppliedResult -> [Address])
-> NonEmpty AppliedResult -> NonEmpty [Address]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty AppliedResult
ars2
      NonEmpty (OperationInfo Result)
opsRes <- NonEmpty (OperationInfo ClientInput, [Address])
-> ((OperationInfo ClientInput, [Address])
    -> m (OperationInfo Result))
-> m (NonEmpty (OperationInfo Result))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (NonEmpty (OperationInfo ClientInput)
-> NonEmpty [Address]
-> NonEmpty (OperationInfo ClientInput, [Address])
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty (OperationInfo ClientInput)
operations NonEmpty [Address]
contractAddrs) (((OperationInfo ClientInput, [Address])
  -> m (OperationInfo Result))
 -> m (NonEmpty (OperationInfo Result)))
-> ((OperationInfo ClientInput, [Address])
    -> m (OperationInfo Result))
-> m (NonEmpty (OperationInfo Result))
forall a b. (a -> b) -> a -> b
$ \case
        (OpTransfer TransferInfo ClientInput
_, []) ->
          OperationInfo Result -> m (OperationInfo Result)
forall (m :: * -> *) a. Monad m => a -> m a
return (OperationInfo Result -> m (OperationInfo Result))
-> OperationInfo Result -> m (OperationInfo Result)
forall a b. (a -> b) -> a -> b
$ TransferInfo Result -> OperationInfo Result
forall i. TransferInfo i -> OperationInfo i
OpTransfer ()
        (OpTransfer TransferInfo ClientInput
_, [Address]
addrs) -> do
          Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            Builder
"The following contracts were originated during transactions: " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+|
            [Address] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF [Address]
addrs Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
          return $ TransferInfo Result -> OperationInfo Result
forall i. TransferInfo i -> OperationInfo i
OpTransfer ()
        (OpOriginate OriginationInfo ClientInput
_, []) ->
          IncorrectRpcResponse -> m (OperationInfo Result)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM IncorrectRpcResponse
RpcOriginatedNoContracts
        (OpOriginate OriginationData{Bool
Maybe Mutez
Mutez
Contract cp st
Value st
Alias
odMbFee :: Maybe Mutez
odStorage :: Value st
odContract :: Contract cp st
odBalance :: Mutez
odName :: Alias
odReplaceExisting :: Bool
odMbFee :: OriginationData -> Maybe Mutez
odStorage :: ()
odContract :: ()
odBalance :: OriginationData -> Mutez
odReplaceExisting :: OriginationData -> Bool
odName :: OriginationData -> Alias
..}, [Address
addr]) -> do
          Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder
"Saving " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" for " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias
odName Alias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
          Bool -> Address -> Alias -> m ()
forall (m :: * -> *).
HasTezosClient m =>
Bool -> Address -> Alias -> m ()
rememberContract Bool
odReplaceExisting Address
addr Alias
odName
          Alias
alias <- AddressOrAlias -> m Alias
forall (m :: * -> *). HasTezosClient m => AddressOrAlias -> m Alias
getAlias (AddressOrAlias -> m Alias) -> AddressOrAlias -> m Alias
forall a b. (a -> b) -> a -> b
$ Address -> AddressOrAlias
AddressResolved Address
addr
          Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Originated contract: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Alias -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Alias
alias
          return $ OriginationInfo Result -> OperationInfo Result
forall i. OriginationInfo i -> OperationInfo i
OpOriginate OriginationInfo Result
Address
addr
        (OpOriginate OriginationInfo ClientInput
_, addrs :: [Address]
addrs@(Address
_ : Address
_ : [Address]
_)) ->
          IncorrectRpcResponse -> m (OperationInfo Result)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IncorrectRpcResponse -> m (OperationInfo Result))
-> IncorrectRpcResponse -> m (OperationInfo Result)
forall a b. (a -> b) -> a -> b
$ [Address] -> IncorrectRpcResponse
RpcOriginatedMoreContracts [Address]
addrs
        (OpReveal RevealInfo ClientInput
_, [Address]
_) ->
          OperationInfo Result -> m (OperationInfo Result)
forall (m :: * -> *) a. Monad m => a -> m a
return (OperationInfo Result -> m (OperationInfo Result))
-> OperationInfo Result -> m (OperationInfo Result)
forall a b. (a -> b) -> a -> b
$ RevealInfo Result -> OperationInfo Result
forall i. RevealInfo i -> OperationInfo i
OpReveal ()
      NonEmpty AppliedResult
-> (Element (NonEmpty AppliedResult) -> m ()) -> m ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ NonEmpty AppliedResult
ars2 Element (NonEmpty AppliedResult) -> m ()
AppliedResult -> m ()
logStatistics
      return (OperationHash
operationHash, NonEmpty (OperationInfo Result)
opsRes)
      m (OperationHash, NonEmpty (OperationInfo Result))
-> (UnexpectedErrors
    -> m (OperationHash, NonEmpty (OperationInfo Result)))
-> m (OperationHash, NonEmpty (OperationInfo Result))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \case
        (UnexpectedRunErrors [RunError]
errs) | Natural
retryCount Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0 -> do
          Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Builder -> Builder
nameF Builder
"When injecting operations, there were unexpected errors" (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
            [RunError] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF [RunError]
errs
          forall (runMode :: RunMode) (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
 SingI runMode) =>
Natural
-> AddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (RunResult runMode)
runOperationsNonEmptyHelper @runMode (Natural
retryCount Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1) AddressOrAlias
sender NonEmpty (OperationInfo ClientInput)
operations
        UnexpectedErrors
e -> UnexpectedErrors
-> m (OperationHash, NonEmpty (OperationInfo Result))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM UnexpectedErrors
e
  where
    mayNeedSenderRevealing :: [OperationInfo i] -> Bool
    mayNeedSenderRevealing :: forall i. [OperationInfo i] -> Bool
mayNeedSenderRevealing = (Element [OperationInfo i] -> Bool) -> [OperationInfo i] -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
any \case
      OpTransfer{} -> Bool
True
      OpOriginate{} -> Bool
True
      OpReveal{} -> Bool
False

    logStatistics :: AppliedResult -> m ()
    logStatistics :: AppliedResult -> m ()
logStatistics AppliedResult
ar = do
      let showTezosInt64 :: TezosInt64 -> Text
showTezosInt64 = Int64 -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Int64 -> Text) -> (TezosInt64 -> Int64) -> TezosInt64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TezosInt64 -> Int64
forall a. StringEncode a -> a
unStringEncode
      Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Consumed gas: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TezosInt64 -> Text
showTezosInt64 (AppliedResult -> TezosInt64
arConsumedGas AppliedResult
ar)
      Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Storage size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TezosInt64 -> Text
showTezosInt64 (AppliedResult -> TezosInt64
arStorageSize AppliedResult
ar)
      Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Paid storage size diff: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TezosInt64 -> Text
showTezosInt64 (AppliedResult -> TezosInt64
arPaidStorageDiff AppliedResult
ar)

    prohibitContractSender :: Address -> OperationInfo ClientInput -> m ()
    prohibitContractSender :: Address -> OperationInfo ClientInput -> m ()
prohibitContractSender Address
addr OperationInfo ClientInput
op = case (Address
addr, OperationInfo ClientInput
op) of
      (KeyAddress KeyHash
_, OperationInfo ClientInput
_) -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
      (ContractAddress ContractHash
_, OperationInfo ClientInput
op') -> TezosClientError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m ()) -> TezosClientError -> m ()
forall a b. (a -> b) -> a -> b
$ Address -> Text -> TezosClientError
ContractSender Address
addr (OperationInfo ClientInput -> Text
forall {i}. OperationInfo i -> Text
opName OperationInfo ClientInput
op')
      (TransactionRollupAddress TxRollupHash
_, OperationInfo ClientInput
op') -> TezosClientError -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TezosClientError -> m ()) -> TezosClientError -> m ()
forall a b. (a -> b) -> a -> b
$ Address -> Text -> TezosClientError
ContractSender Address
addr (OperationInfo ClientInput -> Text
forall {i}. OperationInfo i -> Text
opName OperationInfo ClientInput
op')

    opName :: OperationInfo i -> Text
opName = \case
      OpTransfer TransferInfo i
_ -> Text
"transfer"
      OpOriginate OriginationInfo i
_ -> Text
"origination"
      OpReveal RevealInfo i
_ -> Text
"reveal"