module Morley.Michelson.Runtime
(
originateContract
, runContract
, transfer
, runCode
, RunCodeParameters(..)
, runCodeParameters
, resolveRunCodeBigMaps
, mkBigMapFinder
, parseContract
, parseExpandContract
, readAndParseContract
, prepareContract
, ContractState (..)
, VotingPowers
, mkVotingPowers
, mkVotingPowersFromMap
, TxData (..)
, TxParam (..)
, ExecutorOp (..)
, ExecutorRes (..)
, erGState
, erUpdates
, erInterpretResults
, erRemainingSteps
, ExecutorError' (..)
, ExecutorError
, ExecutorM
, runExecutorM
, runExecutorMWithDB
, executeGlobalOperations
, executeGlobalOrigination
, executeOrigination
, executeTransfer
, ExecutorState(..)
, esGState
, esRemainingSteps
, esSourceAddress
, esLog
, esOperationHash
, esPrevCounters
, ExecutorLog(..)
, elInterpreterResults
, elUpdates
) where
import Control.Lens (assign, at, each, ix, makeLenses, to, (.=), (<>=))
import Control.Monad.Except (Except, liftEither, runExcept, throwError)
import Data.Constraint (Dict(..), (\\))
import Data.Default (def)
import Data.HashSet qualified as HS
import Data.Semigroup.Generic (GenericSemigroupMonoid(..))
import Data.Singletons (demote)
import Data.Text.IO (getContents)
import Data.Text.IO.Utf8 qualified as Utf8 (readFile)
import Data.Type.Equality (pattern Refl)
import 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 Morley.Michelson.Parser qualified as P
import Morley.Michelson.Runtime.Dummy
import Morley.Michelson.Runtime.GState
import Morley.Michelson.Runtime.RunCode
import Morley.Michelson.Runtime.TxData
import Morley.Michelson.TypeCheck
import Morley.Michelson.Typed
(Constrained(..), CreateContract(..), EntrypointCallT, EpName, Operation'(..),
SomeContractAndStorage(..), SomeStorage, TransferTokens(..), untypeValue)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Operation
import Morley.Michelson.Untyped (Contract)
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Core
(Mutez, Timestamp(..), getCurrentTime, unsafeAddMutez, unsafeSubMutez, zeroMutez)
import Morley.Tezos.Crypto (KeyHash, parseHash)
import Morley.Util.Interpolate (itu)
import Morley.Util.MismatchError
import Morley.Util.Named
data ExecutorOp
= OriginateOp OriginationOperation
| TransferOp TransferOperation
| SetDelegateOp SetDelegateOperation
| EmitOp EmitOperation
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{L1Address
EpName
Mutez
TxParam
tdAmount :: TxData -> Mutez
tdEntrypoint :: TxData -> EpName
tdParameter :: TxData -> TxParam
tdSenderAddress :: TxData -> L1Address
tdAmount :: Mutez
tdEntrypoint :: EpName
tdParameter :: TxParam
tdSenderAddress :: L1Address
..} 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
+| L1Address
tdSenderAddress L1Address -> 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
Maybe ContractAlias
Mutez
KindedAddress kind
GlobalCounter
Contract cp st
Value st
ooAlias :: OriginationOperation -> Maybe ContractAlias
ooCounter :: OriginationOperation -> GlobalCounter
ooContract :: ()
ooStorage :: ()
ooBalance :: OriginationOperation -> Mutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooOriginator :: ()
ooAlias :: Maybe ContractAlias
ooCounter :: GlobalCounter
ooContract :: Contract cp st
ooStorage :: Value st
ooBalance :: Mutez
ooDelegate :: Maybe KeyHash
ooOriginator :: KindedAddress kind
..} ->
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
L1Address
GlobalCounter
sdoCounter :: SetDelegateOperation -> GlobalCounter
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoContract :: SetDelegateOperation -> L1Address
sdoCounter :: GlobalCounter
sdoDelegate :: Maybe KeyHash
sdoContract :: L1Address
..} ->
Builder
"Set delegate of contract " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| L1Address
sdoContract L1Address -> 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
""
EmitOp (EmitOperation ContractAddress
source T.Emit{Text
GlobalCounter
Notes t
Value' Instr t
emCounter :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> GlobalCounter
emValue :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> Value' instr t
emNotes :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Notes t
emTag :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Text
emCounter :: GlobalCounter
emValue :: Value' Instr t
emNotes :: Notes t
emTag :: Text
..}) ->
Builder
"Emit event " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
emTag Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
Builder
" from contract " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
source ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
Builder
" with type " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Notes t
emNotes Notes t -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
Builder
" and value " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value' Instr t
emValue Value' Instr t -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
data ExecutorRes = ExecutorRes
{ ExecutorRes -> GState
_erGState :: GState
, ExecutorRes -> [GStateUpdate]
_erUpdates :: [GStateUpdate]
, ExecutorRes -> [(Address, InterpretResult)]
_erInterpretResults :: [(Address, InterpretResult)]
, ExecutorRes -> RemainingSteps
_erRemainingSteps :: RemainingSteps
} 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
, ExecutorEnv -> Natural
_eeMinBlockTime :: 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 L1Address
_esSourceAddress :: Maybe L1Address
, ExecutorState -> ExecutorLog
_esLog :: ExecutorLog
, ExecutorState -> OperationHash
_esOperationHash :: ~OperationHash
, ExecutorState -> HashSet GlobalCounter
_esPrevCounters :: HashSet GlobalCounter
}
deriving stock (Int -> ExecutorState -> ShowS
[ExecutorState] -> ShowS
ExecutorState -> String
(Int -> ExecutorState -> ShowS)
-> (ExecutorState -> String)
-> ([ExecutorState] -> ShowS)
-> Show ExecutorState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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 (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 :: forall b. Integral b => 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
Monoid) via GenericSemigroupMonoid ExecutorLog
makeLenses ''ExecutorRes
makeLenses ''ExecutorEnv
makeLenses ''ExecutorState
makeLenses ''ExecutorLog
data ExecutorError' a
= EEUnknownContract a
| EEInterpreterFailed a (InterpretError Void)
| EEUnknownAddressAlias SomeAlias
| EEUnknownL1AddressAlias Text
| EEAmbiguousAlias Text ImplicitAddress ContractAddress
| EEUnknownSender a
| EEUnknownManager a
| EENotEnoughFunds a Mutez
| EEEmptyImplicitContract a
| EEZeroTransaction a
| EEFailedToApplyUpdates GStateUpdateError
| EEIllTypedParameter a TcError
| EEUnexpectedParameterType a (MismatchError T.T)
| EEUnknownEntrypoint EpName
| EETransactionFromContract a Mutez
| EEWrongParameterType a
| EEOperationReplay ExecutorOp
| EEGlobalOperationSourceNotImplicit Address
| EEGlobalEmitOp
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, (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
<$ :: forall a b. a -> ExecutorError' b -> ExecutorError' a
$c<$ :: forall a b. a -> ExecutorError' b -> ExecutorError' a
fmap :: forall a b. (a -> b) -> ExecutorError' a -> ExecutorError' b
$cfmap :: forall a b. (a -> b) -> ExecutorError' a -> ExecutorError' b
Functor, (forall m. Monoid m => ExecutorError' m -> m)
-> (forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m)
-> (forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m)
-> (forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b)
-> (forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b)
-> (forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b)
-> (forall a. (a -> a -> a) -> ExecutorError' a -> a)
-> (forall a. (a -> a -> a) -> ExecutorError' a -> a)
-> (forall a. ExecutorError' a -> [a])
-> (forall a. ExecutorError' a -> Bool)
-> (forall a. ExecutorError' a -> Int)
-> (forall a. Eq a => a -> ExecutorError' a -> Bool)
-> (forall a. Ord a => ExecutorError' a -> a)
-> (forall a. Ord a => ExecutorError' a -> a)
-> (forall a. Num a => ExecutorError' a -> a)
-> (forall a. Num a => ExecutorError' a -> a)
-> Foldable ExecutorError'
forall a. Eq a => a -> ExecutorError' a -> Bool
forall a. Num a => ExecutorError' a -> a
forall a. Ord a => ExecutorError' a -> a
forall m. Monoid m => ExecutorError' m -> m
forall a. ExecutorError' a -> Bool
forall a. ExecutorError' a -> Int
forall a. ExecutorError' a -> [a]
forall a. (a -> a -> a) -> ExecutorError' a -> a
forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => ExecutorError' a -> a
$cproduct :: forall a. Num a => ExecutorError' a -> a
sum :: forall a. Num a => ExecutorError' a -> a
$csum :: forall a. Num a => ExecutorError' a -> a
minimum :: forall a. Ord a => ExecutorError' a -> a
$cminimum :: forall a. Ord a => ExecutorError' a -> a
maximum :: forall a. Ord a => ExecutorError' a -> a
$cmaximum :: forall a. Ord a => ExecutorError' a -> a
elem :: forall a. Eq a => a -> ExecutorError' a -> Bool
$celem :: forall a. Eq a => a -> ExecutorError' a -> Bool
length :: forall a. ExecutorError' a -> Int
$clength :: forall a. ExecutorError' a -> Int
null :: forall a. ExecutorError' a -> Bool
$cnull :: forall a. ExecutorError' a -> Bool
toList :: forall a. ExecutorError' a -> [a]
$ctoList :: forall a. ExecutorError' a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ExecutorError' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ExecutorError' a -> a
foldr1 :: forall a. (a -> a -> a) -> ExecutorError' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ExecutorError' a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ExecutorError' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ExecutorError' a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ExecutorError' a -> m
fold :: forall m. Monoid m => ExecutorError' m -> m
$cfold :: forall m. Monoid m => ExecutorError' m -> m
Foldable, Functor ExecutorError'
Foldable ExecutorError'
Functor ExecutorError'
-> Foldable ExecutorError'
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorError' a -> f (ExecutorError' b))
-> (forall (f :: * -> *) a.
Applicative f =>
ExecutorError' (f a) -> f (ExecutorError' a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorError' a -> m (ExecutorError' b))
-> (forall (m :: * -> *) a.
Monad m =>
ExecutorError' (m a) -> m (ExecutorError' a))
-> Traversable ExecutorError'
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ExecutorError' (m a) -> m (ExecutorError' a)
forall (f :: * -> *) a.
Applicative f =>
ExecutorError' (f a) -> f (ExecutorError' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorError' a -> m (ExecutorError' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorError' a -> f (ExecutorError' b)
sequence :: forall (m :: * -> *) a.
Monad m =>
ExecutorError' (m a) -> m (ExecutorError' a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ExecutorError' (m a) -> m (ExecutorError' a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorError' a -> m (ExecutorError' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExecutorError' a -> m (ExecutorError' b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ExecutorError' (f a) -> f (ExecutorError' a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ExecutorError' (f a) -> f (ExecutorError' a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorError' a -> f (ExecutorError' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExecutorError' a -> f (ExecutorError' b)
Traversable)
instance (Buildable a) => Buildable (ExecutorError' a) where
build :: ExecutorError' a -> Builder
build =
\case
EEUnknownAddressAlias (SomeAlias (Alias a
alias :: Alias kind)) ->
[itu|The alias '#{alias}' is not associated to a #{kind} address|]
where
kind :: AddressKind
kind = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: AddressKind).
(SingKind AddressKind, SingI a) =>
Demote AddressKind
demote @kind ((L1AddressKind a, SingI a) => AddressKind)
-> Dict (L1AddressKind a, SingI a) -> AddressKind
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Alias a -> Dict (L1AddressKind a, SingI a)
forall (kind :: AddressKind).
Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity Alias a
alias :: AddressKind
EEUnknownL1AddressAlias Text
aliasText ->
[itu|The alias '#{aliasText}' is not associated with any address|]
EEAmbiguousAlias Text
aliasText KindedAddress 'AddressKindImplicit
implicitAddr ContractAddress
contractAddr ->
[itu|
The alias '#{aliasText}' is assigned to both:
* a contract address: #{contractAddr}
* and an implicit address: #{implicitAddr}
Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate.
|]
EEUnknownContract a
addr -> 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 Void
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 Void
err InterpretError Void -> 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
")"
EEEmptyImplicitContract a
addr ->
Builder
"Empty implicit 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
")"
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' ExpandedOp
err -> Builder
"The contract parameter is ill-typed: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TcError' ExpandedOp
err TcError' ExpandedOp -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
EEUnexpectedParameterType a
_ MismatchError T
merr ->
Builder
"The contract parameter is well-typed, but did not match the contract's entrypoint's type.\n"
Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MismatchError T
merr MismatchError 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
""
EEGlobalOperationSourceNotImplicit Address
addr ->
Builder
"Attempted to initiate global operation from a non-implicit address " 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
""
ExecutorError' a
EEGlobalEmitOp ->
Builder
"Attempted to run emit event as a global operation, this should be impossible."
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
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)
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
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
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
originateContract
:: FilePath
-> TypeCheckOptions
-> ImplicitAddress
-> Maybe ContractAlias
-> Maybe KeyHash
-> Mutez
-> U.Value
-> U.Contract
-> "verbose" :! Bool
-> IO ContractAddress
originateContract :: String
-> TypeCheckOptions
-> KindedAddress 'AddressKindImplicit
-> Maybe ContractAlias
-> Maybe KeyHash
-> Mutez
-> Value
-> Contract
-> ("verbose" :! Bool)
-> IO ContractAddress
originateContract String
dbPath TypeCheckOptions
tcOpts KindedAddress 'AddressKindImplicit
originator Maybe ContractAlias
mbAlias Maybe KeyHash
delegate Mutez
balance Value
uStorage Contract
uContract "verbose" :! Bool
verbose = do
OriginationOperation
origination <- (TcError' ExpandedOp -> IO OriginationOperation)
-> (OriginationOperation -> IO OriginationOperation)
-> Either (TcError' ExpandedOp) OriginationOperation
-> IO OriginationOperation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError' ExpandedOp -> 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' ExpandedOp) OriginationOperation
-> IO OriginationOperation)
-> (TypeCheckResult ExpandedOp OriginationOperation
-> Either (TcError' ExpandedOp) OriginationOperation)
-> TypeCheckResult ExpandedOp OriginationOperation
-> IO OriginationOperation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult ExpandedOp OriginationOperation
-> Either (TcError' ExpandedOp) OriginationOperation
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
tcOpts (TypeCheckResult ExpandedOp OriginationOperation
-> IO OriginationOperation)
-> TypeCheckResult ExpandedOp OriginationOperation
-> IO OriginationOperation
forall a b. (a -> b) -> a -> b
$
SomeContractAndStorage -> OriginationOperation
mkOrigination (SomeContractAndStorage -> OriginationOperation)
-> ReaderT
TypeCheckOptions
(Except (TcError' ExpandedOp))
SomeContractAndStorage
-> TypeCheckResult ExpandedOp OriginationOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contract
-> Value
-> ReaderT
TypeCheckOptions
(Except (TcError' ExpandedOp))
SomeContractAndStorage
typeCheckContractAndStorage Contract
uContract Value
uStorage
((ExecutorRes, ContractAddress) -> ContractAddress)
-> IO (ExecutorRes, ContractAddress) -> IO ContractAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, ContractAddress) -> ContractAddress
forall a b. (a, b) -> b
snd (IO (ExecutorRes, ContractAddress) -> IO ContractAddress)
-> IO (ExecutorRes, ContractAddress) -> IO ContractAddress
forall a b. (a -> b) -> a -> b
$ Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> NamedF Maybe Bool "dryRun"
-> ExecutorM ContractAddress
-> IO (ExecutorRes, ContractAddress)
forall a.
Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> NamedF Maybe Bool "dryRun"
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
forall a. Maybe a
Nothing Maybe Natural
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 -> NamedF Maybe Bool "dryRun"
forall (name :: Symbol) a.
Name name -> Maybe a -> NamedF Maybe a name
:? Maybe Bool
forall a. Maybe a
Nothing) (ExecutorM ContractAddress -> IO (ExecutorRes, ContractAddress))
-> ExecutorM ContractAddress -> IO (ExecutorRes, ContractAddress)
forall a b. (a -> b) -> a -> b
$ do
OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination OriginationOperation
origination
where
mkOrigination :: SomeContractAndStorage -> OriginationOperation
mkOrigination (SomeContractAndStorage Contract cp st
contract Value st
storage) = OriginationOperation :: forall (cp :: T) (st :: T) (kind :: AddressKind).
(StorageScope st, ParameterScope cp, L1AddressKind kind) =>
KindedAddress kind
-> Maybe KeyHash
-> Mutez
-> Value st
-> Contract cp st
-> GlobalCounter
-> Maybe ContractAlias
-> OriginationOperation
OriginationOperation
{ ooOriginator :: KindedAddress 'AddressKindImplicit
ooOriginator = KindedAddress 'AddressKindImplicit
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
, ooAlias :: Maybe ContractAlias
ooAlias = Maybe ContractAlias
mbAlias
}
runContract
:: Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> Word64
-> Mutez
-> FilePath
-> TypeCheckOptions
-> U.Value
-> U.Contract
-> TxData
-> "verbose" :! Bool
-> "dryRun" :! Bool
-> IO SomeStorage
runContract :: Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> Word64
-> Mutez
-> String
-> TypeCheckOptions
-> Value
-> Contract
-> TxData
-> ("verbose" :! Bool)
-> ("dryRun" :! Bool)
-> IO SomeStorage
runContract Maybe Timestamp
maybeNow Maybe Natural
maybeLevel Maybe Natural
maybeMinBlockTime Word64
maxSteps Mutez
initBalance String
dbPath TypeCheckOptions
tcOpts Value
uStorage Contract
uContract TxData
txData
"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
OriginationOperation
origination <- (TcError' ExpandedOp -> IO OriginationOperation)
-> (OriginationOperation -> IO OriginationOperation)
-> Either (TcError' ExpandedOp) OriginationOperation
-> IO OriginationOperation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError' ExpandedOp -> 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' ExpandedOp) OriginationOperation
-> IO OriginationOperation)
-> (TypeCheckResult ExpandedOp OriginationOperation
-> Either (TcError' ExpandedOp) OriginationOperation)
-> TypeCheckResult ExpandedOp OriginationOperation
-> IO OriginationOperation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> TypeCheckResult ExpandedOp OriginationOperation
-> Either (TcError' ExpandedOp) OriginationOperation
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
tcOpts (TypeCheckResult ExpandedOp OriginationOperation
-> IO OriginationOperation)
-> TypeCheckResult ExpandedOp OriginationOperation
-> IO OriginationOperation
forall a b. (a -> b) -> a -> b
$
SomeContractAndStorage -> OriginationOperation
mkOrigination (SomeContractAndStorage -> OriginationOperation)
-> ReaderT
TypeCheckOptions
(Except (TcError' ExpandedOp))
SomeContractAndStorage
-> TypeCheckResult ExpandedOp OriginationOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contract
-> Value
-> ReaderT
TypeCheckOptions
(Except (TcError' ExpandedOp))
SomeContractAndStorage
typeCheckContractAndStorage Contract
uContract Value
uStorage
(ExecutorRes
_, SomeStorage
newSt) <- Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> NamedF Maybe Bool "dryRun"
-> ExecutorM SomeStorage
-> IO (ExecutorRes, SomeStorage)
forall a.
Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> NamedF Maybe Bool "dryRun"
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
maybeNow Maybe Natural
maybeLevel Maybe Natural
maybeMinBlockTime String
dbPath
(Word64 -> RemainingSteps
RemainingSteps Word64
maxSteps) "verbose" :! Bool
verbose (NamedF Maybe Bool "dryRun"
-> ExecutorM SomeStorage -> IO (ExecutorRes, SomeStorage))
-> Param (NamedF Maybe Bool "dryRun")
-> ExecutorM SomeStorage
-> IO (ExecutorRes, SomeStorage)
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! IsLabel "dryRun" (Bool -> Param (NamedF Maybe Bool "dryRun"))
Bool -> Param (NamedF Maybe Bool "dryRun")
#dryRun Bool
dryRun (ExecutorM SomeStorage -> IO (ExecutorRes, SomeStorage))
-> ExecutorM SomeStorage -> IO (ExecutorRes, SomeStorage)
forall a b. (a -> b) -> a -> b
$ do
ContractAddress
addr <- OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination OriginationOperation
origination
let transferOp :: ExecutorOp
transferOp = TransferOperation -> ExecutorOp
TransferOp (TransferOperation -> ExecutorOp)
-> TransferOperation -> ExecutorOp
forall a b. (a -> b) -> a -> b
$ Address -> TxData -> GlobalCounter -> TransferOperation
TransferOperation (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr) TxData
txData GlobalCounter
1
ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ TypeCheckOptions
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeGlobalOperations TypeCheckOptions
tcOpts [ExecutorOp
transferOp]
ContractAddress -> ExecutorM SomeStorage
getContractStorage ContractAddress
addr
SomeStorage -> IO SomeStorage
forall (m :: * -> *) a. Monad m => a -> m a
return SomeStorage
newSt
where
delegate :: KeyHash
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
forall (kind :: HashKind).
AllHashTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash Text
"tz1YCABRTa6H8PLKx2EtDWeCGPaKxUhNgv47"
mkOrigination :: SomeContractAndStorage -> OriginationOperation
mkOrigination (SomeContractAndStorage Contract cp st
contract Value st
storage) = OriginationOperation :: forall (cp :: T) (st :: T) (kind :: AddressKind).
(StorageScope st, ParameterScope cp, L1AddressKind kind) =>
KindedAddress kind
-> Maybe KeyHash
-> Mutez
-> Value st
-> Contract cp st
-> GlobalCounter
-> Maybe ContractAlias
-> OriginationOperation
OriginationOperation
{ ooOriginator :: KindedAddress 'AddressKindImplicit
ooOriginator = KindedAddress 'AddressKindImplicit
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
, ooAlias :: Maybe ContractAlias
ooAlias = Maybe ContractAlias
forall a. Maybe a
Nothing
}
getContractStorage :: ContractAddress -> ExecutorM SomeStorage
getContractStorage :: ContractAddress -> ExecutorM SomeStorage
getContractStorage ContractAddress
addr = do
Map ContractAddress ContractState
addrs <- Getting
(Map ContractAddress ContractState)
ExecutorState
(Map ContractAddress ContractState)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Map ContractAddress ContractState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Map ContractAddress ContractState) GState)
-> ExecutorState
-> Const (Map ContractAddress ContractState) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (Map ContractAddress ContractState) GState)
-> ExecutorState
-> Const (Map ContractAddress ContractState) ExecutorState)
-> ((Map ContractAddress ContractState
-> Const
(Map ContractAddress ContractState)
(Map ContractAddress ContractState))
-> GState -> Const (Map ContractAddress ContractState) GState)
-> Getting
(Map ContractAddress ContractState)
ExecutorState
(Map ContractAddress ContractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ContractAddress ContractState
-> Const
(Map ContractAddress ContractState)
(Map ContractAddress ContractState))
-> GState -> Const (Map ContractAddress ContractState) GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL)
case Map ContractAddress ContractState
addrs Map ContractAddress ContractState
-> Getting
(Maybe ContractState)
(Map ContractAddress ContractState)
(Maybe ContractState)
-> Maybe ContractState
forall s a. s -> Getting a s a -> a
^. Index (Map ContractAddress ContractState)
-> Lens'
(Map ContractAddress ContractState)
(Maybe (IxValue (Map ContractAddress ContractState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ContractAddress ContractState)
ContractAddress
addr of
Maybe ContractState
Nothing -> Text -> ExecutorM SomeStorage
forall a. HasCallStack => Text -> a
error (Text -> ExecutorM SomeStorage) -> Text -> ExecutorM SomeStorage
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ContractAddress
addr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is unknown"
Just ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
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 (t :: T). StorageScope t => Value t -> SomeStorage
SomeStorage Value st
csStorage
mkBigMapFinder :: ExecutorM BigMapFinder
mkBigMapFinder :: ExecutorM BigMapFinder
mkBigMapFinder = do
ExecutorState
pureState <- ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorState
forall s (m :: * -> *). MonadState s m => m s
get
pure \Natural
bigMapId ->
ExecutorState
pureState ExecutorState
-> Getting (First SomeVBigMap) ExecutorState SomeVBigMap
-> Maybe SomeVBigMap
forall s a. s -> Getting (First a) s a -> Maybe a
^?
(GState -> Const (First SomeVBigMap) GState)
-> ExecutorState -> Const (First SomeVBigMap) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (First SomeVBigMap) GState)
-> ExecutorState -> Const (First SomeVBigMap) ExecutorState)
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> GState -> Const (First SomeVBigMap) GState)
-> Getting (First SomeVBigMap) ExecutorState SomeVBigMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ContractAddress ContractState
-> Const (First SomeVBigMap) (Map ContractAddress ContractState))
-> GState -> Const (First SomeVBigMap) GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL ((Map ContractAddress ContractState
-> Const (First SomeVBigMap) (Map ContractAddress ContractState))
-> GState -> Const (First SomeVBigMap) GState)
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> Map ContractAddress ContractState
-> Const (First SomeVBigMap) (Map ContractAddress ContractState))
-> (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> GState
-> Const (First SomeVBigMap) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractState -> Const (First SomeVBigMap) ContractState)
-> Map ContractAddress ContractState
-> Const (First SomeVBigMap) (Map ContractAddress ContractState)
forall s t a b. Each s t a b => Traversal s t a b
each ((ContractState -> Const (First SomeVBigMap) ContractState)
-> Map ContractAddress ContractState
-> Const (First SomeVBigMap) (Map ContractAddress ContractState))
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> ContractState -> Const (First SomeVBigMap) ContractState)
-> (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> Map ContractAddress ContractState
-> Const (First SomeVBigMap) (Map ContractAddress ContractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractState -> SomeValue)
-> Optic' (->) (Const (First SomeVBigMap)) ContractState SomeValue
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ContractState -> SomeValue
getContractStorage Optic' (->) (Const (First SomeVBigMap)) ContractState SomeValue
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> SomeValue -> Const (First SomeVBigMap) SomeValue)
-> (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> ContractState
-> Const (First SomeVBigMap) ContractState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(SomeValue -> [SomeVBigMap])
-> Optic' (->) (Const (First SomeVBigMap)) SomeValue [SomeVBigMap]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Natural -> SomeValue -> [SomeVBigMap]
getBigMapsWithId Natural
bigMapId) Optic' (->) (Const (First SomeVBigMap)) SomeValue [SomeVBigMap]
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> [SomeVBigMap] -> Const (First SomeVBigMap) [SomeVBigMap])
-> (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> SomeValue
-> Const (First SomeVBigMap) SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> [SomeVBigMap] -> Const (First SomeVBigMap) [SomeVBigMap]
forall s t a b. Each s t a b => Traversal s t a b
each
where
getContractStorage :: ContractState -> T.SomeValue
getContractStorage :: ContractState -> SomeValue
getContractStorage (ContractState Mutez
_ Contract cp st
_ Value st
storage Maybe KeyHash
_) = Value st -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
T.SomeValue Value st
storage
getBigMapsWithId :: Natural -> T.SomeValue -> [T.SomeVBigMap]
getBigMapsWithId :: Natural -> SomeValue -> [SomeVBigMap]
getBigMapsWithId Natural
bigMapId (T.SomeValue Value t
val) =
(forall (t' :: T). Value t' -> [SomeVBigMap])
-> Value t -> [SomeVBigMap]
forall x (t :: T).
Monoid x =>
(forall (t' :: T). Value t' -> x) -> Value t -> x
T.dfsFoldMapValue
(\Value t'
v -> case Value t'
v of
T.VBigMap (Just Natural
bigMapId') Map (Value' Instr k) (Value' Instr v)
_ | Natural
bigMapId' Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
bigMapId -> [Value ('TBigMap k v) -> SomeVBigMap
forall (k :: T) (v :: T). Value ('TBigMap k v) -> SomeVBigMap
T.SomeVBigMap Value t'
Value ('TBigMap k v)
v]
Value t'
_ -> []
)
Value t
val
transfer
:: Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> Word64
-> FilePath
-> TypeCheckOptions
-> SomeAddressOrAlias
-> TxData
-> "verbose" :! Bool
-> "dryRun" :? Bool
-> IO ()
transfer :: Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> Word64
-> String
-> TypeCheckOptions
-> SomeAddressOrAlias
-> TxData
-> ("verbose" :! Bool)
-> NamedF Maybe Bool "dryRun"
-> IO ()
transfer Maybe Timestamp
maybeNow Maybe Natural
maybeLevel Maybe Natural
maybeMinBlockTime Word64
maxSteps String
dbPath TypeCheckOptions
tcOpts SomeAddressOrAlias
destination TxData
txData "verbose" :! Bool
verbose NamedF Maybe Bool "dryRun"
dryRun = do
IO (ExecutorRes, [EmitOperation]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ExecutorRes, [EmitOperation]) -> IO ())
-> IO (ExecutorRes, [EmitOperation]) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> NamedF Maybe Bool "dryRun"
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> IO (ExecutorRes, [EmitOperation])
forall a.
Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> NamedF Maybe Bool "dryRun"
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
maybeNow Maybe Natural
maybeLevel Maybe Natural
maybeMinBlockTime String
dbPath (Word64 -> RemainingSteps
RemainingSteps Word64
maxSteps) "verbose" :! Bool
verbose NamedF Maybe Bool "dryRun"
dryRun (ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> IO (ExecutorRes, [EmitOperation]))
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> IO (ExecutorRes, [EmitOperation])
forall a b. (a -> b) -> a -> b
$ do
Address
destAddr <- SomeAddressOrAlias -> ExecutorM Address
resolveAddress SomeAddressOrAlias
destination
TypeCheckOptions
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeGlobalOperations TypeCheckOptions
tcOpts [TransferOperation -> ExecutorOp
TransferOp (TransferOperation -> ExecutorOp)
-> TransferOperation -> ExecutorOp
forall a b. (a -> b) -> a -> b
$ Address -> TxData -> GlobalCounter -> TransferOperation
TransferOperation Address
destAddr TxData
txData GlobalCounter
0]
type ExecutorM =
ReaderT ExecutorEnv
(StateT ExecutorState
(Except ExecutorError)
)
runExecutorM
:: Timestamp
-> Natural
-> Natural
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM :: forall a.
Timestamp
-> Natural
-> Natural
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now Natural
level Natural
minBlockTime 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 -> Natural -> ExecutorEnv
ExecutorEnv Timestamp
now Natural
level Natural
minBlockTime)
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 L1Address
-> ExecutorLog
-> OperationHash
-> HashSet GlobalCounter
-> ExecutorState
ExecutorState
{ _esGState :: GState
_esGState = GState
gState
, _esRemainingSteps :: RemainingSteps
_esRemainingSteps = RemainingSteps
remainingSteps
, _esSourceAddress :: Maybe L1Address
_esSourceAddress = Maybe L1Address
forall a. Maybe a
Nothing
, _esLog :: ExecutorLog
_esLog = ExecutorLog
forall a. Monoid a => a
mempty
, _esOperationHash :: OperationHash
_esOperationHash = OperationHash
forall {a}. a
initialOpHash
, _esPrevCounters :: HashSet GlobalCounter
_esPrevCounters = HashSet GlobalCounter
forall a. Monoid a => a
mempty
}
preResToRes :: (a, ExecutorState) -> (ExecutorRes, a)
preResToRes :: forall a. (a, ExecutorState) -> (ExecutorRes, a)
preResToRes (a
r, ExecutorState{Maybe L1Address
HashSet GlobalCounter
GState
OperationHash
RemainingSteps
ExecutorLog
_esPrevCounters :: HashSet GlobalCounter
_esOperationHash :: OperationHash
_esLog :: ExecutorLog
_esSourceAddress :: Maybe L1Address
_esRemainingSteps :: RemainingSteps
_esGState :: GState
_esPrevCounters :: ExecutorState -> HashSet GlobalCounter
_esOperationHash :: ExecutorState -> OperationHash
_esLog :: ExecutorState -> ExecutorLog
_esSourceAddress :: ExecutorState -> Maybe L1Address
_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
)
runExecutorMWithDB
:: Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> FilePath
-> RemainingSteps
-> "verbose" :! Bool
-> "dryRun" :? Bool
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB :: forall a.
Maybe Timestamp
-> Maybe Natural
-> Maybe Natural
-> String
-> RemainingSteps
-> ("verbose" :! Bool)
-> NamedF Maybe Bool "dryRun"
-> ExecutorM a
-> IO (ExecutorRes, a)
runExecutorMWithDB Maybe Timestamp
maybeNow Maybe Natural
maybeLevel Maybe Natural
maybeMinBlockTime String
dbPath 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 -> NamedF Maybe Bool "dryRun" -> 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
mbt :: Natural
mbt = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
dummyMinBlockTime Maybe Natural
maybeMinBlockTime
(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
-> Natural
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
forall a.
Timestamp
-> Natural
-> Natural
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now Natural
level Natural
mbt 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
""
resolveAddress
:: SomeAddressOrAlias
-> ExecutorM Address
resolveAddress :: SomeAddressOrAlias -> ExecutorM Address
resolveAddress = \case
SAOAKindUnspecified Text
aliasText -> do
Maybe (KindedAddress 'AddressKindImplicit)
implicitAddrMb <- Getting
(First (KindedAddress 'AddressKindImplicit))
ExecutorState
(KindedAddress 'AddressKindImplicit)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe (KindedAddress 'AddressKindImplicit))
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting
(First (KindedAddress 'AddressKindImplicit))
ExecutorState
(KindedAddress 'AddressKindImplicit)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe (KindedAddress 'AddressKindImplicit)))
-> Getting
(First (KindedAddress 'AddressKindImplicit))
ExecutorState
(KindedAddress 'AddressKindImplicit)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe (KindedAddress 'AddressKindImplicit))
forall a b. (a -> b) -> a -> b
$ (GState
-> Const (First (KindedAddress 'AddressKindImplicit)) GState)
-> ExecutorState
-> Const (First (KindedAddress 'AddressKindImplicit)) ExecutorState
Lens' ExecutorState GState
esGState ((GState
-> Const (First (KindedAddress 'AddressKindImplicit)) GState)
-> ExecutorState
-> Const
(First (KindedAddress 'AddressKindImplicit)) ExecutorState)
-> ((KindedAddress 'AddressKindImplicit
-> Const
(First (KindedAddress 'AddressKindImplicit))
(KindedAddress 'AddressKindImplicit))
-> GState
-> Const (First (KindedAddress 'AddressKindImplicit)) GState)
-> Getting
(First (KindedAddress 'AddressKindImplicit))
ExecutorState
(KindedAddress 'AddressKindImplicit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
(First (KindedAddress 'AddressKindImplicit))
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> GState
-> Const (First (KindedAddress 'AddressKindImplicit)) GState
Lens'
GState (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
gsImplicitAddressAliasesL ((Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
(First (KindedAddress 'AddressKindImplicit))
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> GState
-> Const (First (KindedAddress 'AddressKindImplicit)) GState)
-> ((KindedAddress 'AddressKindImplicit
-> Const
(First (KindedAddress 'AddressKindImplicit))
(KindedAddress 'AddressKindImplicit))
-> Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
(First (KindedAddress 'AddressKindImplicit))
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> (KindedAddress 'AddressKindImplicit
-> Const
(First (KindedAddress 'AddressKindImplicit))
(KindedAddress 'AddressKindImplicit))
-> GState
-> Const (First (KindedAddress 'AddressKindImplicit)) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
-> Traversal'
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
(IxValue
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> ImplicitAlias
ImplicitAlias Text
aliasText)
Maybe ContractAddress
contractAddrMb <- Getting (First ContractAddress) ExecutorState ContractAddress
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe ContractAddress)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting (First ContractAddress) ExecutorState ContractAddress
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe ContractAddress))
-> Getting (First ContractAddress) ExecutorState ContractAddress
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe ContractAddress)
forall a b. (a -> b) -> a -> b
$ (GState -> Const (First ContractAddress) GState)
-> ExecutorState -> Const (First ContractAddress) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (First ContractAddress) GState)
-> ExecutorState -> Const (First ContractAddress) ExecutorState)
-> ((ContractAddress
-> Const (First ContractAddress) ContractAddress)
-> GState -> Const (First ContractAddress) GState)
-> Getting (First ContractAddress) ExecutorState ContractAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAlias ContractAddress
-> Const
(First ContractAddress) (Bimap ContractAlias ContractAddress))
-> GState -> Const (First ContractAddress) GState
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL ((Bimap ContractAlias ContractAddress
-> Const
(First ContractAddress) (Bimap ContractAlias ContractAddress))
-> GState -> Const (First ContractAddress) GState)
-> ((ContractAddress
-> Const (First ContractAddress) ContractAddress)
-> Bimap ContractAlias ContractAddress
-> Const
(First ContractAddress) (Bimap ContractAlias ContractAddress))
-> (ContractAddress
-> Const (First ContractAddress) ContractAddress)
-> GState
-> Const (First ContractAddress) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ContractAlias ContractAddress)
-> Traversal'
(Bimap ContractAlias ContractAddress)
(IxValue (Bimap ContractAlias ContractAddress))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> ContractAlias
ContractAlias Text
aliasText)
case (Maybe (KindedAddress 'AddressKindImplicit)
implicitAddrMb, Maybe ContractAddress
contractAddrMb) of
(Maybe (KindedAddress 'AddressKindImplicit)
Nothing, Maybe ContractAddress
Nothing) -> 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
$ Text -> ExecutorError
forall a. Text -> ExecutorError' a
EEUnknownL1AddressAlias Text
aliasText
(Just KindedAddress 'AddressKindImplicit
implicitAddr, Maybe ContractAddress
Nothing) -> Address -> ExecutorM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> ExecutorM Address) -> Address -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ KindedAddress 'AddressKindImplicit -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress 'AddressKindImplicit
implicitAddr
(Maybe (KindedAddress 'AddressKindImplicit)
Nothing, Just ContractAddress
contractAddr) -> Address -> ExecutorM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> ExecutorM Address) -> Address -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ContractAddress
contractAddr
(Just KindedAddress 'AddressKindImplicit
implicitAddr, Just ContractAddress
contractAddr) -> 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
$ Text
-> KindedAddress 'AddressKindImplicit
-> ContractAddress
-> ExecutorError
forall a.
Text
-> KindedAddress 'AddressKindImplicit
-> ContractAddress
-> ExecutorError' a
EEAmbiguousAlias Text
aliasText KindedAddress 'AddressKindImplicit
implicitAddr ContractAddress
contractAddr
SAOAKindSpecified (AddressResolved (addr :: KindedAddress kind
addr@ContractAddress{})) -> Address -> ExecutorM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> ExecutorM Address) -> Address -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
addr
SAOAKindSpecified (AddressResolved (addr :: KindedAddress kind
addr@ImplicitAddress{})) -> Address -> ExecutorM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> ExecutorM Address) -> Address -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
addr
SAOAKindSpecified (AddressAlias Alias kind
alias) -> do
Maybe Address
addrMb <- Getting (First Address) ExecutorState Address
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe Address)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting (First Address) ExecutorState Address
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe Address))
-> Getting (First Address) ExecutorState Address
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe Address)
forall a b. (a -> b) -> a -> b
$
case Alias kind
alias of
ImplicitAlias{} -> (GState -> Const (First Address) GState)
-> ExecutorState -> Const (First Address) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (First Address) GState)
-> ExecutorState -> Const (First Address) ExecutorState)
-> ((Address -> Const (First Address) Address)
-> GState -> Const (First Address) GState)
-> Getting (First Address) ExecutorState Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
(First Address)
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> GState -> Const (First Address) GState
Lens'
GState (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
gsImplicitAddressAliasesL ((Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
(First Address)
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> GState -> Const (First Address) GState)
-> ((Address -> Const (First Address) Address)
-> Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
(First Address)
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> (Address -> Const (First Address) Address)
-> GState
-> Const (First Address) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
-> Traversal'
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
(IxValue
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
Alias kind
alias ((KindedAddress 'AddressKindImplicit
-> Const (First Address) (KindedAddress 'AddressKindImplicit))
-> Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
(First Address)
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)))
-> ((Address -> Const (First Address) Address)
-> KindedAddress 'AddressKindImplicit
-> Const (First Address) (KindedAddress 'AddressKindImplicit))
-> (Address -> Const (First Address) Address)
-> Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit)
-> Const
(First Address)
(Bimap ImplicitAlias (KindedAddress 'AddressKindImplicit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KindedAddress 'AddressKindImplicit -> Address)
-> (Address -> Const (First Address) Address)
-> KindedAddress 'AddressKindImplicit
-> Const (First Address) (KindedAddress 'AddressKindImplicit)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to KindedAddress 'AddressKindImplicit -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained
ContractAlias{} -> (GState -> Const (First Address) GState)
-> ExecutorState -> Const (First Address) ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const (First Address) GState)
-> ExecutorState -> Const (First Address) ExecutorState)
-> ((Address -> Const (First Address) Address)
-> GState -> Const (First Address) GState)
-> Getting (First Address) ExecutorState Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAlias ContractAddress
-> Const (First Address) (Bimap ContractAlias ContractAddress))
-> GState -> Const (First Address) GState
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL ((Bimap ContractAlias ContractAddress
-> Const (First Address) (Bimap ContractAlias ContractAddress))
-> GState -> Const (First Address) GState)
-> ((Address -> Const (First Address) Address)
-> Bimap ContractAlias ContractAddress
-> Const (First Address) (Bimap ContractAlias ContractAddress))
-> (Address -> Const (First Address) Address)
-> GState
-> Const (First Address) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ContractAlias ContractAddress)
-> Traversal'
(Bimap ContractAlias ContractAddress)
(IxValue (Bimap ContractAlias ContractAddress))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Bimap ContractAlias ContractAddress)
Alias kind
alias ((ContractAddress -> Const (First Address) ContractAddress)
-> Bimap ContractAlias ContractAddress
-> Const (First Address) (Bimap ContractAlias ContractAddress))
-> ((Address -> Const (First Address) Address)
-> ContractAddress -> Const (First Address) ContractAddress)
-> (Address -> Const (First Address) Address)
-> Bimap ContractAlias ContractAddress
-> Const (First Address) (Bimap ContractAlias ContractAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractAddress -> Address)
-> (Address -> Const (First Address) Address)
-> ContractAddress
-> Const (First Address) ContractAddress
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ContractAddress -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained
case Maybe Address
addrMb of
Just Address
addr -> Address -> ExecutorM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure Address
addr
Maybe Address
Nothing -> 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
$ SomeAlias -> ExecutorError
forall a. SomeAlias -> ExecutorError' a
EEUnknownAddressAlias (SomeAlias -> ExecutorError) -> SomeAlias -> ExecutorError
forall a b. (a -> b) -> a -> b
$ Alias kind -> SomeAlias
forall (a :: AddressKind). Alias a -> SomeAlias
SomeAlias Alias kind
alias
executeGlobalOperations
:: TypeCheckOptions
-> [ExecutorOp]
-> ExecutorM [EmitOperation]
executeGlobalOperations :: TypeCheckOptions
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeGlobalOperations TypeCheckOptions
tcOpts = (ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation])
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
forall (f :: * -> *) m (l :: * -> *) a.
(Applicative f, Monoid m, Container (l m), Element (l m) ~ m,
Traversable l) =>
(a -> f m) -> l a -> f m
concatMapM ((ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation])
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation])
-> (ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation])
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
forall a b. (a -> b) -> a -> b
$ \ExecutorOp
op -> NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
True) [ExecutorOp
op]
where
executeMany :: "isGlobalOp" :! Bool -> [ExecutorOp] -> ExecutorM [EmitOperation]
executeMany :: NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeMany NamedF Identity Bool "isGlobalOp"
isGlobalOp = \case
[] -> [EmitOperation]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
(ExecutorOp
op:[ExecutorOp]
opsTail) -> do
case ExecutorOp
op of
OriginateOp OriginationOperation
origination -> do
ExecutorM ContractAddress
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExecutorM ContractAddress
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorM ContractAddress
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ NamedF Identity Bool "isGlobalOp"
-> OriginationOperation -> ExecutorM ContractAddress
executeOrigination NamedF Identity Bool "isGlobalOp"
isGlobalOp OriginationOperation
origination
NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) [ExecutorOp]
opsTail
SetDelegateOp SetDelegateOperation
operation -> do
NamedF Identity Bool "isGlobalOp"
-> SetDelegateOperation
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
executeDelegation NamedF Identity Bool "isGlobalOp"
isGlobalOp SetDelegateOperation
operation
NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) [ExecutorOp]
opsTail
TransferOp TransferOperation
transferOperation -> do
[ExecutorOp]
moreOps <- NamedF Identity Bool "isGlobalOp"
-> TypeCheckOptions -> TransferOperation -> ExecutorM [ExecutorOp]
executeTransfer NamedF Identity Bool "isGlobalOp"
isGlobalOp TypeCheckOptions
tcOpts TransferOperation
transferOperation
NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) ([ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation])
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
forall a b. (a -> b) -> a -> b
$ [ExecutorOp]
moreOps [ExecutorOp] -> [ExecutorOp] -> [ExecutorOp]
forall a. Semigroup a => a -> a -> a
<> [ExecutorOp]
opsTail
EmitOp EmitOperation
emitOperation -> do
(EmitOperation -> [EmitOperation] -> [EmitOperation])
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
EmitOperation
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (NamedF Identity Bool "isGlobalOp"
-> EmitOperation
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
EmitOperation
executeEmit NamedF Identity Bool "isGlobalOp"
isGlobalOp EmitOperation
emitOperation) (ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation])
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
forall a b. (a -> b) -> a -> b
$
NamedF Identity Bool "isGlobalOp"
-> [ExecutorOp]
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
[EmitOperation]
executeMany (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> NamedF Identity Bool "isGlobalOp"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) [ExecutorOp]
opsTail
executeGlobalOrigination :: OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination :: OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination = NamedF Identity Bool "isGlobalOp"
-> OriginationOperation -> ExecutorM ContractAddress
executeOrigination (NamedF Identity Bool "isGlobalOp"
-> OriginationOperation -> ExecutorM ContractAddress)
-> Param (NamedF Identity Bool "isGlobalOp")
-> OriginationOperation
-> ExecutorM ContractAddress
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! IsLabel
"isGlobalOp" (Bool -> Param (NamedF Identity Bool "isGlobalOp"))
Bool -> Param (NamedF Identity Bool "isGlobalOp")
#isGlobalOp Bool
True
executeOrigination
:: "isGlobalOp" :! Bool
-> OriginationOperation
-> ExecutorM ContractAddress
executeOrigination :: NamedF Identity Bool "isGlobalOp"
-> OriginationOperation -> ExecutorM ContractAddress
executeOrigination (Name "isGlobalOp" -> NamedF Identity Bool "isGlobalOp" -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp -> Bool
isGlobalOp) origination :: OriginationOperation
origination@(OriginationOperation{Maybe KeyHash
Maybe ContractAlias
Mutez
KindedAddress kind
GlobalCounter
Contract cp st
Value st
ooAlias :: Maybe ContractAlias
ooCounter :: GlobalCounter
ooContract :: Contract cp st
ooStorage :: Value st
ooBalance :: Mutez
ooDelegate :: Maybe KeyHash
ooOriginator :: KindedAddress kind
ooAlias :: OriginationOperation -> Maybe ContractAlias
ooCounter :: OriginationOperation -> GlobalCounter
ooContract :: ()
ooStorage :: ()
ooBalance :: OriginationOperation -> Mutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooOriginator :: ()
..}) = do
Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ do
ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
beginGlobalOperation
ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ExecutorState ExecutorState OperationHash OperationHash
Lens' ExecutorState OperationHash
esOperationHash (OperationHash
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> OperationHash
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> OperationHash
mkOriginationOperationHash OriginationOperation
origination
ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay (ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination
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
let bigMapCounter0 :: BigMapCounter
bigMapCounter0 = GState
gs GState
-> Getting BigMapCounter GState BigMapCounter -> BigMapCounter
forall s a. s -> Getting a s a -> a
^. Getting BigMapCounter GState BigMapCounter
Lens' GState BigMapCounter
gsBigMapCounterL
let (Value st
storageWithIds, BigMapCounter
bigMapCounter1) = State BigMapCounter (Value st)
-> BigMapCounter -> (Value st, BigMapCounter)
forall s a. State s a -> s -> (a, s)
runState (Bool -> Value st -> State BigMapCounter (Value st)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Bool -> Value t -> m (Value t)
assignBigMapIds Bool
False Value st
ooStorage) BigMapCounter
bigMapCounter0
let contractState :: ContractState
contractState = Mutez
-> Contract cp st -> Value st -> Maybe KeyHash -> ContractState
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Mutez
-> Contract cp st -> Value st -> Maybe KeyHash -> ContractState
ContractState Mutez
ooBalance Contract cp st
ooContract Value st
storageWithIds Maybe KeyHash
ooDelegate
let originatorAddress :: KindedAddress kind
originatorAddress = KindedAddress kind
ooOriginator
Mutez
originatorBalance <- case KindedAddress kind -> GState -> Maybe Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> GState -> Maybe Mutez
lookupBalance KindedAddress kind
originatorAddress GState
gs of
Maybe Mutez
Nothing -> 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 -> ExecutorError
forall a. a -> ExecutorError' a
EEUnknownManager (Address -> ExecutorError) -> Address -> ExecutorError
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
ooOriginator
Just Mutez
oldBalance
| Mutez
oldBalance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< Mutez
ooBalance ->
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 (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
ooOriginator) Mutez
oldBalance
| Bool
otherwise ->
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 :: ContractAddress
address = OperationHash -> GlobalCounter -> ContractAddress
mkContractAddress OperationHash
opHash GlobalCounter
ooCounter
updates :: [GStateUpdate]
updates =
[Maybe GStateUpdate] -> [GStateUpdate]
forall a. [Maybe a] -> [a]
catMaybes
[ (ContractAlias -> ContractAddress -> GStateUpdate)
-> Maybe ContractAlias
-> Maybe ContractAddress
-> Maybe GStateUpdate
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ContractAlias -> ContractAddress -> GStateUpdate
GSAddContractAddressAlias Maybe ContractAlias
ooAlias (ContractAddress -> Maybe ContractAddress
forall a. a -> Maybe a
Just ContractAddress
address)
, GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ ContractAddress -> ContractState -> GStateUpdate
GSAddContractAddress ContractAddress
address ContractState
contractState
, GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Mutez -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Mutez -> GStateUpdate
GSSetBalance KindedAddress kind
originatorAddress Mutez
originatorBalance
, GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just GStateUpdate
GSIncrementCounter
, if BigMapCounter
bigMapCounter0 BigMapCounter -> BigMapCounter -> Bool
forall a. Eq a => a -> a -> Bool
== BigMapCounter
bigMapCounter1
then Maybe GStateUpdate
forall a. Maybe a
Nothing
else GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ BigMapCounter -> GStateUpdate
GSSetBigMapCounter BigMapCounter
bigMapCounter1
]
case [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates [GStateUpdate]
updates GState
gs of
Left GStateUpdateError
err -> ExecutorError -> ExecutorM ContractAddress
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM ContractAddress)
-> ExecutorError -> ExecutorM ContractAddress
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
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GState
newGS
(ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState ExecutorLog
esLog ((ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState)
-> ExecutorLog
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, InterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates []
return ContractAddress
address
executeDelegation
:: "isGlobalOp" :! Bool
-> SetDelegateOperation
-> ExecutorM ()
executeDelegation :: NamedF Identity Bool "isGlobalOp"
-> SetDelegateOperation
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
executeDelegation (Name "isGlobalOp" -> NamedF Identity Bool "isGlobalOp" -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp -> Bool
isGlobalOp) delegation :: SetDelegateOperation
delegation@SetDelegateOperation{Maybe KeyHash
L1Address
GlobalCounter
sdoCounter :: GlobalCounter
sdoDelegate :: Maybe KeyHash
sdoContract :: L1Address
sdoCounter :: SetDelegateOperation -> GlobalCounter
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoContract :: SetDelegateOperation -> L1Address
..} = do
Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ do
ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
beginGlobalOperation
ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter ExecutorState ExecutorState OperationHash OperationHash
Lens' ExecutorState OperationHash
esOperationHash (OperationHash
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> OperationHash
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ SetDelegateOperation -> OperationHash
mkDelegationOperationHash SetDelegateOperation
delegation
ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay (ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ SetDelegateOperation -> ExecutorOp
SetDelegateOp SetDelegateOperation
delegation
GState
gs <- Getting GState ExecutorState GState
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState ExecutorState GState
Lens' ExecutorState GState
esGState
Constrained KindedAddress a
address <- L1Address
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) L1Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure L1Address
sdoContract
let updates :: [GStateUpdate]
updates = [KindedAddress a -> Maybe KeyHash -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Maybe KeyHash -> GStateUpdate
GSSetDelegate KindedAddress a
address Maybe KeyHash
sdoDelegate]
case [GStateUpdate] -> GState -> Either GStateUpdateError GState
applyUpdates [GStateUpdate]
updates GState
gs of
Left GStateUpdateError
err -> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
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
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GState
newGS
(ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState ExecutorLog
esLog ((ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState)
-> ExecutorLog
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, InterpretResult)] -> ExecutorLog
ExecutorLog [GStateUpdate]
updates []
return ()
executeEmit
:: "isGlobalOp" :! Bool
-> EmitOperation
-> ExecutorM EmitOperation
executeEmit :: NamedF Identity Bool "isGlobalOp"
-> EmitOperation
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
EmitOperation
executeEmit (Name "isGlobalOp" -> NamedF Identity Bool "isGlobalOp" -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp -> Bool
isGlobalOp) EmitOperation
op = do
Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ExecutorError
forall a. ExecutorError' a
EEGlobalEmitOp
ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay (ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ EmitOperation -> ExecutorOp
EmitOp EmitOperation
op
pure EmitOperation
op
executeTransfer
:: "isGlobalOp" :! Bool
-> TypeCheckOptions
-> TransferOperation
-> ExecutorM [ExecutorOp]
executeTransfer :: NamedF Identity Bool "isGlobalOp"
-> TypeCheckOptions -> TransferOperation -> ExecutorM [ExecutorOp]
executeTransfer (Name "isGlobalOp" -> NamedF Identity Bool "isGlobalOp" -> Bool
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp -> Bool
isGlobalOp) TypeCheckOptions
tcOpts
transferOperation :: TransferOperation
transferOperation@(
TransferOperation (MkAddress (KindedAddress kind
addr :: KindedAddress kind))
txData :: TxData
txData@TxData{tdSenderAddress :: TxData -> L1Address
tdSenderAddress=Constrained KindedAddress a
senderAddr,EpName
Mutez
TxParam
tdAmount :: Mutez
tdEntrypoint :: EpName
tdParameter :: TxParam
tdAmount :: TxData -> Mutez
tdEntrypoint :: TxData -> EpName
tdParameter :: TxData -> TxParam
..} GlobalCounter
_) = do
Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
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
Natural
mbt <- Getting Natural ExecutorEnv Natural
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) Natural
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Natural ExecutorEnv Natural
Lens' ExecutorEnv Natural
eeMinBlockTime
GState
gs <- Getting GState ExecutorState GState
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState ExecutorState GState
Lens' ExecutorState GState
esGState
RemainingSteps
remainingSteps <- Getting RemainingSteps ExecutorState RemainingSteps
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
RemainingSteps
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting RemainingSteps ExecutorState RemainingSteps
Lens' ExecutorState RemainingSteps
esRemainingSteps
L1Address
sourceAddr <- L1Address -> Maybe L1Address -> L1Address
forall a. a -> Maybe a -> a
fromMaybe (TxData -> L1Address
tdSenderAddress TxData
txData) (Maybe L1Address -> L1Address)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe L1Address)
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) L1Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe L1Address) ExecutorState (Maybe L1Address)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe L1Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe L1Address) ExecutorState (Maybe L1Address)
Lens' ExecutorState (Maybe L1Address)
esSourceAddress
let globalCounter :: GlobalCounter
globalCounter = GState -> GlobalCounter
gsCounter GState
gs
let addresses :: Map (KindedAddress kind) (AddressStateFam kind)
addresses :: Map (KindedAddress kind) (AddressStateFam kind)
addresses = case KindedAddress kind
addr of
ImplicitAddress{} -> GState -> Map (KindedAddress 'AddressKindImplicit) ImplicitState
gsImplicitAddresses GState
gs
ContractAddress{} -> GState -> Map ContractAddress ContractState
gsContractAddresses GState
gs
TxRollupAddress{} -> GState -> Map TxRollupAddress ()
gsTxRollupAddresses GState
gs
let isZeroTransfer :: Bool
isZeroTransfer = Mutez
tdAmount Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
zeroMutez
let senderBalance :: Maybe Mutez
senderBalance = KindedAddress a -> GState -> Maybe Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> GState -> Maybe Mutez
lookupBalance KindedAddress a
senderAddr GState
gs
ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay (ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ TransferOperation -> ExecutorOp
TransferOp TransferOperation
transferOperation
case KindedAddress a -> Maybe (a :~: 'AddressKindImplicit)
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (kind :~: 'AddressKindImplicit)
isImplicitAddress KindedAddress a
senderAddr of
Maybe (a :~: 'AddressKindImplicit)
Nothing -> do
Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isGlobalOp Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Bool -> Bool
not Bool
isZeroTransfer) (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> Mutez -> ExecutorError
forall a. a -> Mutez -> ExecutorError' a
EETransactionFromContract (KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr) Mutez
tdAmount
Just a :~: 'AddressKindImplicit
Refl -> do
case Maybe Mutez
senderBalance of
Maybe Mutez
Nothing -> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEEmptyImplicitContract (Address -> ExecutorError) -> Address -> ExecutorError
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr
Just Mutez
balance | Mutez
balance Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
zeroMutez ->
ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEEmptyImplicitContract (Address -> ExecutorError) -> Address -> ExecutorError
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr
Maybe Mutez
_ -> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => f ()
pass
case KindedAddress kind -> Maybe (kind :~: 'AddressKindImplicit)
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (kind :~: 'AddressKindImplicit)
isImplicitAddress KindedAddress kind
addr of
Maybe (kind :~: 'AddressKindImplicit)
Nothing -> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => f ()
pass
Just kind :~: 'AddressKindImplicit
Refl -> do
Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TxParam -> Bool
badParamToImplicitAccount TxParam
tdParameter) (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEWrongParameterType (Address -> ExecutorError) -> Address -> ExecutorError
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr
Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isZeroTransfer) (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEZeroTransaction (Address -> ExecutorError) -> Address -> ExecutorError
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr
Maybe GStateUpdate
mDecreaseSenderBalance <- case Maybe Mutez
senderBalance of
Maybe Mutez
_ | Bool
isZeroTransfer -> Maybe GStateUpdate
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe GStateUpdate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GStateUpdate
forall a. Maybe a
Nothing
Maybe Mutez
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 -> ExecutorError) -> Address -> ExecutorError
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr
Just Mutez
balance
| Mutez
balance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< Mutez
tdAmount ->
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 (KindedAddress a -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress a
senderAddr) Mutez
balance
| Bool
otherwise -> do
let newBal :: Mutez
newBal = Mutez
balance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeSubMutez` Mutez
tdAmount
Maybe GStateUpdate
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe GStateUpdate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GStateUpdate
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe GStateUpdate))
-> Maybe GStateUpdate
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Maybe GStateUpdate)
forall a b. (a -> b) -> a -> b
$ GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> Mutez -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Mutez -> GStateUpdate
GSSetBalance KindedAddress a
senderAddr Mutez
newBal
let commonFinishup
:: Dict (L1AddressKind kind)
-> [GStateUpdate]
-> [T.Operation]
-> Maybe InterpretResult
-> RemainingSteps
-> ExecutorM [ExecutorOp]
commonFinishup :: Dict (L1AddressKind kind)
-> [GStateUpdate]
-> [Operation]
-> Maybe InterpretResult
-> RemainingSteps
-> ExecutorM [ExecutorOp]
commonFinishup Dict (L1AddressKind kind)
Dict [GStateUpdate]
otherUpdates [Operation]
sideEffects Maybe InterpretResult
maybeInterpretRes RemainingSteps
newRemSteps = do
let
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
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GState
newGState
(RemainingSteps -> Identity RemainingSteps)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState RemainingSteps
esRemainingSteps ((RemainingSteps -> Identity RemainingSteps)
-> ExecutorState -> Identity ExecutorState)
-> RemainingSteps
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RemainingSteps
newRemSteps
(Maybe L1Address -> Identity (Maybe L1Address))
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState (Maybe L1Address)
esSourceAddress ((Maybe L1Address -> Identity (Maybe L1Address))
-> ExecutorState -> Identity ExecutorState)
-> Maybe L1Address
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= L1Address -> Maybe L1Address
forall a. a -> Maybe a
Just L1Address
sourceAddr
(ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState ExecutorLog
esLog ((ExecutorLog -> Identity ExecutorLog)
-> ExecutorState -> Identity ExecutorState)
-> ExecutorLog
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= [GStateUpdate] -> [(Address, 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
. (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr, )) Maybe InterpretResult
maybeInterpretRes)
(Operation
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp)
-> [Operation] -> ExecutorM [ExecutorOp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (KindedAddress kind
-> Operation
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind
-> Operation
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
convertOp KindedAddress kind
addr) ([Operation] -> ExecutorM [ExecutorOp])
-> [Operation] -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$ [Operation]
sideEffects
onlyUpdates :: Dict (L1AddressKind kind) -> [GStateUpdate] -> ExecutorM [ExecutorOp]
onlyUpdates :: Dict (L1AddressKind kind)
-> [GStateUpdate] -> ExecutorM [ExecutorOp]
onlyUpdates Dict (L1AddressKind kind)
dict [GStateUpdate]
updates = Dict (L1AddressKind kind)
-> [GStateUpdate]
-> [Operation]
-> Maybe InterpretResult
-> RemainingSteps
-> ExecutorM [ExecutorOp]
commonFinishup Dict (L1AddressKind kind)
dict [GStateUpdate]
updates [] Maybe InterpretResult
forall a. Maybe a
Nothing RemainingSteps
remainingSteps
case KindedAddress kind
addr of
TxRollupAddress{} ->
ExecutorError -> ExecutorM [ExecutorOp]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM [ExecutorOp])
-> ExecutorError -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEUnknownContract (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr)
ImplicitAddress{} -> case Map (KindedAddress kind) (AddressStateFam kind)
addresses Map (KindedAddress kind) (AddressStateFam kind)
-> Getting
(Maybe ImplicitState)
(Map (KindedAddress kind) (AddressStateFam kind))
(Maybe ImplicitState)
-> Maybe ImplicitState
forall s a. s -> Getting a s a -> a
^. Index (Map (KindedAddress kind) (AddressStateFam kind))
-> Lens'
(Map (KindedAddress kind) (AddressStateFam kind))
(Maybe (IxValue (Map (KindedAddress kind) (AddressStateFam kind))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (KindedAddress kind) (AddressStateFam kind))
KindedAddress kind
addr of
Maybe ImplicitState
Nothing -> do
let
transferAmount :: Mutez
transferAmount = Mutez
tdAmount
addrState :: Mutez
addrState = Mutez
transferAmount
upd :: GStateUpdate
upd = KindedAddress 'AddressKindImplicit -> Mutez -> GStateUpdate
GSAddImplicitAddress KindedAddress kind
KindedAddress 'AddressKindImplicit
addr Mutez
addrState
Dict (L1AddressKind kind)
-> [GStateUpdate] -> ExecutorM [ExecutorOp]
onlyUpdates Dict (L1AddressKind kind)
forall (a :: Constraint). a => Dict a
Dict [GStateUpdate
upd]
Just ImplicitState{Maybe KeyHash
Mutez
isDelegate :: ImplicitState -> Maybe KeyHash
isBalance :: ImplicitState -> Mutez
isDelegate :: Maybe KeyHash
isBalance :: Mutez
..} -> do
let
newBalance :: Mutez
newBalance = Mutez
isBalance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeAddMutez` Mutez
tdAmount
upd :: GStateUpdate
upd = KindedAddress kind -> Mutez -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Mutez -> GStateUpdate
GSSetBalance KindedAddress kind
addr Mutez
newBalance
Dict (L1AddressKind kind)
-> [GStateUpdate] -> ExecutorM [ExecutorOp]
onlyUpdates Dict (L1AddressKind kind)
forall (a :: Constraint). a => Dict a
Dict [GStateUpdate
upd]
ContractAddress{} -> case Map (KindedAddress kind) (AddressStateFam kind)
addresses Map (KindedAddress kind) (AddressStateFam kind)
-> Getting
(Maybe ContractState)
(Map (KindedAddress kind) (AddressStateFam kind))
(Maybe ContractState)
-> Maybe ContractState
forall s a. s -> Getting a s a -> a
^. Index (Map (KindedAddress kind) (AddressStateFam kind))
-> Lens'
(Map (KindedAddress kind) (AddressStateFam kind))
(Maybe (IxValue (Map (KindedAddress kind) (AddressStateFam kind))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (KindedAddress kind) (AddressStateFam kind))
KindedAddress kind
addr of
Maybe ContractState
Nothing -> ExecutorError -> ExecutorM [ExecutorOp]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError -> ExecutorM [ExecutorOp])
-> ExecutorError -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEUnknownContract (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr)
Just ContractState{Maybe KeyHash
Mutez
Contract cp st
Value st
csDelegate :: Maybe KeyHash
csStorage :: Value st
csContract :: Contract cp st
csBalance :: Mutez
csDelegate :: ContractState -> Maybe KeyHash
csStorage :: ()
csContract :: ()
csBalance :: ContractState -> Mutez
..} -> do
let
existingContracts :: TcOriginatedContracts
existingContracts = GState -> TcOriginatedContracts
extractAllContracts GState
gs
newBalance :: Mutez
newBalance = Mutez
csBalance HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeAddMutez` Mutez
tdAmount
epName :: EpName
epName = EpName
tdEntrypoint
T.MkEntrypointCallRes Notes arg
_ (EntrypointCallT cp arg
epc :: EntrypointCallT cp epArg)
<- EpName -> ParamNotes cp -> Maybe (MkEntrypointCallRes cp)
forall (param :: T).
ParameterScope param =>
EpName -> ParamNotes param -> Maybe (MkEntrypointCallRes param)
T.mkEntrypointCall EpName
epName (Contract cp st -> ParamNotes cp
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
T.cParamNotes Contract cp st
csContract)
Maybe (MkEntrypointCallRes cp)
-> (Maybe (MkEntrypointCallRes cp)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(MkEntrypointCallRes cp))
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(MkEntrypointCallRes cp)
forall a b. a -> (a -> b) -> b
& ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(MkEntrypointCallRes cp)
-> (MkEntrypointCallRes cp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(MkEntrypointCallRes cp))
-> Maybe (MkEntrypointCallRes cp)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(MkEntrypointCallRes cp)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 <-
case TxParam
tdParameter of
TxTypedParam (Value t
typedVal :: T.Value t) ->
forall (a :: T) (b :: T) (t :: T -> *) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
t a -> (forall x. MismatchError T -> m x) -> m (t b)
T.castM @t @epArg Value t
typedVal ((forall x.
MismatchError T
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Value arg))
-> (forall x.
MismatchError T
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(Value arg)
forall a b. (a -> b) -> a -> b
$
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)
-> (MismatchError T -> ExecutorError)
-> MismatchError T
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> MismatchError T -> ExecutorError
forall a. a -> MismatchError T -> ExecutorError' a
EEUnexpectedParameterType (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
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' ExpandedOp -> ExecutorError)
-> Either (TcError' ExpandedOp) (Value arg)
-> Either ExecutorError (Value arg)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Address -> TcError' ExpandedOp -> ExecutorError
forall a. a -> TcError' ExpandedOp -> ExecutorError' a
EEIllTypedParameter (Address -> TcError' ExpandedOp -> ExecutorError)
-> Address -> TcError' ExpandedOp -> ExecutorError
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr) (Either (TcError' ExpandedOp) (Value arg)
-> Either ExecutorError (Value arg))
-> Either (TcError' ExpandedOp) (Value arg)
-> Either ExecutorError (Value arg)
forall a b. (a -> b) -> a -> b
$
TypeCheckOptions
-> TypeCheckResult ExpandedOp (Value arg)
-> Either (TcError' ExpandedOp) (Value arg)
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
tcOpts (TypeCheckResult ExpandedOp (Value arg)
-> Either (TcError' ExpandedOp) (Value arg))
-> TypeCheckResult ExpandedOp (Value arg)
-> Either (TcError' ExpandedOp) (Value arg)
forall a b. (a -> b) -> a -> b
$
forall (t :: T).
SingI t =>
TcOriginatedContracts
-> Value -> TypeCheckResult ExpandedOp (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 (Bool -> Value arg -> State BigMapCounter (Value arg)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Bool -> Value t -> m (Value t)
assignBigMapIds Bool
False Value arg
typedParameter) BigMapCounter
bigMapCounter0
() <- Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGlobalOp (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
ASetter ExecutorState ExecutorState OperationHash OperationHash
Lens' ExecutorState OperationHash
esOperationHash ASetter ExecutorState ExecutorState OperationHash OperationHash
-> OperationHash
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= KindedAddress kind -> Value arg -> EpName -> Mutez -> OperationHash
forall (t :: T) (kind :: AddressKind).
ParameterScope t =>
KindedAddress kind -> Value t -> EpName -> Mutez -> OperationHash
mkTransferOperationHash
KindedAddress kind
addr
Value arg
typedParameterWithIds
EpName
tdEntrypoint
Mutez
tdAmount
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 ContractAddress ContractState
-> ContractAddress
-> L1Address
-> L1Address
-> Mutez
-> VotingPowers
-> ChainId
-> Maybe OperationHash
-> Natural
-> ErrorSrcPos
-> Natural
-> ContractEnv
ContractEnv
{ ceNow :: Timestamp
ceNow = Timestamp
now
, ceMaxSteps :: RemainingSteps
ceMaxSteps = RemainingSteps
remainingSteps
, ceBalance :: Mutez
ceBalance = Mutez
newBalance
, ceContracts :: Map ContractAddress ContractState
ceContracts = GState -> Map ContractAddress ContractState
gsContractAddresses GState
gs
, ceSelf :: ContractAddress
ceSelf = KindedAddress kind
ContractAddress
addr
, ceSource :: L1Address
ceSource = L1Address
sourceAddr
, ceSender :: L1Address
ceSender = KindedAddress a -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress a
senderAddr
, ceAmount :: Mutez
ceAmount = Mutez
tdAmount
, 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
, ceErrorSrcPos :: ErrorSrcPos
ceErrorSrcPos = ErrorSrcPos
forall a. Default a => a
def
, ceMinBlockTime :: Natural
ceMinBlockTime = Natural
mbt
}
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 Void -> ExecutorError)
-> Either (InterpretError Void) InterpretResult
-> Either ExecutorError InterpretResult
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Address -> InterpretError Void -> ExecutorError
forall a. a -> InterpretError Void -> ExecutorError' a
EEInterpreterFailed (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr)) (Either (InterpretError Void) InterpretResult
-> Either ExecutorError InterpretResult)
-> Either (InterpretError Void) InterpretResult
-> Either ExecutorError InterpretResult
forall a b. (a -> b) -> a -> b
$
ContractReturn st -> Either (InterpretError Void) InterpretResult
forall (st :: T).
StorageScope st =>
ContractReturn st -> Either (InterpretError Void) InterpretResult
handleContractReturn (ContractReturn st -> Either (InterpretError Void) InterpretResult)
-> ContractReturn st
-> Either (InterpretError Void) 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
$ KindedAddress kind -> Mutez -> GStateUpdate
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> Mutez -> GStateUpdate
GSSetBalance KindedAddress kind
addr Mutez
newBalance
updStorage :: Maybe GStateUpdate
updStorage
| Value st -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
SomeValue Value st
newValue SomeValue -> SomeValue -> Bool
forall a. Eq a => a -> a -> Bool
== Value st -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
SomeValue Value st
csStorage = Maybe GStateUpdate
forall a. Maybe a
Nothing
| Bool
otherwise = GStateUpdate -> Maybe GStateUpdate
forall a. a -> Maybe a
Just (GStateUpdate -> Maybe GStateUpdate)
-> GStateUpdate -> Maybe GStateUpdate
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Value st -> GStateUpdate
forall (st :: T).
StorageScope st =>
ContractAddress -> Value st -> GStateUpdate
GSSetStorageValue KindedAddress kind
ContractAddress
addr Value st
newValue
updBigMapCounter :: Maybe GStateUpdate
updBigMapCounter
| 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
]
Dict (L1AddressKind kind)
-> [GStateUpdate]
-> [Operation]
-> Maybe InterpretResult
-> RemainingSteps
-> ExecutorM [ExecutorOp]
commonFinishup Dict (L1AddressKind kind)
forall (a :: Constraint). a => Dict a
Dict [GStateUpdate]
updates [Operation]
sideEffects (InterpretResult -> Maybe InterpretResult
forall a. a -> Maybe a
Just InterpretResult
iur) RemainingSteps
newRemainingSteps
checkOperationReplay :: ExecutorOp -> ExecutorM ()
checkOperationReplay :: ExecutorOp
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
checkOperationReplay ExecutorOp
op = do
let
opCounter :: GlobalCounter
opCounter = ExecutorOp
op ExecutorOp -> (ExecutorOp -> GlobalCounter) -> GlobalCounter
forall a b. a -> (a -> b) -> b
& \case
OriginateOp OriginationOperation{Maybe KeyHash
Maybe ContractAlias
Mutez
KindedAddress kind
GlobalCounter
Contract cp st
Value st
ooAlias :: Maybe ContractAlias
ooCounter :: GlobalCounter
ooContract :: Contract cp st
ooStorage :: Value st
ooBalance :: Mutez
ooDelegate :: Maybe KeyHash
ooOriginator :: KindedAddress kind
ooAlias :: OriginationOperation -> Maybe ContractAlias
ooCounter :: OriginationOperation -> GlobalCounter
ooContract :: ()
ooStorage :: ()
ooBalance :: OriginationOperation -> Mutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooOriginator :: ()
..} -> GlobalCounter
ooCounter
TransferOp TransferOperation{Address
GlobalCounter
TxData
toCounter :: TransferOperation -> GlobalCounter
toTxData :: TransferOperation -> TxData
toDestination :: TransferOperation -> Address
toCounter :: GlobalCounter
toTxData :: TxData
toDestination :: Address
..} -> GlobalCounter
toCounter
SetDelegateOp SetDelegateOperation{Maybe KeyHash
L1Address
GlobalCounter
sdoCounter :: GlobalCounter
sdoDelegate :: Maybe KeyHash
sdoContract :: L1Address
sdoCounter :: SetDelegateOperation -> GlobalCounter
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoContract :: SetDelegateOperation -> L1Address
..} -> GlobalCounter
sdoCounter
EmitOp (EmitOperation ContractAddress
_ T.Emit{Text
GlobalCounter
Notes t
Value' Instr t
emCounter :: GlobalCounter
emValue :: Value' Instr t
emNotes :: Notes t
emTag :: Text
emCounter :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> GlobalCounter
emValue :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> Value' instr t
emNotes :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Notes t
emTag :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Text
..}) -> GlobalCounter
emCounter
HashSet GlobalCounter
prevCounters <- Getting
(HashSet GlobalCounter) ExecutorState (HashSet GlobalCounter)
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
(HashSet GlobalCounter)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
(HashSet GlobalCounter) ExecutorState (HashSet GlobalCounter)
Lens' ExecutorState (HashSet GlobalCounter)
esPrevCounters
Bool
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GlobalCounter
opCounter GlobalCounter -> HashSet GlobalCounter -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet GlobalCounter
prevCounters) (ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall a b. (a -> b) -> a -> b
$
ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> ExecutorError
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
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
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a.
(MonadState s m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= OneItem (HashSet GlobalCounter) -> HashSet GlobalCounter
forall x. One x => OneItem x -> x
one OneItem (HashSet GlobalCounter)
GlobalCounter
opCounter
convertOp :: L1AddressKind kind => KindedAddress kind -> T.Operation -> ExecutorM ExecutorOp
convertOp :: forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind
-> Operation
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
convertOp KindedAddress kind
interpretedAddr =
\case
OpTransferTokens TransferTokens Instr p
tt ->
ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp)
-> ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall a b. (a -> b) -> a -> b
$ case TransferTokens Instr p -> Value' Instr ('TContract p)
forall (instr :: [T] -> [T] -> *) (p :: T).
TransferTokens instr p -> Value' instr ('TContract p)
ttContract TransferTokens Instr p
tt of
T.VContract Address
destAddress SomeEntrypointCallT arg
sepc ->
let txData :: TxData
txData =
TxData :: L1Address -> TxParam -> EpName -> Mutez -> TxData
TxData
{ tdSenderAddress :: L1Address
tdSenderAddress = KindedAddress kind -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
interpretedAddr
, tdEntrypoint :: EpName
tdEntrypoint = SomeEntrypointCallT arg -> EpName
forall (arg :: T). SomeEntrypointCallT arg -> EpName
T.sepcName SomeEntrypointCallT arg
sepc
, tdParameter :: TxParam
tdParameter = Value p -> TxParam
forall (t :: T). ParameterScope t => Value t -> TxParam
TxTypedParam (TransferTokens Instr p -> Value p
forall (instr :: [T] -> [T] -> *) (p :: T).
TransferTokens instr p -> Value' instr p
ttTransferArgument TransferTokens Instr p
tt)
, tdAmount :: Mutez
tdAmount = TransferTokens Instr p -> Mutez
forall (instr :: [T] -> [T] -> *) (p :: T).
TransferTokens instr p -> Mutez
ttAmount TransferTokens Instr p
tt
}
transferOperation :: TransferOperation
transferOperation =
TransferOperation :: 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
..} -> ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp)
-> ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall a b. (a -> b) -> a -> b
$ SetDelegateOperation -> ExecutorOp
SetDelegateOp SetDelegateOperation :: L1Address -> Maybe KeyHash -> GlobalCounter -> SetDelegateOperation
SetDelegateOperation
{ sdoContract :: L1Address
sdoContract = KindedAddress kind -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress kind
interpretedAddr
, sdoDelegate :: Maybe KeyHash
sdoDelegate = Maybe KeyHash
sdMbKeyHash
, sdoCounter :: GlobalCounter
sdoCounter = GlobalCounter
sdCounter
}
OpCreateContract CreateContract{ccOriginator :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> L1Address
ccOriginator=Constrained KindedAddress a
ccOriginator, Maybe KeyHash
Mutez
GlobalCounter
Contract' Instr cp st
Value' Instr st
ccCounter :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> GlobalCounter
ccContract :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Contract' instr cp st
ccStorageVal :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Value' instr st
ccBalance :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Mutez
ccDelegate :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
CreateContract instr cp st -> Maybe KeyHash
ccCounter :: GlobalCounter
ccContract :: Contract' Instr cp st
ccStorageVal :: Value' Instr st
ccBalance :: Mutez
ccDelegate :: Maybe KeyHash
..} ->
ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp)
-> ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation :: forall (cp :: T) (st :: T) (kind :: AddressKind).
(StorageScope st, ParameterScope cp, L1AddressKind kind) =>
KindedAddress kind
-> Maybe KeyHash
-> Mutez
-> Value st
-> Contract cp st
-> GlobalCounter
-> Maybe ContractAlias
-> OriginationOperation
OriginationOperation
{ ooOriginator :: KindedAddress a
ooOriginator = KindedAddress a
ccOriginator
, ooDelegate :: Maybe KeyHash
ooDelegate = Maybe KeyHash
ccDelegate
, ooBalance :: Mutez
ooBalance = Mutez
ccBalance
, ooStorage :: Value' Instr st
ooStorage = Value' Instr st
ccStorageVal
, ooContract :: Contract' Instr cp st
ooContract = Contract' Instr cp st
ccContract
, ooCounter :: GlobalCounter
ooCounter = GlobalCounter
ccCounter
, ooAlias :: Maybe ContractAlias
ooAlias = Maybe ContractAlias
forall a. Maybe a
Nothing
}
OpEmit Emit Instr t
emit -> case KindedAddress kind
interpretedAddr of
ContractAddress{} -> ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp)
-> ExecutorOp
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall a b. (a -> b) -> a -> b
$ EmitOperation -> ExecutorOp
EmitOp (EmitOperation -> ExecutorOp) -> EmitOperation -> ExecutorOp
forall a b. (a -> b) -> a -> b
$ ContractAddress -> Emit Instr t -> EmitOperation
forall (t :: T).
PackedValScope t =>
ContractAddress -> Emit Instr t -> EmitOperation
EmitOperation KindedAddress kind
ContractAddress
interpretedAddr Emit Instr t
emit
KindedAddress kind
_ -> ExecutorError
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExecutorError
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp)
-> ExecutorError
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
ExecutorOp
forall a b. (a -> b) -> a -> b
$ Address -> ExecutorError
forall a. a -> ExecutorError' a
EEUnknownContract (Address -> ExecutorError) -> Address -> ExecutorError
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
interpretedAddr
beginGlobalOperation :: ExecutorM ()
beginGlobalOperation :: ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
beginGlobalOperation =
(Maybe L1Address -> Identity (Maybe L1Address))
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState (Maybe L1Address)
esSourceAddress ((Maybe L1Address -> Identity (Maybe L1Address))
-> ExecutorState -> Identity ExecutorState)
-> Maybe L1Address
-> ReaderT
ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe L1Address
forall a. Maybe a
Nothing
badParamToImplicitAccount :: TxParam -> Bool
badParamToImplicitAccount :: TxParam -> Bool
badParamToImplicitAccount (TxTypedParam Value' Instr t
T.VUnit) = Bool
False
badParamToImplicitAccount (TxUntypedParam Value
U.ValueUnit) = Bool
False
badParamToImplicitAccount TxParam
_ = Bool
True