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

-- | Executor and typechecker of a contract in Morley language.

module Morley.Michelson.Runtime
  (
    -- * High level interface for end user
    originateContract
  , runContract
  , transfer
  , runCode
  , runView
  , RunCodeParameters(..)
  , runCodeParameters
  , resolveRunCodeBigMaps
  , mkBigMapFinder
  , CommonRunOptions(..)
  , ContractSpecification (..)
  , ContractSimpleOriginationData(..)

  -- * Other helpers
  , parseContract
  , parseExpandContract
  , readAndParseContract
  , prepareContract

  -- * Re-exports
  , ContractState (..)
  , VotingPowers
  , mkVotingPowers
  , mkVotingPowersFromMap
  , TxData (..)
  , TxParam (..)

  -- * For testing
  , ExecutorOp (..)
  , ExecutorRes (..)
  , erGState
  , erUpdates
  , erInterpretResults
  , erRemainingSteps
  , ExecutorError' (..)
  , ExecutorErrorPrim (..)
  , ExecutorError
  , ExecutorM
  , runExecutorM
  , runExecutorMWithDB
  , executeGlobalOperations
  , executeGlobalOrigination
  , executeOrigination
  , executeTransfer
  , ExecutorState(..)
  , esGState
  , esRemainingSteps
  , esSourceAddress
  , esLog
  , esOperationHash
  , esPrevCounters
  , ExecutorLog(..)
  , SomeInterpretResult(..)
  , elInterpreterResults
  , elUpdates
  ) where

import Control.Lens (assign, at, each, ix, makeLenses, to, (.=), (<>=))
import Control.Monad.Except (Except, liftEither, runExcept, throwError)
import Data.Coerce (coerce)
import Data.Constraint (Dict(..), (\\))
import Data.Default (Default(..))
import Data.HashSet qualified as HS
import Data.Semigroup.Generic (GenericSemigroupMonoid(..))
import Data.Singletons (demote)
import Data.Text.IO (getContents)
import Data.Text.IO.Utf8 qualified as Utf8 (readFile)
import Data.Type.Equality (pattern Refl)
import Data.Typeable (cast)
import Fmt (Buildable(build), blockListF, fmt, indentF, nameF, pretty, unlinesF, (+|), (|+))
import Text.Megaparsec (parse)

import Morley.Michelson.Interpret
import Morley.Michelson.Macro (ParsedOp, expandContract)
import Morley.Michelson.Parser qualified as P
import Morley.Michelson.Runtime.Dummy
import Morley.Michelson.Runtime.GState
import Morley.Michelson.Runtime.RunCode
import Morley.Michelson.Runtime.TxData
import Morley.Michelson.TypeCheck
import Morley.Michelson.TypeCheck.Helpers (checkContractDeprecations, checkSingDeprecations)
import Morley.Michelson.Typed
  (Constrained(..), CreateContract(..), EntrypointCallT, EpName, Operation'(..),
  SomeContractAndStorage(..), SomeStorage, TransferTokens(..), sing)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Operation
import Morley.Michelson.Untyped (Contract)
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Core
  (Mutez, Timestamp(..), getCurrentTime, unsafeAddMutez, unsafeSubMutez, zeroMutez)
import Morley.Tezos.Crypto (KeyHash)
import Morley.Util.Interpolate (itu)
import Morley.Util.MismatchError
import Morley.Util.Named

----------------------------------------------------------------------------
-- Auxiliary types
----------------------------------------------------------------------------

-- | Operations executed by interpreter.
-- In our model one Michelson's operation (@operation@ type in Michelson)
-- corresponds to 0 or 1 interpreter operation.
--
-- Note: 'Address' is not part of 'TxData', because 'TxData' is
-- supposed to be provided by the user, while 'Address' can be
-- computed by our code.
data ExecutorOp
  = OriginateOp OriginationOperation
  -- ^ Originate a contract.
  | TransferOp TransferOperation
  -- ^ Transfer tokens to the address.
  | SetDelegateOp SetDelegateOperation
  -- ^ Set the delegate of a contract.
  | EmitOp EmitOperation
  -- ^ Emit contract event.
  deriving stock (Int -> ExecutorOp -> ShowS
[ExecutorOp] -> ShowS
ExecutorOp -> String
(Int -> ExecutorOp -> ShowS)
-> (ExecutorOp -> String)
-> ([ExecutorOp] -> ShowS)
-> Show ExecutorOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutorOp -> ShowS
showsPrec :: Int -> ExecutorOp -> ShowS
$cshow :: ExecutorOp -> String
show :: ExecutorOp -> String
$cshowList :: [ExecutorOp] -> ShowS
showList :: [ExecutorOp] -> ShowS
Show)

instance Buildable ExecutorOp where
  build :: ExecutorOp -> Doc
build = \case
    TransferOp TransferOperation
op -> TransferOperation -> Doc
forall a. Buildable a => a -> Doc
build TransferOperation
op
    OriginateOp OriginationOperation
op -> OriginationOperation -> Doc
forall a. Buildable a => a -> Doc
build OriginationOperation
op
    SetDelegateOp SetDelegateOperation
op -> SetDelegateOperation -> Doc
forall a. Buildable a => a -> Doc
build SetDelegateOperation
op
    EmitOp EmitOperation
op -> EmitOperation -> Doc
forall a. Buildable a => a -> Doc
build EmitOperation
op

data SomeInterpretResult = forall st. SomeInterpretResult
  { ()
unSomeInterpretResult :: InterpretResult st
  }

deriving stock instance Show SomeInterpretResult

-- | Result of a single execution of interpreter.
data ExecutorRes = ExecutorRes
  { ExecutorRes -> GState
_erGState :: GState
  -- ^ New 'GState'.
  , ExecutorRes -> [GStateUpdate]
_erUpdates :: [GStateUpdate]
  -- ^ Updates applied to 'GState'.
  , ExecutorRes -> [(Address, SomeInterpretResult)]
_erInterpretResults :: [(Address, SomeInterpretResult)]
  -- ^ During execution a contract can print logs and in the end it returns
  -- a pair. All logs and returned values are kept until all called contracts
  -- are executed. In the end they are printed.
  , ExecutorRes -> RemainingSteps
_erRemainingSteps :: RemainingSteps
  -- ^ Now much gas all remaining executions can consume.
  } deriving stock Int -> ExecutorRes -> ShowS
[ExecutorRes] -> ShowS
ExecutorRes -> String
(Int -> ExecutorRes -> ShowS)
-> (ExecutorRes -> String)
-> ([ExecutorRes] -> ShowS)
-> Show ExecutorRes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutorRes -> ShowS
showsPrec :: Int -> ExecutorRes -> ShowS
$cshow :: ExecutorRes -> String
show :: ExecutorRes -> String
$cshowList :: [ExecutorRes] -> ShowS
showList :: [ExecutorRes] -> ShowS
Show

data ExecutorEnv = ExecutorEnv
  { ExecutorEnv -> Timestamp
_eeNow :: Timestamp
  , ExecutorEnv -> Natural
_eeLevel :: Natural
  , ExecutorEnv -> Natural
_eeMinBlockTime :: Natural
  , ExecutorEnv -> TypeCheckOptions
_eeTcOpts :: TypeCheckOptions
  , ExecutorEnv -> [ExecutorOp]
_eeCallChain :: [ExecutorOp]
  }
  deriving stock ((forall x. ExecutorEnv -> Rep ExecutorEnv x)
-> (forall x. Rep ExecutorEnv x -> ExecutorEnv)
-> Generic ExecutorEnv
forall x. Rep ExecutorEnv x -> ExecutorEnv
forall x. ExecutorEnv -> Rep ExecutorEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecutorEnv -> Rep ExecutorEnv x
from :: forall x. ExecutorEnv -> Rep ExecutorEnv x
$cto :: forall x. Rep ExecutorEnv x -> ExecutorEnv
to :: forall x. Rep ExecutorEnv x -> ExecutorEnv
Generic)

data ExecutorState = ExecutorState
  { ExecutorState -> GState
_esGState :: GState
  , ExecutorState -> RemainingSteps
_esRemainingSteps :: RemainingSteps
  , ExecutorState -> Maybe L1Address
_esSourceAddress :: Maybe L1Address
  , ExecutorState -> ExecutorLog
_esLog :: ExecutorLog
  , ExecutorState -> OperationHash
_esOperationHash :: ~OperationHash
  , ExecutorState -> HashSet GlobalCounter
_esPrevCounters :: HashSet GlobalCounter
  }
  deriving stock (Int -> ExecutorState -> ShowS
[ExecutorState] -> ShowS
ExecutorState -> String
(Int -> ExecutorState -> ShowS)
-> (ExecutorState -> String)
-> ([ExecutorState] -> ShowS)
-> Show ExecutorState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutorState -> ShowS
showsPrec :: Int -> ExecutorState -> ShowS
$cshow :: ExecutorState -> String
show :: ExecutorState -> String
$cshowList :: [ExecutorState] -> ShowS
showList :: [ExecutorState] -> ShowS
Show, (forall x. ExecutorState -> Rep ExecutorState x)
-> (forall x. Rep ExecutorState x -> ExecutorState)
-> Generic ExecutorState
forall x. Rep ExecutorState x -> ExecutorState
forall x. ExecutorState -> Rep ExecutorState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecutorState -> Rep ExecutorState x
from :: forall x. ExecutorState -> Rep ExecutorState x
$cto :: forall x. Rep ExecutorState x -> ExecutorState
to :: forall x. Rep ExecutorState x -> ExecutorState
Generic)

data ExecutorLog = ExecutorLog
  { ExecutorLog -> [GStateUpdate]
_elUpdates :: [GStateUpdate]
  , ExecutorLog -> [(Address, SomeInterpretResult)]
_elInterpreterResults :: [(Address, SomeInterpretResult)]
  }
  deriving stock (Int -> ExecutorLog -> ShowS
[ExecutorLog] -> ShowS
ExecutorLog -> String
(Int -> ExecutorLog -> ShowS)
-> (ExecutorLog -> String)
-> ([ExecutorLog] -> ShowS)
-> Show ExecutorLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutorLog -> ShowS
showsPrec :: Int -> ExecutorLog -> ShowS
$cshow :: ExecutorLog -> String
show :: ExecutorLog -> String
$cshowList :: [ExecutorLog] -> ShowS
showList :: [ExecutorLog] -> ShowS
Show, (forall x. ExecutorLog -> Rep ExecutorLog x)
-> (forall x. Rep ExecutorLog x -> ExecutorLog)
-> Generic ExecutorLog
forall x. Rep ExecutorLog x -> ExecutorLog
forall x. ExecutorLog -> Rep ExecutorLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecutorLog -> Rep ExecutorLog x
from :: forall x. ExecutorLog -> Rep ExecutorLog x
$cto :: forall x. Rep ExecutorLog x -> ExecutorLog
to :: forall x. Rep ExecutorLog x -> ExecutorLog
Generic)
  deriving (NonEmpty ExecutorLog -> ExecutorLog
ExecutorLog -> ExecutorLog -> ExecutorLog
(ExecutorLog -> ExecutorLog -> ExecutorLog)
-> (NonEmpty ExecutorLog -> ExecutorLog)
-> (forall b. Integral b => b -> ExecutorLog -> ExecutorLog)
-> Semigroup ExecutorLog
forall b. Integral b => b -> ExecutorLog -> ExecutorLog
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ExecutorLog -> ExecutorLog -> ExecutorLog
<> :: ExecutorLog -> ExecutorLog -> ExecutorLog
$csconcat :: NonEmpty ExecutorLog -> ExecutorLog
sconcat :: NonEmpty ExecutorLog -> ExecutorLog
$cstimes :: forall b. Integral b => b -> ExecutorLog -> ExecutorLog
stimes :: forall b. Integral b => b -> ExecutorLog -> ExecutorLog
Semigroup, Semigroup ExecutorLog
ExecutorLog
Semigroup ExecutorLog
-> ExecutorLog
-> (ExecutorLog -> ExecutorLog -> ExecutorLog)
-> ([ExecutorLog] -> ExecutorLog)
-> Monoid ExecutorLog
[ExecutorLog] -> ExecutorLog
ExecutorLog -> ExecutorLog -> ExecutorLog
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ExecutorLog
mempty :: ExecutorLog
$cmappend :: ExecutorLog -> ExecutorLog -> ExecutorLog
mappend :: ExecutorLog -> ExecutorLog -> ExecutorLog
$cmconcat :: [ExecutorLog] -> ExecutorLog
mconcat :: [ExecutorLog] -> ExecutorLog
Monoid) via GenericSemigroupMonoid ExecutorLog

makeLenses ''ExecutorRes
makeLenses ''ExecutorEnv
makeLenses ''ExecutorState
makeLenses ''ExecutorLog

-- | 'ExecutorErrorPrim', enriched by the list of operations that succeeded
-- before the error.
data ExecutorError' a = ExecutorError
  { forall a. ExecutorError' a -> [ExecutorOp]
eeCallStack :: [ExecutorOp]
  , forall a. ExecutorError' a -> ExecutorErrorPrim a
eeError :: ExecutorErrorPrim a
  } deriving stock (Int -> ExecutorError' a -> ShowS
[ExecutorError' a] -> ShowS
ExecutorError' a -> String
(Int -> ExecutorError' a -> ShowS)
-> (ExecutorError' a -> String)
-> ([ExecutorError' a] -> ShowS)
-> Show (ExecutorError' a)
forall a. Show a => Int -> ExecutorError' a -> ShowS
forall a. Show a => [ExecutorError' a] -> ShowS
forall a. Show a => ExecutorError' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ExecutorError' a -> ShowS
showsPrec :: Int -> ExecutorError' a -> ShowS
$cshow :: forall a. Show a => ExecutorError' a -> String
show :: ExecutorError' a -> String
$cshowList :: forall a. Show a => [ExecutorError' a] -> ShowS
showList :: [ExecutorError' a] -> ShowS
Show, (forall a b. (a -> b) -> ExecutorError' a -> ExecutorError' b)
-> (forall a b. a -> ExecutorError' b -> ExecutorError' a)
-> Functor ExecutorError'
forall a b. a -> ExecutorError' b -> ExecutorError' a
forall a b. (a -> b) -> ExecutorError' a -> ExecutorError' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ExecutorError' a -> ExecutorError' b
fmap :: forall a b. (a -> b) -> ExecutorError' a -> ExecutorError' b
$c<$ :: forall a b. a -> ExecutorError' b -> ExecutorError' a
<$ :: forall a b. a -> ExecutorError' b -> ExecutorError' a
Functor, (forall m. Monoid m => ExecutorError' m -> m)
-> (forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m)
-> (forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m)
-> (forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b)
-> (forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b)
-> (forall a. (a -> a -> a) -> ExecutorError' a -> a)
-> (forall a. (a -> a -> a) -> ExecutorError' a -> a)
-> (forall a. ExecutorError' a -> [a])
-> (forall a. ExecutorError' a -> Bool)
-> (forall a. ExecutorError' a -> Int)
-> (forall a. Eq a => a -> ExecutorError' a -> Bool)
-> (forall a. Ord a => ExecutorError' a -> a)
-> (forall a. Ord a => ExecutorError' a -> a)
-> (forall a. Num a => ExecutorError' a -> a)
-> (forall a. Num a => ExecutorError' a -> a)
-> Foldable ExecutorError'
forall a. Eq a => a -> ExecutorError' a -> Bool
forall a. Num a => ExecutorError' a -> a
forall a. Ord a => ExecutorError' a -> a
forall m. Monoid m => ExecutorError' m -> m
forall a. ExecutorError' a -> Bool
forall a. ExecutorError' a -> Int
forall a. ExecutorError' a -> [a]
forall a. (a -> a -> a) -> ExecutorError' a -> a
forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ExecutorError' m -> m
fold :: forall m. Monoid m => ExecutorError' m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ExecutorError' a -> a
foldr1 :: forall a. (a -> a -> a) -> ExecutorError' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ExecutorError' a -> a
foldl1 :: forall a. (a -> a -> a) -> ExecutorError' a -> a
$ctoList :: forall a. ExecutorError' a -> [a]
toList :: forall a. ExecutorError' a -> [a]
$cnull :: forall a. ExecutorError' a -> Bool
null :: forall a. ExecutorError' a -> Bool
$clength :: forall a. ExecutorError' a -> Int
length :: forall a. ExecutorError' a -> Int
$celem :: forall a. Eq a => a -> ExecutorError' a -> Bool
elem :: forall a. Eq a => a -> ExecutorError' a -> Bool
$cmaximum :: forall a. Ord a => ExecutorError' a -> a
maximum :: forall a. Ord a => ExecutorError' a -> a
$cminimum :: forall a. Ord a => ExecutorError' a -> a
minimum :: forall a. Ord a => ExecutorError' a -> a
$csum :: forall a. Num a => ExecutorError' a -> a
sum :: forall a. Num a => ExecutorError' a -> a
$cproduct :: forall a. Num a => ExecutorError' a -> a
product :: forall a. Num a => ExecutorError' a -> a
Foldable, Functor ExecutorError'
Foldable ExecutorError'
Functor ExecutorError'
-> Foldable ExecutorError'
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ExecutorError' a -> f (ExecutorError' b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ExecutorError' (f a) -> f (ExecutorError' a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ExecutorError' a -> m (ExecutorError' b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ExecutorError' (m a) -> m (ExecutorError' a))
-> Traversable ExecutorError'
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ExecutorError' (m a) -> m (ExecutorError' a)
forall (f :: * -> *) a.
Applicative f =>
ExecutorError' (f a) -> f (ExecutorError' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorError' a -> m (ExecutorError' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorError' a -> f (ExecutorError' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorError' a -> f (ExecutorError' b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorError' a -> f (ExecutorError' b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ExecutorError' (f a) -> f (ExecutorError' a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ExecutorError' (f a) -> f (ExecutorError' a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorError' a -> m (ExecutorError' b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorError' a -> m (ExecutorError' b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ExecutorError' (m a) -> m (ExecutorError' a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ExecutorError' (m a) -> m (ExecutorError' a)
Traversable)

-- | Errors that can happen during contract interpreting.
-- Type parameter @a@ determines how contracts will be represented
-- in these errors, e.g. 'Address'.
data ExecutorErrorPrim a
  = EEUnknownContract a
  -- ^ The interpreted contract hasn't been originated.
  | EEInterpreterFailed a (InterpretError Void)
  -- ^ Interpretation of Michelson contract failed.
  | EEViewLookupError a ViewLookupError
  -- ^ Error looking up view while trying to call it.
  | EEViewArgTcError a TcError
  -- ^ Error type-checking untyped view argument.
  | EEUnknownAddressAlias SomeAlias
  -- ^ The given alias isn't associated with any address
  -- OR is associated with an address of an unexpected kind
  -- (e.g. we expected an implicit address and found a contract address, or vice-versa).
  | EEUnknownL1AddressAlias Text
  -- ^ The given alias is not associated with any address.
  | EEAmbiguousAlias Text ImplicitAddress ContractAddress
  -- ^ The given alias is ambiguous, i.e. it is associated with __both__ an
  -- implicit address and a contract address.
  | EEUnknownSender a
  -- ^ Sender address is unknown.
  | EEUnknownManager a
  -- ^ Manager address is unknown.
  | EENotEnoughFunds a Mutez
  -- ^ Sender doesn't have enough funds.
  | EEEmptyImplicitContract a
  -- ^ Sender is an implicit address with the balance of 0. We mimic
  -- @octez-client@ in calling it "Empty implicit contract".
  | EEZeroTransaction a
  -- ^ Sending 0tz towards an address.
  | EEFailedToApplyUpdates GStateUpdateError
  -- ^ Failed to apply updates to GState.
  | EEIllTypedParameter a TcError
  -- ^ Contract parameter is ill-typed.
  | EEDeprecatedType TcError
  -- ^ Found deprecated types.
  | EEUnexpectedParameterType a (MismatchError T.T)
  -- ^ Contract parameter is well-typed, but its type does
  -- not match the entrypoint's type.
  | EEUnknownEntrypoint EpName
  -- ^ Specified entrypoint to run is not found.
  | EETransactionFromContract a Mutez
  -- ^ A transaction from an originated contract was attempted as a global operation.
  | EEWrongParameterType a
  -- ^ Type of parameter in transfer to an implicit account is not Unit.
  | EEOperationReplay ExecutorOp
  -- ^ An attempt to perform the operation duplicated with @DUP@ instruction.
  | EEGlobalOperationSourceNotImplicit Address
  -- ^ Attempted to initiate global operation from a non-implicit address.
  | EEGlobalEmitOp
  -- ^ Trying to run emit operation as a global operation, which should be impossible.
  deriving stock (Int -> ExecutorErrorPrim a -> ShowS
[ExecutorErrorPrim a] -> ShowS
ExecutorErrorPrim a -> String
(Int -> ExecutorErrorPrim a -> ShowS)
-> (ExecutorErrorPrim a -> String)
-> ([ExecutorErrorPrim a] -> ShowS)
-> Show (ExecutorErrorPrim a)
forall a. Show a => Int -> ExecutorErrorPrim a -> ShowS
forall a. Show a => [ExecutorErrorPrim a] -> ShowS
forall a. Show a => ExecutorErrorPrim a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ExecutorErrorPrim a -> ShowS
showsPrec :: Int -> ExecutorErrorPrim a -> ShowS
$cshow :: forall a. Show a => ExecutorErrorPrim a -> String
show :: ExecutorErrorPrim a -> String
$cshowList :: forall a. Show a => [ExecutorErrorPrim a] -> ShowS
showList :: [ExecutorErrorPrim a] -> ShowS
Show, (forall a b.
 (a -> b) -> ExecutorErrorPrim a -> ExecutorErrorPrim b)
-> (forall a b. a -> ExecutorErrorPrim b -> ExecutorErrorPrim a)
-> Functor ExecutorErrorPrim
forall a b. a -> ExecutorErrorPrim b -> ExecutorErrorPrim a
forall a b. (a -> b) -> ExecutorErrorPrim a -> ExecutorErrorPrim b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ExecutorErrorPrim a -> ExecutorErrorPrim b
fmap :: forall a b. (a -> b) -> ExecutorErrorPrim a -> ExecutorErrorPrim b
$c<$ :: forall a b. a -> ExecutorErrorPrim b -> ExecutorErrorPrim a
<$ :: forall a b. a -> ExecutorErrorPrim b -> ExecutorErrorPrim a
Functor, (forall m. Monoid m => ExecutorErrorPrim m -> m)
-> (forall m a. Monoid m => (a -> m) -> ExecutorErrorPrim a -> m)
-> (forall m a. Monoid m => (a -> m) -> ExecutorErrorPrim a -> m)
-> (forall a b. (a -> b -> b) -> b -> ExecutorErrorPrim a -> b)
-> (forall a b. (a -> b -> b) -> b -> ExecutorErrorPrim a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExecutorErrorPrim a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExecutorErrorPrim a -> b)
-> (forall a. (a -> a -> a) -> ExecutorErrorPrim a -> a)
-> (forall a. (a -> a -> a) -> ExecutorErrorPrim a -> a)
-> (forall a. ExecutorErrorPrim a -> [a])
-> (forall a. ExecutorErrorPrim a -> Bool)
-> (forall a. ExecutorErrorPrim a -> Int)
-> (forall a. Eq a => a -> ExecutorErrorPrim a -> Bool)
-> (forall a. Ord a => ExecutorErrorPrim a -> a)
-> (forall a. Ord a => ExecutorErrorPrim a -> a)
-> (forall a. Num a => ExecutorErrorPrim a -> a)
-> (forall a. Num a => ExecutorErrorPrim a -> a)
-> Foldable ExecutorErrorPrim
forall a. Eq a => a -> ExecutorErrorPrim a -> Bool
forall a. Num a => ExecutorErrorPrim a -> a
forall a. Ord a => ExecutorErrorPrim a -> a
forall m. Monoid m => ExecutorErrorPrim m -> m
forall a. ExecutorErrorPrim a -> Bool
forall a. ExecutorErrorPrim a -> Int
forall a. ExecutorErrorPrim a -> [a]
forall a. (a -> a -> a) -> ExecutorErrorPrim a -> a
forall m a. Monoid m => (a -> m) -> ExecutorErrorPrim a -> m
forall b a. (b -> a -> b) -> b -> ExecutorErrorPrim a -> b
forall a b. (a -> b -> b) -> b -> ExecutorErrorPrim a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ExecutorErrorPrim m -> m
fold :: forall m. Monoid m => ExecutorErrorPrim m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ExecutorErrorPrim a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ExecutorErrorPrim a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ExecutorErrorPrim a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ExecutorErrorPrim a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ExecutorErrorPrim a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ExecutorErrorPrim a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ExecutorErrorPrim a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ExecutorErrorPrim a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ExecutorErrorPrim a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ExecutorErrorPrim a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ExecutorErrorPrim a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ExecutorErrorPrim a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ExecutorErrorPrim a -> a
foldr1 :: forall a. (a -> a -> a) -> ExecutorErrorPrim a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ExecutorErrorPrim a -> a
foldl1 :: forall a. (a -> a -> a) -> ExecutorErrorPrim a -> a
$ctoList :: forall a. ExecutorErrorPrim a -> [a]
toList :: forall a. ExecutorErrorPrim a -> [a]
$cnull :: forall a. ExecutorErrorPrim a -> Bool
null :: forall a. ExecutorErrorPrim a -> Bool
$clength :: forall a. ExecutorErrorPrim a -> Int
length :: forall a. ExecutorErrorPrim a -> Int
$celem :: forall a. Eq a => a -> ExecutorErrorPrim a -> Bool
elem :: forall a. Eq a => a -> ExecutorErrorPrim a -> Bool
$cmaximum :: forall a. Ord a => ExecutorErrorPrim a -> a
maximum :: forall a. Ord a => ExecutorErrorPrim a -> a
$cminimum :: forall a. Ord a => ExecutorErrorPrim a -> a
minimum :: forall a. Ord a => ExecutorErrorPrim a -> a
$csum :: forall a. Num a => ExecutorErrorPrim a -> a
sum :: forall a. Num a => ExecutorErrorPrim a -> a
$cproduct :: forall a. Num a => ExecutorErrorPrim a -> a
product :: forall a. Num a => ExecutorErrorPrim a -> a
Foldable, Functor ExecutorErrorPrim
Foldable ExecutorErrorPrim
Functor ExecutorErrorPrim
-> Foldable ExecutorErrorPrim
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ExecutorErrorPrim a -> f (ExecutorErrorPrim b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ExecutorErrorPrim (f a) -> f (ExecutorErrorPrim a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ExecutorErrorPrim a -> m (ExecutorErrorPrim b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ExecutorErrorPrim (m a) -> m (ExecutorErrorPrim a))
-> Traversable ExecutorErrorPrim
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ExecutorErrorPrim (m a) -> m (ExecutorErrorPrim a)
forall (f :: * -> *) a.
Applicative f =>
ExecutorErrorPrim (f a) -> f (ExecutorErrorPrim a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorErrorPrim a -> m (ExecutorErrorPrim b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorErrorPrim a -> f (ExecutorErrorPrim b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorErrorPrim a -> f (ExecutorErrorPrim b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorErrorPrim a -> f (ExecutorErrorPrim b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ExecutorErrorPrim (f a) -> f (ExecutorErrorPrim a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ExecutorErrorPrim (f a) -> f (ExecutorErrorPrim a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorErrorPrim a -> m (ExecutorErrorPrim b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorErrorPrim a -> m (ExecutorErrorPrim b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ExecutorErrorPrim (m a) -> m (ExecutorErrorPrim a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ExecutorErrorPrim (m a) -> m (ExecutorErrorPrim a)
Traversable)

instance (Buildable a) => Buildable (ExecutorErrorPrim a) where
  build :: ExecutorErrorPrim a -> Doc
build =
    \case
      EEUnknownAddressAlias (SomeAlias (Alias a
alias :: Alias kind)) ->
        [itu|The alias '#{alias}' is not associated to a #{kind} address|]
        where
          kind :: AddressKind
kind = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: AddressKind).
(SingKind AddressKind, SingI a) =>
Demote AddressKind
demote @kind ((L1AddressKind a, SingI a) => AddressKind)
-> Dict (L1AddressKind a, SingI a) -> AddressKind
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Alias a -> Dict (L1AddressKind a, SingI a)
forall (kind :: AddressKind).
Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity Alias a
alias :: AddressKind
      EEUnknownL1AddressAlias Text
aliasText ->
        [itu|The alias '#{aliasText}' is not associated with any address|]
      EEAmbiguousAlias Text
aliasText KindedAddress 'AddressKindImplicit
implicitAddr ContractAddress
contractAddr ->
        [itu|
        The alias '#{aliasText}' is assigned to both:
          * a contract address: #{contractAddr}
          * and an implicit address: #{implicitAddr}
        Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate.
        |]
      EEUnknownContract a
addr -> Doc
"The contract is not originated " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EEInterpreterFailed a
addr InterpretError Void
err ->
        Doc
"Michelson interpreter failed for contract " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
": " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| InterpretError Void
err InterpretError Void -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EEViewLookupError a
addr ViewLookupError
err ->
        Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF (Doc
"View lookup for contract " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" failed") (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ViewLookupError -> Doc
forall a. Buildable a => a -> Doc
build ViewLookupError
err
      EEViewArgTcError a
addr TcError
err ->
        Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF (Doc
"Typechecking view argument for contract " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" failed") (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ TcError -> Doc
forall a. Buildable a => a -> Doc
build TcError
err
      EEUnknownSender a
addr -> Doc
"The sender address is unknown " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EEUnknownManager a
addr -> Doc
"The manager address is unknown " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EENotEnoughFunds a
addr Mutez
amount ->
        Doc
"The sender (" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+
        Doc
") doesn't have enough funds (has only " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
amount Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
")"
      EEEmptyImplicitContract a
addr ->
        Doc
"Empty implicit contract (" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
")"
      EEZeroTransaction a
addr ->
        Doc
"Transaction of 0ꜩ towards a key address " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" which has no code is prohibited"
      EEFailedToApplyUpdates GStateUpdateError
err -> Doc
"Failed to update GState: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| GStateUpdateError
err GStateUpdateError -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EEIllTypedParameter a
_ TcError
err -> Doc
"The contract parameter is ill-typed: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| TcError
err TcError -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EEDeprecatedType TcError
err -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Deprecation error" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ TcError -> Doc
forall a. Buildable a => a -> Doc
build TcError
err
      EEUnexpectedParameterType a
_ MismatchError T
merr ->
        Doc
"The contract parameter is well-typed, but did not match the contract's entrypoint's type.\n"
        Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| MismatchError T
merr MismatchError T -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EEUnknownEntrypoint EpName
epName -> Doc
"The contract does not contain entrypoint '" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| EpName
epName EpName -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"'"
      EETransactionFromContract a
addr Mutez
amount ->
        Doc
"Global transaction of funds (" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
amount Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
") from an originated contract (" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
") is prohibited."
      EEWrongParameterType a
addr ->
        Doc
"Bad contract parameter for: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| a
addr a -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EEOperationReplay ExecutorOp
op ->
        Doc
"Operation replay attempt:\n" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Int -> Doc -> Doc
indentF Int
2 (ExecutorOp -> Doc
forall a. Buildable a => a -> Doc
build ExecutorOp
op) Doc -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      EEGlobalOperationSourceNotImplicit Address
addr ->
        Doc
"Attempted to initiate global operation from a non-implicit address " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Address
addr Address -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
      ExecutorErrorPrim a
EEGlobalEmitOp ->
        Doc
"Attempted to run emit event as a global operation, this should be impossible."

-- | To reduce friction between 'ExecutorError'' and 'ExecutorErrorPrim', this
-- instance will try to run 'fromException' for both.
instance (Typeable a, Show a, Buildable a) => Exception (ExecutorErrorPrim a) where
  displayException :: ExecutorErrorPrim a -> String
displayException = ExecutorErrorPrim a -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
  fromException :: SomeException -> Maybe (ExecutorErrorPrim a)
fromException (SomeException e
exc) = e -> Maybe (ExecutorErrorPrim a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
exc Maybe (ExecutorErrorPrim a)
-> Maybe (ExecutorErrorPrim a) -> Maybe (ExecutorErrorPrim a)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ExecutorError' a -> ExecutorErrorPrim a)
-> Maybe (ExecutorError' a) -> Maybe (ExecutorErrorPrim a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExecutorError' a -> ExecutorErrorPrim a
forall a. ExecutorError' a -> ExecutorErrorPrim a
eeError (e -> Maybe (ExecutorError' a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
exc)

instance (Buildable a) => Buildable (ExecutorError' a) where
  build :: ExecutorError' a -> Doc
build ExecutorError{[ExecutorOp]
ExecutorErrorPrim a
eeCallStack :: forall a. ExecutorError' a -> [ExecutorOp]
eeError :: forall a. ExecutorError' a -> ExecutorErrorPrim a
eeCallStack :: [ExecutorOp]
eeError :: ExecutorErrorPrim a
..} = [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
    [ ExecutorErrorPrim a -> Doc
forall a. Buildable a => a -> Doc
build ExecutorErrorPrim a
eeError
    , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"While running" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ExecutorOp -> Doc
forall a. Buildable a => a -> Doc
build (ExecutorOp -> Doc) -> [ExecutorOp] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExecutorOp]
eeCallStack
    ]

type ExecutorError = ExecutorError' Address

instance (Typeable a, Show a, Buildable a) => Exception (ExecutorError' a) where
  displayException :: ExecutorError' a -> String
displayException = ExecutorError' a -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty

----------------------------------------------------------------------------
-- Interface
----------------------------------------------------------------------------

-- | Parse a contract from 'Text'.
parseContract
  :: P.MichelsonSource -> Text -> Either P.ParserException (U.Contract' ParsedOp)
parseContract :: MichelsonSource
-> Text -> Either ParserException (Contract' ParsedOp)
parseContract MichelsonSource
source =
  (ParseErrorBundle Text CustomParserException -> ParserException)
-> Either
     (ParseErrorBundle Text CustomParserException) (Contract' ParsedOp)
-> Either ParserException (Contract' ParsedOp)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text CustomParserException -> ParserException
P.ParserException (Either
   (ParseErrorBundle Text CustomParserException) (Contract' ParsedOp)
 -> Either ParserException (Contract' ParsedOp))
-> (Text
    -> Either
         (ParseErrorBundle Text CustomParserException) (Contract' ParsedOp))
-> Text
-> Either ParserException (Contract' ParsedOp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec CustomParserException Text (Contract' ParsedOp)
-> String
-> Text
-> Either
     (ParseErrorBundle Text CustomParserException) (Contract' ParsedOp)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec CustomParserException Text (Contract' ParsedOp)
P.program (MichelsonSource -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty MichelsonSource
source)

-- | Parse a contract from 'Text' and expand macros.
parseExpandContract
  :: P.MichelsonSource -> Text -> Either P.ParserException Contract
parseExpandContract :: MichelsonSource -> Text -> Either ParserException Contract
parseExpandContract = (Contract' ParsedOp -> Contract)
-> Either ParserException (Contract' ParsedOp)
-> Either ParserException Contract
forall a b.
(a -> b) -> Either ParserException a -> Either ParserException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Contract' ParsedOp -> Contract
expandContract (Either ParserException (Contract' ParsedOp)
 -> Either ParserException Contract)
-> (MichelsonSource
    -> Text -> Either ParserException (Contract' ParsedOp))
-> MichelsonSource
-> Text
-> Either ParserException Contract
forall a b c. SuperComposition a b c => a -> b -> c
... MichelsonSource
-> Text -> Either ParserException (Contract' ParsedOp)
parseContract

-- | Read and parse a contract from give path or `stdin` (if the
-- argument is 'Nothing'). The contract is not expanded.
readAndParseContract :: Maybe FilePath -> IO (U.Contract' ParsedOp)
readAndParseContract :: Maybe String -> IO (Contract' ParsedOp)
readAndParseContract Maybe String
mFilename = do
  Text
code <- Maybe String -> IO Text
readCode Maybe String
mFilename
  (ParserException -> IO (Contract' ParsedOp))
-> (Contract' ParsedOp -> IO (Contract' ParsedOp))
-> Either ParserException (Contract' ParsedOp)
-> IO (Contract' ParsedOp)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParserException -> IO (Contract' ParsedOp)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Contract' ParsedOp -> IO (Contract' ParsedOp)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParserException (Contract' ParsedOp)
 -> IO (Contract' ParsedOp))
-> Either ParserException (Contract' ParsedOp)
-> IO (Contract' ParsedOp)
forall a b. (a -> b) -> a -> b
$ MichelsonSource
-> Text -> Either ParserException (Contract' ParsedOp)
parseContract (Maybe String -> MichelsonSource
toSrc Maybe String
mFilename) Text
code
  where
    readCode :: Maybe FilePath -> IO Text
    readCode :: Maybe String -> IO Text
readCode = IO Text -> (String -> IO Text) -> Maybe String -> IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Text
getContents String -> IO Text
forall (m :: * -> *). MonadIO m => String -> m Text
Utf8.readFile

    toSrc :: Maybe FilePath -> P.MichelsonSource
    toSrc :: Maybe String -> MichelsonSource
toSrc = MichelsonSource
-> (String -> MichelsonSource) -> Maybe String -> MichelsonSource
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MichelsonSource
P.MSUnspecified String -> MichelsonSource
P.MSFile

-- | Read a contract using 'readAndParseContract', expand and
-- flatten. The contract is not type checked.
prepareContract :: Maybe FilePath -> IO Contract
prepareContract :: Maybe String -> IO Contract
prepareContract Maybe String
mFile = Contract' ParsedOp -> Contract
expandContract (Contract' ParsedOp -> Contract)
-> IO (Contract' ParsedOp) -> IO Contract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> IO (Contract' ParsedOp)
readAndParseContract Maybe String
mFile

-- | Originate a contract. Returns the address of the originated
-- contract.
originateContract
  :: "dbPath" :! FilePath
  -> "tcOpts" :? TypeCheckOptions
  -> "originator" :? ImplicitAddress
  -> "alias" :? ContractAlias
  -> "delegate" :? KeyHash
  -> "csod" :! ContractSimpleOriginationData U.Contract
  -> "verbose" :? Bool
  -> IO ContractAddress
originateContract :: ("dbPath" :! String)
-> ("tcOpts" :? TypeCheckOptions)
-> ("originator" :? KindedAddress 'AddressKindImplicit)
-> ("alias" :? ContractAlias)
-> ("delegate" :? KeyHash)
-> ("csod" :! ContractSimpleOriginationData Contract)
-> ("verbose" :? Bool)
-> IO ContractAddress
originateContract
  (Name "dbPath" -> ("dbPath" :! String) -> String
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "dbPath"
#dbPath -> String
croDBPath)
  (Name "tcOpts"
-> TypeCheckOptions
-> ("tcOpts" :? TypeCheckOptions)
-> TypeCheckOptions
forall (name :: Symbol) a. Name name -> a -> (name :? a) -> a
argDef Name "tcOpts"
#tcOpts TypeCheckOptions
forall a. Default a => a
def -> TypeCheckOptions
croTCOpts)
  "originator" :? KindedAddress 'AddressKindImplicit
originator
  "alias" :? ContractAlias
alias
  (Name "delegate" -> ("delegate" :? KeyHash) -> Maybe KeyHash
forall (name :: Symbol) (f :: * -> *) a.
Name name -> NamedF f a name -> f a
argF Name "delegate"
#delegate -> Maybe KeyHash
mbDelegate)
  (Name "csod"
-> ("csod" :! ContractSimpleOriginationData Contract)
-> ContractSimpleOriginationData Contract
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "csod"
#csod -> ContractSimpleOriginationData Contract
csod)
  (Name "verbose" -> Bool -> ("verbose" :? Bool) -> Bool
forall (name :: Symbol) a. Name name -> a -> (name :? a) -> a
argDef Name "verbose"
#verbose Bool
False -> Bool
croVerbose)
  = do
  OriginationOperation
origination <- (TcError -> IO OriginationOperation)
-> (OriginationOperation -> IO OriginationOperation)
-> Either TcError OriginationOperation
-> IO OriginationOperation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError -> IO OriginationOperation
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM OriginationOperation -> IO OriginationOperation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TcError OriginationOperation -> IO OriginationOperation)
-> Either TcError OriginationOperation -> IO OriginationOperation
forall a b. (a -> b) -> a -> b
$
    TypeCheckOptions
-> ContractSimpleOriginationData Contract
-> ("originator" :? KindedAddress 'AddressKindImplicit)
-> ("alias" :? ContractAlias)
-> NamedF Maybe (Maybe KeyHash) "delegate"
-> Either TcError OriginationOperation
mkOrigination TypeCheckOptions
croTCOpts ContractSimpleOriginationData Contract
csod "originator" :? KindedAddress 'AddressKindImplicit
originator "alias" :? ContractAlias
alias (NamedF Maybe (Maybe KeyHash) "delegate"
 -> Either TcError OriginationOperation)
-> Param (NamedF Maybe (Maybe KeyHash) "delegate")
-> Either TcError OriginationOperation
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Maybe KeyHash -> Param (NamedF Maybe (Maybe KeyHash) "delegate")
forall (x :: Symbol) a. IsLabel x a => a
#delegate Maybe KeyHash
mbDelegate
  let croDryRun :: Bool
croDryRun = Bool
False
  ((ExecutorRes, ContractAddress) -> ContractAddress)
-> IO (ExecutorRes, ContractAddress) -> IO ContractAddress
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, ContractAddress) -> ContractAddress
forall a b. (a, b) -> b
snd (IO (ExecutorRes, ContractAddress) -> IO ContractAddress)
-> IO (ExecutorRes, ContractAddress) -> IO ContractAddress
forall a b. (a -> b) -> a -> b
$ CommonRunOptions
-> ExecutorM ContractAddress -> IO (ExecutorRes, ContractAddress)
forall a. CommonRunOptions -> ExecutorM a -> IO (ExecutorRes, a)
runExecutorMWithDB CommonRunOptions
forall a. Default a => a
def{String
croDBPath :: String
croDBPath :: String
croDBPath, Bool
croDryRun :: Bool
croDryRun :: Bool
croDryRun, Bool
croVerbose :: Bool
croVerbose :: Bool
croVerbose, TypeCheckOptions
croTCOpts :: TypeCheckOptions
croTCOpts :: TypeCheckOptions
croTCOpts} (ExecutorM ContractAddress -> IO (ExecutorRes, ContractAddress))
-> ExecutorM ContractAddress -> IO (ExecutorRes, ContractAddress)
forall a b. (a -> b) -> a -> b
$
    OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination OriginationOperation
origination

-- | Run a contract. The contract is originated first (if it's not
-- already) and then we pretend that we send a transaction to it.
runContract
  :: CommonRunOptions
  -> ContractSimpleOriginationData U.Contract
  -> TxData
  -> IO SomeStorage
runContract :: CommonRunOptions
-> ContractSimpleOriginationData Contract
-> TxData
-> IO SomeStorage
runContract cro :: CommonRunOptions
cro@CommonRunOptions{Bool
Natural
String
Maybe Timestamp
TypeCheckOptions
RemainingSteps
croDBPath :: CommonRunOptions -> String
croDryRun :: CommonRunOptions -> Bool
croVerbose :: CommonRunOptions -> Bool
croTCOpts :: CommonRunOptions -> TypeCheckOptions
croNow :: Maybe Timestamp
croLevel :: Natural
croMinBlockTime :: Natural
croMaxSteps :: RemainingSteps
croDBPath :: String
croTCOpts :: TypeCheckOptions
croVerbose :: Bool
croDryRun :: Bool
croNow :: CommonRunOptions -> Maybe Timestamp
croLevel :: CommonRunOptions -> Natural
croMinBlockTime :: CommonRunOptions -> Natural
croMaxSteps :: CommonRunOptions -> RemainingSteps
..} ContractSimpleOriginationData Contract
csOrig TxData
txData = do
  OriginationOperation
origination <- (TcError -> IO OriginationOperation)
-> (OriginationOperation -> IO OriginationOperation)
-> Either TcError OriginationOperation
-> IO OriginationOperation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError -> IO OriginationOperation
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM OriginationOperation -> IO OriginationOperation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TcError OriginationOperation -> IO OriginationOperation)
-> Either TcError OriginationOperation -> IO OriginationOperation
forall a b. (a -> b) -> a -> b
$ TypeCheckOptions
-> ContractSimpleOriginationData Contract
-> ("originator" :? KindedAddress 'AddressKindImplicit)
-> ("alias" :? ContractAlias)
-> NamedF Maybe (Maybe KeyHash) "delegate"
-> Either TcError OriginationOperation
mkOrigination TypeCheckOptions
croTCOpts ContractSimpleOriginationData Contract
csOrig (("originator" :? KindedAddress 'AddressKindImplicit)
 -> ("alias" :? ContractAlias)
 -> NamedF Maybe (Maybe KeyHash) "delegate"
 -> Either TcError OriginationOperation)
-> Param Defaults -> Either TcError OriginationOperation
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Param Defaults
forall a. Default a => a
def
  (ExecutorRes
_, SomeStorage
newSt) <- CommonRunOptions
-> ExecutorM SomeStorage -> IO (ExecutorRes, SomeStorage)
forall a. CommonRunOptions -> ExecutorM a -> IO (ExecutorRes, a)
runExecutorMWithDB CommonRunOptions
cro do
    -- Here we are safe to bypass executeGlobalOperations for origination,
    -- since origination can't generate more operations.
    ContractAddress
addr <- OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination OriginationOperation
origination
    let transferOp :: ExecutorOp
transferOp = TransferOperation -> ExecutorOp
TransferOp (TransferOperation -> ExecutorOp)
-> TransferOperation -> ExecutorOp
forall a b. (a -> b) -> a -> b
$ Address -> TxData -> GlobalCounter -> TransferOperation
TransferOperation (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr) TxData
txData GlobalCounter
1
    ReaderT
  ExecutorEnv
  (StateT ExecutorState (Except ExecutorError))
  [EmitOperation]
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT
   ExecutorEnv
   (StateT ExecutorState (Except ExecutorError))
   [EmitOperation]
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeGlobalOperations [ExecutorOp
transferOp]
    ContractAddress -> ExecutorM SomeStorage
getContractStorage ContractAddress
addr
  SomeStorage -> IO SomeStorage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SomeStorage
newSt
  where
    getContractStorage :: ContractAddress -> ExecutorM SomeStorage
    getContractStorage :: ContractAddress -> ExecutorM SomeStorage
getContractStorage ContractAddress
addr = do
      Map ContractAddress ContractState
addrs <- Getting
  (Map ContractAddress ContractState)
  ExecutorState
  (Map ContractAddress ContractState)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Map ContractAddress ContractState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Map ContractAddress ContractState) GState)
-> ExecutorState
-> Const (Map ContractAddress ContractState) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (Map ContractAddress ContractState) GState)
 -> ExecutorState
 -> Const (Map ContractAddress ContractState) ExecutorState)
-> ((Map ContractAddress ContractState
     -> Const
          (Map ContractAddress ContractState)
          (Map ContractAddress ContractState))
    -> GState -> Const (Map ContractAddress ContractState) GState)
-> Getting
     (Map ContractAddress ContractState)
     ExecutorState
     (Map ContractAddress ContractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ContractAddress ContractState
 -> Const
      (Map ContractAddress ContractState)
      (Map ContractAddress ContractState))
-> GState -> Const (Map ContractAddress ContractState) GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL)
      case Map ContractAddress ContractState
addrs Map ContractAddress ContractState
-> Getting
     (Maybe ContractState)
     (Map ContractAddress ContractState)
     (Maybe ContractState)
-> Maybe ContractState
forall s a. s -> Getting a s a -> a
^. Index (Map ContractAddress ContractState)
-> Lens'
     (Map ContractAddress ContractState)
     (Maybe (IxValue (Map ContractAddress ContractState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ContractAddress ContractState)
ContractAddress
addr of
        Maybe ContractState
Nothing -> Text -> ExecutorM SomeStorage
forall a. HasCallStack => Text -> a
error (Text -> ExecutorM SomeStorage) -> Text -> ExecutorM SomeStorage
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty ContractAddress
addr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is unknown"
        Just ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
csBalance :: Mutez
csContract :: Contract cp st
csStorage :: Value st
csDelegate :: Maybe KeyHash
csBalance :: ContractState -> Mutez
csContract :: ()
csStorage :: ()
csDelegate :: ContractState -> Maybe KeyHash
..} -> SomeStorage -> ExecutorM SomeStorage
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeStorage -> ExecutorM SomeStorage)
-> SomeStorage -> ExecutorM SomeStorage
forall a b. (a -> b) -> a -> b
$ Value st -> SomeStorage
forall (t :: T). StorageScope t => Value t -> SomeStorage
SomeStorage Value st
csStorage

data ContractSpecification a
  = ContractSpecAddressOrAlias ContractAddressOrAlias
  | ContractSpecOrigination a
  deriving stock ((forall a b.
 (a -> b) -> ContractSpecification a -> ContractSpecification b)
-> (forall a b.
    a -> ContractSpecification b -> ContractSpecification a)
-> Functor ContractSpecification
forall a b. a -> ContractSpecification b -> ContractSpecification a
forall a b.
(a -> b) -> ContractSpecification a -> ContractSpecification b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ContractSpecification a -> ContractSpecification b
fmap :: forall a b.
(a -> b) -> ContractSpecification a -> ContractSpecification b
$c<$ :: forall a b. a -> ContractSpecification b -> ContractSpecification a
<$ :: forall a b. a -> ContractSpecification b -> ContractSpecification a
Functor, (forall m. Monoid m => ContractSpecification m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ContractSpecification a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ContractSpecification a -> m)
-> (forall a b. (a -> b -> b) -> b -> ContractSpecification a -> b)
-> (forall a b. (a -> b -> b) -> b -> ContractSpecification a -> b)
-> (forall b a. (b -> a -> b) -> b -> ContractSpecification a -> b)
-> (forall b a. (b -> a -> b) -> b -> ContractSpecification a -> b)
-> (forall a. (a -> a -> a) -> ContractSpecification a -> a)
-> (forall a. (a -> a -> a) -> ContractSpecification a -> a)
-> (forall a. ContractSpecification a -> [a])
-> (forall a. ContractSpecification a -> Bool)
-> (forall a. ContractSpecification a -> Int)
-> (forall a. Eq a => a -> ContractSpecification a -> Bool)
-> (forall a. Ord a => ContractSpecification a -> a)
-> (forall a. Ord a => ContractSpecification a -> a)
-> (forall a. Num a => ContractSpecification a -> a)
-> (forall a. Num a => ContractSpecification a -> a)
-> Foldable ContractSpecification
forall a. Eq a => a -> ContractSpecification a -> Bool
forall a. Num a => ContractSpecification a -> a
forall a. Ord a => ContractSpecification a -> a
forall m. Monoid m => ContractSpecification m -> m
forall a. ContractSpecification a -> Bool
forall a. ContractSpecification a -> Int
forall a. ContractSpecification a -> [a]
forall a. (a -> a -> a) -> ContractSpecification a -> a
forall m a. Monoid m => (a -> m) -> ContractSpecification a -> m
forall b a. (b -> a -> b) -> b -> ContractSpecification a -> b
forall a b. (a -> b -> b) -> b -> ContractSpecification a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ContractSpecification m -> m
fold :: forall m. Monoid m => ContractSpecification m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ContractSpecification a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ContractSpecification a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ContractSpecification a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ContractSpecification a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ContractSpecification a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ContractSpecification a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ContractSpecification a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ContractSpecification a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ContractSpecification a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ContractSpecification a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ContractSpecification a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ContractSpecification a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ContractSpecification a -> a
foldr1 :: forall a. (a -> a -> a) -> ContractSpecification a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ContractSpecification a -> a
foldl1 :: forall a. (a -> a -> a) -> ContractSpecification a -> a
$ctoList :: forall a. ContractSpecification a -> [a]
toList :: forall a. ContractSpecification a -> [a]
$cnull :: forall a. ContractSpecification a -> Bool
null :: forall a. ContractSpecification a -> Bool
$clength :: forall a. ContractSpecification a -> Int
length :: forall a. ContractSpecification a -> Int
$celem :: forall a. Eq a => a -> ContractSpecification a -> Bool
elem :: forall a. Eq a => a -> ContractSpecification a -> Bool
$cmaximum :: forall a. Ord a => ContractSpecification a -> a
maximum :: forall a. Ord a => ContractSpecification a -> a
$cminimum :: forall a. Ord a => ContractSpecification a -> a
minimum :: forall a. Ord a => ContractSpecification a -> a
$csum :: forall a. Num a => ContractSpecification a -> a
sum :: forall a. Num a => ContractSpecification a -> a
$cproduct :: forall a. Num a => ContractSpecification a -> a
product :: forall a. Num a => ContractSpecification a -> a
Foldable, Functor ContractSpecification
Foldable ContractSpecification
Functor ContractSpecification
-> Foldable ContractSpecification
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> ContractSpecification a -> f (ContractSpecification b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ContractSpecification (f a) -> f (ContractSpecification a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> ContractSpecification a -> m (ContractSpecification b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ContractSpecification (m a) -> m (ContractSpecification a))
-> Traversable ContractSpecification
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ContractSpecification (m a) -> m (ContractSpecification a)
forall (f :: * -> *) a.
Applicative f =>
ContractSpecification (f a) -> f (ContractSpecification a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ContractSpecification a -> m (ContractSpecification b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSpecification a -> f (ContractSpecification b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSpecification a -> f (ContractSpecification b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSpecification a -> f (ContractSpecification b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ContractSpecification (f a) -> f (ContractSpecification a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ContractSpecification (f a) -> f (ContractSpecification a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ContractSpecification a -> m (ContractSpecification b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ContractSpecification a -> m (ContractSpecification b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ContractSpecification (m a) -> m (ContractSpecification a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ContractSpecification (m a) -> m (ContractSpecification a)
Traversable)

data ContractSimpleOriginationData a = ContractSimpleOriginationData
  { forall a. ContractSimpleOriginationData a -> a
csodContract :: a
  , forall a. ContractSimpleOriginationData a -> Value
csodStorage :: U.Value
  , forall a. ContractSimpleOriginationData a -> Mutez
csodBalance :: Mutez
  }
  deriving stock ((forall a b.
 (a -> b)
 -> ContractSimpleOriginationData a
 -> ContractSimpleOriginationData b)
-> (forall a b.
    a
    -> ContractSimpleOriginationData b
    -> ContractSimpleOriginationData a)
-> Functor ContractSimpleOriginationData
forall a b.
a
-> ContractSimpleOriginationData b
-> ContractSimpleOriginationData a
forall a b.
(a -> b)
-> ContractSimpleOriginationData a
-> ContractSimpleOriginationData b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b)
-> ContractSimpleOriginationData a
-> ContractSimpleOriginationData b
fmap :: forall a b.
(a -> b)
-> ContractSimpleOriginationData a
-> ContractSimpleOriginationData b
$c<$ :: forall a b.
a
-> ContractSimpleOriginationData b
-> ContractSimpleOriginationData a
<$ :: forall a b.
a
-> ContractSimpleOriginationData b
-> ContractSimpleOriginationData a
Functor, (forall m. Monoid m => ContractSimpleOriginationData m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ContractSimpleOriginationData a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ContractSimpleOriginationData a -> m)
-> (forall a b.
    (a -> b -> b) -> b -> ContractSimpleOriginationData a -> b)
-> (forall a b.
    (a -> b -> b) -> b -> ContractSimpleOriginationData a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> ContractSimpleOriginationData a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> ContractSimpleOriginationData a -> b)
-> (forall a.
    (a -> a -> a) -> ContractSimpleOriginationData a -> a)
-> (forall a.
    (a -> a -> a) -> ContractSimpleOriginationData a -> a)
-> (forall a. ContractSimpleOriginationData a -> [a])
-> (forall a. ContractSimpleOriginationData a -> Bool)
-> (forall a. ContractSimpleOriginationData a -> Int)
-> (forall a. Eq a => a -> ContractSimpleOriginationData a -> Bool)
-> (forall a. Ord a => ContractSimpleOriginationData a -> a)
-> (forall a. Ord a => ContractSimpleOriginationData a -> a)
-> (forall a. Num a => ContractSimpleOriginationData a -> a)
-> (forall a. Num a => ContractSimpleOriginationData a -> a)
-> Foldable ContractSimpleOriginationData
forall a. Eq a => a -> ContractSimpleOriginationData a -> Bool
forall a. Num a => ContractSimpleOriginationData a -> a
forall a. Ord a => ContractSimpleOriginationData a -> a
forall m. Monoid m => ContractSimpleOriginationData m -> m
forall a. ContractSimpleOriginationData a -> Bool
forall a. ContractSimpleOriginationData a -> Int
forall a. ContractSimpleOriginationData a -> [a]
forall a. (a -> a -> a) -> ContractSimpleOriginationData a -> a
forall m a.
Monoid m =>
(a -> m) -> ContractSimpleOriginationData a -> m
forall b a.
(b -> a -> b) -> b -> ContractSimpleOriginationData a -> b
forall a b.
(a -> b -> b) -> b -> ContractSimpleOriginationData a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ContractSimpleOriginationData m -> m
fold :: forall m. Monoid m => ContractSimpleOriginationData m -> m
$cfoldMap :: forall m a.
Monoid m =>
(a -> m) -> ContractSimpleOriginationData a -> m
foldMap :: forall m a.
Monoid m =>
(a -> m) -> ContractSimpleOriginationData a -> m
$cfoldMap' :: forall m a.
Monoid m =>
(a -> m) -> ContractSimpleOriginationData a -> m
foldMap' :: forall m a.
Monoid m =>
(a -> m) -> ContractSimpleOriginationData a -> m
$cfoldr :: forall a b.
(a -> b -> b) -> b -> ContractSimpleOriginationData a -> b
foldr :: forall a b.
(a -> b -> b) -> b -> ContractSimpleOriginationData a -> b
$cfoldr' :: forall a b.
(a -> b -> b) -> b -> ContractSimpleOriginationData a -> b
foldr' :: forall a b.
(a -> b -> b) -> b -> ContractSimpleOriginationData a -> b
$cfoldl :: forall b a.
(b -> a -> b) -> b -> ContractSimpleOriginationData a -> b
foldl :: forall b a.
(b -> a -> b) -> b -> ContractSimpleOriginationData a -> b
$cfoldl' :: forall b a.
(b -> a -> b) -> b -> ContractSimpleOriginationData a -> b
foldl' :: forall b a.
(b -> a -> b) -> b -> ContractSimpleOriginationData a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ContractSimpleOriginationData a -> a
foldr1 :: forall a. (a -> a -> a) -> ContractSimpleOriginationData a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ContractSimpleOriginationData a -> a
foldl1 :: forall a. (a -> a -> a) -> ContractSimpleOriginationData a -> a
$ctoList :: forall a. ContractSimpleOriginationData a -> [a]
toList :: forall a. ContractSimpleOriginationData a -> [a]
$cnull :: forall a. ContractSimpleOriginationData a -> Bool
null :: forall a. ContractSimpleOriginationData a -> Bool
$clength :: forall a. ContractSimpleOriginationData a -> Int
length :: forall a. ContractSimpleOriginationData a -> Int
$celem :: forall a. Eq a => a -> ContractSimpleOriginationData a -> Bool
elem :: forall a. Eq a => a -> ContractSimpleOriginationData a -> Bool
$cmaximum :: forall a. Ord a => ContractSimpleOriginationData a -> a
maximum :: forall a. Ord a => ContractSimpleOriginationData a -> a
$cminimum :: forall a. Ord a => ContractSimpleOriginationData a -> a
minimum :: forall a. Ord a => ContractSimpleOriginationData a -> a
$csum :: forall a. Num a => ContractSimpleOriginationData a -> a
sum :: forall a. Num a => ContractSimpleOriginationData a -> a
$cproduct :: forall a. Num a => ContractSimpleOriginationData a -> a
product :: forall a. Num a => ContractSimpleOriginationData a -> a
Foldable, Functor ContractSimpleOriginationData
Foldable ContractSimpleOriginationData
Functor ContractSimpleOriginationData
-> Foldable ContractSimpleOriginationData
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> ContractSimpleOriginationData a
    -> f (ContractSimpleOriginationData b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ContractSimpleOriginationData (f a)
    -> f (ContractSimpleOriginationData a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> ContractSimpleOriginationData a
    -> m (ContractSimpleOriginationData b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ContractSimpleOriginationData (m a)
    -> m (ContractSimpleOriginationData a))
-> Traversable ContractSimpleOriginationData
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ContractSimpleOriginationData (m a)
-> m (ContractSimpleOriginationData a)
forall (f :: * -> *) a.
Applicative f =>
ContractSimpleOriginationData (f a)
-> f (ContractSimpleOriginationData a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ContractSimpleOriginationData a
-> m (ContractSimpleOriginationData b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSimpleOriginationData a
-> f (ContractSimpleOriginationData b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSimpleOriginationData a
-> f (ContractSimpleOriginationData b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSimpleOriginationData a
-> f (ContractSimpleOriginationData b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ContractSimpleOriginationData (f a)
-> f (ContractSimpleOriginationData a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ContractSimpleOriginationData (f a)
-> f (ContractSimpleOriginationData a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ContractSimpleOriginationData a
-> m (ContractSimpleOriginationData b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ContractSimpleOriginationData a
-> m (ContractSimpleOriginationData b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ContractSimpleOriginationData (m a)
-> m (ContractSimpleOriginationData a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ContractSimpleOriginationData (m a)
-> m (ContractSimpleOriginationData a)
Traversable)

data CommonRunOptions = CommonRunOptions
  { CommonRunOptions -> Maybe Timestamp
croNow :: Maybe Timestamp
  , CommonRunOptions -> Natural
croLevel :: Natural
  , CommonRunOptions -> Natural
croMinBlockTime :: Natural
  , CommonRunOptions -> RemainingSteps
croMaxSteps :: RemainingSteps
  , CommonRunOptions -> String
croDBPath :: FilePath
  , CommonRunOptions -> TypeCheckOptions
croTCOpts :: TypeCheckOptions
  , CommonRunOptions -> Bool
croVerbose :: Bool
  , CommonRunOptions -> Bool
croDryRun :: Bool
  }

instance Default CommonRunOptions where
  def :: CommonRunOptions
def = CommonRunOptions
    { croNow :: Maybe Timestamp
croNow = Maybe Timestamp
forall a. Maybe a
Nothing
    , croLevel :: Natural
croLevel = Natural
0
    , croMinBlockTime :: Natural
croMinBlockTime = Natural
dummyMinBlockTime
    , croMaxSteps :: RemainingSteps
croMaxSteps = RemainingSteps
dummyMaxSteps
    , croDBPath :: String
croDBPath = String
"db.json"
    , croTCOpts :: TypeCheckOptions
croTCOpts = TypeCheckOptions
forall a. Default a => a
def
    , croVerbose :: Bool
croVerbose = Bool
False
    , croDryRun :: Bool
croDryRun = Bool
True
    }

-- | Run a contract view. The contract is originated first (if it's not already)
-- and then we pretend that we send a transaction to it.
runView
  :: CommonRunOptions
  -> ContractSpecification (ContractSimpleOriginationData U.Contract)
  -> U.ViewName
  -> SomeAddressOrAlias
  -> TxParam
  -> IO T.SomeValue
runView :: CommonRunOptions
-> ContractSpecification (ContractSimpleOriginationData Contract)
-> ViewName
-> SomeAddressOrAlias
-> TxParam
-> IO SomeValue
runView cro :: CommonRunOptions
cro@CommonRunOptions{Bool
Natural
String
Maybe Timestamp
TypeCheckOptions
RemainingSteps
croDBPath :: CommonRunOptions -> String
croDryRun :: CommonRunOptions -> Bool
croVerbose :: CommonRunOptions -> Bool
croTCOpts :: CommonRunOptions -> TypeCheckOptions
croNow :: CommonRunOptions -> Maybe Timestamp
croLevel :: CommonRunOptions -> Natural
croMinBlockTime :: CommonRunOptions -> Natural
croMaxSteps :: CommonRunOptions -> RemainingSteps
croNow :: Maybe Timestamp
croLevel :: Natural
croMinBlockTime :: Natural
croMaxSteps :: RemainingSteps
croDBPath :: String
croTCOpts :: TypeCheckOptions
croVerbose :: Bool
croDryRun :: Bool
..} ContractSpecification (ContractSimpleOriginationData Contract)
contractOrAddr ViewName
viewName SomeAddressOrAlias
sender' TxParam
viewArg = do
  ContractSpecification OriginationOperation
origination <- (ContractSimpleOriginationData Contract -> IO OriginationOperation)
-> ContractSpecification (ContractSimpleOriginationData Contract)
-> IO (ContractSpecification OriginationOperation)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ContractSpecification a -> f (ContractSpecification b)
traverse ((TcError -> IO OriginationOperation)
-> (OriginationOperation -> IO OriginationOperation)
-> Either TcError OriginationOperation
-> IO OriginationOperation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError -> IO OriginationOperation
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM OriginationOperation -> IO OriginationOperation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TcError OriginationOperation -> IO OriginationOperation)
-> (ContractSimpleOriginationData Contract
    -> Either TcError OriginationOperation)
-> ContractSimpleOriginationData Contract
-> IO OriginationOperation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeCheckOptions
-> ContractSimpleOriginationData Contract
-> ("originator" :? KindedAddress 'AddressKindImplicit)
-> ("alias" :? ContractAlias)
-> NamedF Maybe (Maybe KeyHash) "delegate"
-> Either TcError OriginationOperation
mkOrigination TypeCheckOptions
croTCOpts (ContractSimpleOriginationData Contract
 -> ("originator" :? KindedAddress 'AddressKindImplicit)
 -> ("alias" :? ContractAlias)
 -> NamedF Maybe (Maybe KeyHash) "delegate"
 -> Either TcError OriginationOperation)
-> Param Defaults
-> ContractSimpleOriginationData Contract
-> Either TcError OriginationOperation
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Param Defaults
forall a. Default a => a
def)) ContractSpecification (ContractSimpleOriginationData Contract)
contractOrAddr
  (ExecutorRes
_, SomeValue
newSt) <- CommonRunOptions
-> ExecutorM SomeValue -> IO (ExecutorRes, SomeValue)
forall a. CommonRunOptions -> ExecutorM a -> IO (ExecutorRes, a)
runExecutorMWithDB CommonRunOptions
cro do
      ContractAddress
addr <- case ContractSpecification OriginationOperation
origination of
        ContractSpecAddressOrAlias ContractAddressOrAlias
addr -> ContractAddressOrAlias -> ExecutorM ContractAddress
resolveContractAddress ContractAddressOrAlias
addr
        ContractSpecOrigination OriginationOperation
origOp -> OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination OriginationOperation
origOp
      -- Here we are safe to bypass executeGlobalOperations for origination,
      -- since origination can't generate more operations.
      L1Address
sender <- SomeAddressOrAlias -> ExecutorM L1Address
resolveAddress SomeAddressOrAlias
sender'
      L1Address
-> ContractAddress -> ViewName -> TxParam -> ExecutorM SomeValue
callView L1Address
sender ContractAddress
addr ViewName
viewName TxParam
viewArg
  SomeValue -> IO SomeValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SomeValue
newSt

mkOrigination
  :: TypeCheckOptions
  -> ContractSimpleOriginationData U.Contract
  -> "originator" :? ImplicitAddress
  -> "alias" :? ContractAlias
  -> "delegate" :? Maybe KeyHash
  -> Either TcError OriginationOperation
mkOrigination :: TypeCheckOptions
-> ContractSimpleOriginationData Contract
-> ("originator" :? KindedAddress 'AddressKindImplicit)
-> ("alias" :? ContractAlias)
-> NamedF Maybe (Maybe KeyHash) "delegate"
-> Either TcError OriginationOperation
mkOrigination TypeCheckOptions
tcOpts ContractSimpleOriginationData{Mutez
Value
Contract
csodContract :: forall a. ContractSimpleOriginationData a -> a
csodStorage :: forall a. ContractSimpleOriginationData a -> Value
csodBalance :: forall a. ContractSimpleOriginationData a -> Mutez
csodContract :: Contract
csodStorage :: Value
csodBalance :: Mutez
..}
  (Name "originator"
-> KindedAddress 'AddressKindImplicit
-> ("originator" :? KindedAddress 'AddressKindImplicit)
-> KindedAddress 'AddressKindImplicit
forall (name :: Symbol) a. Name name -> a -> (name :? a) -> a
argDef Name "originator"
#originator KindedAddress 'AddressKindImplicit
genesisAddress -> KindedAddress 'AddressKindImplicit
ooOriginator)
  (Name "alias" -> ("alias" :? ContractAlias) -> Maybe ContractAlias
forall (name :: Symbol) (f :: * -> *) a.
Name name -> NamedF f a name -> f a
argF Name "alias"
#alias -> Maybe ContractAlias
ooAlias)
  (Name "delegate"
-> Maybe KeyHash
-> NamedF Maybe (Maybe KeyHash) "delegate"
-> Maybe KeyHash
forall (name :: Symbol) a. Name name -> a -> (name :? a) -> a
argDef Name "delegate"
#delegate (KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just KeyHash
dummyDelegate) -> Maybe KeyHash
ooDelegate)
  = do
  SomeContractAndStorage Contract cp st
ooContract Value st
ooStorage <- TypeCheckOptions
-> TypeCheckResult ExpandedOp SomeContractAndStorage
-> Either TcError SomeContractAndStorage
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
tcOpts (TypeCheckResult ExpandedOp SomeContractAndStorage
 -> Either TcError SomeContractAndStorage)
-> TypeCheckResult ExpandedOp SomeContractAndStorage
-> Either TcError SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$
    Contract
-> Value -> TypeCheckResult ExpandedOp SomeContractAndStorage
typeCheckContractAndStorage Contract
csodContract Value
csodStorage
  OriginationOperation -> Either TcError OriginationOperation
forall a. a -> Either TcError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OriginationOperation
    { ooBalance :: Mutez
ooBalance = Mutez
csodBalance
    , ooCounter :: GlobalCounter
ooCounter = GlobalCounter
0
    , Maybe KeyHash
Maybe ContractAlias
KindedAddress 'AddressKindImplicit
Contract cp st
Value st
ooOriginator :: KindedAddress 'AddressKindImplicit
ooAlias :: Maybe ContractAlias
ooDelegate :: Maybe KeyHash
ooContract :: Contract cp st
ooStorage :: Value st
ooOriginator :: KindedAddress 'AddressKindImplicit
ooDelegate :: Maybe KeyHash
ooStorage :: Value st
ooContract :: Contract cp st
ooAlias :: Maybe ContractAlias
..
    }

-- | We hardcode some random key hash here as delegate to make sure that:
--
-- 1. Contract's address won't clash with already originated one (because it may
-- have different storage value which may be confusing).
--
-- 2. If one uses this functionality twice with the same contract and other
-- data, the contract will have the same address.
dummyDelegate :: KeyHash
dummyDelegate :: KeyHash
dummyDelegate =  let ImplicitAddress KeyHash
kh = [ta|tz1YCABRTa6H8PLKx2EtDWeCGPaKxUhNgv47|] in KeyHash
kh

-- | Construct 'BigMapFinder' using the current executor context.
mkBigMapFinder :: ExecutorM BigMapFinder
mkBigMapFinder :: ExecutorM BigMapFinder
mkBigMapFinder = do
  ExecutorState
pureState <- ReaderT
  ExecutorEnv
  (StateT ExecutorState (Except ExecutorError))
  ExecutorState
forall s (m :: * -> *). MonadState s m => m s
get

  pure \Natural
bigMapId ->
    ExecutorState
pureState ExecutorState
-> Getting (First SomeVBigMap) ExecutorState SomeVBigMap
-> Maybe SomeVBigMap
forall s a. s -> Getting (First a) s a -> Maybe a
^?
      (GState -> Const (First SomeVBigMap) GState)
-> ExecutorState -> Const (First SomeVBigMap) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (First SomeVBigMap) GState)
 -> ExecutorState -> Const (First SomeVBigMap) ExecutorState)
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
    -> GState -> Const (First SomeVBigMap) GState)
-> Getting (First SomeVBigMap) ExecutorState SomeVBigMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ContractAddress ContractState
 -> Const (First SomeVBigMap) (Map ContractAddress ContractState))
-> GState -> Const (First SomeVBigMap) GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL ((Map ContractAddress ContractState
  -> Const (First SomeVBigMap) (Map ContractAddress ContractState))
 -> GState -> Const (First SomeVBigMap) GState)
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
    -> Map ContractAddress ContractState
    -> Const (First SomeVBigMap) (Map ContractAddress ContractState))
-> (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> GState
-> Const (First SomeVBigMap) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractState -> Const (First SomeVBigMap) ContractState)
-> Map ContractAddress ContractState
-> Const (First SomeVBigMap) (Map ContractAddress ContractState)
forall s t a b. Each s t a b => Traversal s t a b
Traversal
  (Map ContractAddress ContractState)
  (Map ContractAddress ContractState)
  ContractState
  ContractState
each ((ContractState -> Const (First SomeVBigMap) ContractState)
 -> Map ContractAddress ContractState
 -> Const (First SomeVBigMap) (Map ContractAddress ContractState))
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
    -> ContractState -> Const (First SomeVBigMap) ContractState)
-> (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> Map ContractAddress ContractState
-> Const (First SomeVBigMap) (Map ContractAddress ContractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractState -> SomeValue)
-> (SomeValue -> Const (First SomeVBigMap) SomeValue)
-> ContractState
-> Const (First SomeVBigMap) ContractState
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ContractState -> SomeValue
getContractStorage ((SomeValue -> Const (First SomeVBigMap) SomeValue)
 -> ContractState -> Const (First SomeVBigMap) ContractState)
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
    -> SomeValue -> Const (First SomeVBigMap) SomeValue)
-> (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> ContractState
-> Const (First SomeVBigMap) ContractState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (SomeValue -> [SomeVBigMap])
-> Optic' (->) (Const (First SomeVBigMap)) SomeValue [SomeVBigMap]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Natural -> SomeValue -> [SomeVBigMap]
getBigMapsWithId Natural
bigMapId) Optic' (->) (Const (First SomeVBigMap)) SomeValue [SomeVBigMap]
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
    -> [SomeVBigMap] -> Const (First SomeVBigMap) [SomeVBigMap])
-> (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> SomeValue
-> Const (First SomeVBigMap) SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> [SomeVBigMap] -> Const (First SomeVBigMap) [SomeVBigMap]
forall s t a b. Each s t a b => Traversal s t a b
Traversal [SomeVBigMap] [SomeVBigMap] SomeVBigMap SomeVBigMap
each
  where
    getContractStorage :: ContractState -> T.SomeValue
    getContractStorage :: ContractState -> SomeValue
getContractStorage (ContractState Mutez
_ Contract cp st
_ Value st
storage Maybe KeyHash
_) = Value st -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
T.SomeValue Value st
storage

    getBigMapsWithId :: Natural -> T.SomeValue -> [T.SomeVBigMap]
    getBigMapsWithId :: Natural -> SomeValue -> [SomeVBigMap]
getBigMapsWithId Natural
bigMapId (T.SomeValue Value t
val) =
      (forall (t' :: T). Value t' -> [SomeVBigMap])
-> Value t -> [SomeVBigMap]
forall x (t :: T).
Monoid x =>
(forall (t' :: T). Value t' -> x) -> Value t -> x
T.dfsFoldMapValue
        (\Value t'
v -> case Value t'
v of
            T.VBigMap (Just Natural
bigMapId') Map (Value' Instr k) (Value' Instr v)
_ | Natural
bigMapId' Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
bigMapId -> [Value ('TBigMap k v) -> SomeVBigMap
forall (k :: T) (v :: T). Value ('TBigMap k v) -> SomeVBigMap
T.SomeVBigMap Value t'
Value ('TBigMap k v)
v]
            Value t'
_ -> []
        )
        Value t
val

-- | Send a transaction to given address with given parameters.
transfer
  :: CommonRunOptions
  -> SomeAddressOrAlias
  -> TxData
  -> IO ()
transfer :: CommonRunOptions -> SomeAddressOrAlias -> TxData -> IO ()
transfer CommonRunOptions
cro SomeAddressOrAlias
destination TxData
txData = do
  -- TODO [#905]: simplify with convertAddress
  IO (ExecutorRes, [EmitOperation]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ExecutorRes, [EmitOperation]) -> IO ())
-> IO (ExecutorRes, [EmitOperation]) -> IO ()
forall a b. (a -> b) -> a -> b
$ forall a. CommonRunOptions -> ExecutorM a -> IO (ExecutorRes, a)
runExecutorMWithDB @[EmitOperation] CommonRunOptions
cro (ReaderT
   ExecutorEnv
   (StateT ExecutorState (Except ExecutorError))
   [EmitOperation]
 -> IO (ExecutorRes, [EmitOperation]))
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
-> IO (ExecutorRes, [EmitOperation])
forall a b. (a -> b) -> a -> b
$ do
    Constrained KindedAddress a
destAddr <- SomeAddressOrAlias -> ExecutorM L1Address
resolveAddress SomeAddressOrAlias
destination
    [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeGlobalOperations [TransferOperation -> ExecutorOp
TransferOp (TransferOperation -> ExecutorOp)
-> TransferOperation -> ExecutorOp
forall a b. (a -> b) -> a -> b
$ Address -> TxData -> GlobalCounter -> TransferOperation
TransferOperation (KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
destAddr) TxData
txData GlobalCounter
0]

----------------------------------------------------------------------------
-- Executor
----------------------------------------------------------------------------

-- | A monad in which contract executor runs.
type ExecutorM =
  ReaderT ExecutorEnv
    (StateT ExecutorState
      (Except ExecutorError)
    )

-- | Run some executor action, returning its result and final executor state in 'ExecutorRes'.
--
-- The action has access to the hash of currently executed global operation, in order to construct
-- addresses of originated contracts. It is expected that the action uses @#isGlobalOp :! True@
-- to specify this hash. Otherwise it is initialized with 'error'.
runExecutorM
  :: Timestamp
  -> Natural
  -> Natural
  -> RemainingSteps
  -> TypeCheckOptions
  -> GState
  -> ExecutorM a
  -> Either ExecutorError (ExecutorRes, a)
runExecutorM :: forall a.
Timestamp
-> Natural
-> Natural
-> RemainingSteps
-> TypeCheckOptions
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now Natural
level Natural
minBlockTime RemainingSteps
remainingSteps TypeCheckOptions
tcOpts GState
gState ExecutorM a
action =
  ((a, ExecutorState) -> (ExecutorRes, a))
-> Either ExecutorError (a, ExecutorState)
-> Either ExecutorError (ExecutorRes, a)
forall a b.
(a -> b) -> Either ExecutorError a -> Either ExecutorError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ExecutorState) -> (ExecutorRes, a)
forall a. (a, ExecutorState) -> (ExecutorRes, a)
preResToRes
    (Either ExecutorError (a, ExecutorState)
 -> Either ExecutorError (ExecutorRes, a))
-> Either ExecutorError (a, ExecutorState)
-> Either ExecutorError (ExecutorRes, a)
forall a b. (a -> b) -> a -> b
$ Except ExecutorError (a, ExecutorState)
-> Either ExecutorError (a, ExecutorState)
forall e a. Except e a -> Either e a
runExcept
    (Except ExecutorError (a, ExecutorState)
 -> Either ExecutorError (a, ExecutorState))
-> Except ExecutorError (a, ExecutorState)
-> Either ExecutorError (a, ExecutorState)
forall a b. (a -> b) -> a -> b
$ StateT ExecutorState (Except ExecutorError) a
-> ExecutorState -> Except ExecutorError (a, ExecutorState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExecutorM a
-> ExecutorEnv -> StateT ExecutorState (Except ExecutorError) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ExecutorM a
action (ExecutorEnv -> StateT ExecutorState (Except ExecutorError) a)
-> ExecutorEnv -> StateT ExecutorState (Except ExecutorError) a
forall a b. (a -> b) -> a -> b
$ Timestamp
-> Natural
-> Natural
-> TypeCheckOptions
-> [ExecutorOp]
-> ExecutorEnv
ExecutorEnv Timestamp
now Natural
level Natural
minBlockTime TypeCheckOptions
tcOpts [ExecutorOp]
forall a. Monoid a => a
mempty)
      ExecutorState
initialState
  where
    initialOpHash :: a
initialOpHash = Text -> a
forall a. HasCallStack => Text -> a
error Text
"Initial OperationHash touched"

    initialState :: ExecutorState
initialState = ExecutorState
      { _esGState :: GState
_esGState = GState
gState
      , _esRemainingSteps :: RemainingSteps
_esRemainingSteps = RemainingSteps
remainingSteps
      , _esSourceAddress :: Maybe L1Address
_esSourceAddress = Maybe L1Address
forall a. Maybe a
Nothing
      , _esLog :: ExecutorLog
_esLog = ExecutorLog
forall a. Monoid a => a
mempty
      , _esOperationHash :: OperationHash
_esOperationHash = OperationHash
forall {a}. a
initialOpHash
      , _esPrevCounters :: HashSet GlobalCounter
_esPrevCounters = HashSet GlobalCounter
forall a. Monoid a => a
mempty
      }

    preResToRes :: (a, ExecutorState) -> (ExecutorRes, a)
    preResToRes :: forall a. (a, ExecutorState) -> (ExecutorRes, a)
preResToRes (a
r, ExecutorState{Maybe L1Address
HashSet GlobalCounter
GState
OperationHash
RemainingSteps
ExecutorLog
_esGState :: ExecutorState -> GState
_esRemainingSteps :: ExecutorState -> RemainingSteps
_esSourceAddress :: ExecutorState -> Maybe L1Address
_esLog :: ExecutorState -> ExecutorLog
_esOperationHash :: ExecutorState -> OperationHash
_esPrevCounters :: ExecutorState -> HashSet GlobalCounter
_esGState :: GState
_esRemainingSteps :: RemainingSteps
_esSourceAddress :: Maybe L1Address
_esLog :: ExecutorLog
_esOperationHash :: OperationHash
_esPrevCounters :: HashSet GlobalCounter
..}) =
      ( ExecutorRes
          { _erGState :: GState
_erGState = GState
_esGState
          , _erUpdates :: [GStateUpdate]
_erUpdates = ExecutorLog
_esLog ExecutorLog
-> Getting [GStateUpdate] ExecutorLog [GStateUpdate]
-> [GStateUpdate]
forall s a. s -> Getting a s a -> a
^. Getting [GStateUpdate] ExecutorLog [GStateUpdate]
Lens' ExecutorLog [GStateUpdate]
elUpdates
          , _erInterpretResults :: [(Address, SomeInterpretResult)]
_erInterpretResults = ExecutorLog
_esLog ExecutorLog
-> Getting
     [(Address, SomeInterpretResult)]
     ExecutorLog
     [(Address, SomeInterpretResult)]
-> [(Address, SomeInterpretResult)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Address, SomeInterpretResult)]
  ExecutorLog
  [(Address, SomeInterpretResult)]
Lens' ExecutorLog [(Address, SomeInterpretResult)]
elInterpreterResults
          , _erRemainingSteps :: RemainingSteps
_erRemainingSteps = RemainingSteps
_esRemainingSteps
          }
      , a
r
      )

-- | Run some executor action, reading state from the DB on disk.
--
-- If 'croDryRun' is @False@, the final state is written back to the disk.
--
-- If the executor fails with t'ExecutorError' it will be thrown as an exception.
runExecutorMWithDB
  :: CommonRunOptions
  -> ExecutorM a
  -> IO (ExecutorRes, a)
runExecutorMWithDB :: forall a. CommonRunOptions -> ExecutorM a -> IO (ExecutorRes, a)
runExecutorMWithDB (CommonRunOptions Maybe Timestamp
mNow Natural
level Natural
minBlockTime RemainingSteps
steps String
dbPath TypeCheckOptions
tcOpts Bool
verbose Bool
dryRun) ExecutorM a
action = do
  GState
gState <- String -> IO GState
readGState String
dbPath
  Timestamp
now <- IO Timestamp
-> (Timestamp -> IO Timestamp) -> Maybe Timestamp -> IO Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Timestamp
getCurrentTime Timestamp -> IO Timestamp
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Timestamp
mNow
  (res :: ExecutorRes
res@ExecutorRes{[(Address, SomeInterpretResult)]
[GStateUpdate]
GState
RemainingSteps
_erGState :: ExecutorRes -> GState
_erUpdates :: ExecutorRes -> [GStateUpdate]
_erInterpretResults :: ExecutorRes -> [(Address, SomeInterpretResult)]
_erRemainingSteps :: ExecutorRes -> RemainingSteps
_erGState :: GState
_erUpdates :: [GStateUpdate]
_erInterpretResults :: [(Address, SomeInterpretResult)]
_erRemainingSteps :: RemainingSteps
..}, a
a) <- (ExecutorError -> IO (ExecutorRes, a))
-> ((ExecutorRes, a) -> IO (ExecutorRes, a))
-> Either ExecutorError (ExecutorRes, a)
-> IO (ExecutorRes, a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExecutorError -> IO (ExecutorRes, a)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ExecutorRes, a) -> IO (ExecutorRes, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ExecutorError (ExecutorRes, a) -> IO (ExecutorRes, a))
-> Either ExecutorError (ExecutorRes, a) -> IO (ExecutorRes, a)
forall a b. (a -> b) -> a -> b
$
    Timestamp
-> Natural
-> Natural
-> RemainingSteps
-> TypeCheckOptions
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
forall a.
Timestamp
-> Natural
-> Natural
-> RemainingSteps
-> TypeCheckOptions
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now Natural
level Natural
minBlockTime RemainingSteps
steps TypeCheckOptions
tcOpts GState
gState ExecutorM a
action

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dryRun (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> GState -> IO ()
writeGState String
dbPath GState
_erGState

  (Element [(Address, SomeInterpretResult)] -> IO ())
-> [(Address, SomeInterpretResult)] -> IO ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
(Element t -> m b) -> t -> m ()
mapM_ (Address, SomeInterpretResult) -> IO ()
Element [(Address, SomeInterpretResult)] -> IO ()
printInterpretResult [(Address, SomeInterpretResult)]
_erInterpretResults
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
verbose Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Bool -> Bool
forall a. Boolean a => a -> a
not ([GStateUpdate] -> Bool
forall t. Container t => t -> Bool
null [GStateUpdate]
_erUpdates)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> Text
forall a. FromDoc a => Doc -> a
fmt (Doc -> Text) -> Doc -> Text
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Updates" ([GStateUpdate] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF [GStateUpdate]
_erUpdates)
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Remaining gas: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemainingSteps -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty RemainingSteps
_erRemainingSteps Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."

  return (ExecutorRes
res, a
a)
  where
    printInterpretResult
      :: (Address, SomeInterpretResult) -> IO ()
    printInterpretResult :: (Address, SomeInterpretResult) -> IO ()
printInterpretResult
      (Address
addr, SomeInterpretResult ResultStateLogs{Value st
InterpreterState
MorleyLogs
rslResult :: Value st
rslState :: InterpreterState
rslLogs :: MorleyLogs
rslResult :: forall res. ResultStateLogs res -> res
rslState :: forall res. ResultStateLogs res -> InterpreterState
rslLogs :: forall res. ResultStateLogs res -> MorleyLogs
..}) = do
      Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Executed contract " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Address -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty Address
addr
      () <- case Value st
rslResult of
        T.VPair (ops :: Value' Instr l
ops@T.VList{}, Value' Instr r
res)
          | Value ('TList t1)
_ :: T.Value ('T.TList ops) <- Value' Instr l
ops
          , SingT t1
T.STOperation <- forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
T.sing @ops (SingI ('TList t1) => SingT t1) -> Dict (SingI l) -> SingT t1
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Value' Instr l -> Dict (SingI l)
forall (instr :: [T] -> [T] -> *) (t :: T).
Value' instr t -> Dict (SingI t)
T.valueTypeSanity Value' Instr l
ops
          -> do
              Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ case forall a. IsoValue a => Value (ToT a) -> a
T.fromVal @[T.Operation] Value' Instr l
Value (ToT [Operation])
ops of
                [] -> Text
"It didn't return any operations."
                [Operation]
xs -> Doc -> Text
forall a. FromDoc a => Doc -> a
fmt (Doc -> Text) -> Doc -> Text
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"It returned operations" ([Operation] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF [Operation]
xs)
              Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"It returned: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value' Instr r -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty Value' Instr r
res Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
        Value st
_ -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"It returned: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value st -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty Value st
rslResult Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      let MorleyLogs [Text]
logs = MorleyLogs
rslLogs
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall t. Container t => t -> Bool
null [Text]
logs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"And produced logs:"
        (Element [Text] -> IO ()) -> [Text] -> IO ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
(Element t -> m b) -> t -> m ()
mapM_ Text -> IO ()
Element [Text] -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn [Text]
logs
      Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"" -- extra break line to separate logs from two sequence contracts

-- | Resolves 'SomeAddressOrAlias' type to an address.
resolveAddress
  :: SomeAddressOrAlias
  -> ExecutorM L1Address
resolveAddress :: SomeAddressOrAlias -> ExecutorM L1Address
resolveAddress = \case
  SAOAKindUnspecified Text
aliasText -> do
    Maybe (KindedAddress 'AddressKindImplicit)
implicitAddrMb <- Getting
  (First (KindedAddress 'AddressKindImplicit))
  ExecutorState
  (KindedAddress 'AddressKindImplicit)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe (KindedAddress 'AddressKindImplicit))
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting
   (First (KindedAddress 'AddressKindImplicit))
   ExecutorState
   (KindedAddress 'AddressKindImplicit)
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Maybe (KindedAddress 'AddressKindImplicit)))
-> Getting
     (First (KindedAddress 'AddressKindImplicit))
     ExecutorState
     (KindedAddress 'AddressKindImplicit)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe (KindedAddress 'AddressKindImplicit))
forall a b. (a -> b) -> a -> b
$ (GState
 -> Const (First (KindedAddress 'AddressKindImplicit)) GState)
-> ExecutorState
-> Const (First (KindedAddress 'AddressKindImplicit)) ExecutorState
Lens' ExecutorState GState
esGState ((GState
  -> Const (First (KindedAddress 'AddressKindImplicit)) GState)
 -> ExecutorState
 -> Const
      (First (KindedAddress 'AddressKindImplicit)) ExecutorState)
-> ((KindedAddress 'AddressKindImplicit
     -> Const
          (First (KindedAddress 'AddressKindImplicit))
          (KindedAddress 'AddressKindImplicit))
    -> GState
    -> Const (First (KindedAddress 'AddressKindImplicit)) GState)
-> Getting
     (First (KindedAddress 'AddressKindImplicit))
     ExecutorState
     (KindedAddress 'AddressKindImplicit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
 -> Const
      (First (KindedAddress 'AddressKindImplicit))
      (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> GState
-> Const (First (KindedAddress 'AddressKindImplicit)) GState
Lens'
  GState (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
gsImplicitAddressAliasesL ((Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
  -> Const
       (First (KindedAddress 'AddressKindImplicit))
       (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
 -> GState
 -> Const (First (KindedAddress 'AddressKindImplicit)) GState)
-> ((KindedAddress 'AddressKindImplicit
     -> Const
          (First (KindedAddress 'AddressKindImplicit))
          (KindedAddress 'AddressKindImplicit))
    -> Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
    -> Const
         (First (KindedAddress 'AddressKindImplicit))
         (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> (KindedAddress 'AddressKindImplicit
    -> Const
         (First (KindedAddress 'AddressKindImplicit))
         (KindedAddress 'AddressKindImplicit))
-> GState
-> Const (First (KindedAddress 'AddressKindImplicit)) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
-> Traversal'
     (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
     (IxValue
        (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> ImplicitAlias
ImplicitAlias Text
aliasText)
    Maybe ContractAddress
contractAddrMb <- Getting (First ContractAddress) ExecutorState ContractAddress
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe ContractAddress)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting (First ContractAddress) ExecutorState ContractAddress
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Maybe ContractAddress))
-> Getting (First ContractAddress) ExecutorState ContractAddress
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe ContractAddress)
forall a b. (a -> b) -> a -> b
$ (GState -> Const (First ContractAddress) GState)
-> ExecutorState -> Const (First ContractAddress) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (First ContractAddress) GState)
 -> ExecutorState -> Const (First ContractAddress) ExecutorState)
-> ((ContractAddress
     -> Const (First ContractAddress) ContractAddress)
    -> GState -> Const (First ContractAddress) GState)
-> Getting (First ContractAddress) ExecutorState ContractAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAlias ContractAddress
 -> Const
      (First ContractAddress) (Bimap ContractAlias ContractAddress))
-> GState -> Const (First ContractAddress) GState
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL ((Bimap ContractAlias ContractAddress
  -> Const
       (First ContractAddress) (Bimap ContractAlias ContractAddress))
 -> GState -> Const (First ContractAddress) GState)
-> ((ContractAddress
     -> Const (First ContractAddress) ContractAddress)
    -> Bimap ContractAlias ContractAddress
    -> Const
         (First ContractAddress) (Bimap ContractAlias ContractAddress))
-> (ContractAddress
    -> Const (First ContractAddress) ContractAddress)
-> GState
-> Const (First ContractAddress) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ContractAlias ContractAddress)
-> Traversal'
     (Bimap ContractAlias ContractAddress)
     (IxValue (Bimap ContractAlias ContractAddress))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> ContractAlias
ContractAlias Text
aliasText)
    case (Maybe (KindedAddress 'AddressKindImplicit)
implicitAddrMb, Maybe ContractAddress
contractAddrMb) of
      (Maybe (KindedAddress 'AddressKindImplicit)
Nothing, Maybe ContractAddress
Nothing) -> ExecutorErrorPrim Address -> ExecutorM L1Address
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address -> ExecutorM L1Address)
-> ExecutorErrorPrim Address -> ExecutorM L1Address
forall a b. (a -> b) -> a -> b
$ Text -> ExecutorErrorPrim Address
forall a. Text -> ExecutorErrorPrim a
EEUnknownL1AddressAlias Text
aliasText
      (Just KindedAddress 'AddressKindImplicit
implicitAddr, Maybe ContractAddress
Nothing) -> L1Address -> ExecutorM L1Address
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L1Address -> ExecutorM L1Address)
-> L1Address -> ExecutorM L1Address
forall a b. (a -> b) -> a -> b
$ KindedAddress 'AddressKindImplicit -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress 'AddressKindImplicit
implicitAddr
      (Maybe (KindedAddress 'AddressKindImplicit)
Nothing, Just ContractAddress
contractAddr) -> L1Address -> ExecutorM L1Address
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L1Address -> ExecutorM L1Address)
-> L1Address -> ExecutorM L1Address
forall a b. (a -> b) -> a -> b
$ ContractAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ContractAddress
contractAddr
      (Just KindedAddress 'AddressKindImplicit
implicitAddr, Just ContractAddress
contractAddr) -> ExecutorErrorPrim Address -> ExecutorM L1Address
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address -> ExecutorM L1Address)
-> ExecutorErrorPrim Address -> ExecutorM L1Address
forall a b. (a -> b) -> a -> b
$ Text
-> KindedAddress 'AddressKindImplicit
-> ContractAddress
-> ExecutorErrorPrim Address
forall a.
Text
-> KindedAddress 'AddressKindImplicit
-> ContractAddress
-> ExecutorErrorPrim a
EEAmbiguousAlias Text
aliasText KindedAddress 'AddressKindImplicit
implicitAddr ContractAddress
contractAddr
  SAOAKindSpecified (AddressResolved (addr :: KindedAddress kind
addr@ContractAddress{})) -> L1Address -> ExecutorM L1Address
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L1Address -> ExecutorM L1Address)
-> L1Address -> ExecutorM L1Address
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
addr
  SAOAKindSpecified (AddressResolved (addr :: KindedAddress kind
addr@ImplicitAddress{})) -> L1Address -> ExecutorM L1Address
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (L1Address -> ExecutorM L1Address)
-> L1Address -> ExecutorM L1Address
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
addr
  SAOAKindSpecified (AddressAlias Alias kind
alias) -> do
    Maybe L1Address
addrMb <- Getting (First L1Address) ExecutorState L1Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe L1Address)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting (First L1Address) ExecutorState L1Address
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Maybe L1Address))
-> Getting (First L1Address) ExecutorState L1Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe L1Address)
forall a b. (a -> b) -> a -> b
$
      case Alias kind
alias of
        ImplicitAlias{} -> (GState -> Const (First L1Address) GState)
-> ExecutorState -> Const (First L1Address) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (First L1Address) GState)
 -> ExecutorState -> Const (First L1Address) ExecutorState)
-> ((L1Address -> Const (First L1Address) L1Address)
    -> GState -> Const (First L1Address) GState)
-> Getting (First L1Address) ExecutorState L1Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
 -> Const
      (First L1Address)
      (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> GState -> Const (First L1Address) GState
Lens'
  GState (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
gsImplicitAddressAliasesL ((Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
  -> Const
       (First L1Address)
       (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
 -> GState -> Const (First L1Address) GState)
-> ((L1Address -> Const (First L1Address) L1Address)
    -> Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
    -> Const
         (First L1Address)
         (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> (L1Address -> Const (First L1Address) L1Address)
-> GState
-> Const (First L1Address) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
-> Traversal'
     (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
     (IxValue
        (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
Alias kind
alias ((KindedAddress 'AddressKindImplicit
  -> Const (First L1Address) (KindedAddress 'AddressKindImplicit))
 -> Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
 -> Const
      (First L1Address)
      (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> ((L1Address -> Const (First L1Address) L1Address)
    -> KindedAddress 'AddressKindImplicit
    -> Const (First L1Address) (KindedAddress 'AddressKindImplicit))
-> (L1Address -> Const (First L1Address) L1Address)
-> Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
     (First L1Address)
     (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KindedAddress 'AddressKindImplicit -> L1Address)
-> (L1Address -> Const (First L1Address) L1Address)
-> KindedAddress 'AddressKindImplicit
-> Const (First L1Address) (KindedAddress 'AddressKindImplicit)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to KindedAddress 'AddressKindImplicit -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained
        ContractAlias{} -> (GState -> Const (First L1Address) GState)
-> ExecutorState -> Const (First L1Address) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (First L1Address) GState)
 -> ExecutorState -> Const (First L1Address) ExecutorState)
-> ((L1Address -> Const (First L1Address) L1Address)
    -> GState -> Const (First L1Address) GState)
-> Getting (First L1Address) ExecutorState L1Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAlias ContractAddress
 -> Const (First L1Address) (Bimap ContractAlias ContractAddress))
-> GState -> Const (First L1Address) GState
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL ((Bimap ContractAlias ContractAddress
  -> Const (First L1Address) (Bimap ContractAlias ContractAddress))
 -> GState -> Const (First L1Address) GState)
-> ((L1Address -> Const (First L1Address) L1Address)
    -> Bimap ContractAlias ContractAddress
    -> Const (First L1Address) (Bimap ContractAlias ContractAddress))
-> (L1Address -> Const (First L1Address) L1Address)
-> GState
-> Const (First L1Address) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ContractAlias ContractAddress)
-> Traversal'
     (Bimap ContractAlias ContractAddress)
     (IxValue (Bimap ContractAlias ContractAddress))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Bimap ContractAlias ContractAddress)
Alias kind
alias ((ContractAddress -> Const (First L1Address) ContractAddress)
 -> Bimap ContractAlias ContractAddress
 -> Const (First L1Address) (Bimap ContractAlias ContractAddress))
-> ((L1Address -> Const (First L1Address) L1Address)
    -> ContractAddress -> Const (First L1Address) ContractAddress)
-> (L1Address -> Const (First L1Address) L1Address)
-> Bimap ContractAlias ContractAddress
-> Const (First L1Address) (Bimap ContractAlias ContractAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractAddress -> L1Address)
-> (L1Address -> Const (First L1Address) L1Address)
-> ContractAddress
-> Const (First L1Address) ContractAddress
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ContractAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained
    case Maybe L1Address
addrMb of
      Just L1Address
addr -> L1Address -> ExecutorM L1Address
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure L1Address
addr
      Maybe L1Address
Nothing -> ExecutorErrorPrim Address -> ExecutorM L1Address
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address -> ExecutorM L1Address)
-> ExecutorErrorPrim Address -> ExecutorM L1Address
forall a b. (a -> b) -> a -> b
$ SomeAlias -> ExecutorErrorPrim Address
forall a. SomeAlias -> ExecutorErrorPrim a
EEUnknownAddressAlias (SomeAlias -> ExecutorErrorPrim Address)
-> SomeAlias -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ Alias kind -> SomeAlias
forall (a :: AddressKind). Alias a -> SomeAlias
SomeAlias Alias kind
alias

-- | Resolves 'ContractAddressOrAlias' type to an address.
resolveContractAddress
  :: ContractAddressOrAlias
  -- TODO [#905] or [#889]: Change the return type to `L1Address`
  -> ExecutorM ContractAddress
resolveContractAddress :: ContractAddressOrAlias -> ExecutorM ContractAddress
resolveContractAddress ContractAddressOrAlias
ct = case ContractAddressOrAlias
ct of
  AddressResolved ContractAddress
r -> ContractAddress -> ExecutorM ContractAddress
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractAddress
r
  AddressAlias ContractAlias
alias -> SomeAddressOrAlias -> ExecutorM L1Address
resolveAddress (ContractAddressOrAlias -> SomeAddressOrAlias
forall (kind :: AddressKind).
AddressOrAlias kind -> SomeAddressOrAlias
SAOAKindSpecified ContractAddressOrAlias
ct) ExecutorM L1Address
-> (L1Address -> ExecutorM ContractAddress)
-> ExecutorM ContractAddress
forall a b.
ReaderT ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
-> (a
    -> ReaderT
         ExecutorEnv (StateT ExecutorState (Except ExecutorError)) b)
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Constrained KindedAddress a
result -> case KindedAddress a
result of
      ContractAddress{} -> ContractAddress -> ExecutorM ContractAddress
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KindedAddress a
ContractAddress
result
      ImplicitAddress{} -> ExecutorErrorPrim Address -> ExecutorM ContractAddress
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address -> ExecutorM ContractAddress)
-> ExecutorErrorPrim Address -> ExecutorM ContractAddress
forall a b. (a -> b) -> a -> b
$ SomeAlias -> ExecutorErrorPrim Address
forall a. SomeAlias -> ExecutorErrorPrim a
EEUnknownAddressAlias (ContractAlias -> SomeAlias
forall (a :: AddressKind). Alias a -> SomeAlias
SomeAlias ContractAlias
alias)

-- | Execute a list of global operations, returning a list of generated events.
executeGlobalOperations
  :: [ExecutorOp]
  -> ExecutorM [EmitOperation]
executeGlobalOperations :: [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeGlobalOperations = (ExecutorOp
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      [EmitOperation])
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
forall (f :: * -> *) m (l :: * -> *) a.
(Applicative f, Monoid m, Container (l m), Element (l m) ~ m,
 Traversable l) =>
(a -> f m) -> l a -> f m
concatMapM ((ExecutorOp
  -> ReaderT
       ExecutorEnv
       (StateT ExecutorState (Except ExecutorError))
       [EmitOperation])
 -> [ExecutorOp]
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      [EmitOperation])
-> (ExecutorOp
    -> ReaderT
         ExecutorEnv
         (StateT ExecutorState (Except ExecutorError))
         [EmitOperation])
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
forall a b. (a -> b) -> a -> b
$ \ExecutorOp
op -> NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeMany (Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
True) [ExecutorOp
op]
  where
    -- Execute a list of operations and additional operations they return, until there are none.
    executeMany :: "isGlobalOp" :! Bool -> [ExecutorOp] -> ExecutorM [EmitOperation]
    executeMany :: NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeMany NamedF Identity Bool "isGlobalOp"
isGlobalOp = \case
        [] -> [EmitOperation]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        (ExecutorOp
op:[ExecutorOp]
opsTail) -> ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
forall a. ExecutorOp -> ExecutorM a -> ExecutorM a
addStackEntry ExecutorOp
op do
          case ExecutorOp
op of
            OriginateOp OriginationOperation
origination -> do
              ExecutorM ContractAddress
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExecutorM ContractAddress
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorM ContractAddress
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ NamedF Identity Bool "isGlobalOp"
-> OriginationOperation -> ExecutorM ContractAddress
executeOrigination NamedF Identity Bool "isGlobalOp"
isGlobalOp OriginationOperation
origination
              NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeMany (Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) [ExecutorOp]
opsTail
            SetDelegateOp SetDelegateOperation
operation -> do
              NamedF Identity Bool "isGlobalOp"
-> SetDelegateOperation
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
executeDelegation NamedF Identity Bool "isGlobalOp"
isGlobalOp SetDelegateOperation
operation
              NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeMany (Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) [ExecutorOp]
opsTail
            TransferOp TransferOperation
transferOperation -> do
              [ExecutorOp]
moreOps <- NamedF Identity Bool "isGlobalOp"
-> TransferOperation -> ExecutorM [ExecutorOp]
executeTransfer NamedF Identity Bool "isGlobalOp"
isGlobalOp TransferOperation
transferOperation
              NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeMany (Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) ([ExecutorOp]
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      [EmitOperation])
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
forall a b. (a -> b) -> a -> b
$ [ExecutorOp]
moreOps [ExecutorOp] -> [ExecutorOp] -> [ExecutorOp]
forall a. Semigroup a => a -> a -> a
<> [ExecutorOp]
opsTail
            EmitOp EmitOperation
emitOperation -> do
              (EmitOperation -> [EmitOperation] -> [EmitOperation])
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     EmitOperation
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (NamedF Identity Bool "isGlobalOp"
-> EmitOperation
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     EmitOperation
executeEmit NamedF Identity Bool "isGlobalOp"
isGlobalOp EmitOperation
emitOperation) (ReaderT
   ExecutorEnv
   (StateT ExecutorState (Except ExecutorError))
   [EmitOperation]
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      [EmitOperation])
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
forall a b. (a -> b) -> a -> b
$
                NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     [EmitOperation]
executeMany (Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) [ExecutorOp]
opsTail

-- | Execute a global origination operation.
executeGlobalOrigination :: OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination :: OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination = NamedF Identity Bool "isGlobalOp"
-> OriginationOperation -> ExecutorM ContractAddress
executeOrigination (NamedF Identity Bool "isGlobalOp"
 -> OriginationOperation -> ExecutorM ContractAddress)
-> Param (NamedF Identity Bool "isGlobalOp")
-> OriginationOperation
-> ExecutorM ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Bool -> Param (NamedF Identity Bool "isGlobalOp")
forall (x :: Symbol) a. IsLabel x a => a
#isGlobalOp Bool
True

-- | Execute an origination operation.
executeOrigination
  :: "isGlobalOp" :! Bool
  -> OriginationOperation
  -> ExecutorM ContractAddress
executeOrigination :: NamedF Identity Bool "isGlobalOp"
-> OriginationOperation -> ExecutorM ContractAddress
executeOrigination (Name "isGlobalOp" -> NamedF Identity Bool "isGlobalOp" -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "isGlobalOp"
#isGlobalOp -> Bool
isGlobalOp) origination :: OriginationOperation
origination@(OriginationOperation{Maybe KeyHash
Maybe ContractAlias
Mutez
KindedAddress kind
GlobalCounter
Contract cp st
Value st
ooBalance :: OriginationOperation -> Mutez
ooCounter :: OriginationOperation -> GlobalCounter
ooOriginator :: ()
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooStorage :: ()
ooContract :: ()
ooAlias :: OriginationOperation -> Maybe ContractAlias
ooOriginator :: KindedAddress kind
ooDelegate :: Maybe KeyHash
ooBalance :: Mutez
ooStorage :: Value st
ooContract :: Contract cp st
ooCounter :: GlobalCounter
ooAlias :: Maybe ContractAlias
..}) = do
  Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ do
    ReaderT
  ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
beginGlobalOperation
    ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ExecutorState ExecutorState OperationHash OperationHash
Lens' ExecutorState OperationHash
esOperationHash (OperationHash
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> OperationHash
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> OperationHash
mkOriginationOperationHash OriginationOperation
origination

  ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay (ExecutorOp
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination

  TypeCheckOptions
tcOpts <- Getting TypeCheckOptions ExecutorEnv TypeCheckOptions
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     TypeCheckOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TypeCheckOptions ExecutorEnv TypeCheckOptions
Lens' ExecutorEnv TypeCheckOptions
eeTcOpts

  Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TypeCheckOptions -> Bool
tcStrict TypeCheckOptions
tcOpts) (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
    Either (ExecutorErrorPrim Address) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE (Either (ExecutorErrorPrim Address) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> Either (ExecutorErrorPrim Address) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ (TcError -> ExecutorErrorPrim Address)
-> Either TcError () -> Either (ExecutorErrorPrim Address) ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TcError -> ExecutorErrorPrim Address
forall a. TcError -> ExecutorErrorPrim a
EEDeprecatedType (Either TcError () -> Either (ExecutorErrorPrim Address) ())
-> Either TcError () -> Either (ExecutorErrorPrim Address) ()
forall a b. (a -> b) -> a -> b
$ Contract cp st -> Either TcError ()
forall (cp :: T) (st :: T) op.
Contract cp st -> Either (TcError' op) ()
checkContractDeprecations Contract cp st
ooContract

  OperationHash
opHash <- Getting OperationHash ExecutorState OperationHash
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     OperationHash
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting OperationHash ExecutorState OperationHash
Lens' ExecutorState OperationHash
esOperationHash

  GState
gs <- Getting GState ExecutorState GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState ExecutorState GState
Lens' ExecutorState GState
esGState

  -- Add big_map IDS to storage
  let bigMapCounter0 :: BigMapCounter
bigMapCounter0 = GState
gs GState
-> Getting BigMapCounter GState BigMapCounter -> BigMapCounter
forall s a. s -> Getting a s a -> a
^. Getting BigMapCounter GState BigMapCounter
Lens' GState BigMapCounter
gsBigMapCounterL
  let (Value st
storageWithIds, BigMapCounter
bigMapCounter1) = State BigMapCounter (Value st)
-> BigMapCounter -> (Value st, BigMapCounter)
forall s a. State s a -> s -> (a, s)
runState (Bool -> Value st -> State BigMapCounter (Value st)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Bool -> Value t -> m (Value t)
assignBigMapIds Bool
False Value st
ooStorage) BigMapCounter
bigMapCounter0

  let contractState :: ContractState
contractState = Mutez
-> Contract cp st -> Value st -> Maybe KeyHash -> ContractState
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Mutez
-> Contract cp st -> Value st -> Maybe KeyHash -> ContractState
ContractState Mutez
ooBalance Contract cp st
ooContract Value st
storageWithIds Maybe KeyHash
ooDelegate

  let originatorAddress :: KindedAddress kind
originatorAddress = KindedAddress kind
ooOriginator

  Mutez
originatorBalance <- case KindedAddress kind -> GState -> Maybe Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> GState -> Maybe Mutez
lookupBalance KindedAddress kind
originatorAddress GState
gs of
    Maybe Mutez
Nothing -> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez)
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEUnknownManager (Address -> ExecutorErrorPrim Address)
-> Address -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
ooOriginator
    Just Mutez
oldBalance
      | Mutez
oldBalance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< Mutez
ooBalance ->
        ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez)
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall a b. (a -> b) -> a -> b
$ Address -> Mutez -> ExecutorErrorPrim Address
forall a. a -> Mutez -> ExecutorErrorPrim a
EENotEnoughFunds (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
ooOriginator) Mutez
oldBalance
      | Bool
otherwise ->
        -- Subtraction is safe because we have checked its
        -- precondition in guard.
        Mutez
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutez
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez)
-> Mutez
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall a b. (a -> b) -> a -> b
$ Mutez
oldBalance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeSubMutez` Mutez
ooBalance
  let
    address :: ContractAddress
address = OperationHash -> GlobalCounter -> ContractAddress
mkContractAddress OperationHash
opHash GlobalCounter
ooCounter
    updates :: [GStateUpdate]
updates =
      [Maybe GStateUpdate] -> [GStateUpdate]
forall a. [Maybe a] -> [a]
catMaybes
        [ (ContractAlias -> ContractAddress -> GStateUpdate)
-> Maybe ContractAlias
-> Maybe ContractAddress
-> Maybe GStateUpdate
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ContractAlias -> ContractAddress -> GStateUpdate
GSAddContractAddressAlias Maybe ContractAlias
ooAlias (ContractAddress -> Maybe ContractAddress
forall a. a -> Maybe a
Just ContractAddress
address)
        , GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ ContractAddress -> ContractState -> GStateUpdate
GSAddContractAddress ContractAddress
address ContractState
contractState
        , GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Mutez -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Mutez -> GStateUpdate
GSSetBalance KindedAddress kind
originatorAddress Mutez
originatorBalance
        , GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just GStateUpdate
GSIncrementCounter
        , if BigMapCounter
bigMapCounter0 BigMapCounter -> BigMapCounter -> Bool
forall a. Eq a => a -> a -> Bool
== BigMapCounter
bigMapCounter1
            then Maybe GStateUpdate
forall a. Maybe a
Nothing
            else GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ BigMapCounter -> GStateUpdate
GSSetBigMapCounter BigMapCounter
bigMapCounter1
        ]

  case [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates [GStateUpdate]
updates GState
gs of
    Left GStateUpdateError
err -> ExecutorErrorPrim Address -> ExecutorM ContractAddress
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address -> ExecutorM ContractAddress)
-> ExecutorErrorPrim Address -> ExecutorM ContractAddress
forall a b. (a -> b) -> a -> b
$ GStateUpdateError -> ExecutorErrorPrim Address
forall a. GStateUpdateError -> ExecutorErrorPrim a
EEFailedToApplyUpdates GStateUpdateError
err
    Right GState
newGS -> do
      (GState -> Identity GState)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Identity GState)
 -> ExecutorState -> Identity ExecutorState)
-> GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GState
newGS
      (ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState ExecutorLog
esLog ((ExecutorLog -> Identity ExecutorLog)
 -> ExecutorState -> Identity ExecutorState)
-> ExecutorLog
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, SomeInterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates []

      return ContractAddress
address

-- | Execute delegation operation.
executeDelegation
  :: "isGlobalOp" :! Bool
  -> SetDelegateOperation
  -> ExecutorM ()
executeDelegation :: NamedF Identity Bool "isGlobalOp"
-> SetDelegateOperation
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
executeDelegation (Name "isGlobalOp" -> NamedF Identity Bool "isGlobalOp" -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "isGlobalOp"
#isGlobalOp -> Bool
isGlobalOp) delegation :: SetDelegateOperation
delegation@SetDelegateOperation{Maybe KeyHash
L1Address
GlobalCounter
sdoContract :: L1Address
sdoDelegate :: Maybe KeyHash
sdoCounter :: GlobalCounter
sdoContract :: SetDelegateOperation -> L1Address
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoCounter :: SetDelegateOperation -> GlobalCounter
..} = do
  Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ do
    ReaderT
  ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
beginGlobalOperation
    ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ExecutorState ExecutorState OperationHash OperationHash
Lens' ExecutorState OperationHash
esOperationHash (OperationHash
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> OperationHash
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ SetDelegateOperation -> OperationHash
mkDelegationOperationHash SetDelegateOperation
delegation

  ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay (ExecutorOp
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ SetDelegateOperation -> ExecutorOp
SetDelegateOp SetDelegateOperation
delegation

  GState
gs <- Getting GState ExecutorState GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState ExecutorState GState
Lens' ExecutorState GState
esGState

  Constrained KindedAddress a
address <- L1Address -> ExecutorM L1Address
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure L1Address
sdoContract

  let updates :: [GStateUpdate]
updates = [KindedAddress a -> Maybe KeyHash -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Maybe KeyHash -> GStateUpdate
GSSetDelegate KindedAddress a
address Maybe KeyHash
sdoDelegate]
  case [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates [GStateUpdate]
updates GState
gs of
    Left GStateUpdateError
err -> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ GStateUpdateError -> ExecutorErrorPrim Address
forall a. GStateUpdateError -> ExecutorErrorPrim a
EEFailedToApplyUpdates GStateUpdateError
err
    Right GState
newGS -> do
      (GState -> Identity GState)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Identity GState)
 -> ExecutorState -> Identity ExecutorState)
-> GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GState
newGS
      (ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState ExecutorLog
esLog ((ExecutorLog -> Identity ExecutorLog)
 -> ExecutorState -> Identity ExecutorState)
-> ExecutorLog
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, SomeInterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates []

      return ()

-- | Execute delegation operation.
executeEmit
  :: "isGlobalOp" :! Bool
  -> EmitOperation
  -> ExecutorM EmitOperation
executeEmit :: NamedF Identity Bool "isGlobalOp"
-> EmitOperation
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     EmitOperation
executeEmit (Name "isGlobalOp" -> NamedF Identity Bool "isGlobalOp" -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "isGlobalOp"
#isGlobalOp -> Bool
isGlobalOp) EmitOperation
op = do
  Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE ExecutorErrorPrim Address
forall a. ExecutorErrorPrim a
EEGlobalEmitOp
  ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay (ExecutorOp
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ EmitOperation -> ExecutorOp
EmitOp EmitOperation
op
  pure EmitOperation
op

mkContractEnv
  :: ("balance" :! Mutez)
  -> ("self" :! ContractAddress)
  -> ("sender" :! L1Address)
  -> ("amount" :! Mutez)
  -> ("useOpHash" :! Bool)
  -> ExecutorM ContractEnv
mkContractEnv :: ("balance" :! Mutez)
-> ("self" :! ContractAddress)
-> ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
mkContractEnv
  (Name "balance" -> ("balance" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "balance"
#balance -> Mutez
ceBalance)
  (Name "self" -> ("self" :! ContractAddress) -> ContractAddress
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "self"
#self -> ContractAddress
ceSelf)
  (Name "sender" -> ("sender" :! L1Address) -> L1Address
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "sender"
#sender -> L1Address
ceSender)
  (Name "amount" -> ("amount" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "amount"
#amount -> Mutez
ceAmount)
  (Name "useOpHash" -> ("useOpHash" :! Bool) -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "useOpHash"
#useOpHash -> Bool
useOpHash) = do
  Timestamp
ceNow <- Getting Timestamp ExecutorEnv Timestamp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Timestamp
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Timestamp ExecutorEnv Timestamp
Lens' ExecutorEnv Timestamp
eeNow
  Natural
ceLevel <- Getting Natural ExecutorEnv Natural
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Natural
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Natural ExecutorEnv Natural
Lens' ExecutorEnv Natural
eeLevel
  Natural
ceMinBlockTime <- Getting Natural ExecutorEnv Natural
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Natural
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Natural ExecutorEnv Natural
Lens' ExecutorEnv Natural
eeMinBlockTime
  Maybe OperationHash
ceOperationHash <- if Bool
useOpHash then OperationHash -> Maybe OperationHash
forall a. a -> Maybe a
Just (OperationHash -> Maybe OperationHash)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     OperationHash
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe OperationHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting OperationHash ExecutorState OperationHash
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     OperationHash
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting OperationHash ExecutorState OperationHash
Lens' ExecutorState OperationHash
esOperationHash else Maybe OperationHash
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe OperationHash)
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OperationHash
forall a. Maybe a
Nothing
  GState
    { gsChainId :: GState -> ChainId
gsChainId = ChainId
ceChainId
    , gsContractAddresses :: GState -> Map ContractAddress ContractState
gsContractAddresses=Map ContractAddress ContractState
ceContractsMap
    , gsVotingPowers :: GState -> VotingPowers
gsVotingPowers = VotingPowers
ceVotingPowers
    } <- Getting GState ExecutorState GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState ExecutorState GState
Lens' ExecutorState GState
esGState
  RemainingSteps
ceMaxSteps <- Getting RemainingSteps ExecutorState RemainingSteps
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     RemainingSteps
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting RemainingSteps ExecutorState RemainingSteps
Lens' ExecutorState RemainingSteps
esRemainingSteps
  L1Address
ceSource <- L1Address -> Maybe L1Address -> L1Address
forall a. a -> Maybe a -> a
fromMaybe L1Address
ceSender (Maybe L1Address -> L1Address)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe L1Address)
-> ExecutorM L1Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe L1Address) ExecutorState (Maybe L1Address)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe L1Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe L1Address) ExecutorState (Maybe L1Address)
Lens' ExecutorState (Maybe L1Address)
esSourceAddress
  pure ContractEnv
    { ceErrorSrcPos :: ErrorSrcPos
ceErrorSrcPos = ErrorSrcPos
forall a. Default a => a
def
    , ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper = Instr i o -> Instr i o
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
forall a. a -> a
id
    , ceContracts :: ContractAddress -> EvalOp (Maybe ContractState)
ceContracts = \ContractAddress
addr -> Maybe ContractState -> EvalOp (Maybe ContractState)
forall a. a -> EvalOp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ContractState -> EvalOp (Maybe ContractState))
-> Maybe ContractState -> EvalOp (Maybe ContractState)
forall a b. (a -> b) -> a -> b
$ Map ContractAddress ContractState
ceContractsMap Map ContractAddress ContractState
-> Getting
     (Maybe ContractState)
     (Map ContractAddress ContractState)
     (Maybe ContractState)
-> Maybe ContractState
forall s a. s -> Getting a s a -> a
^. Index (Map ContractAddress ContractState)
-> Lens'
     (Map ContractAddress ContractState)
     (Maybe (IxValue (Map ContractAddress ContractState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ContractAddress ContractState)
ContractAddress
addr
    , Natural
Maybe OperationHash
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ceBalance :: Mutez
ceSelf :: ContractAddress
ceSender :: L1Address
ceAmount :: Mutez
ceNow :: Timestamp
ceLevel :: Natural
ceMinBlockTime :: Natural
ceOperationHash :: Maybe OperationHash
ceChainId :: ChainId
ceVotingPowers :: VotingPowers
ceMaxSteps :: RemainingSteps
ceSource :: L1Address
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceMinBlockTime :: Natural
..
    }

-- | Typeckeck if necessary and assign big map ids to a parameter.
prepareParameter
  :: forall arg. T.SingI arg
  => ContractAddress
  -> TxParam
  -> "typedParamError" :! (Address -> MismatchError T.T -> ExecutorErrorPrim Address)
  -> "untypedParamError" :! (Address -> TcError -> ExecutorErrorPrim Address)
  -> ExecutorM (T.Value arg, BigMapCounter)
prepareParameter :: forall (arg :: T).
SingI arg =>
ContractAddress
-> TxParam
-> ("typedParamError"
    :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
-> ("untypedParamError"
    :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
prepareParameter ContractAddress
addr TxParam
tdParameter
  (Name "typedParamError"
-> ("typedParamError"
    :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
-> Address
-> MismatchError T
-> ExecutorErrorPrim Address
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "typedParamError"
#typedParamError -> Address -> MismatchError T -> ExecutorErrorPrim Address
tyParErr)
  (Name "untypedParamError"
-> ("untypedParamError"
    :! (Address -> TcError -> ExecutorErrorPrim Address))
-> Address
-> TcError
-> ExecutorErrorPrim Address
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "untypedParamError"
#untypedParamError -> Address -> TcError -> ExecutorErrorPrim Address
unTyParErr)
  = do
  TypeCheckOptions
tcOpts <- Getting TypeCheckOptions ExecutorEnv TypeCheckOptions
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     TypeCheckOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TypeCheckOptions ExecutorEnv TypeCheckOptions
Lens' ExecutorEnv TypeCheckOptions
eeTcOpts
  GState
gs <- Getting GState ExecutorState GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState ExecutorState GState
Lens' ExecutorState GState
esGState
  let existingContracts :: TcOriginatedContracts
existingContracts = GState -> TcOriginatedContracts
extractAllContracts GState
gs
  Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TypeCheckOptions -> Bool
tcStrict TypeCheckOptions
tcOpts) (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Either (ExecutorErrorPrim Address) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE (Either (ExecutorErrorPrim Address) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> Either (ExecutorErrorPrim Address) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ (TcError -> ExecutorErrorPrim Address)
-> Either TcError () -> Either (ExecutorErrorPrim Address) ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TcError -> ExecutorErrorPrim Address
forall a. TcError -> ExecutorErrorPrim a
EEDeprecatedType (Either TcError () -> Either (ExecutorErrorPrim Address) ())
-> Either TcError () -> Either (ExecutorErrorPrim Address) ()
forall a b. (a -> b) -> a -> b
$ SingT arg -> Either TcError ()
forall (t :: T) op. SingT t -> Either (TcError' op) ()
checkSingDeprecations (forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @arg)
  -- If the parameter has already been typechecked, simply check if
  -- its type matches the contract's entrypoint's type.
  -- Otherwise (e.g. if it was parsed from stdin via the CLI),
  -- we need to typecheck the parameter.
  Value arg
typedParameter <-
    case TxParam
tdParameter of
      TxTypedParam (Value t
typedVal :: T.Value t) ->
        forall (a :: T) (b :: T) (t :: T -> *) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
t a -> (forall x. MismatchError T -> m x) -> m (t b)
T.castM @t @arg Value t
typedVal ((forall {x}.
  MismatchError T
  -> ReaderT
       ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x)
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Value arg))
-> (forall {x}.
    MismatchError T
    -> ReaderT
         ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Value arg)
forall a b. (a -> b) -> a -> b
$
          ExecutorErrorPrim Address -> ExecutorM x
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address -> ExecutorM x)
-> (MismatchError T -> ExecutorErrorPrim Address)
-> MismatchError T
-> ExecutorM x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> MismatchError T -> ExecutorErrorPrim Address
tyParErr (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr)
      TxUntypedParam Value
untypedVal ->
        Either (ExecutorErrorPrim Address) (Value arg)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Value arg)
forall r. Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE (Either (ExecutorErrorPrim Address) (Value arg)
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Value arg))
-> Either (ExecutorErrorPrim Address) (Value arg)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Value arg)
forall a b. (a -> b) -> a -> b
$ (TcError -> ExecutorErrorPrim Address)
-> Either TcError (Value arg)
-> Either (ExecutorErrorPrim Address) (Value arg)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Address -> TcError -> ExecutorErrorPrim Address
unTyParErr (Address -> TcError -> ExecutorErrorPrim Address)
-> Address -> TcError -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr) (Either TcError (Value arg)
 -> Either (ExecutorErrorPrim Address) (Value arg))
-> Either TcError (Value arg)
-> Either (ExecutorErrorPrim Address) (Value arg)
forall a b. (a -> b) -> a -> b
$
          TypeCheckOptions
-> TypeCheckResult ExpandedOp (Value arg)
-> Either TcError (Value arg)
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
tcOpts (TypeCheckResult ExpandedOp (Value arg)
 -> Either TcError (Value arg))
-> TypeCheckResult ExpandedOp (Value arg)
-> Either TcError (Value arg)
forall a b. (a -> b) -> a -> b
$
            forall (t :: T).
SingI t =>
TcOriginatedContracts
-> Value -> TypeCheckResult ExpandedOp (Value t)
typeVerifyParameter @arg TcOriginatedContracts
existingContracts Value
untypedVal

  pure $ State BigMapCounter (Value arg)
-> BigMapCounter -> (Value arg, BigMapCounter)
forall s a. State s a -> s -> (a, s)
runState (Bool -> Value arg -> State BigMapCounter (Value arg)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Bool -> Value t -> m (Value t)
assignBigMapIds Bool
False Value arg
typedParameter) (BigMapCounter -> (Value arg, BigMapCounter))
-> BigMapCounter -> (Value arg, BigMapCounter)
forall a b. (a -> b) -> a -> b
$ GState
gs GState
-> Getting BigMapCounter GState BigMapCounter -> BigMapCounter
forall s a. s -> Getting a s a -> a
^. Getting BigMapCounter GState BigMapCounter
Lens' GState BigMapCounter
gsBigMapCounterL

-- | Execute a transfer operation.
--
-- Note: we're handling both XTZ and ticket transfers here to avoid code
-- duplication. We assume that if an implicit account sends tickets via
-- 'TxTypedParam', it should be interpreted as @transfer_ticket@ manager
-- operation, and not a regular transfer.
--
-- Note that this only works for 'TxTypedParam', as for ticket transfers between
-- implicit accounts we can't know the exact type of the ticket to transfer if
-- the value is untyped.
executeTransfer
  :: "isGlobalOp" :! Bool
  -> TransferOperation
  -> ExecutorM [ExecutorOp]
executeTransfer :: NamedF Identity Bool "isGlobalOp"
-> TransferOperation -> ExecutorM [ExecutorOp]
executeTransfer (Name "isGlobalOp" -> NamedF Identity Bool "isGlobalOp" -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "isGlobalOp"
#isGlobalOp -> Bool
isGlobalOp) TransferOperation
transferOperation
  | TransferOperation Address
addr' TxData
txData GlobalCounter
_ <- TransferOperation
transferOperation
  , MkAddress (KindedAddress kind
addr :: KindedAddress kind) <- Address
addr'
  , TxData{tdSenderAddress :: TxData -> L1Address
tdSenderAddress=Constrained KindedAddress a
senderAddr,EpName
Mutez
TxParam
tdParameter :: TxParam
tdEntrypoint :: EpName
tdAmount :: Mutez
tdParameter :: TxData -> TxParam
tdEntrypoint :: TxData -> EpName
tdAmount :: TxData -> Mutez
..} <- TxData
txData
  = do
    Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
      ReaderT
  ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
beginGlobalOperation

    GState
gs <- Getting GState ExecutorState GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState ExecutorState GState
Lens' ExecutorState GState
esGState
    RemainingSteps
remainingSteps <- Getting RemainingSteps ExecutorState RemainingSteps
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     RemainingSteps
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting RemainingSteps ExecutorState RemainingSteps
Lens' ExecutorState RemainingSteps
esRemainingSteps
    L1Address
sourceAddr <- L1Address -> Maybe L1Address -> L1Address
forall a. a -> Maybe a -> a
fromMaybe (TxData -> L1Address
tdSenderAddress TxData
txData) (Maybe L1Address -> L1Address)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe L1Address)
-> ExecutorM L1Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe L1Address) ExecutorState (Maybe L1Address)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe L1Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe L1Address) ExecutorState (Maybe L1Address)
Lens' ExecutorState (Maybe L1Address)
esSourceAddress

    let globalCounter :: GlobalCounter
globalCounter = GState -> GlobalCounter
gsCounter GState
gs
    let addresses :: Map (KindedAddress kind) (AddressStateFam kind)
        addresses :: Map (KindedAddress kind) (AddressStateFam kind)
addresses = GState
gs GState
-> Getting
     (Map (KindedAddress kind) (AddressStateFam kind))
     GState
     (Map (KindedAddress kind) (AddressStateFam kind))
-> Map (KindedAddress kind) (AddressStateFam kind)
forall s a. s -> Getting a s a -> a
^. KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
forall (kind :: AddressKind).
KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
addressesL KindedAddress kind
addr
    let isZeroTransfer :: Bool
isZeroTransfer = Mutez
tdAmount Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
zeroMutez
    let senderBalance :: Maybe Mutez
senderBalance = KindedAddress a -> GState -> Maybe Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> GState -> Maybe Mutez
lookupBalance KindedAddress a
senderAddr GState
gs

    ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay (ExecutorOp
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ TransferOperation -> ExecutorOp
TransferOp TransferOperation
transferOperation

    -- Implicit addresses can't be senders with a balance of 0tz even when the transfer amount
    -- is zero.
    case KindedAddress a -> Maybe (a :~: 'AddressKindImplicit)
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (kind :~: 'AddressKindImplicit)
isImplicitAddress KindedAddress a
senderAddr of
      Maybe (a :~: 'AddressKindImplicit)
Nothing -> do
        Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isGlobalOp Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Bool -> Bool
forall a. Boolean a => a -> a
not Bool
isZeroTransfer) (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
          ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> Mutez -> ExecutorErrorPrim Address
forall a. a -> Mutez -> ExecutorErrorPrim a
EETransactionFromContract (KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr) Mutez
tdAmount

      Just a :~: 'AddressKindImplicit
Refl -> do
        case Maybe Mutez
senderBalance of
          Maybe Mutez
Nothing -> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEEmptyImplicitContract (Address -> ExecutorErrorPrim Address)
-> Address -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr
          Just Mutez
balance | Mutez
balance Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
zeroMutez ->
            ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEEmptyImplicitContract (Address -> ExecutorErrorPrim Address)
-> Address -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr
          Maybe Mutez
_ -> ReaderT
  ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => f ()
pass

    case KindedAddress kind -> Maybe (kind :~: 'AddressKindImplicit)
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (kind :~: 'AddressKindImplicit)
isImplicitAddress KindedAddress kind
addr of
      Maybe (kind :~: 'AddressKindImplicit)
Nothing -> ReaderT
  ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => f ()
pass
      Just kind :~: 'AddressKindImplicit
Refl -> do
        Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TxParam -> Bool
badParamToImplicitAccount TxParam
tdParameter) (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
          ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEWrongParameterType (Address -> ExecutorErrorPrim Address)
-> Address -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr

        -- Transferring 0 XTZ to a key address is prohibited.
        Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isZeroTransfer Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& TxParam -> Bool
isUnitParam TxParam
tdParameter) (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
          ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEZeroTransaction (Address -> ExecutorErrorPrim Address)
-> Address -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr

    Maybe GStateUpdate
mDecreaseSenderBalance <- case Maybe Mutez
senderBalance of
      Maybe Mutez
_ | Bool
isZeroTransfer -> Maybe GStateUpdate
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GStateUpdate
forall a. Maybe a
Nothing
      Maybe Mutez
Nothing -> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Maybe GStateUpdate))
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEUnknownSender (Address -> ExecutorErrorPrim Address)
-> Address -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr
      Just Mutez
balance
        | Mutez
balance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< Mutez
tdAmount ->
          ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Maybe GStateUpdate))
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall a b. (a -> b) -> a -> b
$ Address -> Mutez -> ExecutorErrorPrim Address
forall a. a -> Mutez -> ExecutorErrorPrim a
EENotEnoughFunds (KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr) Mutez
balance
        | Bool
otherwise -> do
          -- Subtraction is safe because we have checked its
          -- precondition in guard.
          let newBal :: Mutez
newBal = Mutez
balance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeSubMutez` Mutez
tdAmount
          Maybe GStateUpdate
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GStateUpdate
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Maybe GStateUpdate))
-> Maybe GStateUpdate
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall a b. (a -> b) -> a -> b
$ GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> Mutez -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Mutez -> GStateUpdate
GSSetBalance KindedAddress a
senderAddr Mutez
newBal

    let Maybe GStateUpdate
mDecreaseSenderTickets :: Maybe GStateUpdate
          | Just a :~: 'AddressKindImplicit
Refl <- KindedAddress a -> Maybe (a :~: 'AddressKindImplicit)
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (kind :~: 'AddressKindImplicit)
isImplicitAddress KindedAddress a
senderAddr
          -- if an implicit account sends tickets, it can't forge them, so it
          -- must own them.
          = (TicketKey -> Natural -> GStateUpdate)
-> (TicketKey, Natural) -> GStateUpdate
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (KindedAddress 'AddressKindImplicit
-> TicketKey -> Natural -> GStateUpdate
GSRemoveTickets KindedAddress a
KindedAddress 'AddressKindImplicit
senderAddr) ((TicketKey, Natural) -> GStateUpdate)
-> Maybe (TicketKey, Natural) -> Maybe GStateUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TicketKey, Natural)
sentTickets
          | Bool
otherwise = Maybe GStateUpdate
forall a. Maybe a
Nothing
        Maybe (TicketKey, Natural)
sentTickets :: Maybe (TicketKey, Natural)
          | TxTypedParam v :: Value t
v@T.VTicket{} <- TxParam
tdParameter
          = (TicketKey, Natural) -> Maybe (TicketKey, Natural)
forall a. a -> Maybe a
Just ((TicketKey, Natural) -> Maybe (TicketKey, Natural))
-> (TicketKey, Natural) -> Maybe (TicketKey, Natural)
forall a b. (a -> b) -> a -> b
$ Value ('TTicket arg) -> (TicketKey, Natural)
forall (t :: T). Value ('TTicket t) -> (TicketKey, Natural)
toTicketKey Value t
Value ('TTicket arg)
v
          | Bool
otherwise = Maybe (TicketKey, Natural)
forall a. Maybe a
Nothing

    let commonFinishup
          :: Dict (L1AddressKind kind)
          -- NB: this is a Dict and not a constraint because GHC desugars these
          -- let-bindings such that it expects this constraint at the definition
          -- site.
          -> [GStateUpdate]
          -> [T.Operation]
          -> Maybe SomeInterpretResult
          -> RemainingSteps
          -> ExecutorM [ExecutorOp]
        commonFinishup :: Dict (L1AddressKind kind)
-> [GStateUpdate]
-> [Operation]
-> Maybe SomeInterpretResult
-> RemainingSteps
-> ExecutorM [ExecutorOp]
commonFinishup Dict (L1AddressKind kind)
Dict [GStateUpdate]
otherUpdates [Operation]
sideEffects Maybe SomeInterpretResult
maybeInterpretRes RemainingSteps
newRemSteps = do
          let
            -- According to the reference implementation, counter is incremented for transfers as well.
            updates :: [GStateUpdate]
updates = [Maybe GStateUpdate] -> [GStateUpdate]
forall a. [Maybe a] -> [a]
catMaybes [Maybe GStateUpdate
mDecreaseSenderBalance, Maybe GStateUpdate
mDecreaseSenderTickets] [GStateUpdate] -> [GStateUpdate] -> [GStateUpdate]
forall a. Semigroup a => a -> a -> a
<> [GStateUpdate]
otherUpdates
              [GStateUpdate] -> [GStateUpdate] -> [GStateUpdate]
forall a. Semigroup a => a -> a -> a
<> [GStateUpdate
GSIncrementCounter]

          GState
newGState <- Either (ExecutorErrorPrim Address) GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall r. Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE (Either (ExecutorErrorPrim Address) GState
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState)
-> Either (ExecutorErrorPrim Address) GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall a b. (a -> b) -> a -> b
$ (GStateUpdateError -> ExecutorErrorPrim Address)
-> Either GStateUpdateError GState
-> Either (ExecutorErrorPrim Address) GState
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GStateUpdateError -> ExecutorErrorPrim Address
forall a. GStateUpdateError -> ExecutorErrorPrim a
EEFailedToApplyUpdates (Either GStateUpdateError GState
 -> Either (ExecutorErrorPrim Address) GState)
-> Either GStateUpdateError GState
-> Either (ExecutorErrorPrim Address) GState
forall a b. (a -> b) -> a -> b
$ [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates [GStateUpdate]
updates GState
gs

          (GState -> Identity GState)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Identity GState)
 -> ExecutorState -> Identity ExecutorState)
-> GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GState
newGState
          (RemainingSteps -> Identity RemainingSteps)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState RemainingSteps
esRemainingSteps ((RemainingSteps -> Identity RemainingSteps)
 -> ExecutorState -> Identity ExecutorState)
-> RemainingSteps
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RemainingSteps
newRemSteps
          (Maybe L1Address -> Identity (Maybe L1Address))
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState (Maybe L1Address)
esSourceAddress ((Maybe L1Address -> Identity (Maybe L1Address))
 -> ExecutorState -> Identity ExecutorState)
-> Maybe L1Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= L1Address -> Maybe L1Address
forall a. a -> Maybe a
Just L1Address
sourceAddr

          (ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState ExecutorLog
esLog ((ExecutorLog -> Identity ExecutorLog)
 -> ExecutorState -> Identity ExecutorState)
-> ExecutorLog
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, SomeInterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates
            ( [(Address, SomeInterpretResult)]
-> (SomeInterpretResult -> [(Address, SomeInterpretResult)])
-> Maybe SomeInterpretResult
-> [(Address, SomeInterpretResult)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                [(Address, SomeInterpretResult)]
forall a. Monoid a => a
mempty
                ((Address, SomeInterpretResult) -> [(Address, SomeInterpretResult)]
OneItem [(Address, SomeInterpretResult)]
-> [(Address, SomeInterpretResult)]
forall x. One x => OneItem x -> x
one ((Address, SomeInterpretResult)
 -> [(Address, SomeInterpretResult)])
-> (SomeInterpretResult -> (Address, SomeInterpretResult))
-> SomeInterpretResult
-> [(Address, SomeInterpretResult)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr,))
                Maybe SomeInterpretResult
maybeInterpretRes
            )

          (Operation
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      ExecutorOp)
-> [Operation] -> ExecutorM [ExecutorOp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (KindedAddress kind
-> Operation
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind
-> Operation
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
convertOp KindedAddress kind
addr) ([Operation] -> ExecutorM [ExecutorOp])
-> [Operation] -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$ [Operation]
sideEffects
        onlyUpdates :: Dict (L1AddressKind kind) -> [GStateUpdate] -> ExecutorM [ExecutorOp]
        onlyUpdates :: Dict (L1AddressKind kind)
-> [GStateUpdate] -> ExecutorM [ExecutorOp]
onlyUpdates Dict (L1AddressKind kind)
dict [GStateUpdate]
updates = Dict (L1AddressKind kind)
-> [GStateUpdate]
-> [Operation]
-> Maybe SomeInterpretResult
-> RemainingSteps
-> ExecutorM [ExecutorOp]
commonFinishup Dict (L1AddressKind kind)
dict [GStateUpdate]
updates [] Maybe SomeInterpretResult
forall a. Maybe a
Nothing RemainingSteps
remainingSteps

    case KindedAddress kind
addr of
      SmartRollupAddress{} ->
        ExecutorErrorPrim Address -> ExecutorM [ExecutorOp]
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address -> ExecutorM [ExecutorOp])
-> ExecutorErrorPrim Address -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEUnknownContract (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr)
      ImplicitAddress{} -> case Map (KindedAddress kind) (AddressStateFam kind)
addresses Map (KindedAddress kind) (AddressStateFam kind)
-> Getting
     (Maybe ImplicitState)
     (Map (KindedAddress kind) (AddressStateFam kind))
     (Maybe ImplicitState)
-> Maybe ImplicitState
forall s a. s -> Getting a s a -> a
^. Index (Map (KindedAddress kind) (AddressStateFam kind))
-> Lens'
     (Map (KindedAddress kind) (AddressStateFam kind))
     (Maybe (IxValue (Map (KindedAddress kind) (AddressStateFam kind))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (KindedAddress kind) (AddressStateFam kind))
KindedAddress kind
addr of
        Maybe ImplicitState
Nothing -> Dict (L1AddressKind kind)
-> [GStateUpdate] -> ExecutorM [ExecutorOp]
onlyUpdates Dict (L1AddressKind kind)
forall (a :: Constraint). a => Dict a
Dict ([GStateUpdate] -> ExecutorM [ExecutorOp])
-> (GStateUpdate -> [GStateUpdate])
-> GStateUpdate
-> ExecutorM [ExecutorOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneItem [GStateUpdate] -> [GStateUpdate]
GStateUpdate -> [GStateUpdate]
forall x. One x => OneItem x -> x
one (GStateUpdate -> ExecutorM [ExecutorOp])
-> GStateUpdate -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$
          KindedAddress 'AddressKindImplicit
-> Mutez -> [(TicketKey, Natural)] -> GStateUpdate
GSAddImplicitAddress KindedAddress kind
KindedAddress 'AddressKindImplicit
addr Mutez
tdAmount ([(TicketKey, Natural)] -> GStateUpdate)
-> [(TicketKey, Natural)] -> GStateUpdate
forall a b. (a -> b) -> a -> b
$ Maybe (TicketKey, Natural) -> [(TicketKey, Natural)]
forall a. Maybe a -> [a]
maybeToList Maybe (TicketKey, Natural)
sentTickets
        Just ImplicitState{Maybe KeyHash
HashMap TicketKey Natural
Mutez
isBalance :: Mutez
isTickets :: HashMap TicketKey Natural
isDelegate :: Maybe KeyHash
isBalance :: ImplicitState -> Mutez
isTickets :: ImplicitState -> HashMap TicketKey Natural
isDelegate :: ImplicitState -> Maybe KeyHash
..} -> do
          let
            -- Calculate the account's new balance.
            --
            -- Note: `unsafeAddMutez` can't overflow if global state is correct
            -- (because we can't create money out of nowhere)
            newBalance :: Mutez
newBalance = Mutez
isBalance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeAddMutez` Mutez
tdAmount
            updBalance :: Maybe GStateUpdate
updBalance
              | Mutez
tdAmount Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
zeroMutez = Maybe GStateUpdate
forall a. Maybe a
Nothing
              | Bool
otherwise = GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Mutez -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Mutez -> GStateUpdate
GSSetBalance KindedAddress kind
addr Mutez
newBalance
            updTickets :: Maybe GStateUpdate
updTickets = (TicketKey -> Natural -> GStateUpdate)
-> (TicketKey, Natural) -> GStateUpdate
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (KindedAddress 'AddressKindImplicit
-> TicketKey -> Natural -> GStateUpdate
GSAddTickets KindedAddress kind
KindedAddress 'AddressKindImplicit
addr) ((TicketKey, Natural) -> GStateUpdate)
-> Maybe (TicketKey, Natural) -> Maybe GStateUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TicketKey, Natural)
sentTickets
          Dict (L1AddressKind kind)
-> [GStateUpdate] -> ExecutorM [ExecutorOp]
onlyUpdates Dict (L1AddressKind kind)
forall (a :: Constraint). a => Dict a
Dict ([GStateUpdate] -> ExecutorM [ExecutorOp])
-> [GStateUpdate] -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$ [Maybe GStateUpdate] -> [GStateUpdate]
forall a. [Maybe a] -> [a]
catMaybes [Maybe GStateUpdate
updBalance, Maybe GStateUpdate
updTickets]
      ContractAddress{} -> case Map (KindedAddress kind) (AddressStateFam kind)
addresses Map (KindedAddress kind) (AddressStateFam kind)
-> Getting
     (Maybe ContractState)
     (Map (KindedAddress kind) (AddressStateFam kind))
     (Maybe ContractState)
-> Maybe ContractState
forall s a. s -> Getting a s a -> a
^. Index (Map (KindedAddress kind) (AddressStateFam kind))
-> Lens'
     (Map (KindedAddress kind) (AddressStateFam kind))
     (Maybe (IxValue (Map (KindedAddress kind) (AddressStateFam kind))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (KindedAddress kind) (AddressStateFam kind))
KindedAddress kind
addr of
        Maybe ContractState
Nothing -> ExecutorErrorPrim Address -> ExecutorM [ExecutorOp]
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address -> ExecutorM [ExecutorOp])
-> ExecutorErrorPrim Address -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEUnknownContract (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr)
        Just ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
csBalance :: ContractState -> Mutez
csContract :: ()
csStorage :: ()
csDelegate :: ContractState -> Maybe KeyHash
csBalance :: Mutez
csContract :: Contract cp st
csStorage :: Value st
csDelegate :: Maybe KeyHash
..} -> do
          let
            -- Calculate the contract's new balance.
            --
            -- Note: `unsafeAddMutez` can't overflow if global state is
            -- correct (because we can't create money out of nowhere)
            newBalance :: Mutez
newBalance = Mutez
csBalance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeAddMutez` Mutez
tdAmount
            epName :: EpName
epName = EpName
tdEntrypoint

          T.MkEntrypointCallRes Notes arg
_ (EntrypointCallT cp arg
epc :: EntrypointCallT cp epArg)
            <- EpName -> ParamNotes cp -> Maybe (MkEntrypointCallRes cp)
forall (param :: T).
ParameterScope param =>
EpName -> ParamNotes param -> Maybe (MkEntrypointCallRes param)
T.mkEntrypointCall EpName
epName (Contract cp st -> ParamNotes cp
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
T.cParamNotes Contract cp st
csContract)
              Maybe (MkEntrypointCallRes cp)
-> (Maybe (MkEntrypointCallRes cp)
    -> ReaderT
         ExecutorEnv
         (StateT ExecutorState (Except ExecutorError))
         (MkEntrypointCallRes cp))
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (MkEntrypointCallRes cp)
forall a b. a -> (a -> b) -> b
& ReaderT
  ExecutorEnv
  (StateT ExecutorState (Except ExecutorError))
  (MkEntrypointCallRes cp)
-> (MkEntrypointCallRes cp
    -> ReaderT
         ExecutorEnv
         (StateT ExecutorState (Except ExecutorError))
         (MkEntrypointCallRes cp))
-> Maybe (MkEntrypointCallRes cp)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (MkEntrypointCallRes cp)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (MkEntrypointCallRes cp)
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (MkEntrypointCallRes cp))
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (MkEntrypointCallRes cp)
forall a b. (a -> b) -> a -> b
$ EpName -> ExecutorErrorPrim Address
forall a. EpName -> ExecutorErrorPrim a
EEUnknownEntrypoint EpName
epName) MkEntrypointCallRes cp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (MkEntrypointCallRes cp)
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

          (Value arg
typedParameterWithIds, BigMapCounter
bigMapCounter1) <- ContractAddress
-> TxParam
-> ("typedParamError"
    :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
-> ("untypedParamError"
    :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
forall (arg :: T).
SingI arg =>
ContractAddress
-> TxParam
-> ("typedParamError"
    :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
-> ("untypedParamError"
    :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
prepareParameter KindedAddress kind
ContractAddress
addr TxParam
tdParameter
            (("typedParamError"
  :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
 -> ("untypedParamError"
     :! (Address -> TcError -> ExecutorErrorPrim Address))
 -> ExecutorM (Value arg, BigMapCounter))
-> Param
     ("typedParamError"
      :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
-> ("untypedParamError"
    :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! (Address -> MismatchError T -> ExecutorErrorPrim Address)
-> Param
     ("typedParamError"
      :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
forall (x :: Symbol) a. IsLabel x a => a
#typedParamError Address -> MismatchError T -> ExecutorErrorPrim Address
forall a. a -> MismatchError T -> ExecutorErrorPrim a
EEUnexpectedParameterType
            (("untypedParamError"
  :! (Address -> TcError -> ExecutorErrorPrim Address))
 -> ExecutorM (Value arg, BigMapCounter))
-> Param
     ("untypedParamError"
      :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! (Address -> TcError -> ExecutorErrorPrim Address)
-> Param
     ("untypedParamError"
      :! (Address -> TcError -> ExecutorErrorPrim Address))
forall (x :: Symbol) a. IsLabel x a => a
#untypedParamError Address -> TcError -> ExecutorErrorPrim Address
forall a. a -> TcError -> ExecutorErrorPrim a
EEIllTypedParameter

          -- I'm not entirely sure why we need to pattern match on `()` here,
          -- but, if we don't, we get a compiler error that I suspect is somehow related
          -- to the existential types we're matching on a few lines above.
          --
          -- • Couldn't match type ‘a0’
          --                  with ‘(InterpretResult, RemainingSteps, [Operation], [GStateUpdate])’
          --     ‘a0’ is untouchable inside the constraints: StorageScope st1
          () <- Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ ASetter ExecutorState ExecutorState OperationHash OperationHash
Lens' ExecutorState OperationHash
esOperationHash ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case KindedAddress a -> Maybe (a :~: 'AddressKindImplicit)
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (kind :~: 'AddressKindImplicit)
isImplicitAddress KindedAddress a
senderAddr of
            Just a :~: 'AddressKindImplicit
Refl | Just (TicketKey
tKey, Natural
tAmount) <- Maybe (TicketKey, Natural)
sentTickets
              -- transfer_ticket is only used when sender is implicit address,
              -- contracts use regular transfer to send tickets.
              -> TicketKey -> Natural -> Address -> EpName -> OperationHash
mkTransferTicketOperationHash TicketKey
tKey Natural
tAmount (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr) EpName
tdEntrypoint
            Maybe (a :~: 'AddressKindImplicit)
_ -> KindedAddress kind -> Value arg -> EpName -> Mutez -> OperationHash
forall (t :: T) (kind :: AddressKind).
ParameterScope t =>
KindedAddress kind -> Value t -> EpName -> Mutez -> OperationHash
mkTransferOperationHash KindedAddress kind
addr Value arg
typedParameterWithIds EpName
tdEntrypoint Mutez
tdAmount

          ContractEnv
contractEnv <- ("balance" :! Mutez)
-> ("self" :! ContractAddress)
-> ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
mkContractEnv
            (("balance" :! Mutez)
 -> ("self" :! ContractAddress)
 -> ("sender" :! L1Address)
 -> ("amount" :! Mutez)
 -> ("useOpHash" :! Bool)
 -> ExecutorM ContractEnv)
-> Param ("balance" :! Mutez)
-> ("self" :! ContractAddress)
-> ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Mutez -> Param ("balance" :! Mutez)
forall (x :: Symbol) a. IsLabel x a => a
#balance Mutez
newBalance
            (("self" :! ContractAddress)
 -> ("sender" :! L1Address)
 -> ("amount" :! Mutez)
 -> ("useOpHash" :! Bool)
 -> ExecutorM ContractEnv)
-> Param ("self" :! ContractAddress)
-> ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! KindedAddress kind -> Param ("self" :! ContractAddress)
forall (x :: Symbol) a. IsLabel x a => a
#self KindedAddress kind
addr
            (("sender" :! L1Address)
 -> ("amount" :! Mutez)
 -> ("useOpHash" :! Bool)
 -> ExecutorM ContractEnv)
-> Param ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! L1Address -> Param ("sender" :! L1Address)
forall (x :: Symbol) a. IsLabel x a => a
#sender (KindedAddress a -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress a
senderAddr)
            (("amount" :! Mutez)
 -> ("useOpHash" :! Bool) -> ExecutorM ContractEnv)
-> Param ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Mutez -> Param ("amount" :! Mutez)
forall (x :: Symbol) a. IsLabel x a => a
#amount Mutez
tdAmount
            (("useOpHash" :! Bool) -> ExecutorM ContractEnv)
-> Param ("useOpHash" :! Bool) -> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Bool -> Param ("useOpHash" :! Bool)
forall (x :: Symbol) a. IsLabel x a => a
#useOpHash Bool
True

          iur :: ResultStateLogs (Value (ContractOut1 st))
iur@(ResultStateLogs
            { rslResult :: forall res. ResultStateLogs res -> res
rslResult = Value (ContractOut1 st) -> ([Operation], Value st)
forall (st :: T).
Value (ContractOut1 st) -> ([Operation], Value st)
extractValOps -> ([Operation]
sideEffects, Value st
newValue)
            , rslState :: forall res. ResultStateLogs res -> InterpreterState
rslState = InterpreterState RemainingSteps
newRemainingSteps GlobalCounter
globalCounter2 BigMapCounter
bigMapCounter2
            })
            <- Either
  (ExecutorErrorPrim Address)
  (ResultStateLogs (Value (ContractOut1 st)))
-> ExecutorM (ResultStateLogs (Value (ContractOut1 st)))
forall r. Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE (Either
   (ExecutorErrorPrim Address)
   (ResultStateLogs (Value (ContractOut1 st)))
 -> ExecutorM (ResultStateLogs (Value (ContractOut1 st))))
-> Either
     (ExecutorErrorPrim Address)
     (ResultStateLogs (Value (ContractOut1 st)))
-> ExecutorM (ResultStateLogs (Value (ContractOut1 st)))
forall a b. (a -> b) -> a -> b
$ (InterpretError Void -> ExecutorErrorPrim Address)
-> Either
     (InterpretError Void) (ResultStateLogs (Value (ContractOut1 st)))
-> Either
     (ExecutorErrorPrim Address)
     (ResultStateLogs (Value (ContractOut1 st)))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Address -> InterpretError Void -> ExecutorErrorPrim Address
forall a. a -> InterpretError Void -> ExecutorErrorPrim a
EEInterpreterFailed (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr)) (Either
   (InterpretError Void) (ResultStateLogs (Value (ContractOut1 st)))
 -> Either
      (ExecutorErrorPrim Address)
      (ResultStateLogs (Value (ContractOut1 st))))
-> Either
     (InterpretError Void) (ResultStateLogs (Value (ContractOut1 st)))
-> Either
     (ExecutorErrorPrim Address)
     (ResultStateLogs (Value (ContractOut1 st)))
forall a b. (a -> b) -> a -> b
$
                InterpretReturn (ContractOut1 st)
-> Either
     (InterpretError Void) (ResultStateLogs (Value (ContractOut1 st)))
forall (res :: T).
InterpretReturn res
-> Either (InterpretError Void) (ResultStateLogs (Value res))
handleReturn (InterpretReturn (ContractOut1 st)
 -> Either
      (InterpretError Void) (ResultStateLogs (Value (ContractOut1 st))))
-> InterpretReturn (ContractOut1 st)
-> Either
     (InterpretError Void) (ResultStateLogs (Value (ContractOut1 st)))
forall a b. (a -> b) -> a -> b
$
                  Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> InterpretReturn (ContractOut1 st)
forall (cp :: T) (st :: T) (arg :: T).
Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> ContractReturn st
interpret
                    Contract cp st
csContract
                    EntrypointCallT cp arg
epc
                    Value arg
typedParameterWithIds
                    Value st
csStorage
                    (GState -> GlobalCounter
gsCounter GState
gs)
                    BigMapCounter
bigMapCounter1
                    ContractEnv
contractEnv

          let
            updBalance :: Maybe GStateUpdate
updBalance
              | Mutez
newBalance Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
csBalance = Maybe GStateUpdate
forall a. Maybe a
Nothing
              | Bool
otherwise = GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Mutez -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Mutez -> GStateUpdate
GSSetBalance KindedAddress kind
addr Mutez
newBalance
            updStorage :: Maybe GStateUpdate
updStorage
              | Value st -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
SomeValue Value st
newValue SomeValue -> SomeValue -> Bool
forall a. Eq a => a -> a -> Bool
== Value st -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
SomeValue Value st
csStorage = Maybe GStateUpdate
forall a. Maybe a
Nothing
              | Bool
otherwise = GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Value st -> GStateUpdate
forall (st :: T).
StorageScope st =>
ContractAddress -> Value st -> GStateUpdate
GSSetStorageValue KindedAddress kind
ContractAddress
addr Value st
newValue
            updBigMapCounter :: Maybe GStateUpdate
updBigMapCounter
              | GState
gs GState
-> Getting BigMapCounter GState BigMapCounter -> BigMapCounter
forall s a. s -> Getting a s a -> a
^. Getting BigMapCounter GState BigMapCounter
Lens' GState BigMapCounter
gsBigMapCounterL BigMapCounter -> BigMapCounter -> Bool
forall a. Eq a => a -> a -> Bool
== BigMapCounter
bigMapCounter2 = Maybe GStateUpdate
forall a. Maybe a
Nothing
              | Bool
otherwise = GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ BigMapCounter -> GStateUpdate
GSSetBigMapCounter BigMapCounter
bigMapCounter2
            updGlobalCounter :: Maybe GStateUpdate
updGlobalCounter
              | GlobalCounter
globalCounter GlobalCounter -> GlobalCounter -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalCounter
globalCounter2 = Maybe GStateUpdate
forall a. Maybe a
Nothing
              | Bool
otherwise = GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ GlobalCounter -> GStateUpdate
GSUpdateCounter GlobalCounter
globalCounter2
            updates :: [GStateUpdate]
updates = [Maybe GStateUpdate] -> [GStateUpdate]
forall a. [Maybe a] -> [a]
catMaybes
              [ Maybe GStateUpdate
updBalance
              , Maybe GStateUpdate
updStorage
              , Maybe GStateUpdate
updBigMapCounter
              , Maybe GStateUpdate
updGlobalCounter
              ]
          Dict (L1AddressKind kind)
-> [GStateUpdate]
-> [Operation]
-> Maybe SomeInterpretResult
-> RemainingSteps
-> ExecutorM [ExecutorOp]
commonFinishup Dict (L1AddressKind kind)
forall (a :: Constraint). a => Dict a
Dict [GStateUpdate]
updates [Operation]
sideEffects (SomeInterpretResult -> Maybe SomeInterpretResult
forall a. a -> Maybe a
Just (SomeInterpretResult -> Maybe SomeInterpretResult)
-> SomeInterpretResult -> Maybe SomeInterpretResult
forall a b. (a -> b) -> a -> b
$ ResultStateLogs (Value (ContractOut1 st)) -> SomeInterpretResult
forall (st :: T). InterpretResult st -> SomeInterpretResult
SomeInterpretResult ResultStateLogs (Value (ContractOut1 st))
iur)
            RemainingSteps
newRemainingSteps

-- | Execute a view.
callView
  :: L1Address
  -> ContractAddress
  -> U.ViewName
  -> TxParam
  -> ExecutorM T.SomeValue
callView :: L1Address
-> ContractAddress -> ViewName -> TxParam -> ExecutorM SomeValue
callView L1Address
sender ContractAddress
addr ViewName
viewName TxParam
viewArg = do
  ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
csBalance :: ContractState -> Mutez
csContract :: ()
csStorage :: ()
csDelegate :: ContractState -> Maybe KeyHash
csBalance :: Mutez
csContract :: Contract cp st
csStorage :: Value st
csDelegate :: Maybe KeyHash
..} <-
    Getting (Maybe ContractState) ExecutorState (Maybe ContractState)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe ContractState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Maybe ContractState) GState)
-> ExecutorState -> Const (Maybe ContractState) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (Maybe ContractState) GState)
 -> ExecutorState -> Const (Maybe ContractState) ExecutorState)
-> ((Maybe ContractState
     -> Const (Maybe ContractState) (Maybe ContractState))
    -> GState -> Const (Maybe ContractState) GState)
-> Getting
     (Maybe ContractState) ExecutorState (Maybe ContractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ContractAddress ContractState
 -> Const (Maybe ContractState) (Map ContractAddress ContractState))
-> GState -> Const (Maybe ContractState) GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL ((Map ContractAddress ContractState
  -> Const (Maybe ContractState) (Map ContractAddress ContractState))
 -> GState -> Const (Maybe ContractState) GState)
-> Getting
     (Maybe ContractState)
     (Map ContractAddress ContractState)
     (Maybe ContractState)
-> (Maybe ContractState
    -> Const (Maybe ContractState) (Maybe ContractState))
-> GState
-> Const (Maybe ContractState) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ContractAddress ContractState)
-> Lens'
     (Map ContractAddress ContractState)
     (Maybe (IxValue (Map ContractAddress ContractState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ContractAddress ContractState)
ContractAddress
addr)
    ReaderT
  ExecutorEnv
  (StateT ExecutorState (Except ExecutorError))
  (Maybe ContractState)
-> (Maybe ContractState
    -> ReaderT
         ExecutorEnv
         (StateT ExecutorState (Except ExecutorError))
         ContractState)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ContractState
forall a b.
ReaderT ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
-> (a
    -> ReaderT
         ExecutorEnv (StateT ExecutorState (Except ExecutorError)) b)
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT
  ExecutorEnv
  (StateT ExecutorState (Except ExecutorError))
  ContractState
-> (ContractState
    -> ReaderT
         ExecutorEnv
         (StateT ExecutorState (Except ExecutorError))
         ContractState)
-> Maybe ContractState
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ContractState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ContractState
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      ContractState)
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ContractState
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEUnknownContract (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr)) ContractState
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ContractState
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  T.SomeView (view' :: View arg st ret
view'@T.View{} :: T.View viewArg st viewRet)
    <- Either (ExecutorErrorPrim Address) (SomeView' Instr st)
-> ExecutorM (SomeView' Instr st)
forall r. Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE (Either (ExecutorErrorPrim Address) (SomeView' Instr st)
 -> ExecutorM (SomeView' Instr st))
-> Either (ExecutorErrorPrim Address) (SomeView' Instr st)
-> ExecutorM (SomeView' Instr st)
forall a b. (a -> b) -> a -> b
$ (ViewLookupError -> ExecutorErrorPrim Address)
-> Either ViewLookupError (SomeView' Instr st)
-> Either (ExecutorErrorPrim Address) (SomeView' Instr st)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Address -> ViewLookupError -> ExecutorErrorPrim Address
forall a. a -> ViewLookupError -> ExecutorErrorPrim a
EEViewLookupError (ContractAddress -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ContractAddress
addr)) (Either ViewLookupError (SomeView' Instr st)
 -> Either (ExecutorErrorPrim Address) (SomeView' Instr st))
-> Either ViewLookupError (SomeView' Instr st)
-> Either (ExecutorErrorPrim Address) (SomeView' Instr st)
forall a b. (a -> b) -> a -> b
$ Contract cp st
-> ViewName -> Either ViewLookupError (SomeView' Instr st)
forall (cp :: T) (st :: T).
Contract cp st -> ViewName -> Either ViewLookupError (SomeView st)
getViewByName Contract cp st
csContract ViewName
viewName

  (Value arg
typedParameterWithIds, BigMapCounter
bigMapCounter1) <- ContractAddress
-> TxParam
-> ("typedParamError"
    :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
-> ("untypedParamError"
    :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
forall (arg :: T).
SingI arg =>
ContractAddress
-> TxParam
-> ("typedParamError"
    :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
-> ("untypedParamError"
    :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
prepareParameter ContractAddress
addr TxParam
viewArg
    (("typedParamError"
  :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
 -> ("untypedParamError"
     :! (Address -> TcError -> ExecutorErrorPrim Address))
 -> ExecutorM (Value arg, BigMapCounter))
-> Param
     ("typedParamError"
      :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
-> ("untypedParamError"
    :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! (Address -> MismatchError T -> ExecutorErrorPrim Address)
-> Param
     ("typedParamError"
      :! (Address -> MismatchError T -> ExecutorErrorPrim Address))
forall (x :: Symbol) a. IsLabel x a => a
#typedParamError (\Address
a -> Address -> ViewLookupError -> ExecutorErrorPrim Address
forall a. a -> ViewLookupError -> ExecutorErrorPrim a
EEViewLookupError Address
a (ViewLookupError -> ExecutorErrorPrim Address)
-> (MismatchError T -> ViewLookupError)
-> MismatchError T
-> ExecutorErrorPrim Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MismatchError T -> ViewLookupError
ViewArgMismatch)
    (("untypedParamError"
  :! (Address -> TcError -> ExecutorErrorPrim Address))
 -> ExecutorM (Value arg, BigMapCounter))
-> Param
     ("untypedParamError"
      :! (Address -> TcError -> ExecutorErrorPrim Address))
-> ExecutorM (Value arg, BigMapCounter)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! (Address -> TcError -> ExecutorErrorPrim Address)
-> Param
     ("untypedParamError"
      :! (Address -> TcError -> ExecutorErrorPrim Address))
forall (x :: Symbol) a. IsLabel x a => a
#untypedParamError Address -> TcError -> ExecutorErrorPrim Address
forall a. a -> TcError -> ExecutorErrorPrim a
EEViewArgTcError

  ContractEnv
contractEnv <- ("balance" :! Mutez)
-> ("self" :! ContractAddress)
-> ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
mkContractEnv
    (("balance" :! Mutez)
 -> ("self" :! ContractAddress)
 -> ("sender" :! L1Address)
 -> ("amount" :! Mutez)
 -> ("useOpHash" :! Bool)
 -> ExecutorM ContractEnv)
-> Param ("balance" :! Mutez)
-> ("self" :! ContractAddress)
-> ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Mutez -> Param ("balance" :! Mutez)
forall (x :: Symbol) a. IsLabel x a => a
#balance Mutez
csBalance
    (("self" :! ContractAddress)
 -> ("sender" :! L1Address)
 -> ("amount" :! Mutez)
 -> ("useOpHash" :! Bool)
 -> ExecutorM ContractEnv)
-> Param ("self" :! ContractAddress)
-> ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! ContractAddress -> Param ("self" :! ContractAddress)
forall (x :: Symbol) a. IsLabel x a => a
#self ContractAddress
addr
    (("sender" :! L1Address)
 -> ("amount" :! Mutez)
 -> ("useOpHash" :! Bool)
 -> ExecutorM ContractEnv)
-> Param ("sender" :! L1Address)
-> ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! L1Address -> Param ("sender" :! L1Address)
forall (x :: Symbol) a. IsLabel x a => a
#sender L1Address
sender
    (("amount" :! Mutez)
 -> ("useOpHash" :! Bool) -> ExecutorM ContractEnv)
-> Param ("amount" :! Mutez)
-> ("useOpHash" :! Bool)
-> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Mutez -> Param ("amount" :! Mutez)
forall (x :: Symbol) a. IsLabel x a => a
#amount Mutez
zeroMutez
    (("useOpHash" :! Bool) -> ExecutorM ContractEnv)
-> Param ("useOpHash" :! Bool) -> ExecutorM ContractEnv
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Bool -> Param ("useOpHash" :! Bool)
forall (x :: Symbol) a. IsLabel x a => a
#useOpHash Bool
False

  GlobalCounter
counter <- Getting GlobalCounter ExecutorState GlobalCounter
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     GlobalCounter
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting GlobalCounter ExecutorState GlobalCounter
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      GlobalCounter)
-> Getting GlobalCounter ExecutorState GlobalCounter
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     GlobalCounter
forall a b. (a -> b) -> a -> b
$ (GState -> Const GlobalCounter GState)
-> ExecutorState -> Const GlobalCounter ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const GlobalCounter GState)
 -> ExecutorState -> Const GlobalCounter ExecutorState)
-> ((GlobalCounter -> Const GlobalCounter GlobalCounter)
    -> GState -> Const GlobalCounter GState)
-> Getting GlobalCounter ExecutorState GlobalCounter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalCounter -> Const GlobalCounter GlobalCounter)
-> GState -> Const GlobalCounter GState
Lens' GState GlobalCounter
gsCounterL
  RemainingSteps
remainingSteps <- Getting RemainingSteps ExecutorState RemainingSteps
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     RemainingSteps
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting RemainingSteps ExecutorState RemainingSteps
Lens' ExecutorState RemainingSteps
esRemainingSteps

  iur :: ResultStateLogs (Value ret)
iur@ResultStateLogs{Value ret
InterpreterState
MorleyLogs
rslResult :: forall res. ResultStateLogs res -> res
rslState :: forall res. ResultStateLogs res -> InterpreterState
rslLogs :: forall res. ResultStateLogs res -> MorleyLogs
rslResult :: Value ret
rslState :: InterpreterState
rslLogs :: MorleyLogs
..} <-
    Either (ExecutorErrorPrim Address) (ResultStateLogs (Value ret))
-> ExecutorM (ResultStateLogs (Value ret))
forall r. Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE (Either (ExecutorErrorPrim Address) (ResultStateLogs (Value ret))
 -> ExecutorM (ResultStateLogs (Value ret)))
-> Either (ExecutorErrorPrim Address) (ResultStateLogs (Value ret))
-> ExecutorM (ResultStateLogs (Value ret))
forall a b. (a -> b) -> a -> b
$ (InterpretError Void -> ExecutorErrorPrim Address)
-> Either (InterpretError Void) (ResultStateLogs (Value ret))
-> Either (ExecutorErrorPrim Address) (ResultStateLogs (Value ret))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Address -> InterpretError Void -> ExecutorErrorPrim Address
forall a. a -> InterpretError Void -> ExecutorErrorPrim a
EEInterpreterFailed (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr)) (Either (InterpretError Void) (ResultStateLogs (Value ret))
 -> Either
      (ExecutorErrorPrim Address) (ResultStateLogs (Value ret)))
-> Either (InterpretError Void) (ResultStateLogs (Value ret))
-> Either (ExecutorErrorPrim Address) (ResultStateLogs (Value ret))
forall a b. (a -> b) -> a -> b
$
      InterpretReturn ret
-> Either (InterpretError Void) (ResultStateLogs (Value ret))
forall (res :: T).
InterpretReturn res
-> Either (InterpretError Void) (ResultStateLogs (Value res))
handleReturn (InterpretReturn ret
 -> Either (InterpretError Void) (ResultStateLogs (Value ret)))
-> InterpretReturn ret
-> Either (InterpretError Void) (ResultStateLogs (Value ret))
forall a b. (a -> b) -> a -> b
$ View arg st ret
-> Value st
-> Value arg
-> ContractEnv
-> InterpreterState
-> InterpretReturn ret
forall (arg :: T) (st :: T) (ret :: T).
View arg st ret
-> Value st
-> Value arg
-> ContractEnv
-> InterpreterState
-> InterpretReturn ret
interpretView
        View arg st ret
view'
        Value st
csStorage
        Value arg
typedParameterWithIds
        ContractEnv
contractEnv
        (RemainingSteps
-> GlobalCounter -> BigMapCounter -> InterpreterState
InterpreterState RemainingSteps
remainingSteps GlobalCounter
counter BigMapCounter
bigMapCounter1)

  (ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState ExecutorLog
esLog ((ExecutorLog -> Identity ExecutorLog)
 -> ExecutorState -> Identity ExecutorState)
-> ExecutorLog
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, SomeInterpretResult)] -> ExecutorLog
ExecutorLog [] ((Address, SomeInterpretResult) -> [(Address, SomeInterpretResult)]
OneItem [(Address, SomeInterpretResult)]
-> [(Address, SomeInterpretResult)]
forall x. One x => OneItem x -> x
one ((Address, SomeInterpretResult)
 -> [(Address, SomeInterpretResult)])
-> (SomeInterpretResult -> (Address, SomeInterpretResult))
-> SomeInterpretResult
-> [(Address, SomeInterpretResult)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr, ) (SomeInterpretResult -> [(Address, SomeInterpretResult)])
-> SomeInterpretResult -> [(Address, SomeInterpretResult)]
forall a b. (a -> b) -> a -> b
$ ResultStateLogs (Value ret) -> SomeInterpretResult
forall (st :: T). InterpretResult st -> SomeInterpretResult
SomeInterpretResult ResultStateLogs (Value ret)
iur)

  SomeValue -> ExecutorM SomeValue
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeValue -> ExecutorM SomeValue)
-> (Value ret -> SomeValue) -> Value ret -> ExecutorM SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value ret -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
SomeValue (Value ret -> ExecutorM SomeValue)
-> Value ret -> ExecutorM SomeValue
forall a b. (a -> b) -> a -> b
$ Value ret
rslResult


----------------------------------------------------------------------------
-- Simple helpers
----------------------------------------------------------------------------

checkOperationReplay :: ExecutorOp -> ExecutorM ()
checkOperationReplay :: ExecutorOp
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay ExecutorOp
op = do
  let
    opCounter :: GlobalCounter
opCounter = ExecutorOp
op ExecutorOp -> (ExecutorOp -> GlobalCounter) -> GlobalCounter
forall a b. a -> (a -> b) -> b
& \case
      OriginateOp OriginationOperation{Maybe KeyHash
Maybe ContractAlias
Mutez
KindedAddress kind
GlobalCounter
Contract cp st
Value st
ooBalance :: OriginationOperation -> Mutez
ooCounter :: OriginationOperation -> GlobalCounter
ooOriginator :: ()
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooStorage :: ()
ooContract :: ()
ooAlias :: OriginationOperation -> Maybe ContractAlias
ooOriginator :: KindedAddress kind
ooDelegate :: Maybe KeyHash
ooBalance :: Mutez
ooStorage :: Value st
ooContract :: Contract cp st
ooCounter :: GlobalCounter
ooAlias :: Maybe ContractAlias
..} -> GlobalCounter
ooCounter
      TransferOp TransferOperation{Address
GlobalCounter
TxData
toDestination :: Address
toTxData :: TxData
toCounter :: GlobalCounter
toDestination :: TransferOperation -> Address
toTxData :: TransferOperation -> TxData
toCounter :: TransferOperation -> GlobalCounter
..} -> GlobalCounter
toCounter
      SetDelegateOp SetDelegateOperation{Maybe KeyHash
L1Address
GlobalCounter
sdoContract :: SetDelegateOperation -> L1Address
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoCounter :: SetDelegateOperation -> GlobalCounter
sdoContract :: L1Address
sdoDelegate :: Maybe KeyHash
sdoCounter :: GlobalCounter
..} -> GlobalCounter
sdoCounter
      EmitOp (EmitOperation ContractAddress
_ T.Emit{Text
GlobalCounter
Notes t
Value' Instr t
emTag :: Text
emNotes :: Notes t
emValue :: Value' Instr t
emCounter :: GlobalCounter
emTag :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Text
emNotes :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Notes t
emValue :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> Value' instr t
emCounter :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> GlobalCounter
..}) -> GlobalCounter
emCounter
  HashSet GlobalCounter
prevCounters <- Getting
  (HashSet GlobalCounter) ExecutorState (HashSet GlobalCounter)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (HashSet GlobalCounter)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashSet GlobalCounter) ExecutorState (HashSet GlobalCounter)
Lens' ExecutorState (HashSet GlobalCounter)
esPrevCounters
  Bool
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GlobalCounter
opCounter GlobalCounter -> HashSet GlobalCounter -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet GlobalCounter
prevCounters) (ReaderT
   ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
    ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ ExecutorOp -> ExecutorErrorPrim Address
forall a. ExecutorOp -> ExecutorErrorPrim a
EEOperationReplay ExecutorOp
op
  (HashSet GlobalCounter -> Identity (HashSet GlobalCounter))
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState (HashSet GlobalCounter)
esPrevCounters ((HashSet GlobalCounter -> Identity (HashSet GlobalCounter))
 -> ExecutorState -> Identity ExecutorState)
-> HashSet GlobalCounter
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= OneItem (HashSet GlobalCounter) -> HashSet GlobalCounter
forall x. One x => OneItem x -> x
one OneItem (HashSet GlobalCounter)
GlobalCounter
opCounter

-- The argument is the address of the contract that generated this operation.
convertOp :: L1AddressKind kind => KindedAddress kind -> T.Operation -> ExecutorM ExecutorOp
convertOp :: forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind
-> Operation
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
convertOp KindedAddress kind
interpretedAddr =
  \case
    OpTransferTokens TransferTokens Instr p
tt ->
      ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutorOp
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      ExecutorOp)
-> ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a b. (a -> b) -> a -> b
$ case TransferTokens Instr p -> Value' Instr ('TContract p)
forall (instr :: [T] -> [T] -> *) (p :: T).
TransferTokens instr p -> Value' instr ('TContract p)
ttContract TransferTokens Instr p
tt of
        T.VContract Address
destAddress SomeEntrypointCallT arg
sepc ->
          let txData :: TxData
txData =
                TxData
                  { tdSenderAddress :: L1Address
tdSenderAddress = KindedAddress kind -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
interpretedAddr
                  , tdEntrypoint :: EpName
tdEntrypoint = SomeEntrypointCallT arg -> EpName
forall (arg :: T). SomeEntrypointCallT arg -> EpName
T.sepcName SomeEntrypointCallT arg
sepc
                  , tdParameter :: TxParam
tdParameter = Value p -> TxParam
forall (t :: T). ParameterScope t => Value t -> TxParam
TxTypedParam (TransferTokens Instr p -> Value p
forall (instr :: [T] -> [T] -> *) (p :: T).
TransferTokens instr p -> Value' instr p
ttTransferArgument TransferTokens Instr p
tt)
                  , tdAmount :: Mutez
tdAmount = TransferTokens Instr p -> Mutez
forall (instr :: [T] -> [T] -> *) (p :: T).
TransferTokens instr p -> Mutez
ttAmount TransferTokens Instr p
tt
                  }
              transferOperation :: TransferOperation
transferOperation =
                TransferOperation
                  { toDestination :: Address
toDestination = Address
destAddress
                  , toTxData :: TxData
toTxData = TxData
txData
                  , toCounter :: GlobalCounter
toCounter = TransferTokens Instr p -> GlobalCounter
forall (instr :: [T] -> [T] -> *) (p :: T).
TransferTokens instr p -> GlobalCounter
ttCounter TransferTokens Instr p
tt
                  }
          in TransferOperation -> ExecutorOp
TransferOp TransferOperation
transferOperation
    OpSetDelegate T.SetDelegate{Maybe KeyHash
GlobalCounter
sdMbKeyHash :: Maybe KeyHash
sdCounter :: GlobalCounter
sdMbKeyHash :: SetDelegate -> Maybe KeyHash
sdCounter :: SetDelegate -> GlobalCounter
..} -> ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutorOp
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      ExecutorOp)
-> ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a b. (a -> b) -> a -> b
$ SetDelegateOperation -> ExecutorOp
SetDelegateOp SetDelegateOperation
      { sdoContract :: L1Address
sdoContract = KindedAddress kind -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
interpretedAddr
      , sdoDelegate :: Maybe KeyHash
sdoDelegate = Maybe KeyHash
sdMbKeyHash
      , sdoCounter :: GlobalCounter
sdoCounter = GlobalCounter
sdCounter
      }
    OpCreateContract CreateContract{ccOriginator :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> L1Address
ccOriginator=Constrained KindedAddress a
ccOriginator, Maybe KeyHash
Mutez
GlobalCounter
Contract' Instr cp st
Value' Instr st
ccDelegate :: Maybe KeyHash
ccBalance :: Mutez
ccStorageVal :: Value' Instr st
ccContract :: Contract' Instr cp st
ccCounter :: GlobalCounter
ccDelegate :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Maybe KeyHash
ccBalance :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Mutez
ccStorageVal :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Value' instr st
ccContract :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Contract' instr cp st
ccCounter :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> GlobalCounter
..} ->
      ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutorOp
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      ExecutorOp)
-> ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
        { ooOriginator :: KindedAddress a
ooOriginator = KindedAddress a
ccOriginator
        , ooDelegate :: Maybe KeyHash
ooDelegate = Maybe KeyHash
ccDelegate
        , ooBalance :: Mutez
ooBalance = Mutez
ccBalance
        , ooStorage :: Value' Instr st
ooStorage = Value' Instr st
ccStorageVal
        , ooContract :: Contract' Instr cp st
ooContract = Contract' Instr cp st
ccContract
        , ooCounter :: GlobalCounter
ooCounter = GlobalCounter
ccCounter
        , ooAlias :: Maybe ContractAlias
ooAlias = Maybe ContractAlias
forall a. Maybe a
Nothing
        }
    OpEmit Emit Instr t
emit -> case KindedAddress kind
interpretedAddr of
      ContractAddress{} -> ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a.
a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutorOp
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      ExecutorOp)
-> ExecutorOp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a b. (a -> b) -> a -> b
$ EmitOperation -> ExecutorOp
EmitOp (EmitOperation -> ExecutorOp) -> EmitOperation -> ExecutorOp
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Emit Instr t -> EmitOperation
forall (t :: T).
PackedValScope t =>
ContractAddress -> Emit Instr t -> EmitOperation
EmitOperation KindedAddress kind
ContractAddress
interpretedAddr Emit Instr t
emit
      KindedAddress kind
_ -> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE (ExecutorErrorPrim Address
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      ExecutorOp)
-> ExecutorErrorPrim Address
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ExecutorOp
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorErrorPrim Address
forall a. a -> ExecutorErrorPrim a
EEUnknownContract (Address -> ExecutorErrorPrim Address)
-> Address -> ExecutorErrorPrim Address
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
interpretedAddr

-- | Reset source address before executing a global operation.
beginGlobalOperation :: ExecutorM ()
beginGlobalOperation :: ReaderT
  ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
beginGlobalOperation =
  (Maybe L1Address -> Identity (Maybe L1Address))
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState (Maybe L1Address)
esSourceAddress ((Maybe L1Address -> Identity (Maybe L1Address))
 -> ExecutorState -> Identity ExecutorState)
-> Maybe L1Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe L1Address
forall a. Maybe a
Nothing

-- | Return True if the param is not Unit or ticket.
badParamToImplicitAccount :: TxParam -> Bool
badParamToImplicitAccount :: TxParam -> Bool
badParamToImplicitAccount (TxTypedParam T.VTicket{})   = Bool
False
badParamToImplicitAccount TxParam
param = Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TxParam -> Bool
isUnitParam TxParam
param

-- | Return True if parameter is @Unit@.
isUnitParam :: TxParam -> Bool
isUnitParam :: TxParam -> Bool
isUnitParam (TxTypedParam Value' Instr t
T.VUnit)       = Bool
True
isUnitParam (TxUntypedParam Value
U.ValueUnit) = Bool
True
isUnitParam TxParam
_ = Bool
False

getContractStack :: ExecutorM [ExecutorOp]
getContractStack :: ExecutorM [ExecutorOp]
getContractStack = [ExecutorOp] -> [ExecutorOp]
forall a. [a] -> [a]
reverse ([ExecutorOp] -> [ExecutorOp])
-> ExecutorM [ExecutorOp] -> ExecutorM [ExecutorOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [ExecutorOp] ExecutorEnv [ExecutorOp]
-> ExecutorM [ExecutorOp]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ExecutorOp] ExecutorEnv [ExecutorOp]
Lens' ExecutorEnv [ExecutorOp]
eeCallChain

throwEE :: ExecutorErrorPrim Address -> ExecutorM r
throwEE :: forall r. ExecutorErrorPrim Address -> ExecutorM r
throwEE ExecutorErrorPrim Address
err = ExecutorError
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) r
forall a.
ExecutorError
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) r)
-> ([ExecutorOp] -> ExecutorError)
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ExecutorOp] -> ExecutorErrorPrim Address -> ExecutorError)
-> ExecutorErrorPrim Address -> [ExecutorOp] -> ExecutorError
forall a b c. (a -> b -> c) -> b -> a -> c
flip [ExecutorOp] -> ExecutorErrorPrim Address -> ExecutorError
forall a. [ExecutorOp] -> ExecutorErrorPrim a -> ExecutorError' a
ExecutorError ExecutorErrorPrim Address
err ([ExecutorOp]
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) r)
-> ExecutorM [ExecutorOp]
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExecutorM [ExecutorOp]
getContractStack

liftEE :: Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE :: forall r. Either (ExecutorErrorPrim Address) r -> ExecutorM r
liftEE Either (ExecutorErrorPrim Address) r
x = do
  [ExecutorOp]
stack <- ExecutorM [ExecutorOp]
getContractStack
  Either ExecutorError r -> ExecutorM r
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ExecutorError r -> ExecutorM r)
-> (Either (ExecutorErrorPrim Address) r -> Either ExecutorError r)
-> Either (ExecutorErrorPrim Address) r
-> ExecutorM r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExecutorErrorPrim Address -> ExecutorError)
-> Either (ExecutorErrorPrim Address) r -> Either ExecutorError r
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([ExecutorOp] -> ExecutorErrorPrim Address -> ExecutorError
forall a. [ExecutorOp] -> ExecutorErrorPrim a -> ExecutorError' a
ExecutorError [ExecutorOp]
stack) (Either (ExecutorErrorPrim Address) r -> ExecutorM r)
-> Either (ExecutorErrorPrim Address) r -> ExecutorM r
forall a b. (a -> b) -> a -> b
$ Either (ExecutorErrorPrim Address) r
x

addStackEntry :: ExecutorOp -> ExecutorM a -> ExecutorM a
addStackEntry :: forall a. ExecutorOp -> ExecutorM a -> ExecutorM a
addStackEntry ExecutorOp
entry = (ExecutorEnv -> ExecutorEnv)
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall a.
(ExecutorEnv -> ExecutorEnv)
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (([ExecutorOp] -> Identity [ExecutorOp])
-> ExecutorEnv -> Identity ExecutorEnv
Lens' ExecutorEnv [ExecutorOp]
eeCallChain (([ExecutorOp] -> Identity [ExecutorOp])
 -> ExecutorEnv -> Identity ExecutorEnv)
-> ([ExecutorOp] -> [ExecutorOp]) -> ExecutorEnv -> ExecutorEnv
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([ExecutorOp] -> [ExecutorOp]) -> [ExecutorOp] -> [ExecutorOp]
forall a b. Coercible a b => a -> b
coerce (ExecutorOp
entry ExecutorOp -> [ExecutorOp] -> [ExecutorOp]
forall a. a -> [a] -> [a]
:))