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

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

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

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

  -- * Re-exports
  , ContractState (..)
  , AddressState (..)
  , TxData (..)

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

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

import Control.Lens (at, makeLenses, (+=), (.=), (<>=))
import Control.Monad.Except (Except, liftEither, runExcept, throwError)
import qualified Data.Aeson as Aeson
import Data.Binary.Put (putWord64be, runPut)
import qualified Data.ByteString.Lazy as BSL
import Data.Semigroup.Generic
import Data.Text.IO (getContents)
import Fmt (Buildable(build), blockListF, fmt, fmtLn, nameF, pretty, (+|), (|+))
import Named ((:!), (:?), arg, argDef, defaults, (!))
import Text.Megaparsec (parse)

import Michelson.Interpret
  (ContractEnv(..), InterpretError(..), InterpretResult(..), InterpreterState(..), MorleyLogs(..),
  RemainingSteps(..), handleContractReturn, interpret)
import Michelson.Macro (ParsedOp, expandContract)
import qualified Michelson.Parser as P
import Michelson.Runtime.GState
import Michelson.Runtime.TxData
import Michelson.TypeCheck
  (SomeContract, TCError, typeCheckContract, typeCheckTopLevelType, typeVerifyTopLevelType)
import Michelson.Typed
  (CreateContract(..), EpName, Operation'(..), SomeValue'(..), TransferTokens(..),
  convertContractCode, untypeValue)
import qualified Michelson.Typed as T
import Michelson.Untyped
  (Contract, GlobalCounter(..), OperationHash(..), OriginationOperation(..),
  mkOriginationOperationHash)
import qualified Michelson.Untyped as U
import Tezos.Address (Address(..), OriginationIndex(..), mkContractAddress)
import Tezos.Core (Mutez, Timestamp(..), getCurrentTime, toMutez, unsafeAddMutez, unsafeSubMutez)
import Tezos.Crypto (blake2b, parseKeyHash)
import Util.IO (readFileUtf8)

----------------------------------------------------------------------------
-- 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 Address TxData
  -- ^ Send a transaction to given address which is assumed to be the
  -- address of an originated 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)

-- | 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 -> OperationHash
_eeOperationHash :: ~OperationHash
  , ExecutorEnv -> Timestamp
_eeNow :: Timestamp
  }
  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 -> Int32
_esOriginationNonce :: Int32
  , ExecutorState -> Maybe Address
_esSourceAddress :: Maybe Address
  , ExecutorState -> ExecutorLog
_esLog :: ExecutorLog
  }
  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.
  | EEIllTypedContract !TCError
  -- ^ A contract is ill-typed.
  | EEIllTypedStorage !TCError
  -- ^ Contract storage is ill-typed.
  | EEIllTypedParameter !TCError
  -- ^ Contract parameter is ill-typed.
  | EEUnknownEntrypoint EpName
  -- ^ Specified entrypoint to run is not found.
  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 addr :: a
addr -> "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
|+ ""
      EEInterpreterFailed addr :: a
addr err :: InterpretError
err ->
        "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
forall b. FromBuilder b => Builder -> Builder -> b
+| InterpretError
err InterpretError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
      EEAlreadyOriginated addr :: a
addr cs :: ContractState
cs ->
        "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
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractState
cs ContractState -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
      EEUnknownSender addr :: a
addr -> "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
|+ ""
      EEUnknownManager addr :: a
addr -> "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
|+ ""
      EENotEnoughFunds addr :: a
addr amount :: Mutez
amount ->
        "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
|+
        ") 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
|+ ")"
      EEZeroTransaction addr :: a
addr ->
        "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
|+ " which has no code is prohibited"
      EEFailedToApplyUpdates err :: GStateUpdateError
err -> "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
|+ ""
      EEIllTypedContract err :: TCError
err -> "The contract 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
|+ ""
      EEIllTypedStorage err :: TCError
err -> "The contract storage 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
|+ ""
      EEIllTypedParameter err :: TCError
err -> "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
|+ ""
      EEUnknownEntrypoint epName :: EpName
epName -> "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
|+ "'"

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 ::
     Maybe FilePath -> Text -> Either P.ParserException (U.Contract' ParsedOp)
parseContract :: Maybe String -> Text -> Either ParserException (Contract' ParsedOp)
parseContract mFileName :: Maybe String
mFileName =
  (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 (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "<stdin>" Maybe String
mFileName)

-- | Parse a contract from 'Text' and expand macros.
parseExpandContract ::
     Maybe FilePath -> Text -> Either P.ParserException Contract
parseExpandContract :: Maybe String -> Text -> Either ParserException Contract
parseExpandContract mFileName :: Maybe String
mFileName = (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)
-> (Text -> Either ParserException (Contract' ParsedOp))
-> Text
-> Either ParserException Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Text -> Either ParserException (Contract' ParsedOp)
parseContract Maybe String
mFileName

-- | 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 mFilename :: 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
$ Maybe String -> Text -> Either ParserException (Contract' ParsedOp)
parseContract 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
readFileUtf8

-- | 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 mFile :: 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 -> OriginationOperation -> "verbose" :! Bool -> IO Address
originateContract :: String -> OriginationOperation -> ("verbose" :! Bool) -> IO Address
originateContract dbPath :: String
dbPath origination :: OriginationOperation
origination verbose :: "verbose" :! Bool
verbose =
  -- 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
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM Address
-> IO (ExecutorRes, Address)
forall a.
Maybe Timestamp
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
forall a. Maybe a
Nothing String
dbPath 100500 "verbose" :! Bool
verbose (("dryRun" :? Bool)
 -> ExecutorM Address -> IO (ExecutorRes, Address))
-> Param Defaults -> ExecutorM Address -> IO (ExecutorRes, Address)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! Param Defaults
defaults (ExecutorM Address -> IO (ExecutorRes, Address))
-> ExecutorM Address -> IO (ExecutorRes, Address)
forall a b. (a -> b) -> a -> b
$ do
    ExecutorOp -> ExecutorM Address -> ExecutorM Address
forall a. ExecutorOp -> ExecutorM a -> ExecutorM a
withGlobalOperation (OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination)
      (ExecutorM Address -> ExecutorM Address)
-> ExecutorM Address -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorM Address
executeOrigination OriginationOperation
origination

-- | Run a contract. The contract is originated first (if it's not
-- already) and then we pretend that we send a transaction to it.
runContract
  :: Maybe Timestamp
  -> Word64
  -> Mutez
  -> FilePath
  -> U.Value
  -> Contract
  -> TxData
  -> "verbose" :! Bool
  -> "dryRun" :! Bool
  -> IO ()
runContract :: Maybe Timestamp
-> Word64
-> Mutez
-> String
-> Value
-> Contract
-> TxData
-> ("verbose" :! Bool)
-> ("dryRun" :! Bool)
-> IO ()
runContract maybeNow :: Maybe Timestamp
maybeNow maxSteps :: Word64
maxSteps initBalance :: Mutez
initBalance dbPath :: String
dbPath storageValue :: Value
storageValue contract :: Contract
contract txData :: TxData
txData
  verbose :: "verbose" :! Bool
verbose (Name "dryRun" -> ("dryRun" :! Bool) -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "dryRun" (Name "dryRun")
Name "dryRun"
#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
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM ()
-> IO (ExecutorRes, ())
forall a.
Maybe Timestamp
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
maybeNow String
dbPath (Word64 -> RemainingSteps
RemainingSteps Word64
maxSteps) "verbose" :! Bool
verbose (("dryRun" :? Bool) -> ExecutorM () -> IO (ExecutorRes, ()))
-> Param ("dryRun" :? Bool) -> ExecutorM () -> IO (ExecutorRes, ())
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 () -> IO (ExecutorRes, ()))
-> ExecutorM () -> IO (ExecutorRes, ())
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 <- ExecutorOp -> ExecutorM Address -> ExecutorM Address
forall a. ExecutorOp -> ExecutorM a -> ExecutorM a
withGlobalOperation (OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination)
      (ExecutorM Address -> ExecutorM Address)
-> ExecutorM Address -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorM Address
executeOrigination OriginationOperation
origination
    let transferOp :: ExecutorOp
transferOp = Address -> TxData -> ExecutorOp
TransferOp Address
addr TxData
txData
    [ExecutorOp] -> ExecutorM ()
executeGlobalOperations [ExecutorOp
transferOp]
  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 "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 "tz1YCABRTa6H8PLKx2EtDWeCGPaKxUhNgv47"
    origination :: OriginationOperation
origination = $WOriginationOperation :: Address
-> Maybe KeyHash
-> Mutez
-> Value
-> Contract
-> 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
ooStorage = Value
storageValue
      , ooContract :: Contract
ooContract = Contract
contract
      }

-- | Send a transaction to given address with given parameters.
transfer ::
     Maybe Timestamp
  -> Word64
  -> FilePath
  -> Address
  -> TxData
  -> "verbose" :! Bool
  -> "dryRun" :? Bool
  -> IO ()
transfer :: Maybe Timestamp
-> Word64
-> String
-> Address
-> TxData
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> IO ()
transfer maybeNow :: Maybe Timestamp
maybeNow maxSteps :: Word64
maxSteps dbPath :: String
dbPath destination :: Address
destination txData :: TxData
txData verbose :: "verbose" :! Bool
verbose dryRun :: "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
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM ()
-> IO (ExecutorRes, ())
forall a.
Maybe Timestamp
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
maybeNow 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
$
    [ExecutorOp] -> ExecutorM ()
executeGlobalOperations [Address -> TxData -> ExecutorOp
TransferOp Address
destination TxData
txData]

----------------------------------------------------------------------------
-- 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 'withGlobalOperation'
-- to specify this hash. Otherwise it is initialized with 'error'.
runExecutorM
  :: Timestamp
  -> RemainingSteps
  -> GState
  -> ExecutorM a
  -> Either ExecutorError (ExecutorRes, a)
runExecutorM :: Timestamp
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM now :: Timestamp
now remainingSteps :: RemainingSteps
remainingSteps gState :: GState
gState action :: 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
$ OperationHash -> Timestamp -> ExecutorEnv
ExecutorEnv OperationHash
forall a. a
initialOpHash Timestamp
now)
      ExecutorState
initialState
  where
    initialOpHash :: a
initialOpHash = Text -> a
forall a. HasCallStack => Text -> a
error "Initial OperationHash touched"

    initialState :: ExecutorState
initialState = $WExecutorState :: GState
-> RemainingSteps
-> Int32
-> Maybe Address
-> ExecutorLog
-> ExecutorState
ExecutorState
      { _esGState :: GState
_esGState = GState
gState
      , _esRemainingSteps :: RemainingSteps
_esRemainingSteps = RemainingSteps
remainingSteps
      , _esOriginationNonce :: Int32
_esOriginationNonce = 0
      , _esSourceAddress :: Maybe Address
_esSourceAddress = Maybe Address
forall a. Maybe a
Nothing
      , _esLog :: ExecutorLog
_esLog = ExecutorLog
forall a. Monoid a => a
mempty
      }

    preResToRes :: (a, ExecutorState) -> (ExecutorRes, a)
    preResToRes :: (a, ExecutorState) -> (ExecutorRes, a)
preResToRes (r :: a
r, ExecutorState{..}) =
      ( $WExecutorRes :: 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
  -> FilePath
  -> RemainingSteps
  -> "verbose" :! Bool
  -> "dryRun" :? Bool
  -> ExecutorM a
  -> IO (ExecutorRes, a)
runExecutorMWithDB :: Maybe Timestamp
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> ("dryRun" :? Bool)
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB maybeNow :: Maybe Timestamp
maybeNow dbPath :: String
dbPath remainingSteps :: RemainingSteps
remainingSteps
  (Name "verbose" -> ("verbose" :! Bool) -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "verbose" (Name "verbose")
Name "verbose"
#verbose -> 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)
  action :: 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
  (res :: ExecutorRes
res@ExecutorRes{..}, a :: 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
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
forall a.
Timestamp
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now 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
&& 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 "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
$ "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
<> "."

  return (ExecutorRes
res, a
a)
  where
    printInterpretResult
      :: (Address, InterpretResult) -> IO ()
    printInterpretResult :: (Address, InterpretResult) -> IO ()
printInterpretResult (addr :: Address
addr, InterpretResult {..}) = do
      Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "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 "It didn't return any operations."
        _ -> Builder -> IO ()
forall b. FromBuilder b => Builder -> b
fmt (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> Builder -> Builder
nameF "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
$
        "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). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value st
iurNewStorage) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
      let MorleyLogs logs :: [Text]
logs = InterpreterState -> MorleyLogs
isMorleyLogs InterpreterState
iurNewState
      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
$
        (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 "" -- extra break line to separate logs from two sequence contracts

-- | Run some executor action in a context of global operation.
--
-- Use this function to execute one global operation, potentially with its internal
-- suboperations.
withGlobalOperation
  :: ExecutorOp
  -> ExecutorM a
  -> ExecutorM a
withGlobalOperation :: ExecutorOp -> ExecutorM a -> ExecutorM a
withGlobalOperation op :: ExecutorOp
op action :: ExecutorM a
action = do
  Word64
counter <- Getting Word64 ExecutorState Word64
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Word64
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Word64 ExecutorState Word64
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Word64)
-> Getting Word64 ExecutorState Word64
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Word64
forall a b. (a -> b) -> a -> b
$ (GState -> Const Word64 GState)
-> ExecutorState -> Const Word64 ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const Word64 GState)
 -> ExecutorState -> Const Word64 ExecutorState)
-> ((Word64 -> Const Word64 Word64)
    -> GState -> Const Word64 GState)
-> Getting Word64 ExecutorState Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Const Word64 Word64) -> GState -> Const Word64 GState
Lens' GState Word64
gsCounterL
  -- Reset nonce and source address before executing a global operation.
  (Int32 -> Identity Int32)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState Int32
esOriginationNonce ((Int32 -> Identity Int32)
 -> ExecutorState -> Identity ExecutorState)
-> Int32 -> ExecutorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 0
  (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
  (ExecutorEnv -> ExecutorEnv) -> ExecutorM a -> ExecutorM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (ASetter ExecutorEnv ExecutorEnv OperationHash OperationHash
-> OperationHash -> ExecutorEnv -> ExecutorEnv
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ExecutorEnv ExecutorEnv OperationHash OperationHash
Lens' ExecutorEnv OperationHash
eeOperationHash (OperationHash -> ExecutorEnv -> ExecutorEnv)
-> OperationHash -> ExecutorEnv -> ExecutorEnv
forall a b. (a -> b) -> a -> b
$ ExecutorOp -> GlobalCounter -> OperationHash
mkExecutorOpHash ExecutorOp
op (GlobalCounter -> OperationHash) -> GlobalCounter -> OperationHash
forall a b. (a -> b) -> a -> b
$ Word64 -> GlobalCounter
GlobalCounter Word64
counter)
    (ExecutorM a -> ExecutorM a) -> ExecutorM a -> ExecutorM a
forall a b. (a -> b) -> a -> b
$ ExecutorM a
action

-- | Execute a list of global operation, discarding their results.
--
-- Uses 'withGlobalOperation' internally.
executeGlobalOperations
  :: [ExecutorOp]
  -> ExecutorM ()
executeGlobalOperations :: [ExecutorOp] -> ExecutorM ()
executeGlobalOperations = (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
$ \op :: Element [ExecutorOp]
op ->
  ExecutorOp -> ExecutorM () -> ExecutorM ()
forall a. ExecutorOp -> ExecutorM a -> ExecutorM a
withGlobalOperation Element [ExecutorOp]
ExecutorOp
op (ExecutorM () -> ExecutorM ()) -> ExecutorM () -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ [ExecutorOp] -> ExecutorM ()
executeMany [Element [ExecutorOp]
ExecutorOp
op]
  where
    -- | Execute a list of operations and additional operations they return, until there are none.
    executeMany :: [ExecutorOp] -> ExecutorM ()
    executeMany :: [ExecutorOp] -> ExecutorM ()
executeMany = \case
        [] -> ExecutorM ()
forall (f :: * -> *). Applicative f => f ()
pass
        (op :: ExecutorOp
op:opsTail :: [ExecutorOp]
opsTail) -> do
          case ExecutorOp
op of
            OriginateOp origination :: OriginationOperation
origination -> 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
$ OriginationOperation -> ExecutorM Address
executeOrigination OriginationOperation
origination
            TransferOp addr :: Address
addr txData :: TxData
txData -> do
              [ExecutorOp]
moreOps <- Address -> TxData -> ExecutorM [ExecutorOp]
executeTransfer Address
addr TxData
txData
              -- TODO why does opsTail go before moreOps?
              [ExecutorOp] -> ExecutorM ()
executeMany ([ExecutorOp] -> ExecutorM ()) -> [ExecutorOp] -> ExecutorM ()
forall a b. (a -> b) -> a -> b
$ [ExecutorOp]
opsTail [ExecutorOp] -> [ExecutorOp] -> [ExecutorOp]
forall a. Semigroup a => a -> a -> a
<> [ExecutorOp]
moreOps

-- | Execute an origination operation.
executeOrigination
  :: OriginationOperation
  -> ExecutorM Address
executeOrigination :: OriginationOperation -> ExecutorM Address
executeOrigination origination :: OriginationOperation
origination = do
  OperationHash
opHash <- Getting OperationHash ExecutorEnv OperationHash
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     OperationHash
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting OperationHash ExecutorEnv OperationHash
Lens' ExecutorEnv OperationHash
eeOperationHash
  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
  Int32
originationNonce <- Getting Int32 ExecutorState Int32
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Int32
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int32 ExecutorState Int32
Lens' ExecutorState Int32
esOriginationNonce

  SomeContract
typedContract <- Either ExecutorError SomeContract
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     SomeContract
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ExecutorError SomeContract
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      SomeContract)
-> Either ExecutorError SomeContract
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     SomeContract
forall a b. (a -> b) -> a -> b
$ (TCError -> ExecutorError)
-> Either TCError SomeContract -> Either ExecutorError SomeContract
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TCError -> ExecutorError
forall a. TCError -> ExecutorError' a
EEIllTypedContract (Either TCError SomeContract -> Either ExecutorError SomeContract)
-> Either TCError SomeContract -> Either ExecutorError SomeContract
forall a b. (a -> b) -> a -> b
$
    TcOriginatedContracts -> Contract -> Either TCError SomeContract
typeCheckContract (GState -> TcOriginatedContracts
extractAllContracts GState
gs) (OriginationOperation -> Contract
ooContract OriginationOperation
origination)
  SomeValue
typedStorage <- Either ExecutorError SomeValue
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) SomeValue
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ExecutorError SomeValue
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      SomeValue)
-> Either ExecutorError SomeValue
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) SomeValue
forall a b. (a -> b) -> a -> b
$ (TCError -> ExecutorError)
-> Either TCError SomeValue -> Either ExecutorError SomeValue
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TCError -> ExecutorError
forall a. TCError -> ExecutorError' a
EEIllTypedStorage (Either TCError SomeValue -> Either ExecutorError SomeValue)
-> Either TCError SomeValue -> Either ExecutorError SomeValue
forall a b. (a -> b) -> a -> b
$
    HasCallStack =>
TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue
TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue
typeCheckTopLevelType
      (GState -> TcOriginatedContracts
extractAllContracts GState
gs) (Contract -> Type
forall op. Contract' op -> Type
U.contractStorage (Contract -> Type) -> Contract -> Type
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> Contract
ooContract OriginationOperation
origination)
      (OriginationOperation -> Value
ooStorage OriginationOperation
origination)
  let originatorAddress :: Address
originatorAddress = OriginationOperation -> Address
ooOriginator OriginationOperation
origination
  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
    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
< OriginationOperation -> Mutez
ooBalance OriginationOperation
origination ->
        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` OriginationOperation -> Mutez
ooBalance OriginationOperation
origination
  let
    address :: Address
address = OperationHash -> OriginationIndex -> Address
mkContractAddress OperationHash
opHash (OriginationIndex -> Address) -> OriginationIndex -> Address
forall a b. (a -> b) -> a -> b
$ Int32 -> OriginationIndex
OriginationIndex Int32
originationNonce
    updates :: [GStateUpdate]
updates =
      [ Address -> AddressState -> GStateUpdate
GSAddAddress Address
address (ContractState -> AddressState
ASContract (ContractState -> AddressState) -> ContractState -> AddressState
forall a b. (a -> b) -> a -> b
$ SomeContract -> SomeValue -> ContractState
mkContractState SomeContract
typedContract SomeValue
typedStorage)
      , Address -> Mutez -> GStateUpdate
GSSetBalance Address
originatorAddress Mutez
originatorBalance
      , GStateUpdate
GSIncrementCounter
      ]
  case [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates [GStateUpdate]
updates GState
gs of
    Left _ ->
      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 -> ExecutorError) -> ContractState -> ExecutorError
forall a b. (a -> b) -> a -> b
$ SomeContract -> SomeValue -> ContractState
mkContractState SomeContract
typedContract SomeValue
typedStorage
    Right newGS :: 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
      (Int32 -> Identity Int32)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState Int32
esOriginationNonce ((Int32 -> Identity Int32)
 -> ExecutorState -> Identity ExecutorState)
-> Int32 -> ExecutorM ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= 1

      (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, Monoid a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, InterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates []

      return Address
address
  where
    mkContractState :: SomeContract -> SomeValue -> ContractState
mkContractState typedContract :: SomeContract
typedContract typedStorage :: SomeValue
typedStorage = $WContractState :: Mutez
-> Value
-> Contract
-> Maybe SomeContract
-> Maybe SomeValue
-> ContractState
ContractState
      { csBalance :: Mutez
csBalance = OriginationOperation -> Mutez
ooBalance OriginationOperation
origination
      , csStorage :: Value
csStorage = OriginationOperation -> Value
ooStorage OriginationOperation
origination
      , csContract :: Contract
csContract = OriginationOperation -> Contract
ooContract OriginationOperation
origination
      , csTypedContract :: Maybe SomeContract
csTypedContract = SomeContract -> Maybe SomeContract
forall a. a -> Maybe a
Just SomeContract
typedContract
      , csTypedStorage :: Maybe SomeValue
csTypedStorage = SomeValue -> Maybe SomeValue
forall a. a -> Maybe a
Just SomeValue
typedStorage
      }

-- | Execute a transfer operation.
executeTransfer
  :: Address
  -> TxData
  -> ExecutorM [ExecutorOp]
executeTransfer :: Address -> TxData -> ExecutorM [ExecutorOp]
executeTransfer addr :: Address
addr txData :: TxData
txData = do
    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
    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

    OperationHash
opHash <- Getting OperationHash ExecutorEnv OperationHash
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     OperationHash
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting OperationHash ExecutorEnv OperationHash
Lens' ExecutorEnv OperationHash
eeOperationHash
    let addresses :: Map Address AddressState
addresses = GState -> Map Address AddressState
gsAddresses GState
gs
    let sourceAddr :: Address
sourceAddr = Address -> Maybe Address -> Address
forall a. a -> Maybe a -> a
fromMaybe (TxData -> Address
tdSenderAddress TxData
txData) Maybe Address
mSourceAddr
    let senderAddr :: Address
senderAddr = TxData -> Address
tdSenderAddress TxData
txData
    let isKeyAddress :: Address -> Bool
isKeyAddress (KeyAddress _) = Bool
True
        isKeyAddress _  = Bool
False
    let isZeroTransfer :: Bool
isZeroTransfer = TxData -> Mutez
tdAmount TxData
txData Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Mutez
toMutez 0

    -- 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
&& 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
      (True, _) -> 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
      (False, 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
      (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)
    let onlyUpdates :: [GStateUpdate]
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     ([GStateUpdate], [Operation], Maybe InterpretResult,
      RemainingSteps)
onlyUpdates updates :: [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)
    (otherUpdates :: [GStateUpdate]
otherUpdates, sideEffects :: [Operation]
sideEffects, Maybe InterpretResult
maybeInterpretRes :: Maybe InterpretResult, newRemSteps :: 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
      (Nothing, ContractAddress _) ->
        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
      (Nothing, KeyAddress _) -> 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 oldBalance :: Mutez
oldBalance), _) -> 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 cs :: ContractState
cs), _) -> 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 = ContractState -> Mutez
csBalance ContractState
cs HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeAddMutez` TxData -> Mutez
tdAmount TxData
txData
          contractEnv :: ContractEnv
contractEnv = $WContractEnv :: Timestamp
-> RemainingSteps
-> Mutez
-> TcOriginatedContracts
-> Address
-> Address
-> Address
-> Mutez
-> ChainId
-> Maybe OperationHash
-> ContractEnv
ContractEnv
            { ceNow :: Timestamp
ceNow = Timestamp
now
            , ceMaxSteps :: RemainingSteps
ceMaxSteps = RemainingSteps
remainingSteps
            , ceBalance :: Mutez
ceBalance = Mutez
newBalance
            , ceContracts :: TcOriginatedContracts
ceContracts = TcOriginatedContracts
existingContracts
            , ceSelf :: Address
ceSelf = Address
addr
            , ceSource :: Address
ceSource = Address
sourceAddr
            , ceSender :: Address
ceSender = Address
senderAddr
            , ceAmount :: Mutez
ceAmount = TxData -> Mutez
tdAmount TxData
txData
            , ceChainId :: ChainId
ceChainId = GState -> ChainId
gsChainId GState
gs
            , ceOperationHash :: Maybe OperationHash
ceOperationHash = OperationHash -> Maybe OperationHash
forall a. a -> Maybe a
Just OperationHash
opHash
            }
          epName :: EpName
epName = TxData -> EpName
tdEntrypoint TxData
txData

        SomeContractAndStorage typedContract :: Contract cp st
typedContract typedStorage :: Value st
typedStorage
          <- Either ExecutorError SomeContractAndStorage
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     SomeContractAndStorage
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ExecutorError SomeContractAndStorage
 -> ReaderT
      ExecutorEnv
      (StateT ExecutorState (Except ExecutorError))
      SomeContractAndStorage)
-> Either ExecutorError SomeContractAndStorage
-> ReaderT
     ExecutorEnv
     (StateT ExecutorState (Except ExecutorError))
     SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ (TCError -> ExecutorError)
-> (TCError -> ExecutorError)
-> GState
-> ContractState
-> Either ExecutorError SomeContractAndStorage
forall err.
(TCError -> err)
-> (TCError -> err)
-> GState
-> ContractState
-> Either err SomeContractAndStorage
getTypedContractAndStorage TCError -> ExecutorError
forall a. TCError -> ExecutorError' a
EEIllTypedContract TCError -> ExecutorError
forall a. TCError -> ExecutorError' a
EEIllTypedStorage GState
gs ContractState
cs
        T.MkEntryPointCallRes _ epc :: EntryPointCallT cp arg
epc
          <- 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 (cp :: T) (st :: T). Contract cp st -> ParamNotes cp
T.cParamNotes Contract cp st
typedContract)
             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
        Value arg
typedParameter <- 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 TCError -> ExecutorError
forall a. TCError -> ExecutorError' a
EEIllTypedParameter (Either TCError (Value arg) -> Either ExecutorError (Value arg))
-> Either TCError (Value arg) -> Either ExecutorError (Value arg)
forall a b. (a -> b) -> a -> b
$
           TcOriginatedContracts -> Value -> Either TCError (Value arg)
forall (t :: T).
(SingI t, HasCallStack) =>
TcOriginatedContracts -> Value -> Either TCError (Value t)
typeVerifyTopLevelType TcOriginatedContracts
existingContracts (TxData -> Value
tdParameter TxData
txData)
        iur :: InterpretResult
iur@InterpretResult
          { iurOps :: InterpretResult -> [Operation]
iurOps = [Operation]
sideEffects
          , iurNewStorage :: ()
iurNewStorage = Value st
newValue
          , iurNewState :: InterpretResult -> InterpreterState
iurNewState = InterpreterState _ newRemainingSteps :: RemainingSteps
newRemainingSteps _
          }
          <- 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
$
                ContractCode cp st
-> EntryPointCallT cp arg
-> Value arg
-> Value st
-> ContractEnv
-> ContractReturn st
forall (cp :: T) (st :: T) (arg :: T).
ContractCode cp st
-> EntryPointCallT cp arg
-> Value arg
-> Value st
-> ContractEnv
-> ContractReturn st
interpret (Contract cp st -> ContractCode cp st
forall (cp :: T) (st :: T). Contract cp st -> ContractCode cp st
T.cCode Contract cp st
typedContract) EntryPointCallT cp arg
epc
                Value arg
typedParameter Value st
typedStorage ContractEnv
contractEnv
        let
          newValueU :: Value
newValueU = Value st -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value st
newValue
          updBalance :: Maybe GStateUpdate
updBalance
            | Mutez
newBalance Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== ContractState -> Mutez
csBalance ContractState
cs = 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) (instr :: [T] -> [T] -> *).
KnownT t =>
Value' instr t -> SomeValue' instr
SomeValue Value st
newValue SomeValue -> SomeValue -> Bool
forall a. Eq a => a -> a -> Bool
== Value st -> SomeValue
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
Value' instr t -> SomeValue' instr
SomeValue Value st
typedStorage = 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 -> SomeValue -> GStateUpdate
GSSetStorageValue Address
addr Value
newValueU (Value st -> SomeValue
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
Value' instr t -> SomeValue' instr
SomeValue Value st
newValue)
          updates :: [GStateUpdate]
updates = [Maybe GStateUpdate] -> [GStateUpdate]
forall a. [Maybe a] -> [a]
catMaybes
            [ Maybe GStateUpdate
updBalance
            , Maybe GStateUpdate
updStorage
            ]
        ([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, Monoid 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 $ (Operation -> Maybe ExecutorOp) -> [Operation] -> [ExecutorOp]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Address -> Operation -> Maybe ExecutorOp
convertOp Address
addr) [Operation]
sideEffects

----------------------------------------------------------------------------
-- TypeCheck
----------------------------------------------------------------------------

typeCheckWithDb
  :: FilePath
  -> U.Contract
  -> IO (Either TCError SomeContract)
typeCheckWithDb :: String -> Contract -> IO (Either TCError SomeContract)
typeCheckWithDb dbPath :: String
dbPath morleyContract :: Contract
morleyContract = do
  GState
gState <- String -> IO GState
readGState String
dbPath
  Either TCError SomeContract -> IO (Either TCError SomeContract)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TCError SomeContract -> IO (Either TCError SomeContract))
-> (Contract -> Either TCError SomeContract)
-> Contract
-> IO (Either TCError SomeContract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcOriginatedContracts -> Contract -> Either TCError SomeContract
typeCheckContract (GState -> TcOriginatedContracts
extractAllContracts GState
gState) (Contract -> IO (Either TCError SomeContract))
-> Contract -> IO (Either TCError SomeContract)
forall a b. (a -> b) -> a -> b
$ Contract
morleyContract

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

mkExecutorOpHash :: ExecutorOp -> GlobalCounter -> OperationHash
mkExecutorOpHash :: ExecutorOp -> GlobalCounter -> OperationHash
mkExecutorOpHash (OriginateOp op :: OriginationOperation
op) counter :: GlobalCounter
counter = OriginationOperation -> GlobalCounter -> OperationHash
mkOriginationOperationHash OriginationOperation
op GlobalCounter
counter
mkExecutorOpHash (TransferOp addr :: Address
addr txData :: TxData
txData) counter :: GlobalCounter
counter = Address -> TxData -> GlobalCounter -> OperationHash
mkTransferOperationHash Address
addr TxData
txData GlobalCounter
counter

-- TODO [#235] replace JSON-based encoding of transfer operation hash with
-- one more close to reference Tezos implementation.
mkTransferOperationHash :: Address -> TxData -> GlobalCounter -> OperationHash
mkTransferOperationHash :: Address -> TxData -> GlobalCounter -> OperationHash
mkTransferOperationHash addr :: Address
addr txData :: TxData
txData (GlobalCounter counter :: Word64
counter) =
  ByteString -> OperationHash
OperationHash (ByteString -> OperationHash) -> ByteString -> OperationHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2b
  (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict
  (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Address -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Address
addr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TxData -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode TxData
txData ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Put -> ByteString
runPut (Word64 -> Put
putWord64be Word64
counter)

-- The argument is the address of the contract that generation this operation.
convertOp :: Address -> T.Operation -> Maybe ExecutorOp
convertOp :: Address -> Operation -> Maybe ExecutorOp
convertOp interpretedAddr :: Address
interpretedAddr =
  \case
    OpTransferTokens tt :: 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 destAddress :: Address
destAddress sepc :: SomeEntryPointCallT arg
sepc ->
          let txData :: TxData
txData =
                $WTxData :: Address -> Value -> 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 :: Value
tdParameter = Value' Instr p -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue (TransferTokens Instr p -> Value' Instr 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
                  }
          in ExecutorOp -> Maybe ExecutorOp
forall a. a -> Maybe a
Just (Address -> TxData -> ExecutorOp
TransferOp Address
destAddress TxData
txData)
    OpSetDelegate {} -> Maybe ExecutorOp
forall a. Maybe a
Nothing
    OpCreateContract cc :: CreateContract Instr cp st
cc ->
      let origination :: OriginationOperation
origination = $WOriginationOperation :: Address
-> Maybe KeyHash
-> Mutez
-> Value
-> Contract
-> 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
ooStorage = Value' Instr st -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue (CreateContract Instr cp st -> Value' Instr st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Value' instr st
ccStorageVal CreateContract Instr cp st
cc)
            , ooContract :: Contract
ooContract = ContractCode cp st -> Contract
forall (param :: T) (store :: T).
(SingI param, SingI store) =>
ContractCode param store -> Contract
convertContractCode (CreateContract Instr cp st -> ContractCode cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st
-> instr (ContractInp cp st) (ContractOut st)
ccContractCode CreateContract Instr cp st
cc)
            }
       in ExecutorOp -> Maybe ExecutorOp
forall a. a -> Maybe a
Just (OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination)