-- 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(..)
  , DelegationData(..)
  , ClientInput
  , addOperationPrefix
  , buildTxDataWithAlias
  , getAppliedResults
  , computeFee
  , computeStorageLimit
  , convergingFee
  , preProcessOperation
  , stubSignature
  , prepareOpForInjection
  , updateCommonData
  , toParametersInternals
  , mkOriginationScript
  , revealKeyUnlessRevealed
  , handleOperationResult
  , runErrorsToClientError
  ) 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 (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.Address.Alias
import Morley.Tezos.Core
import Morley.Tezos.Crypto

-- | Datatype that contains various values required for
-- chain operations.
data OperationConstants = OperationConstants
  { OperationConstants -> BlockHash
ocLastBlockHash :: BlockHash
  -- ^ 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 -> StringEncode Int64
ocCounter :: TezosInt64
  -- ^ Sender counter
  }

-- | Helper for 'TransactionData' and t'Morley.Client.Action.Transaction.LTransactionData'.
data TD (t :: Type) = TD
  { forall t. TD t -> L1Address
tdReceiver :: L1Address
  , forall t. TD t -> Mutez
tdAmount :: Mutez
  , forall t. TD t -> EpName
tdEpName :: EpName
  , forall t. TD t -> t
tdParam :: t
  , forall 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 Text -> TransactionData -> Builder
buildTxDataWithAlias Maybe Text
forall a. Maybe a
Nothing

-- | Builds 'TransactionData' with additional info about receiver's alias, if present.
buildTxDataWithAlias :: Maybe Text -> TransactionData -> Builder
buildTxDataWithAlias :: Maybe Text -> TransactionData -> Builder
buildTxDataWithAlias Maybe Text
mbAlias (TransactionData TD{Maybe Mutez
L1Address
Mutez
Value t
EpName
tdMbFee :: Maybe Mutez
tdParam :: Value t
tdEpName :: EpName
tdAmount :: Mutez
tdReceiver :: L1Address
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 -> L1Address
..}) =
  Builder
"To: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| L1Address
tdReceiver L1Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Maybe Text -> Builder
buildMbAlias Maybe Text
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 Text -> Builder
    buildMbAlias :: Maybe Text -> Builder
buildMbAlias = Builder -> (Text -> Builder) -> Maybe Text -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" ((Text -> Builder) -> Maybe Text -> Builder)
-> (Text -> Builder) -> Maybe Text -> Builder
forall a b. (a -> b) -> a -> b
$ \Text
a -> Builder
" (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
a Text -> 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 -> AliasBehavior
odAliasBehavior :: AliasBehavior
  , OriginationData -> ContractAlias
odName :: ContractAlias
  , OriginationData -> Mutez
odBalance :: Mutez
  , ()
odContract :: T.Contract cp st
  , ()
odStorage :: T.Value st
  , OriginationData -> Maybe KeyHash
odDelegate :: Maybe KeyHash
  , OriginationData -> Maybe Mutez
odMbFee :: Maybe Mutez
  }

data DelegationData = DelegationData
  { DelegationData -> Maybe KeyHash
ddDelegate :: Maybe KeyHash
  , DelegationData -> Maybe Mutez
ddMbFee :: Maybe Mutez
  }

data RevealData = RevealData
  { RevealData -> PublicKey
rdPublicKey :: PublicKey
    -- TODO [#516]: extract mbFee out of 'TransactionData', 'OriginationData', 'DelegationData'
    -- 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
  type DelegationInfo ClientInput = DelegationData

toParametersInternals
  :: ParameterScope t
  => EpName
  -> T.Value t
  -> ParametersInternal
toParametersInternals :: forall (t :: T).
ParameterScope t =>
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 :: forall (cp :: T) (st :: T).
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) => ImplicitAddress -> m OperationConstants
preProcessOperation :: forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m OperationConstants
preProcessOperation ImplicitAddress
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
  BlockHash
ocLastBlockHash <- BlockId -> m BlockHash
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockHash
getBlockHash BlockId
FinalHeadId
  BlockConstants
ocBlockConstants <- BlockId -> m BlockConstants
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockConstants
getBlockConstants (BlockHash -> BlockId
BlockHashId BlockHash
ocLastBlockHash)
  let ocFeeConstants :: FeeConstants
ocFeeConstants = FeeConstants
forall a. Default a => a
def
  StringEncode Int64
ocCounter <- ImplicitAddress -> m (StringEncode Int64)
forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m (StringEncode Int64)
getImplicitContractCounter ImplicitAddress
sourceAddr
  pure OperationConstants :: BlockHash
-> BlockConstants
-> FeeConstants
-> StringEncode Int64
-> OperationConstants
OperationConstants{StringEncode Int64
FeeConstants
BlockHash
BlockConstants
ocCounter :: StringEncode Int64
ocFeeConstants :: FeeConstants
ocBlockConstants :: BlockConstants
ocLastBlockHash :: BlockHash
ocCounter :: StringEncode Int64
ocFeeConstants :: FeeConstants
ocBlockConstants :: BlockConstants
ocLastBlockHash :: BlockHash
..}

-- | 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, [InternalOperationData])
getAppliedResults :: forall (m :: * -> *).
HasTezosRpc m =>
Either RunOperation PreApplyOperation
-> m (NonEmpty AppliedResult, [InternalOperationData])
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, [InternalOperationData])
forall (m :: * -> *).
MonadThrow m =>
RunOperationResult
-> Int -> m (NonEmpty AppliedResult, [InternalOperationData])
handleOperationResult RunOperationResult
runResult Int
expectedContentsSize

-- | Handle a result of an operation: throw errors if there was an error,
-- return a nonempty list of applied results if there weren't.
handleOperationResult ::
  MonadThrow m => RunOperationResult -> Int -> m (NonEmpty AppliedResult, [InternalOperationData])
handleOperationResult :: forall (m :: * -> *).
MonadThrow m =>
RunOperationResult
-> Int -> m (NonEmpty AppliedResult, [InternalOperationData])
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)

  let (NonEmpty AppliedResult
appliedResults, Maybe [RunError]
runErrors) =
        NonEmpty (NonEmpty AppliedResult, Maybe [RunError])
-> (NonEmpty AppliedResult, Maybe [RunError])
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty AppliedResult, Maybe [RunError])
 -> (NonEmpty AppliedResult, Maybe [RunError]))
-> NonEmpty (NonEmpty AppliedResult, Maybe [RunError])
-> (NonEmpty AppliedResult, Maybe [RunError])
forall a b. (a -> b) -> a -> b
$ (AppliedResult -> NonEmpty AppliedResult)
-> (AppliedResult, Maybe [RunError])
-> (NonEmpty AppliedResult, Maybe [RunError])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AppliedResult -> NonEmpty AppliedResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AppliedResult, Maybe [RunError])
 -> (NonEmpty AppliedResult, Maybe [RunError]))
-> (OperationContent -> (AppliedResult, Maybe [RunError]))
-> OperationContent
-> (NonEmpty AppliedResult, Maybe [RunError])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationContent -> (AppliedResult, Maybe [RunError])
collectResults (OperationContent -> (NonEmpty AppliedResult, Maybe [RunError]))
-> NonEmpty OperationContent
-> NonEmpty (NonEmpty AppliedResult, Maybe [RunError])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty OperationContent
rrOperationContents
      ioDatas :: [InternalOperationData]
ioDatas = (OperationContent -> [InternalOperationData])
-> [OperationContent] -> [InternalOperationData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((InternalOperation -> InternalOperationData)
-> [InternalOperation] -> [InternalOperationData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map InternalOperation -> InternalOperationData
ioData ([InternalOperation] -> [InternalOperationData])
-> (OperationContent -> [InternalOperation])
-> OperationContent
-> [InternalOperationData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunMetadata -> [InternalOperation]
rmInternalOperationResults (RunMetadata -> [InternalOperation])
-> (OperationContent -> RunMetadata)
-> OperationContent
-> [InternalOperation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationContent -> RunMetadata
unOperationContent)
        ([OperationContent] -> [InternalOperationData])
-> [OperationContent] -> [InternalOperationData]
forall a b. (a -> b) -> a -> b
$ NonEmpty OperationContent -> [Element (NonEmpty OperationContent)]
forall t. Container t => t -> [Element t]
toList NonEmpty OperationContent
rrOperationContents

  Maybe [RunError] -> ([RunError] -> m ()) -> m ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe [RunError]
runErrors [RunError] -> m ()
forall (m :: * -> *) a. MonadThrow m => [RunError] -> m a
handleErrors

  pure (NonEmpty AppliedResult
appliedResults, [InternalOperationData]
ioDatas)

  where
    collectResults :: OperationContent -> (AppliedResult, Maybe [RunError])
    collectResults :: OperationContent -> (AppliedResult, Maybe [RunError])
collectResults (OperationContent (RunMetadata OperationResult
res [InternalOperation]
internalOps)) =
      OperationResult
res OperationResult -> [OperationResult] -> [OperationResult]
forall a. a -> [a] -> [a]
: (InternalOperation -> OperationResult)
-> [InternalOperation] -> [OperationResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map InternalOperation -> OperationResult
ioResult [InternalOperation]
internalOps
      [OperationResult]
-> ([OperationResult] -> (AppliedResult, Maybe [RunError]))
-> (AppliedResult, Maybe [RunError])
forall a b. a -> (a -> b) -> b
& ((OperationResult
  -> (AppliedResult, Maybe [RunError])
  -> (AppliedResult, Maybe [RunError]))
 -> (AppliedResult, Maybe [RunError])
 -> [OperationResult]
 -> (AppliedResult, Maybe [RunError]))
-> (AppliedResult, Maybe [RunError])
-> (OperationResult
    -> (AppliedResult, Maybe [RunError])
    -> (AppliedResult, Maybe [RunError]))
-> [OperationResult]
-> (AppliedResult, Maybe [RunError])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OperationResult
 -> (AppliedResult, Maybe [RunError])
 -> (AppliedResult, Maybe [RunError]))
-> (AppliedResult, Maybe [RunError])
-> [OperationResult]
-> (AppliedResult, Maybe [RunError])
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (AppliedResult
forall a. Monoid a => a
mempty, Maybe [RunError]
forall a. Maybe a
Nothing) \case
        OperationApplied AppliedResult
result -> (AppliedResult -> AppliedResult)
-> (AppliedResult, Maybe [RunError])
-> (AppliedResult, Maybe [RunError])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (AppliedResult
result AppliedResult -> AppliedResult -> AppliedResult
forall a. Semigroup a => a -> a -> a
<>)
        OperationFailed [RunError]
errors -> (Maybe [RunError] -> Maybe [RunError])
-> (AppliedResult, Maybe [RunError])
-> (AppliedResult, Maybe [RunError])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([RunError] -> Maybe [RunError]
forall a. a -> Maybe a
Just [RunError]
errors Maybe [RunError] -> Maybe [RunError] -> Maybe [RunError]
forall a. Semigroup a => a -> a -> a
<>)

    handleErrors :: MonadThrow m => [RunError] -> m a
    handleErrors :: forall (m :: * -> *) a. MonadThrow m => [RunError] -> m a
handleErrors [RunError]
errs
      | Just ClientRpcError
err <- [RunError] -> Maybe ClientRpcError
runErrorsToClientError [RunError]
errs = ClientRpcError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientRpcError
err
      | 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


-- | 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.
runErrorsToClientError :: [RunError] -> Maybe ClientRpcError
runErrorsToClientError :: [RunError] -> Maybe ClientRpcError
runErrorsToClientError [RunError]
errs
  | Just ContractAddress
address <- Prism' RunError ContractAddress -> Maybe ContractAddress
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ContractAddress
_RuntimeError
  , Just Expression
expr <- Prism' RunError Expression -> Maybe Expression
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError Expression
_ScriptRejected
  = ClientRpcError -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Expression -> ClientRpcError
ContractFailed ContractAddress
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 -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
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 -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
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 -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ Address -> Expression -> ClientRpcError
BadParameter Address
address (Text -> Expression
expressionString Text
notation)
  | Just ImplicitAddress
address <- Prism' RunError ImplicitAddress -> Maybe ImplicitAddress
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ImplicitAddress
_REEmptyTransaction
  = ClientRpcError -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> ClientRpcError
EmptyTransaction ImplicitAddress
address
  | Just ContractAddress
address <- Prism' RunError ContractAddress -> Maybe ContractAddress
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ContractAddress
_RuntimeError
  , Just ()
_ <- Prism' RunError () -> Maybe ()
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ()
_ScriptOverflow
  = ClientRpcError -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ContractAddress -> ClientRpcError
ShiftOverflow ContractAddress
address
  | Just ContractAddress
address <- Prism' RunError ContractAddress -> Maybe ContractAddress
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ContractAddress
_RuntimeError
  , Just ()
_ <- Prism' RunError () -> Maybe ()
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ()
_GasExhaustedOperation
  = ClientRpcError -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ContractAddress -> ClientRpcError
GasExhaustion ContractAddress
address
  | Just ImplicitAddress
address <- Prism' RunError ImplicitAddress -> Maybe ImplicitAddress
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ImplicitAddress
_PreviouslyRevealedKey
  = ClientRpcError -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> ClientRpcError
KeyAlreadyRevealed ImplicitAddress
address
  | Just ImplicitAddress
address <- Prism' RunError ImplicitAddress -> Maybe ImplicitAddress
forall a. Prism' RunError a -> Maybe a
findError Prism' RunError ImplicitAddress
_UnregisteredDelegate
  = ClientRpcError -> Maybe ClientRpcError
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientRpcError -> Maybe ClientRpcError)
-> ClientRpcError -> Maybe ClientRpcError
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> ClientRpcError
DelegateNotRegistered ImplicitAddress
address
  | Bool
otherwise = Maybe ClientRpcError
forall a. Maybe a
Nothing
  where
    findError :: Prism' RunError a -> Maybe a
    findError :: forall a. 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)
  => ImplicitAddress
  -> Maybe ScrubbedBytes
  -> m ()
revealKeyUnlessRevealed :: forall env (m :: * -> *).
(WithClientLog env m, HasTezosRpc m, HasTezosClient m) =>
ImplicitAddress -> Maybe ScrubbedBytes -> m ()
revealKeyUnlessRevealed ImplicitAddress
addr Maybe ScrubbedBytes
mbPassword = do
  ImplicitAlias
alias <- AddressOrAlias 'AddressKindImplicit
-> m (ResolvedAlias (AddressOrAlias 'AddressKindImplicit))
forall addressOrAlias (m :: * -> *) env.
(HasTezosClient m, WithClientLog env m, MonadThrow m,
 Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAlias addressOrAlias)
getAlias (AddressOrAlias 'AddressKindImplicit
 -> m (ResolvedAlias (AddressOrAlias 'AddressKindImplicit)))
-> AddressOrAlias 'AddressKindImplicit
-> m (ResolvedAlias (AddressOrAlias 'AddressKindImplicit))
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> AddressOrAlias 'AddressKindImplicit
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> AddressOrAlias kind
AddressResolved ImplicitAddress
addr
  Maybe PublicKey
mbManagerKey <- ImplicitAddress -> m (Maybe PublicKey)
forall (m :: * -> *).
HasTezosRpc m =>
ImplicitAddress -> m (Maybe PublicKey)
getManagerKey ImplicitAddress
addr
  case Maybe PublicKey
mbManagerKey of
    Maybe PublicKey
Nothing -> ImplicitAlias -> Maybe ScrubbedBytes -> m ()
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAlias -> Maybe ScrubbedBytes -> m ()
revealKey ImplicitAlias
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
$ ImplicitAlias
alias ImplicitAlias -> 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 -> StringEncode Int64 -> Mutez
computeFee FeeConstants{Milli
Mutez
fcMutezPerOpByte :: FeeConstants -> Milli
fcMutezPerGas :: FeeConstants -> Milli
fcBase :: FeeConstants -> Mutez
fcMutezPerOpByte :: Milli
fcMutezPerGas :: Milli
fcBase :: Mutez
..} Int
opSize StringEncode Int64
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)
-> ([Ratio Integer] -> Either Text Mutez)
-> [Ratio Integer]
-> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => i -> Either Text Mutez
mkMutez @Word64 (Word64 -> Either Text Mutez)
-> ([Ratio Integer] -> Word64)
-> [Ratio Integer]
-> Either Text Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Integer -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Ratio Integer -> Word64)
-> ([Ratio Integer] -> Ratio Integer) -> [Ratio Integer] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ratio Integer] -> Ratio Integer
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([Ratio Integer] -> Mutez) -> [Ratio Integer] -> Mutez
forall a b. (a -> b) -> a -> b
$
    [ Word63 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Word63 -> Ratio Integer) -> Word63 -> Ratio Integer
forall a b. (a -> b) -> a -> b
$ Mutez -> Word63
unMutez Mutez
fcBase
    , Milli -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Milli
fcMutezPerOpByte Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Int -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Int
opSize
    , Milli -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Milli
fcMutezPerGas Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* StringEncode Int64 -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational StringEncode Int64
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 :: forall op extra (m :: * -> *).
Monad m =>
(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 -> StringEncode Int64
computeStorageLimit [AppliedResult]
appliedResults ProtocolParameters
pp = [StringEncode Int64] -> Element [StringEncode Int64]
forall t. (Container t, Num (Element t)) => t -> Element t
sum ([StringEncode Int64] -> Element [StringEncode Int64])
-> [StringEncode Int64] -> Element [StringEncode Int64]
forall a b. (a -> b) -> a -> b
$ (AppliedResult -> StringEncode Int64)
-> [AppliedResult] -> [StringEncode Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\AppliedResult
ar -> [StringEncode Int64] -> Element [StringEncode Int64]
forall t. (Container t, Num (Element t)) => t -> Element t
sum
  [ AppliedResult -> StringEncode Int64
arPaidStorageDiff AppliedResult
ar
  , (AppliedResult -> StringEncode Int64
arAllocatedDestinationContracts AppliedResult
ar) StringEncode Int64 -> StringEncode Int64 -> StringEncode Int64
forall a. Num a => a -> a -> a
* Int -> StringEncode Int64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral (ProtocolParameters -> Int
ppOriginationSize ProtocolParameters
pp)
  , Int -> StringEncode Int64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral ([ContractAddress] -> Int
forall t. Container t => t -> Int
length ([ContractAddress] -> Int) -> [ContractAddress] -> Int
forall a b. (a -> b) -> a -> b
$ AppliedResult -> [ContractAddress]
arOriginatedContracts AppliedResult
ar) StringEncode Int64 -> StringEncode Int64 -> StringEncode Int64
forall a. Num a => a -> a -> a
* Int -> StringEncode Int64
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 :: StringEncode Int64
-> StringEncode Int64
-> TezosMutez
-> CommonOperationData
-> CommonOperationData
updateCommonData StringEncode Int64
gasLimit StringEncode Int64
storageLimit TezosMutez
fee CommonOperationData
commonData =
  CommonOperationData
commonData
  { codGasLimit :: StringEncode Int64
codGasLimit = StringEncode Int64
gasLimit
  , codStorageLimit :: StringEncode Int64
codStorageLimit = StringEncode Int64
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'