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

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

module Morley.Michelson.Runtime
  (
    -- * High level interface for end user
    originateContract
  , runContract
  , transfer

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

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

  -- * For testing
  , ExecutorOp (..)
  , ExecutorRes (..)
  , ExecutorError' (..)
  , ExecutorError
  , ExecutorM
  , runExecutorM
  , runExecutorMWithDB
  , executeGlobalOperations
  , executeGlobalOrigination
  , executeOrigination
  , executeTransfer

  -- * To avoid warnings (can't generate lenses only for some fields)
  , erInterpretResults
  , erUpdates
  , erGState
  , erRemainingSteps
  , elInterpreterResults
  , elUpdates
  ) where

import Control.Lens (assign, at, makeLenses, (.=), (<>=))
import Control.Monad.Except (Except, liftEither, runExcept, throwError)
import Data.Default (def)
import qualified Data.HashSet as HS
import Data.Semigroup.Generic
import Data.Text.IO (getContents)
import qualified Data.Text.IO.Utf8 as Utf8 (readFile)
import Fmt (Buildable(build), blockListF, fmt, fmtLn, indentF, nameF, pretty, (+|), (|+))
import Text.Megaparsec (parse)

import Morley.Michelson.Interpret
  (ContractEnv(..), InterpretError(..), InterpretResult(..), InterpreterState(..), MorleyLogs(..),
  RemainingSteps(..), assignBigMapIds, handleContractReturn, interpret)
import Morley.Michelson.Macro (ParsedOp, expandContract)
import qualified Morley.Michelson.Parser as P
import Morley.Michelson.Runtime.GState
import Morley.Michelson.Runtime.TxData
import Morley.Michelson.TypeCheck
import Morley.Michelson.Typed
  (CreateContract(..), EntrypointCallT, EpName, Operation'(..), SomeContractAndStorage(..),
  SomeStorage(..), SomeValue(..), TransferTokens(..), untypeValue)
import qualified Morley.Michelson.Typed as T
import Morley.Michelson.Typed.Operation
import Morley.Michelson.Untyped (Contract)
import qualified Morley.Michelson.Untyped as U
import Morley.Tezos.Address (Address(..), GlobalCounter(..), isKeyAddress)
import Morley.Tezos.Core
  (Mutez, Timestamp(..), getCurrentTime, unsafeAddMutez, unsafeSubMutez, zeroMutez)
import Morley.Tezos.Crypto (KeyHash, parseKeyHash)
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.
  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
showList :: [ExecutorOp] -> ShowS
$cshowList :: [ExecutorOp] -> ShowS
show :: ExecutorOp -> String
$cshow :: ExecutorOp -> String
showsPrec :: Int -> ExecutorOp -> ShowS
$cshowsPrec :: Int -> ExecutorOp -> ShowS
Show)

instance Buildable ExecutorOp where
  build :: ExecutorOp -> Builder
build = \case
    TransferOp (TransferOperation Address
addr TxData{EpName
Mutez
Address
TxParam
tdAmount :: TxData -> Mutez
tdEntrypoint :: TxData -> EpName
tdParameter :: TxData -> TxParam
tdSenderAddress :: TxData -> Address
tdAmount :: Mutez
tdEntrypoint :: EpName
tdParameter :: TxParam
tdSenderAddress :: Address
..} GlobalCounter
_)->
      Builder
"Transfer " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
tdAmount Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" tokens from " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
tdSenderAddress Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" to " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    OriginateOp OriginationOperation{Maybe KeyHash
Mutez
GlobalCounter
Address
Contract cp st
Value st
ooCounter :: OriginationOperation -> GlobalCounter
ooContract :: ()
ooStorage :: ()
ooBalance :: OriginationOperation -> Mutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooOriginator :: OriginationOperation -> Address
ooCounter :: GlobalCounter
ooContract :: Contract cp st
ooStorage :: Value st
ooBalance :: Mutez
ooDelegate :: Maybe KeyHash
ooOriginator :: Address
..} ->
      Builder
"Originate a contract with" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
" delegate " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder -> (KeyHash -> Builder) -> Maybe KeyHash -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"<nobody>" KeyHash -> Builder
forall p. Buildable p => p -> Builder
build Maybe KeyHash
ooDelegate Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
      Builder
" and balance = " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
ooBalance Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    SetDelegateOp SetDelegateOperation{Maybe KeyHash
GlobalCounter
Address
sdoCounter :: SetDelegateOperation -> GlobalCounter
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoContract :: SetDelegateOperation -> Address
sdoCounter :: GlobalCounter
sdoDelegate :: Maybe KeyHash
sdoContract :: Address
..} ->
      Builder
"Set delegate of contract " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
sdoContract Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
      Builder
" to " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder -> (KeyHash -> Builder) -> Maybe KeyHash -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"<nobody>" KeyHash -> Builder
forall p. Buildable p => p -> Builder
build Maybe KeyHash
sdoDelegate Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

-- | 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, InterpretResult)]
_erInterpretResults :: [(Address, InterpretResult)]
  -- ^ 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
showList :: [ExecutorRes] -> ShowS
$cshowList :: [ExecutorRes] -> ShowS
show :: ExecutorRes -> String
$cshow :: ExecutorRes -> String
showsPrec :: Int -> ExecutorRes -> ShowS
$cshowsPrec :: Int -> ExecutorRes -> ShowS
Show)

data ExecutorEnv = ExecutorEnv
  { ExecutorEnv -> Timestamp
_eeNow :: Timestamp
  , ExecutorEnv -> Natural
_eeLevel :: Natural
  }
  deriving stock (Int -> ExecutorEnv -> ShowS
[ExecutorEnv] -> ShowS
ExecutorEnv -> String
(Int -> ExecutorEnv -> ShowS)
-> (ExecutorEnv -> String)
-> ([ExecutorEnv] -> ShowS)
-> Show ExecutorEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutorEnv] -> ShowS
$cshowList :: [ExecutorEnv] -> ShowS
show :: ExecutorEnv -> String
$cshow :: ExecutorEnv -> String
showsPrec :: Int -> ExecutorEnv -> ShowS
$cshowsPrec :: Int -> ExecutorEnv -> ShowS
Show, (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
$cto :: forall x. Rep ExecutorEnv x -> ExecutorEnv
$cfrom :: forall x. ExecutorEnv -> Rep ExecutorEnv x
Generic)

data ExecutorState = ExecutorState
  { ExecutorState -> GState
_esGState :: GState
  , ExecutorState -> RemainingSteps
_esRemainingSteps :: RemainingSteps
  , ExecutorState -> Maybe Address
_esSourceAddress :: Maybe Address
  , 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
showList :: [ExecutorState] -> ShowS
$cshowList :: [ExecutorState] -> ShowS
show :: ExecutorState -> String
$cshow :: ExecutorState -> String
showsPrec :: Int -> ExecutorState -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ExecutorState x -> ExecutorState
$cfrom :: forall x. ExecutorState -> Rep ExecutorState x
Generic)

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

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

-- | Errors that can happen during contract interpreting.
-- Type parameter @a@ determines how contracts will be represented
-- in these errors, e.g. 'Address'.
data ExecutorError' a
  = EEUnknownContract a
  -- ^ The interpreted contract hasn't been originated.
  | EEInterpreterFailed a
                        InterpretError
  -- ^ Interpretation of Michelson contract failed.
  | EEAlreadyOriginated a
                        ContractState
  -- ^ A contract is already originated.
  | EEUnknownSender a
  -- ^ Sender address is unknown.
  | EEUnknownManager a
  -- ^ Manager address is unknown.
  | EENotEnoughFunds a Mutez
  -- ^ Sender doesn't have enough funds.
  | EEZeroTransaction a
  -- ^ Sending 0tz towards an address.
  | EEFailedToApplyUpdates GStateUpdateError
  -- ^ Failed to apply updates to GState.
  | EEIllTypedParameter a TCError
  -- ^ Contract parameter is ill-typed.
  | EEUnexpectedParameterType a T.T 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.
  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
showList :: [ExecutorError' a] -> ShowS
$cshowList :: forall a. Show a => [ExecutorError' a] -> ShowS
show :: ExecutorError' a -> String
$cshow :: forall a. Show a => ExecutorError' a -> String
showsPrec :: Int -> ExecutorError' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ExecutorError' a -> ShowS
Show, a -> ExecutorError' b -> ExecutorError' a
(a -> b) -> ExecutorError' a -> ExecutorError' b
(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
<$ :: a -> ExecutorError' b -> ExecutorError' a
$c<$ :: forall a b. a -> ExecutorError' b -> ExecutorError' a
fmap :: (a -> b) -> ExecutorError' a -> ExecutorError' b
$cfmap :: forall a b. (a -> b) -> ExecutorError' a -> ExecutorError' b
Functor)

instance (Buildable a) => Buildable (ExecutorError' a) where
  build :: ExecutorError' a -> Builder
build =
    \case
      EEUnknownContract a
addr -> Builder
"The contract is not originated " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EEInterpreterFailed a
addr InterpretError
err ->
        Builder
"Michelson interpreter failed for contract " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
": " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| InterpretError
err InterpretError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EEAlreadyOriginated a
addr ContractState
cs ->
        Builder
"The following contract is already originated: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
        Builder
", " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractState
cs ContractState -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EEUnknownSender a
addr -> Builder
"The sender address is unknown " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EEUnknownManager a
addr -> Builder
"The manager address is unknown " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EENotEnoughFunds a
addr Mutez
amount ->
        Builder
"The sender (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
        Builder
") doesn't have enough funds (has only " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
amount Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")"
      EEZeroTransaction a
addr ->
        Builder
"Transaction of 0ꜩ towards a key address " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" which has no code is prohibited"
      EEFailedToApplyUpdates GStateUpdateError
err -> Builder
"Failed to update GState: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| GStateUpdateError
err GStateUpdateError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EEIllTypedParameter a
_ TCError
err -> Builder
"The contract parameter is ill-typed: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TCError
err TCError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EEUnexpectedParameterType a
_ T
actualT T
expectedT ->
        Builder
"The contract parameter is well-typed, but did not match the contract's entrypoint's type.\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
"Expected: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| T
expectedT T -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
"Got: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| T
actualT T -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EEUnknownEntrypoint EpName
epName -> Builder
"The contract does not contain entrypoint '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| EpName
epName EpName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"'"
      EETransactionFromContract a
addr Mutez
amount ->
        Builder
"Global transaction of funds (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
amount Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
") from an originated contract (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
") is prohibited."
      EEWrongParameterType a
addr ->
        Builder
"Bad contract parameter for: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
addr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
      EEOperationReplay ExecutorOp
op ->
        Builder
"Operation replay attempt:\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int -> Builder -> Builder
indentF Int
2 (ExecutorOp -> Builder
forall p. Buildable p => p -> Builder
build ExecutorOp
op) Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

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, FromBuilder 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 (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, FromBuilder 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 (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 (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
  :: FilePath
  -> TypeCheckOptions
  -> Address
  -> Maybe KeyHash
  -> Mutez
  -> U.Value
  -> U.Contract
  -> "verbose" :! Bool
  -> IO Address
originateContract :: String
-> TypeCheckOptions
-> Address
-> Maybe KeyHash
-> Mutez
-> Value
-> Contract
-> ("verbose" :! Bool)
-> IO Address
originateContract String
dbPath TypeCheckOptions
tcOpts Address
originator Maybe KeyHash
delegate Mutez
balance Value
uStorage Contract
uContract "verbose" :! Bool
verbose = 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 (f :: * -> *) a. Applicative f => a -> f a
pure (Either TCError OriginationOperation -> IO OriginationOperation)
-> (TypeCheckResult OriginationOperation
    -> Either TCError OriginationOperation)
-> TypeCheckResult OriginationOperation
-> IO OriginationOperation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult OriginationOperation
-> Either TCError OriginationOperation
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
tcOpts (TypeCheckResult OriginationOperation -> IO OriginationOperation)
-> TypeCheckResult OriginationOperation -> IO OriginationOperation
forall a b. (a -> b) -> a -> b
$
    SomeContractAndStorage -> OriginationOperation
mkOrigination (SomeContractAndStorage -> OriginationOperation)
-> ReaderT TypeCheckOptions (Except TCError) SomeContractAndStorage
-> TypeCheckResult OriginationOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contract
-> Value
-> ReaderT TypeCheckOptions (Except TCError) SomeContractAndStorage
typeCheckContractAndStorage Contract
uContract Value
uStorage
  -- pass 100500 as maxSteps, because it doesn't matter for origination,
  -- as well as 'now'
  ((ExecutorRes, Address) -> Address)
-> IO (ExecutorRes, Address) -> IO Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, Address) -> Address
forall a b. (a, b) -> b
snd (IO (ExecutorRes, Address) -> IO Address)
-> IO (ExecutorRes, Address) -> IO Address
forall a b. (a -> b) -> a -> b
$ Maybe Timestamp
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM Address
-> IO (ExecutorRes, Address)
forall a.
Maybe Timestamp
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
forall a. Maybe a
Nothing Maybe Natural
forall a. Maybe a
Nothing String
dbPath RemainingSteps
100500 "verbose" :! Bool
verbose (IsLabel "dryRun" (Name "dryRun")
Name "dryRun"
#dryRun Name "dryRun" -> Maybe Bool -> "dryRun" :? Bool
forall (name :: Symbol) a.
Name name -> Maybe a -> NamedF Maybe a name
:? Maybe Bool
forall a. Maybe a
Nothing) (ExecutorM Address -> IO (ExecutorRes, Address))
-> ExecutorM Address -> IO (ExecutorRes, Address)
forall a b. (a -> b) -> a -> b
$ do
    OriginationOperation -> ExecutorM Address
executeGlobalOrigination OriginationOperation
origination
  where
    mkOrigination :: SomeContractAndStorage -> OriginationOperation
mkOrigination (SomeContractAndStorage Contract cp st
contract Value st
storage) = OriginationOperation :: forall (cp :: T) (st :: T).
(StorageScope st, ParameterScope cp) =>
Address
-> Maybe KeyHash
-> Mutez
-> Value st
-> Contract cp st
-> GlobalCounter
-> OriginationOperation
OriginationOperation
      { ooOriginator :: Address
ooOriginator = Address
originator
      , ooDelegate :: Maybe KeyHash
ooDelegate = Maybe KeyHash
delegate
      , ooBalance :: Mutez
ooBalance = Mutez
balance
      , ooStorage :: Value st
ooStorage = Value st
storage
      , ooContract :: Contract cp st
ooContract = Contract cp st
contract
      , ooCounter :: GlobalCounter
ooCounter = GlobalCounter
0
      }

-- | 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
  :: Maybe Timestamp
  -> Maybe Natural
  -> Word64
  -> Mutez
  -> FilePath
  -> TypeCheckOptions
  -> U.Value
  -> U.Contract
  -> TxData
  -> "verbose" :! Bool
  -> "dryRun" :! Bool
  -> IO SomeStorage
runContract :: Maybe Timestamp
-> Maybe Natural
-> Word64
-> Mutez
-> String
-> TypeCheckOptions
-> Value
-> Contract
-> TxData
-> ("verbose" :! Bool)
-> ("dryRun" :! Bool)
-> IO SomeStorage
runContract Maybe Timestamp
maybeNow Maybe Natural
maybeLevel Word64
maxSteps Mutez
initBalance String
dbPath TypeCheckOptions
tcOpts Value
uStorage Contract
uContract TxData
txData
  "verbose" :! Bool
verbose (N Bool
dryRun) = 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 (f :: * -> *) a. Applicative f => a -> f a
pure (Either TCError OriginationOperation -> IO OriginationOperation)
-> (TypeCheckResult OriginationOperation
    -> Either TCError OriginationOperation)
-> TypeCheckResult OriginationOperation
-> IO OriginationOperation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult OriginationOperation
-> Either TCError OriginationOperation
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
tcOpts (TypeCheckResult OriginationOperation -> IO OriginationOperation)
-> TypeCheckResult OriginationOperation -> IO OriginationOperation
forall a b. (a -> b) -> a -> b
$
    SomeContractAndStorage -> OriginationOperation
mkOrigination (SomeContractAndStorage -> OriginationOperation)
-> ReaderT TypeCheckOptions (Except TCError) SomeContractAndStorage
-> TypeCheckResult OriginationOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contract
-> Value
-> ReaderT TypeCheckOptions (Except TCError) SomeContractAndStorage
typeCheckContractAndStorage Contract
uContract Value
uStorage
  (ExecutorRes
_, SomeStorage
newSt) <- Maybe Timestamp
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM SomeStorage
-> IO (ExecutorRes, SomeStorage)
forall a.
Maybe Timestamp
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
maybeNow Maybe Natural
maybeLevel String
dbPath (Word64 -> RemainingSteps
RemainingSteps Word64
maxSteps) "verbose" :! Bool
verbose (("dryRun" :? Bool)
 -> ExecutorM SomeStorage -> IO (ExecutorRes, SomeStorage))
-> Param ("dryRun" :? Bool)
-> ExecutorM SomeStorage
-> IO (ExecutorRes, SomeStorage)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! IsLabel "dryRun" (Bool -> Param ("dryRun" :? Bool))
Bool -> Param ("dryRun" :? Bool)
#dryRun Bool
dryRun (ExecutorM SomeStorage -> IO (ExecutorRes, SomeStorage))
-> ExecutorM SomeStorage -> IO (ExecutorRes, SomeStorage)
forall a b. (a -> b) -> a -> b
$ do
    -- Here we are safe to bypass executeGlobalOperations for origination,
    -- since origination can't generate more operations.
    Address
addr <- OriginationOperation -> ExecutorM Address
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 Address
addr TxData
txData GlobalCounter
1
    TypeCheckOptions -> [ExecutorOp] -> ExecutorM ()
executeGlobalOperations TypeCheckOptions
tcOpts [ExecutorOp
transferOp]
    Address -> ExecutorM SomeStorage
getContractStorage Address
addr
  SomeStorage -> IO SomeStorage
forall (m :: * -> *) a. Monad m => a -> m a
return SomeStorage
newSt
  where
    -- 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.
    delegate :: KeyHash
delegate =
      (CryptoParseError -> KeyHash)
-> (KeyHash -> KeyHash)
-> Either CryptoParseError KeyHash
-> KeyHash
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> KeyHash
forall a. HasCallStack => Text -> a
error (Text -> KeyHash)
-> (CryptoParseError -> Text) -> CryptoParseError -> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"runContract can't parse delegate: " (Text -> Text)
-> (CryptoParseError -> Text) -> CryptoParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoParseError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) KeyHash -> KeyHash
forall a. a -> a
id (Either CryptoParseError KeyHash -> KeyHash)
-> Either CryptoParseError KeyHash -> KeyHash
forall a b. (a -> b) -> a -> b
$
      Text -> Either CryptoParseError KeyHash
parseKeyHash Text
"tz1YCABRTa6H8PLKx2EtDWeCGPaKxUhNgv47"
    mkOrigination :: SomeContractAndStorage -> OriginationOperation
mkOrigination (SomeContractAndStorage Contract cp st
contract Value st
storage) = OriginationOperation :: forall (cp :: T) (st :: T).
(StorageScope st, ParameterScope cp) =>
Address
-> Maybe KeyHash
-> Mutez
-> Value st
-> Contract cp st
-> GlobalCounter
-> OriginationOperation
OriginationOperation
      { ooOriginator :: Address
ooOriginator = Address
genesisAddress
      , ooDelegate :: Maybe KeyHash
ooDelegate = KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just KeyHash
delegate
      , ooBalance :: Mutez
ooBalance = Mutez
initBalance
      , ooStorage :: Value st
ooStorage = Value st
storage
      , ooContract :: Contract cp st
ooContract = Contract cp st
contract
      , ooCounter :: GlobalCounter
ooCounter = GlobalCounter
0
      }

    getContractStorage :: Address -> ExecutorM SomeStorage
    getContractStorage :: Address -> ExecutorM SomeStorage
getContractStorage Address
addr = do
      Map Address AddressState
addrs <- Getting
  (Map Address AddressState) ExecutorState (Map Address AddressState)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Map Address AddressState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Map Address AddressState) GState)
-> ExecutorState -> Const (Map Address AddressState) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (Map Address AddressState) GState)
 -> ExecutorState -> Const (Map Address AddressState) ExecutorState)
-> ((Map Address AddressState
     -> Const (Map Address AddressState) (Map Address AddressState))
    -> GState -> Const (Map Address AddressState) GState)
-> Getting
     (Map Address AddressState) ExecutorState (Map Address AddressState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Address AddressState
 -> Const (Map Address AddressState) (Map Address AddressState))
-> GState -> Const (Map Address AddressState) GState
Lens' GState (Map Address AddressState)
gsAddressesL)
      case Map Address AddressState
addrs Map Address AddressState
-> Getting
     (Maybe AddressState)
     (Map Address AddressState)
     (Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
     (Map Address AddressState)
     (Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr of
        Maybe AddressState
Nothing -> Text -> ExecutorM SomeStorage
forall a. HasCallStack => Text -> a
error (Text -> ExecutorM SomeStorage) -> Text -> ExecutorM SomeStorage
forall a b. (a -> b) -> a -> b
$ Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Address
addr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is unknown"
        Just (ASSimple {}) -> Text -> ExecutorM SomeStorage
forall a. HasCallStack => Text -> a
error (Text -> ExecutorM SomeStorage) -> Text -> ExecutorM SomeStorage
forall a b. (a -> b) -> a -> b
$ Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Address
addr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is a simple address"
        Just (ASContract (ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
csDelegate :: ContractState -> Maybe KeyHash
csStorage :: ()
csContract :: ()
csBalance :: ContractState -> Mutez
csDelegate :: Maybe KeyHash
csStorage :: Value st
csContract :: Contract cp st
csBalance :: Mutez
..})) -> SomeStorage -> ExecutorM SomeStorage
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 (st :: T). StorageScope st => Value st -> SomeStorage
SomeStorage Value st
csStorage

-- | Send a transaction to given address with given parameters.
transfer ::
     Maybe Timestamp
  -> Maybe Natural
  -> Word64
  -> FilePath
  -> TypeCheckOptions
  -> Address
  -> TxData
  -> "verbose" :! Bool
  -> "dryRun" :? Bool
  -> IO ()
transfer :: Maybe Timestamp
-> Maybe Natural
-> Word64
-> String
-> TypeCheckOptions
-> Address
-> TxData
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> IO ()
transfer Maybe Timestamp
maybeNow Maybe Natural
maybeLevel Word64
maxSteps String
dbPath TypeCheckOptions
tcOpts Address
destination TxData
txData "verbose" :! Bool
verbose "dryRun" :? Bool
dryRun = do
  IO (ExecutorRes, ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ExecutorRes, ()) -> IO ()) -> IO (ExecutorRes, ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Timestamp
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM ()
-> IO (ExecutorRes, ())
forall a.
Maybe Timestamp
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
maybeNow Maybe Natural
maybeLevel String
dbPath (Word64 -> RemainingSteps
RemainingSteps Word64
maxSteps) "verbose" :! Bool
verbose "dryRun" :? Bool
dryRun (ExecutorM () -> IO (ExecutorRes, ()))
-> ExecutorM () -> IO (ExecutorRes, ())
forall a b. (a -> b) -> a -> b
$
    TypeCheckOptions -> [ExecutorOp] -> ExecutorM ()
executeGlobalOperations TypeCheckOptions
tcOpts [TransferOperation -> ExecutorOp
TransferOp (TransferOperation -> ExecutorOp)
-> TransferOperation -> ExecutorOp
forall a b. (a -> b) -> a -> b
$ Address -> TxData -> GlobalCounter -> TransferOperation
TransferOperation Address
destination 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
  -> RemainingSteps
  -> GState
  -> ExecutorM a
  -> Either ExecutorError (ExecutorRes, a)
runExecutorM :: Timestamp
-> Natural
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now Natural
level RemainingSteps
remainingSteps GState
gState ExecutorM a
action =
  ((a, ExecutorState) -> (ExecutorRes, a))
-> Either ExecutorError (a, ExecutorState)
-> Either ExecutorError (ExecutorRes, a)
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 -> ExecutorEnv
ExecutorEnv Timestamp
now Natural
level)
      ExecutorState
initialState
  where
    initialOpHash :: a
initialOpHash = Text -> a
forall a. HasCallStack => Text -> a
error Text
"Initial OperationHash touched"

    initialState :: ExecutorState
initialState = ExecutorState :: GState
-> RemainingSteps
-> Maybe Address
-> ExecutorLog
-> OperationHash
-> HashSet GlobalCounter
-> ExecutorState
ExecutorState
      { _esGState :: GState
_esGState = GState
gState
      , _esRemainingSteps :: RemainingSteps
_esRemainingSteps = RemainingSteps
remainingSteps
      , _esSourceAddress :: Maybe Address
_esSourceAddress = Maybe Address
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 :: (a, ExecutorState) -> (ExecutorRes, a)
preResToRes (a
r, ExecutorState{Maybe Address
HashSet GlobalCounter
GState
OperationHash
RemainingSteps
ExecutorLog
_esPrevCounters :: HashSet GlobalCounter
_esOperationHash :: OperationHash
_esLog :: ExecutorLog
_esSourceAddress :: Maybe Address
_esRemainingSteps :: RemainingSteps
_esGState :: GState
_esPrevCounters :: ExecutorState -> HashSet GlobalCounter
_esOperationHash :: ExecutorState -> OperationHash
_esLog :: ExecutorState -> ExecutorLog
_esSourceAddress :: ExecutorState -> Maybe Address
_esRemainingSteps :: ExecutorState -> RemainingSteps
_esGState :: ExecutorState -> GState
..}) =
      ( ExecutorRes :: GState
-> [GStateUpdate]
-> [(Address, InterpretResult)]
-> RemainingSteps
-> ExecutorRes
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, InterpretResult)]
_erInterpretResults = ExecutorLog
_esLog ExecutorLog
-> Getting
     [(Address, InterpretResult)]
     ExecutorLog
     [(Address, InterpretResult)]
-> [(Address, InterpretResult)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Address, InterpretResult)]
  ExecutorLog
  [(Address, InterpretResult)]
Lens' ExecutorLog [(Address, InterpretResult)]
elInterpreterResults
          , _erRemainingSteps :: RemainingSteps
_erRemainingSteps = RemainingSteps
_esRemainingSteps
          }
      , a
r
      )

-- | Run some executor action, reading state from the DB on disk.
--
-- Unless @dryRun@ is @False@, the final state is written back to the disk.
--
-- If the executor fails with 'ExecutorError' it will be thrown as an exception.
runExecutorMWithDB
  :: Maybe Timestamp
  -> Maybe Natural
  -> FilePath
  -> RemainingSteps
  -> "verbose" :! Bool
  -> "dryRun" :? Bool
  -> ExecutorM a
  -> IO (ExecutorRes, a)
runExecutorMWithDB :: Maybe Timestamp
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
maybeNow Maybe Natural
maybeLevel String
dbPath RemainingSteps
remainingSteps
  (N Bool
verbose)
  (Name "dryRun" -> Bool -> ("dryRun" :? Bool) -> Bool
forall (name :: Symbol) a. Name name -> a -> (name :? a) -> a
argDef IsLabel "dryRun" (Name "dryRun")
Name "dryRun"
#dryRun Bool
False -> 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Timestamp
maybeNow
  let level :: Natural
level = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
0 Maybe Natural
maybeLevel
  (res :: ExecutorRes
res@ExecutorRes{[(Address, InterpretResult)]
[GStateUpdate]
GState
RemainingSteps
_erRemainingSteps :: RemainingSteps
_erInterpretResults :: [(Address, InterpretResult)]
_erUpdates :: [GStateUpdate]
_erGState :: GState
_erRemainingSteps :: ExecutorRes -> RemainingSteps
_erInterpretResults :: ExecutorRes -> [(Address, InterpretResult)]
_erUpdates :: ExecutorRes -> [GStateUpdate]
_erGState :: ExecutorRes -> GState
..}, 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 (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
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
forall a.
Timestamp
-> Natural
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now Natural
level RemainingSteps
remainingSteps 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, InterpretResult)] -> IO ())
-> [(Address, InterpretResult)] -> IO ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
(Element t -> m b) -> t -> m ()
mapM_ (Address, InterpretResult) -> IO ()
Element [(Address, InterpretResult)] -> IO ()
printInterpretResult [(Address, InterpretResult)]
_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
not ([GStateUpdate] -> Bool
forall t. Container t => t -> Bool
null [GStateUpdate]
_erUpdates)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Builder -> IO ()
forall b. FromBuilder b => Builder -> b
fmtLn (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> Builder -> Builder
nameF Builder
"Updates" ([GStateUpdate] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
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, FromBuilder 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, InterpretResult) -> IO ()
    printInterpretResult :: (Address, InterpretResult) -> IO ()
printInterpretResult (Address
addr, InterpretResult {[Operation]
Value st
InterpreterState
MorleyLogs
iurMorleyLogs :: InterpretResult -> MorleyLogs
iurNewState :: InterpretResult -> InterpreterState
iurNewStorage :: ()
iurOps :: InterpretResult -> [Operation]
iurMorleyLogs :: MorleyLogs
iurNewState :: InterpreterState
iurNewStorage :: Value st
iurOps :: [Operation]
..}) = 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, FromBuilder b) => a -> b
pretty Address
addr
      case [Operation]
iurOps of
        [] -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
"It didn't return any operations."
        [Operation]
_ -> Builder -> IO ()
forall b. FromBuilder b => Builder -> b
fmt (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> Builder -> Builder
nameF Builder
"It returned operations" ([Operation] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF [Operation]
iurOps)
      Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
        Text
"It returned storage: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Value st -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
untypeValue Value st
iurNewStorage) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      let MorleyLogs [Text]
logs = MorleyLogs
iurMorleyLogs
      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_ 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

-- | Execute a list of global operations, discarding their results.
executeGlobalOperations
  :: TypeCheckOptions
  -> [ExecutorOp]
  -> ExecutorM ()
executeGlobalOperations :: TypeCheckOptions -> [ExecutorOp] -> ExecutorM ()
executeGlobalOperations TypeCheckOptions
tcOpts = (Element [ExecutorOp] -> ExecutorM ())
-> [ExecutorOp] -> ExecutorM ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
(Element t -> m b) -> t -> m ()
mapM_ ((Element [ExecutorOp] -> ExecutorM ())
 -> [ExecutorOp] -> ExecutorM ())
-> (Element [ExecutorOp] -> ExecutorM ())
-> [ExecutorOp]
-> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ \Element [ExecutorOp]
op ->
  ("isGlobalOp" :! Bool) -> [ExecutorOp] -> ExecutorM ()
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> "isGlobalOp" :! Bool
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
True) [Element [ExecutorOp]
ExecutorOp
op]
  where
    -- | Execute a list of operations and additional operations they return, until there are none.
    executeMany :: "isGlobalOp" :! Bool -> [ExecutorOp] -> ExecutorM ()
    executeMany :: ("isGlobalOp" :! Bool) -> [ExecutorOp] -> ExecutorM ()
executeMany "isGlobalOp" :! Bool
isGlobalOp = \case
        [] -> ExecutorM ()
forall (f :: * -> *). Applicative f => f ()
pass
        (ExecutorOp
op:[ExecutorOp]
opsTail) -> do
          case ExecutorOp
op of
            OriginateOp OriginationOperation
origination -> do
              ExecutorM Address -> ExecutorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExecutorM Address -> ExecutorM ())
-> ExecutorM Address -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ ("isGlobalOp" :! Bool) -> OriginationOperation -> ExecutorM Address
executeOrigination "isGlobalOp" :! Bool
isGlobalOp OriginationOperation
origination
              ("isGlobalOp" :! Bool) -> [ExecutorOp] -> ExecutorM ()
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> "isGlobalOp" :! Bool
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) [ExecutorOp]
opsTail
            SetDelegateOp SetDelegateOperation
operation -> do
              ("isGlobalOp" :! Bool) -> SetDelegateOperation -> ExecutorM ()
executeDelegation "isGlobalOp" :! Bool
isGlobalOp SetDelegateOperation
operation
              ("isGlobalOp" :! Bool) -> [ExecutorOp] -> ExecutorM ()
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> "isGlobalOp" :! Bool
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) [ExecutorOp]
opsTail
            TransferOp TransferOperation
transferOperation -> do
              [ExecutorOp]
moreOps <- ("isGlobalOp" :! Bool)
-> TypeCheckOptions -> TransferOperation -> ExecutorM [ExecutorOp]
executeTransfer "isGlobalOp" :! Bool
isGlobalOp TypeCheckOptions
tcOpts TransferOperation
transferOperation
              ("isGlobalOp" :! Bool) -> [ExecutorOp] -> ExecutorM ()
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> "isGlobalOp" :! Bool
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) ([ExecutorOp] -> ExecutorM ()) -> [ExecutorOp] -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ [ExecutorOp]
moreOps [ExecutorOp] -> [ExecutorOp] -> [ExecutorOp]
forall a. Semigroup a => a -> a -> a
<> [ExecutorOp]
opsTail

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

-- | Execute an origination operation.
executeOrigination
  :: "isGlobalOp" :! Bool
  -> OriginationOperation
  -> ExecutorM Address
executeOrigination :: ("isGlobalOp" :! Bool) -> OriginationOperation -> ExecutorM Address
executeOrigination (N Bool
isGlobalOp) origination :: OriginationOperation
origination@(OriginationOperation{Maybe KeyHash
Mutez
GlobalCounter
Address
Contract cp st
Value st
ooCounter :: GlobalCounter
ooContract :: Contract cp st
ooStorage :: Value st
ooBalance :: Mutez
ooDelegate :: Maybe KeyHash
ooOriginator :: Address
ooCounter :: OriginationOperation -> GlobalCounter
ooContract :: ()
ooStorage :: ()
ooBalance :: OriginationOperation -> Mutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooOriginator :: OriginationOperation -> Address
..}) = do
  Bool -> ExecutorM () -> ExecutorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ do
    ExecutorM ()
beginGlobalOperation
    ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash -> ExecutorM ()
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 -> ExecutorM ()) -> OperationHash -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> OperationHash
mkOriginationOperationHash OriginationOperation
origination

  ExecutorOp -> ExecutorM ()
checkOperationReplay (ExecutorOp -> ExecutorM ()) -> ExecutorOp -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination

  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 (Value st -> State BigMapCounter (Value st)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Value t -> m (Value t)
assignBigMapIds 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 :: Address
originatorAddress = Address
ooOriginator
  Mutez
originatorBalance <- case GState -> Map Address AddressState
gsAddresses GState
gs Map Address AddressState
-> Getting
     (Maybe AddressState)
     (Map Address AddressState)
     (Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
     (Map Address AddressState)
     (Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
originatorAddress of
    Maybe AddressState
Nothing -> ExecutorError
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Address -> ExecutorError
forall a. a -> ExecutorError' a
EEUnknownManager Address
originatorAddress)
    Just (AddressState -> Mutez
asBalance -> Mutez
oldBalance)
      | Mutez
oldBalance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< Mutez
ooBalance ->
        ExecutorError
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez)
-> ExecutorError
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
forall a b. (a -> b) -> a -> b
$ Address -> Mutez -> ExecutorError
forall a. a -> Mutez -> ExecutorError' a
EENotEnoughFunds Address
originatorAddress Mutez
oldBalance
      | Bool
otherwise ->
        -- Subtraction is safe because we have checked its
        -- precondition in guard.
        Mutez
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Mutez
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 :: Address
address = OperationHash -> GlobalCounter -> Address
mkContractAddress OperationHash
opHash GlobalCounter
ooCounter
    updates :: [GStateUpdate]
updates =
      [Maybe GStateUpdate] -> [GStateUpdate]
forall a. [Maybe a] -> [a]
catMaybes
        [ GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ Address -> AddressState -> GStateUpdate
GSAddAddress Address
address (ContractState -> AddressState
ASContract ContractState
contractState)
        , GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ Address -> Mutez -> GStateUpdate
GSSetBalance Address
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
_ ->
      ExecutorError -> ExecutorM Address
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM Address)
-> ExecutorError -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ Address -> ContractState -> ExecutorError
forall a. a -> ContractState -> ExecutorError' a
EEAlreadyOriginated Address
address ContractState
contractState
    Right GState
newGS -> do
      (GState -> Identity GState)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Identity GState)
 -> ExecutorState -> Identity ExecutorState)
-> GState -> ExecutorM ()
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 -> ExecutorM ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, InterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates []

      return Address
address

-- | Execute delegation operation.
executeDelegation
  :: "isGlobalOp" :! Bool
  -> SetDelegateOperation
  -> ExecutorM ()
executeDelegation :: ("isGlobalOp" :! Bool) -> SetDelegateOperation -> ExecutorM ()
executeDelegation (N Bool
isGlobalOp) delegation :: SetDelegateOperation
delegation@(SetDelegateOperation{Maybe KeyHash
GlobalCounter
Address
sdoCounter :: GlobalCounter
sdoDelegate :: Maybe KeyHash
sdoContract :: Address
sdoCounter :: SetDelegateOperation -> GlobalCounter
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoContract :: SetDelegateOperation -> Address
..}) = do
  Bool -> ExecutorM () -> ExecutorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ do
    ExecutorM ()
beginGlobalOperation
    ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash -> ExecutorM ()
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 -> ExecutorM ()) -> OperationHash -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ SetDelegateOperation -> OperationHash
mkDelegationOperationHash SetDelegateOperation
delegation

  ExecutorOp -> ExecutorM ()
checkOperationReplay (ExecutorOp -> ExecutorM ()) -> ExecutorOp -> ExecutorM ()
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

  let updates :: [GStateUpdate]
updates = [Address -> Maybe KeyHash -> GStateUpdate
GSSetDelegate Address
sdoContract Maybe KeyHash
sdoDelegate]
  case [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates [GStateUpdate]
updates GState
gs of
    Left GStateUpdateError
err -> ExecutorError -> ExecutorM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM ()) -> ExecutorError -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ GStateUpdateError -> ExecutorError
forall a. GStateUpdateError -> ExecutorError' 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 -> ExecutorM ()
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 -> ExecutorM ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, InterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates []

      return ()

-- | Execute a transfer operation.
executeTransfer
  :: "isGlobalOp" :! Bool
  -> TypeCheckOptions
  -> TransferOperation
  -> ExecutorM [ExecutorOp]
executeTransfer :: ("isGlobalOp" :! Bool)
-> TypeCheckOptions -> TransferOperation -> ExecutorM [ExecutorOp]
executeTransfer (N Bool
isGlobalOp) TypeCheckOptions
tcOpts transferOperation :: TransferOperation
transferOperation@(TransferOperation Address
addr TxData
txData GlobalCounter
_) = do
    Bool -> ExecutorM () -> ExecutorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$
      ExecutorM ()
beginGlobalOperation

    Timestamp
now <- 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
level <- 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
    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
    Maybe Address
mSourceAddr <- Getting (Maybe Address) ExecutorState (Maybe Address)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Address) ExecutorState (Maybe Address)
Lens' ExecutorState (Maybe Address)
esSourceAddress

    let globalCounter :: GlobalCounter
globalCounter = GState -> GlobalCounter
gsCounter GState
gs
    let addresses :: Map Address AddressState
addresses = GState -> Map Address AddressState
gsAddresses GState
gs
    let senderAddr :: Address
senderAddr = TxData -> Address
tdSenderAddress TxData
txData
    let sourceAddr :: Address
sourceAddr = Address -> Maybe Address -> Address
forall a. a -> Maybe a -> a
fromMaybe Address
senderAddr Maybe Address
mSourceAddr
    let isZeroTransfer :: Bool
isZeroTransfer = TxData -> Mutez
tdAmount TxData
txData Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
zeroMutez

    ExecutorOp -> ExecutorM ()
checkOperationReplay (ExecutorOp -> ExecutorM ()) -> ExecutorOp -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ TransferOperation -> ExecutorOp
TransferOp TransferOperation
transferOperation

    Bool -> ExecutorM () -> ExecutorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Address -> TxParam -> Bool
badParamToImplicitAccount Address
addr (TxParam -> Bool) -> TxParam -> Bool
forall a b. (a -> b) -> a -> b
$ TxData -> TxParam
tdParameter TxData
txData) (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$
      ExecutorError -> ExecutorM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM ()) -> ExecutorError -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEWrongParameterType Address
addr

    -- Transferring 0 XTZ to a key address is prohibited.
    Bool -> ExecutorM () -> ExecutorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isZeroTransfer Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Address -> Bool
isKeyAddress Address
addr) (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$
      ExecutorError -> ExecutorM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM ()) -> ExecutorError -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEZeroTransaction Address
addr
    Maybe GStateUpdate
mDecreaseSenderBalance <- case (Bool
isZeroTransfer, Map Address AddressState
addresses Map Address AddressState
-> Getting
     (Maybe AddressState)
     (Map Address AddressState)
     (Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
     (Map Address AddressState)
     (Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
senderAddr) of
      (Bool
True, Maybe AddressState
_) -> Maybe GStateUpdate
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GStateUpdate
forall a. Maybe a
Nothing
      (Bool
False, Maybe AddressState
Nothing) -> ExecutorError
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Maybe GStateUpdate))
-> ExecutorError
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEUnknownSender Address
senderAddr
      (Bool
False, Just (AddressState -> Mutez
asBalance -> Mutez
balance))
        | Mutez
balance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< TxData -> Mutez
tdAmount TxData
txData ->
          ExecutorError
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Maybe GStateUpdate))
-> ExecutorError
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall a b. (a -> b) -> a -> b
$ Address -> Mutez -> ExecutorError
forall a. a -> Mutez -> ExecutorError' a
EENotEnoughFunds Address
senderAddr Mutez
balance
        | Bool
otherwise ->
          -- Subtraction is safe because we have checked its
          -- precondition in guard.
          Maybe GStateUpdate
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Maybe GStateUpdate)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
$ Address -> Mutez -> GStateUpdate
GSSetBalance Address
senderAddr (Mutez
balance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeSubMutez` TxData -> Mutez
tdAmount TxData
txData)
    Bool -> ExecutorM () -> ExecutorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Address -> Bool
isKeyAddress Address
senderAddr) Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Bool
isGlobalOp Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Bool -> Bool
not Bool
isZeroTransfer) (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$
      ExecutorError -> ExecutorM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM ()) -> ExecutorError -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ Address -> Mutez -> ExecutorError
forall a. a -> Mutez -> ExecutorError' a
EETransactionFromContract Address
senderAddr (Mutez -> ExecutorError) -> Mutez -> ExecutorError
forall a b. (a -> b) -> a -> b
$ TxData -> Mutez
tdAmount TxData
txData
    let onlyUpdates :: [GStateUpdate]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ([GStateUpdate], [Operation], Maybe InterpretResult,
      RemainingSteps)
onlyUpdates [GStateUpdate]
updates = ([GStateUpdate], [Operation], Maybe InterpretResult,
 RemainingSteps)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ([GStateUpdate], [Operation], Maybe InterpretResult,
      RemainingSteps)
forall (m :: * -> *) a. Monad m => a -> m a
return ([GStateUpdate]
updates, [], Maybe InterpretResult
forall a. Maybe a
Nothing, RemainingSteps
remainingSteps)
    ([GStateUpdate]
otherUpdates, [Operation]
sideEffects, Maybe InterpretResult
maybeInterpretRes :: Maybe InterpretResult, RemainingSteps
newRemSteps)
        <- case (Map Address AddressState
addresses Map Address AddressState
-> Getting
     (Maybe AddressState)
     (Map Address AddressState)
     (Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
     (Map Address AddressState)
     (Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr, Address
addr) of
      (Maybe AddressState
Nothing, ContractAddress ContractHash
_) ->
        ExecutorError
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ([GStateUpdate], [Operation], Maybe InterpretResult,
      RemainingSteps)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      ([GStateUpdate], [Operation], Maybe InterpretResult,
       RemainingSteps))
-> ExecutorError
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ([GStateUpdate], [Operation], Maybe InterpretResult,
      RemainingSteps)
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEUnknownContract Address
addr
      (Maybe AddressState
Nothing, KeyAddress KeyHash
_) -> do
        let
          transferAmount :: Mutez
transferAmount = TxData -> Mutez
tdAmount TxData
txData
          addrState :: AddressState
addrState = Mutez -> AddressState
ASSimple Mutez
transferAmount
          upd :: GStateUpdate
upd = Address -> AddressState -> GStateUpdate
GSAddAddress Address
addr AddressState
addrState
        [GStateUpdate]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ([GStateUpdate], [Operation], Maybe InterpretResult,
      RemainingSteps)
onlyUpdates [GStateUpdate
upd]
      (Just (ASSimple Mutez
oldBalance), Address
_) -> do
        -- can't overflow if global state is correct (because we can't
        -- create money out of nowhere)
        let
          newBalance :: Mutez
newBalance = Mutez
oldBalance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeAddMutez` TxData -> Mutez
tdAmount TxData
txData
          upd :: GStateUpdate
upd = Address -> Mutez -> GStateUpdate
GSSetBalance Address
addr Mutez
newBalance
        [GStateUpdate]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ([GStateUpdate], [Operation], Maybe InterpretResult,
      RemainingSteps)
onlyUpdates [GStateUpdate
upd]
      (Just (ASContract (ContractState {Maybe KeyHash
Mutez
Contract cp st
Value st
csDelegate :: Maybe KeyHash
csStorage :: Value st
csContract :: Contract cp st
csBalance :: Mutez
csDelegate :: ContractState -> Maybe KeyHash
csStorage :: ()
csContract :: ()
csBalance :: ContractState -> Mutez
..})), Address
_) -> do
        let
          existingContracts :: TcOriginatedContracts
existingContracts = GState -> TcOriginatedContracts
extractAllContracts GState
gs
          -- 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` TxData -> Mutez
tdAmount TxData
txData
          epName :: EpName
epName = TxData -> EpName
tdEntrypoint TxData
txData

        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 (ExecutorError
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (MkEntrypointCallRes cp)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (MkEntrypointCallRes cp))
-> ExecutorError
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (MkEntrypointCallRes cp)
forall a b. (a -> b) -> a -> b
$ EpName -> ExecutorError
forall a. EpName -> ExecutorError' a
EEUnknownEntrypoint EpName
epName) MkEntrypointCallRes cp
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (MkEntrypointCallRes cp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

        -- 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 TxData -> TxParam
tdParameter TxData
txData of
            TxTypedParam (Value t
typedVal :: T.Value t) -> do
              Value t
-> (forall x.
    Demote T
    -> Demote T
    -> ReaderT
         ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Value arg)
forall (a :: T) (b :: T) (t :: T -> *) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
t a -> (forall x. Demote T -> Demote T -> m x) -> m (t b)
T.castM @t @epArg Value t
typedVal (ExecutorError
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x)
-> (T -> T -> ExecutorError)
-> T
-> T
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x
forall a b c. SuperComposition a b c => a -> b -> c
... Address -> T -> T -> ExecutorError
forall a. a -> T -> T -> ExecutorError' a
EEUnexpectedParameterType Address
addr)
            TxUntypedParam Value
untypedVal ->
              Either ExecutorError (Value arg)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Value arg)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ExecutorError (Value arg)
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      (Value arg))
-> Either ExecutorError (Value arg)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     (Value arg)
forall a b. (a -> b) -> a -> b
$ (TCError -> ExecutorError)
-> Either TCError (Value arg) -> Either ExecutorError (Value arg)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Address -> TCError -> ExecutorError
forall a. a -> TCError -> ExecutorError' a
EEIllTypedParameter Address
addr) (Either TCError (Value arg) -> Either ExecutorError (Value arg))
-> Either TCError (Value arg) -> Either ExecutorError (Value arg)
forall a b. (a -> b) -> a -> b
$ TypeCheckOptions
-> TypeCheckResult (Value arg) -> Either TCError (Value arg)
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
tcOpts (TypeCheckResult (Value arg) -> Either TCError (Value arg))
-> TypeCheckResult (Value arg) -> Either TCError (Value arg)
forall a b. (a -> b) -> a -> b
$
                TcOriginatedContracts -> Value -> TypeCheckResult (Value arg)
forall (t :: T).
SingI t =>
TcOriginatedContracts -> Value -> TypeCheckResult (Value t)
typeVerifyParameter @epArg TcOriginatedContracts
existingContracts Value
untypedVal

        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 arg
typedParameterWithIds, BigMapCounter
bigMapCounter1) = State BigMapCounter (Value arg)
-> BigMapCounter -> (Value arg, BigMapCounter)
forall s a. State s a -> s -> (a, s)
runState (Value arg -> State BigMapCounter (Value arg)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Value t -> m (Value t)
assignBigMapIds Value arg
typedParameter) BigMapCounter
bigMapCounter0

        -- 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 -> ExecutorM () -> ExecutorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$
          ASetter ExecutorState ExecutorState OperationHash OperationHash
Lens' ExecutorState OperationHash
esOperationHash ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash -> ExecutorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Address -> Value arg -> EpName -> Mutez -> OperationHash
forall (t :: T).
ParameterScope t =>
Address -> Value t -> EpName -> Mutez -> OperationHash
mkTransferOperationHash
            Address
addr
            Value arg
typedParameterWithIds
            (TxData -> EpName
tdEntrypoint TxData
txData)
            (TxData -> Mutez
tdAmount TxData
txData)

        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
        let
          contractEnv :: ContractEnv
contractEnv = ContractEnv :: Timestamp
-> RemainingSteps
-> Mutez
-> Map Address AddressState
-> Address
-> Address
-> Address
-> Mutez
-> VotingPowers
-> ChainId
-> Maybe OperationHash
-> Natural
-> InstrCallStack
-> ContractEnv
ContractEnv
            { ceNow :: Timestamp
ceNow = Timestamp
now
            , ceMaxSteps :: RemainingSteps
ceMaxSteps = RemainingSteps
remainingSteps
            , ceBalance :: Mutez
ceBalance = Mutez
newBalance
            , ceContracts :: Map Address AddressState
ceContracts = GState -> Map Address AddressState
gsAddresses GState
gs
            , ceSelf :: Address
ceSelf = Address
addr
            , ceSource :: Address
ceSource = Address
sourceAddr
            , ceSender :: Address
ceSender = Address
senderAddr
            , ceAmount :: Mutez
ceAmount = TxData -> Mutez
tdAmount TxData
txData
            , ceVotingPowers :: VotingPowers
ceVotingPowers = GState -> VotingPowers
gsVotingPowers GState
gs
            , ceChainId :: ChainId
ceChainId = GState -> ChainId
gsChainId GState
gs
            , ceOperationHash :: Maybe OperationHash
ceOperationHash = OperationHash -> Maybe OperationHash
forall a. a -> Maybe a
Just OperationHash
opHash
            , ceLevel :: Natural
ceLevel = Natural
level
            , ceInstrCallStack :: InstrCallStack
ceInstrCallStack = InstrCallStack
forall a. Default a => a
def
            }

        iur :: InterpretResult
iur@InterpretResult
          { iurOps :: InterpretResult -> [Operation]
iurOps = [Operation]
sideEffects
          , iurNewStorage :: ()
iurNewStorage = Value st
newValue
          , iurNewState :: InterpretResult -> InterpreterState
iurNewState = InterpreterState RemainingSteps
newRemainingSteps GlobalCounter
globalCounter2 BigMapCounter
bigMapCounter2
          }
          <- Either ExecutorError InterpretResult
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     InterpretResult
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ExecutorError InterpretResult
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      InterpretResult)
-> Either ExecutorError InterpretResult
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     InterpretResult
forall a b. (a -> b) -> a -> b
$ (InterpretError -> ExecutorError)
-> Either InterpretError InterpretResult
-> Either ExecutorError InterpretResult
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Address -> InterpretError -> ExecutorError
forall a. a -> InterpretError -> ExecutorError' a
EEInterpreterFailed Address
addr) (Either InterpretError InterpretResult
 -> Either ExecutorError InterpretResult)
-> Either InterpretError InterpretResult
-> Either ExecutorError InterpretResult
forall a b. (a -> b) -> a -> b
$
             ContractReturn st -> Either InterpretError InterpretResult
forall (st :: T).
StorageScope st =>
ContractReturn st -> Either InterpretError InterpretResult
handleContractReturn (ContractReturn st -> Either InterpretError InterpretResult)
-> ContractReturn st -> Either InterpretError InterpretResult
forall a b. (a -> b) -> a -> b
$
                Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> ContractReturn 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
$ Address -> Mutez -> GStateUpdate
GSSetBalance Address
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
$ Address -> Value st -> GStateUpdate
forall (st :: T).
StorageScope st =>
Address -> Value st -> GStateUpdate
GSSetStorageValue Address
addr Value st
newValue
          updBigMapCounter :: Maybe GStateUpdate
updBigMapCounter
            | BigMapCounter
bigMapCounter0 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
            ]
        ([GStateUpdate], [Operation], Maybe InterpretResult,
 RemainingSteps)
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ([GStateUpdate], [Operation], Maybe InterpretResult,
      RemainingSteps)
forall (m :: * -> *) a. Monad m => a -> m a
return ([GStateUpdate]
updates, [Operation]
sideEffects, InterpretResult -> Maybe InterpretResult
forall a. a -> Maybe a
Just InterpretResult
iur, RemainingSteps
newRemainingSteps)

    let
      -- According to the reference implementation, counter is incremented for transfers as well.
      updates :: [GStateUpdate]
updates = (([GStateUpdate] -> [GStateUpdate])
-> (GStateUpdate -> [GStateUpdate] -> [GStateUpdate])
-> Maybe GStateUpdate
-> [GStateUpdate]
-> [GStateUpdate]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [GStateUpdate] -> [GStateUpdate]
forall a. a -> a
id (:) Maybe GStateUpdate
mDecreaseSenderBalance [GStateUpdate]
otherUpdates) [GStateUpdate] -> [GStateUpdate] -> [GStateUpdate]
forall a. [a] -> [a] -> [a]
++ [GStateUpdate
GSIncrementCounter]

    GState
newGState <- Either ExecutorError GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ExecutorError GState
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState)
-> Either ExecutorError GState
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall a b. (a -> b) -> a -> b
$ (GStateUpdateError -> ExecutorError)
-> Either GStateUpdateError GState -> Either ExecutorError GState
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GStateUpdateError -> ExecutorError
forall a. GStateUpdateError -> ExecutorError' a
EEFailedToApplyUpdates (Either GStateUpdateError GState -> Either ExecutorError GState)
-> Either GStateUpdateError GState -> Either ExecutorError 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 -> ExecutorM ()
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 -> ExecutorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RemainingSteps
newRemSteps
    (Maybe Address -> Identity (Maybe Address))
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState (Maybe Address)
esSourceAddress ((Maybe Address -> Identity (Maybe Address))
 -> ExecutorState -> Identity ExecutorState)
-> Maybe Address -> ExecutorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Address -> Maybe Address
forall a. a -> Maybe a
Just Address
sourceAddr

    (ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState ExecutorLog
esLog ((ExecutorLog -> Identity ExecutorLog)
 -> ExecutorState -> Identity ExecutorState)
-> ExecutorLog -> ExecutorM ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, InterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates ([(Address, InterpretResult)]
-> (InterpretResult -> [(Address, InterpretResult)])
-> Maybe InterpretResult
-> [(Address, InterpretResult)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Address, InterpretResult)]
forall a. Monoid a => a
mempty ((Address, InterpretResult) -> [(Address, InterpretResult)]
forall x. One x => OneItem x -> x
one ((Address, InterpretResult) -> [(Address, InterpretResult)])
-> (InterpretResult -> (Address, InterpretResult))
-> InterpretResult
-> [(Address, InterpretResult)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address
addr, )) Maybe InterpretResult
maybeInterpretRes)

    return $ Address -> Operation -> ExecutorOp
convertOp Address
addr (Operation -> ExecutorOp) -> [Operation] -> [ExecutorOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Operation]
sideEffects

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

checkOperationReplay :: ExecutorOp -> ExecutorM ()
checkOperationReplay :: ExecutorOp -> ExecutorM ()
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
Mutez
GlobalCounter
Address
Contract cp st
Value st
ooCounter :: GlobalCounter
ooContract :: Contract cp st
ooStorage :: Value st
ooBalance :: Mutez
ooDelegate :: Maybe KeyHash
ooOriginator :: Address
ooCounter :: OriginationOperation -> GlobalCounter
ooContract :: ()
ooStorage :: ()
ooBalance :: OriginationOperation -> Mutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooOriginator :: OriginationOperation -> Address
..} -> GlobalCounter
ooCounter
      TransferOp TransferOperation{GlobalCounter
Address
TxData
toCounter :: TransferOperation -> GlobalCounter
toTxData :: TransferOperation -> TxData
toDestination :: TransferOperation -> Address
toCounter :: GlobalCounter
toTxData :: TxData
toDestination :: Address
..} -> GlobalCounter
toCounter
      SetDelegateOp SetDelegateOperation{Maybe KeyHash
GlobalCounter
Address
sdoCounter :: GlobalCounter
sdoDelegate :: Maybe KeyHash
sdoContract :: Address
sdoCounter :: SetDelegateOperation -> GlobalCounter
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoContract :: SetDelegateOperation -> Address
..} -> GlobalCounter
sdoCounter
  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 -> ExecutorM () -> ExecutorM ()
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) (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$
    ExecutorError -> ExecutorM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM ()) -> ExecutorError -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ ExecutorOp -> ExecutorError
forall a. ExecutorOp -> ExecutorError' 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 -> ExecutorM ()
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 :: Address -> T.Operation -> ExecutorOp
convertOp :: Address -> Operation -> ExecutorOp
convertOp Address
interpretedAddr =
  \case
    OpTransferTokens TransferTokens Instr p
tt ->
      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 :: Address -> TxParam -> EpName -> Mutez -> TxData
TxData
                  { tdSenderAddress :: Address
tdSenderAddress = Address
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 :: Address -> TxData -> GlobalCounter -> 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
sdCounter :: SetDelegate -> GlobalCounter
sdMbKeyHash :: SetDelegate -> Maybe KeyHash
sdCounter :: GlobalCounter
sdMbKeyHash :: Maybe KeyHash
..} -> SetDelegateOperation -> ExecutorOp
SetDelegateOp SetDelegateOperation :: Address -> Maybe KeyHash -> GlobalCounter -> SetDelegateOperation
SetDelegateOperation
      { sdoContract :: Address
sdoContract = Address
interpretedAddr
      , sdoDelegate :: Maybe KeyHash
sdoDelegate = Maybe KeyHash
sdMbKeyHash
      , sdoCounter :: GlobalCounter
sdoCounter = GlobalCounter
sdCounter
      }
    OpCreateContract CreateContract Instr cp st
cc ->
      let origination :: OriginationOperation
origination = OriginationOperation :: forall (cp :: T) (st :: T).
(StorageScope st, ParameterScope cp) =>
Address
-> Maybe KeyHash
-> Mutez
-> Value st
-> Contract cp st
-> GlobalCounter
-> OriginationOperation
OriginationOperation
            { ooOriginator :: Address
ooOriginator = CreateContract Instr cp st -> Address
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Address
ccOriginator CreateContract Instr cp st
cc
            , ooDelegate :: Maybe KeyHash
ooDelegate = CreateContract Instr cp st -> Maybe KeyHash
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Maybe KeyHash
ccDelegate CreateContract Instr cp st
cc
            , ooBalance :: Mutez
ooBalance = CreateContract Instr cp st -> Mutez
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Mutez
ccBalance CreateContract Instr cp st
cc
            , ooStorage :: Value st
ooStorage = CreateContract Instr cp st -> Value st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Value' instr st
ccStorageVal CreateContract Instr cp st
cc
            , ooContract :: Contract cp st
ooContract = CreateContract Instr cp st -> Contract cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Contract' instr cp st
ccContract CreateContract Instr cp st
cc
            , ooCounter :: GlobalCounter
ooCounter = CreateContract Instr cp st -> GlobalCounter
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> GlobalCounter
ccCounter CreateContract Instr cp st
cc
            }
       in OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination

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

-- | Return True if address is an implicit account yet the param is not Unit.
badParamToImplicitAccount :: Address -> TxParam -> Bool
badParamToImplicitAccount :: Address -> TxParam -> Bool
badParamToImplicitAccount (ContractAddress ContractHash
_) TxParam
_                       = Bool
False
badParamToImplicitAccount (KeyAddress KeyHash
_) (TxTypedParam Value' Instr t
T.VUnit)       = Bool
False
badParamToImplicitAccount (KeyAddress KeyHash
_) (TxUntypedParam Value
U.ValueUnit) = Bool
False
badParamToImplicitAccount Address
_ TxParam
_                                         = Bool
True