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

-- | Module with functions that used in both transaction sending and contract
-- origination.
module Morley.Client.Action.Common
  ( OperationConstants(..)
  , TD (..)
  , TransactionData(..)
  , OriginationData(..)
  , RevealData(..)
  , ClientInput
  , addOperationPrefix
  , buildTxDataWithAlias
  , getAppliedResults
  , computeFee
  , computeStorageLimit
  , convergingFee
  , preProcessOperation
  , stubSignature
  , prepareOpForInjection
  , updateCommonData
  , toParametersInternals
  , mkOriginationScript
  , revealKeyUnlessRevealed
  ) where

import Control.Lens (Prism')
import Data.ByteArray (ScrubbedBytes)
import Data.ByteString (cons)
import Data.Default (def)
import Fmt (Buildable(..), Builder, (+|), (|+))

import Morley.Client.Logging (WithClientLog, logDebug)
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.Client.Util
import Morley.Micheline (TezosInt64, TezosMutez(..), toExpression)
import Morley.Micheline.Expression (Expression(ExpressionString))
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Untyped.Entrypoints
import Morley.Tezos.Address
import Morley.Tezos.Core
import Morley.Tezos.Crypto

-- | Datatype that contains various values required for
-- chain operations.
data OperationConstants = OperationConstants
  { OperationConstants -> Text
ocLastBlockHash :: Text
  -- ^ Block in which operations is going to be injected
  , OperationConstants -> BlockConstants
ocBlockConstants :: BlockConstants
  -- ^ Information about block: chain_id and protocol
  , OperationConstants -> FeeConstants
ocFeeConstants :: FeeConstants
  -- ^ Information about fees
  , OperationConstants -> TezosInt64
ocCounter :: TezosInt64
  -- ^ Sender counter
  }

-- | Helper for 'TransactionData' and t'Morley.Client.Action.Transaction.LTransactionData'.
data TD (t :: Type) = TD
  { TD t -> Address
tdReceiver :: Address
  , TD t -> Mutez
tdAmount :: Mutez
  , TD t -> EpName
tdEpName :: EpName
  , TD t -> t
tdParam :: t
  , TD t -> Maybe Mutez
tdMbFee :: Maybe Mutez
  }

-- | Data for a single transaction in a batch.
data TransactionData where
  TransactionData ::
    forall (t :: T.T). ParameterScope t =>
    TD (T.Value t) -> TransactionData

instance Buildable TransactionData where
  build :: TransactionData -> Builder
build = Maybe Alias -> TransactionData -> Builder
buildTxDataWithAlias Maybe Alias
forall a. Maybe a
Nothing

-- | Builds 'TransactionData' with additional info about receiver's alias, if present.
buildTxDataWithAlias :: Maybe Alias -> TransactionData -> Builder
buildTxDataWithAlias :: Maybe Alias -> TransactionData -> Builder
buildTxDataWithAlias Maybe Alias
mbAlias (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
..}) =
  Builder
"To: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
tdReceiver Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Maybe Alias -> Builder
buildMbAlias Maybe Alias
mbAlias Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
". EP: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| EpName
tdEpName EpName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
  Builder
". Parameter: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value t
tdParam Value t -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
". Amount: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
tdAmount Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
  where
    buildMbAlias :: Maybe Alias -> Builder
    buildMbAlias :: Maybe Alias -> Builder
buildMbAlias = Builder -> (Alias -> Builder) -> Maybe Alias -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" ((Alias -> Builder) -> Maybe Alias -> Builder)
-> (Alias -> Builder) -> Maybe Alias -> Builder
forall a b. (a -> b) -> a -> b
$ \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
")"

-- | Data for a single origination in a batch
data OriginationData =
  forall cp st. (ParameterScope cp, StorageScope st) => OriginationData
  { OriginationData -> Bool
odReplaceExisting :: Bool
  , OriginationData -> AliasHint
odName :: AliasHint
  , OriginationData -> Mutez
odBalance :: Mutez
  , ()
odContract :: T.Contract cp st
  , ()
odStorage :: T.Value st
  , OriginationData -> Maybe Mutez
odMbFee :: Maybe Mutez
  }

data RevealData = RevealData
  { RevealData -> PublicKey
rdPublicKey :: PublicKey
    -- TODO [#516]: extract mbFee out of 'TransactionData', 'OriginationData'
    -- and here, try to delete 'RevealData' datatype and pass 'PublicKey' instead
  , RevealData -> Maybe Mutez
rdMbFee :: Maybe Mutez
  }

-- | Standard operation input in morley-client interface.
data ClientInput
instance OperationInfoDescriptor ClientInput where
  type TransferInfo ClientInput = TransactionData
  type OriginationInfo ClientInput = OriginationData
  type RevealInfo ClientInput = RevealData

toParametersInternals
  :: ParameterScope t
  => EpName
  -> T.Value t
  -> ParametersInternal
toParametersInternals :: EpName -> Value t -> ParametersInternal
toParametersInternals EpName
epName Value t
epParam = ParametersInternal :: Text -> Expression -> ParametersInternal
ParametersInternal
  { piEntrypoint :: Text
piEntrypoint = EpName -> Text
epNameToTezosEp EpName
epName
  , piValue :: Expression
piValue = Value t -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value t
epParam
  }

mkOriginationScript
  :: T.Contract cp st -> T.Value st -> OriginationScript
mkOriginationScript :: Contract cp st -> Value st -> OriginationScript
mkOriginationScript contract :: Contract cp st
contract@T.Contract{} Value st
initialStorage = OriginationScript :: Expression -> Expression -> OriginationScript
OriginationScript
  { osCode :: Expression
osCode = Contract cp st -> Expression
forall a. ToExpression a => a -> Expression
toExpression Contract cp st
contract
  , osStorage :: Expression
osStorage = Value st -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value st
initialStorage
  }

-- | Preprocess chain operation in order to get required constants.
preProcessOperation
  :: (HasTezosRpc m) => Address -> m OperationConstants
preProcessOperation :: Address -> m OperationConstants
preProcessOperation Address
sourceAddr = do
  -- NOTE: The block hash returned by this function will be used in the "branch"
  -- field of other operations (e.g. `run_operation`, `forge` and `preapply`).
  --
  -- As of the introduction of the `ithaca` protocol and
  -- the Tenderbake consensus algorithm, it is no longer safe to use the `head` block
  -- as the branch of those operations, because that block "is not necessarily final".
  --
  -- Instead, we should use the `head~2` block.
  --
  -- See:
  --   * https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html
  --   * https://web.archive.org/web/20220305165704/https://tezos.gitlab.io/protocols/012_ithaca.html
  Text
ocLastBlockHash <- BlockId -> m Text
forall (m :: * -> *). HasTezosRpc m => BlockId -> m Text
getBlockHash BlockId
FinalHeadId
  BlockConstants
ocBlockConstants <- BlockId -> m BlockConstants
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockConstants
getBlockConstants (Text -> BlockId
BlockHashId Text
ocLastBlockHash)
  let ocFeeConstants :: FeeConstants
ocFeeConstants = FeeConstants
forall a. Default a => a
def
  TezosInt64
ocCounter <- Address -> m TezosInt64
forall (m :: * -> *). HasTezosRpc m => Address -> m TezosInt64
getImplicitContractCounter Address
sourceAddr
  pure OperationConstants :: Text
-> BlockConstants
-> FeeConstants
-> TezosInt64
-> OperationConstants
OperationConstants{Text
TezosInt64
FeeConstants
BlockConstants
ocCounter :: TezosInt64
ocFeeConstants :: FeeConstants
ocBlockConstants :: BlockConstants
ocLastBlockHash :: Text
ocCounter :: TezosInt64
ocFeeConstants :: FeeConstants
ocBlockConstants :: BlockConstants
ocLastBlockHash :: Text
..}

-- | Perform runOperation or preApplyOperations and combine the results.
--
-- If an error occurs, this function tries to turn errors returned by RPC
-- into 'ClientRpcError'. If it can't do the conversion, 'UnexpectedErrors'
-- will be thrown.
getAppliedResults
  :: (HasTezosRpc m)
  => Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult)
getAppliedResults :: Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult)
getAppliedResults Either RunOperation PreApplyOperation
op = do
  (RunOperationResult
runResult, Int
expectedContentsSize) <- case Either RunOperation PreApplyOperation
op of
    Left RunOperation
runOp ->
      (, NonEmpty OperationInput -> Int
forall t. Container t => t -> Int
length (NonEmpty OperationInput -> Int) -> NonEmpty OperationInput -> Int
forall a b. (a -> b) -> a -> b
$ RunOperationInternal -> NonEmpty OperationInput
roiContents (RunOperationInternal -> NonEmpty OperationInput)
-> RunOperationInternal -> NonEmpty OperationInput
forall a b. (a -> b) -> a -> b
$ RunOperation -> RunOperationInternal
roOperation RunOperation
runOp) (RunOperationResult -> (RunOperationResult, Int))
-> m RunOperationResult -> m (RunOperationResult, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunOperation -> m RunOperationResult
forall (m :: * -> *).
HasTezosRpc m =>
RunOperation -> m RunOperationResult
runOperation RunOperation
runOp
    Right PreApplyOperation
preApplyOp -> do
      [RunOperationResult]
results <- [PreApplyOperation] -> m [RunOperationResult]
forall (m :: * -> *).
HasTezosRpc m =>
[PreApplyOperation] -> m [RunOperationResult]
preApplyOperations [PreApplyOperation
preApplyOp]
      -- There must be exactly one result because we pass a list
      -- consisting of 1 item.
      case [RunOperationResult]
results of
        [RunOperationResult
result] -> (RunOperationResult, Int) -> m (RunOperationResult, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunOperationResult
result, NonEmpty OperationInput -> Int
forall t. Container t => t -> Int
length (NonEmpty OperationInput -> Int) -> NonEmpty OperationInput -> Int
forall a b. (a -> b) -> a -> b
$ PreApplyOperation -> NonEmpty OperationInput
paoContents PreApplyOperation
preApplyOp)
        [RunOperationResult]
_ -> IncorrectRpcResponse -> m (RunOperationResult, Int)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IncorrectRpcResponse -> m (RunOperationResult, Int))
-> IncorrectRpcResponse -> m (RunOperationResult, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> IncorrectRpcResponse
RpcUnexpectedSize Int
1 ([RunOperationResult] -> Int
forall t. Container t => t -> Int
length [RunOperationResult]
results)

  RunOperationResult -> Int -> m (NonEmpty AppliedResult)
forall (m :: * -> *).
MonadThrow m =>
RunOperationResult -> Int -> m (NonEmpty AppliedResult)
handleOperationResult RunOperationResult
runResult Int
expectedContentsSize
  where
    handleOperationResult ::
      MonadThrow m => RunOperationResult -> Int -> m (NonEmpty AppliedResult)
    handleOperationResult :: RunOperationResult -> Int -> m (NonEmpty AppliedResult)
handleOperationResult RunOperationResult{NonEmpty OperationContent
rrOperationContents :: RunOperationResult -> NonEmpty OperationContent
rrOperationContents :: NonEmpty OperationContent
..} Int
expectedContentsSize = do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NonEmpty OperationContent -> Int
forall t. Container t => t -> Int
length NonEmpty OperationContent
rrOperationContents Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expectedContentsSize) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        IncorrectRpcResponse -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IncorrectRpcResponse -> m ()) -> IncorrectRpcResponse -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> IncorrectRpcResponse
RpcUnexpectedSize Int
expectedContentsSize (NonEmpty OperationContent -> Int
forall t. Container t => t -> Int
length NonEmpty OperationContent
rrOperationContents)

      (OperationContent -> m AppliedResult)
-> NonEmpty OperationContent -> m (NonEmpty AppliedResult)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(OperationContent (RunMetadata OperationResult
res [InternalOperation]
internalOps)) ->
              let internalResults :: [OperationResult]
internalResults = (InternalOperation -> OperationResult)
-> [InternalOperation] -> [OperationResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map InternalOperation -> OperationResult
unInternalOperation [InternalOperation]
internalOps in
                case (Element [OperationResult] -> OperationResult -> OperationResult)
-> OperationResult -> [OperationResult] -> OperationResult
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element [OperationResult] -> OperationResult -> OperationResult
OperationResult -> OperationResult -> OperationResult
combineResults OperationResult
res [OperationResult]
internalResults of
                  OperationApplied AppliedResult
appliedRes -> AppliedResult -> m AppliedResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppliedResult
appliedRes
                  OperationFailed [RunError]
errors -> [RunError] -> m AppliedResult
forall (m :: * -> *) a. MonadThrow m => [RunError] -> m a
handleErrors [RunError]
errors
           ) NonEmpty OperationContent
rrOperationContents

    -- When an error happens, we will get a list of 'RunError' in response.
    -- This list often contains more than one item.
    -- We tested which errors are returned in certain scenarios and added
    -- handling of such scenarios here.
    -- We don't rely on any specific order of errors and on the number of errors.
    -- For example, in case of bad parameter this number can be different.
    handleErrors :: MonadThrow m => [RunError] -> m a
    handleErrors :: [RunError] -> m a
handleErrors [RunError]
errs
      | Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Address
_RuntimeError
      , Just Expression
expr <- Prism' RunError Expression -> Maybe Expression
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Expression
_ScriptRejected
        = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ Address -> Expression -> ClientRpcError
ContractFailed Address
address Expression
expr
      -- This case should be removed once 006 is finally deprecated
      | Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Address
_BadContractParameter
      , Just (Expression
_, Expression
expr) <- Prism' RunError (Expression, Expression)
-> Maybe (Expression, Expression)
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError (Expression, Expression)
_InvalidSyntacticConstantError
        = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ Address -> Expression -> ClientRpcError
BadParameter Address
address Expression
expr
      | Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Address
_BadContractParameter
      , Just (Expression
_, Expression
expr) <- Prism' RunError (Expression, Expression)
-> Maybe (Expression, Expression)
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError (Expression, Expression)
_InvalidConstant
        = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ Address -> Expression -> ClientRpcError
BadParameter Address
address Expression
expr
      | Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Address
_BadContractParameter
      , Just Text
notation <- Prism' RunError Text -> Maybe Text
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Text
_InvalidContractNotation
        = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ Address -> Expression -> ClientRpcError
BadParameter Address
address (Text -> Expression
ExpressionString Text
notation)
      | Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Address
_REEmptyTransaction
        = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ Address -> ClientRpcError
EmptyTransaction Address
address
      | Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Address
_RuntimeError
      , Just ()
_ <- Prism' RunError () -> Maybe ()
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ()
_ScriptOverflow
        = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ Address -> ClientRpcError
ShiftOverflow Address
address
      | Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Address
_RuntimeError
      , Just ()
_ <- Prism' RunError () -> Maybe ()
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ()
_GasExhaustedOperation
        = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ Address -> ClientRpcError
GasExhaustion Address
address
      | Just Address
address <- Prism' RunError Address -> Maybe Address
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Address
_PreviouslyRevealedKey
        = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientRpcError -> m a) -> ClientRpcError -> m a
forall a b. (a -> b) -> a -> b
$ Address -> ClientRpcError
KeyAlreadyRevealed Address
address
      | Bool
otherwise
        = UnexpectedErrors -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnexpectedErrors -> m a) -> UnexpectedErrors -> m a
forall a b. (a -> b) -> a -> b
$ [RunError] -> UnexpectedErrors
UnexpectedRunErrors [RunError]
errs
      where
        findError :: Prism' RunError a -> Maybe a
        findError :: Prism' RunError a -> Maybe a
findError Prism' RunError a
prism = (NonEmpty a -> a) -> Maybe (NonEmpty a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty a -> a
forall a. NonEmpty a -> a
head (Maybe (NonEmpty a) -> Maybe a)
-> ([RunError] -> Maybe (NonEmpty a)) -> [RunError] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([a] -> Maybe (NonEmpty a))
-> ([RunError] -> [a]) -> [RunError] -> Maybe (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunError -> Maybe a) -> [RunError] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Getting (First a) RunError a -> RunError -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First a) RunError a
Prism' RunError a
prism) ([RunError] -> Maybe a) -> [RunError] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [RunError]
errs

-- | Reveal key for implicit address if necessary.
--
-- Throws an error if given address is a contract address.
revealKeyUnlessRevealed
  :: (WithClientLog env m, HasTezosRpc m, HasTezosClient m)
  => Address
  -> Maybe ScrubbedBytes
  -> m ()
revealKeyUnlessRevealed :: Address -> Maybe ScrubbedBytes -> m ()
revealKeyUnlessRevealed Address
addr Maybe ScrubbedBytes
mbPassword = do
  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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Address -> Bool
isKeyAddress Address
addr) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    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
$ Alias -> TezosClientError
CantRevealContract Alias
alias
  Maybe PublicKey
mbManagerKey <- Address -> m (Maybe PublicKey)
forall (m :: * -> *).
HasTezosRpc m =>
Address -> m (Maybe PublicKey)
getManagerKey Address
addr
  case Maybe PublicKey
mbManagerKey of
    Maybe PublicKey
Nothing -> Alias -> Maybe ScrubbedBytes -> m ()
forall (m :: * -> *).
HasTezosClient m =>
Alias -> Maybe ScrubbedBytes -> m ()
revealKey Alias
alias Maybe ScrubbedBytes
mbPassword
    Just PublicKey
_  -> Text -> m ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Alias
alias Alias -> Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" alias has already revealed key"

-- | Compute fee for operation.
computeFee :: FeeConstants -> Int -> TezosInt64 -> Mutez
computeFee :: FeeConstants -> Int -> TezosInt64 -> Mutez
computeFee FeeConstants{Milli
Mutez
fcMutezPerOpByte :: FeeConstants -> Milli
fcMutezPerGas :: FeeConstants -> Milli
fcBase :: FeeConstants -> Mutez
fcMutezPerOpByte :: Milli
fcMutezPerGas :: Milli
fcBase :: Mutez
..} Int
opSize TezosInt64
gasLimit =
  -- Here and further we mostly follow the Tezos implementation:
  -- https://gitlab.com/tezos/tezos/-/blob/14d6dafd23eeafe30d931a41d43c99b1ebed5373/src/proto_alpha/lib_client/injection.ml#L584

  Either Text Mutez -> Mutez
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text Mutez -> Mutez)
-> ([Rational] -> Either Text Mutez) -> [Rational] -> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integral Word64 => Word64 -> Either Text Mutez
forall i. Integral i => i -> Either Text Mutez
mkMutez @Word64 (Word64 -> Either Text Mutez)
-> ([Rational] -> Word64) -> [Rational] -> Either Text Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> Word64)
-> ([Rational] -> Rational) -> [Rational] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Rational] -> Rational
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([Rational] -> Mutez) -> [Rational] -> Mutez
forall a b. (a -> b) -> a -> b
$
    [ Word63 -> Rational
forall a. Real a => a -> Rational
toRational (Word63 -> Rational) -> Word63 -> Rational
forall a b. (a -> b) -> a -> b
$ Mutez -> Word63
unMutez Mutez
fcBase
    , Milli -> Rational
forall a. Real a => a -> Rational
toRational Milli
fcMutezPerOpByte Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a. Real a => a -> Rational
toRational Int
opSize
    , Milli -> Rational
forall a. Real a => a -> Rational
toRational Milli
fcMutezPerGas Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* TezosInt64 -> Rational
forall a. Real a => a -> Rational
toRational TezosInt64
gasLimit
    ]

-- | @convergingFee mkOperation countFee@ tries to find the most minimal fee
-- @F@ and the respective operation @Op@ so that @mkOperation F = Op@ and
-- @countFee Op <= F@.
convergingFee
  :: forall op extra m. Monad m
  => (Mutez -> m op)
  -> (op -> m (Mutez, extra))
  -> m (Mutez, op, extra)
convergingFee :: (Mutez -> m op) -> (op -> m (Mutez, extra)) -> m (Mutez, op, extra)
convergingFee Mutez -> m op
mkOperation op -> m (Mutez, extra)
countFee = Word -> Mutez -> m (Mutez, op, extra)
iterateFee Word
5 Mutez
assessedMinimalFee
  where
    assessedMinimalFee :: Mutez
assessedMinimalFee = Mutez
zeroMutez
    -- ↑ In real life we can encounter small fees like ~300 mutez
    -- (for small transfers to implicit addresses), but even if we set this
    -- as a starting fee, we won't win any number of iteration steps.
    -- So setting just zero.

    {- We have to use iterative algorithm because fees are included into
       operation, and higher fees increase operation size and thus fee may
       grow again. Fortunatelly, fees strictly grow with operation size and
       operation size strictly grows with fees, so the implementation is simple.
    -}
    iterateFee :: Word -> Mutez -> m (Mutez, op, extra)
    iterateFee :: Word -> Mutez -> m (Mutez, op, extra)
iterateFee Word
0 Mutez
_ = Text -> m (Mutez, op, extra)
forall a. HasCallStack => Text -> a
error Text
"Failed to converge at some fee"
    iterateFee Word
countdown Mutez
curFee = do
      op
op <- Mutez -> m op
mkOperation Mutez
curFee
      (Mutez
requiredFee, extra
extra) <- op -> m (Mutez, extra)
countFee op
op
      if Mutez
requiredFee Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
<= Mutez
curFee
        then (Mutez, op, extra) -> m (Mutez, op, extra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mutez
curFee, op
op, extra
extra)
        else Word -> Mutez -> m (Mutez, op, extra)
iterateFee (Word
countdown Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Mutez
requiredFee

-- | Compute storage limit based on the results of the operations application
-- and given @ProtocolParameters@.
computeStorageLimit :: [AppliedResult] -> ProtocolParameters -> TezosInt64
computeStorageLimit :: [AppliedResult] -> ProtocolParameters -> TezosInt64
computeStorageLimit [AppliedResult]
appliedResults ProtocolParameters
pp = [TezosInt64] -> Element [TezosInt64]
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([TezosInt64] -> Element [TezosInt64])
-> [TezosInt64] -> Element [TezosInt64]
forall a b. (a -> b) -> a -> b
$ (AppliedResult -> TezosInt64) -> [AppliedResult] -> [TezosInt64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\AppliedResult
ar -> [TezosInt64] -> Element [TezosInt64]
forall t. (Container t, Num (Element t)) => t -> Element t
sum
  [ AppliedResult -> TezosInt64
arPaidStorageDiff AppliedResult
ar
  , (AppliedResult -> TezosInt64
arAllocatedDestinationContracts AppliedResult
ar) TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
* Int -> TezosInt64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (ProtocolParameters -> Int
ppOriginationSize ProtocolParameters
pp)
  , Int -> TezosInt64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral ([Address] -> Int
forall t. Container t => t -> Int
length ([Address] -> Int) -> [Address] -> Int
forall a b. (a -> b) -> a -> b
$ AppliedResult -> [Address]
arOriginatedContracts AppliedResult
ar) TezosInt64 -> TezosInt64 -> TezosInt64
forall a. Num a => a -> a -> a
* Int -> TezosInt64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (ProtocolParameters -> Int
ppOriginationSize ProtocolParameters
pp)
  ]) [AppliedResult]
appliedResults

-- | Update common operation data based on preliminary run which estimates storage and
-- gas limits and fee.
--
-- Reference implementation adds 100 gas and 20 bytes to the limits for safety.
updateCommonData
  :: TezosInt64 -> TezosInt64 -> TezosMutez
  -> CommonOperationData -> CommonOperationData
updateCommonData :: TezosInt64
-> TezosInt64
-> TezosMutez
-> CommonOperationData
-> CommonOperationData
updateCommonData TezosInt64
gasLimit TezosInt64
storageLimit TezosMutez
fee CommonOperationData
commonData =
  CommonOperationData
commonData
  { codGasLimit :: TezosInt64
codGasLimit = TezosInt64
gasLimit
  , codStorageLimit :: TezosInt64
codStorageLimit = TezosInt64
storageLimit
  , codFee :: TezosMutez
codFee = TezosMutez
fee
  }

stubSignature :: Signature
stubSignature :: Signature
stubSignature = Either CryptoParseError Signature -> Signature
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either CryptoParseError Signature -> Signature)
-> Either CryptoParseError Signature -> Signature
forall a b. (a -> b) -> a -> b
$ Text -> Either CryptoParseError Signature
parseSignature
  Text
"edsigtXomBKi5CTRf5cjATJWSyaRvhfYNHqSUGrn4SdbYRcGwQrUGjzEfQDTuqHhuA8b2d8NarZjz8TRf65WkpQmo423BtomS8Q"

addOperationPrefix :: ByteString -> ByteString
addOperationPrefix :: ByteString -> ByteString
addOperationPrefix = Word8 -> ByteString -> ByteString
cons Word8
0x03

prepareOpForInjection :: ByteString -> Signature -> ByteString
prepareOpForInjection :: ByteString -> Signature -> ByteString
prepareOpForInjection ByteString
operationHex Signature
signature' =
  ByteString
operationHex ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Signature -> ByteString
forall ba. ByteArray ba => Signature -> ba
signatureToBytes Signature
signature'