module Morley.Michelson.Runtime.RunCode
( runCode
, RunCodeParameters(..)
, runCodeParameters
, resolveRunCodeBigMaps
) where
import Data.Default (def)
import Data.Map qualified as Map
import Morley.Michelson.Interpret (ContractEnv(..), InterpretError(..), assignBigMapIds, interpret)
import Morley.Michelson.Runtime.Dummy
import Morley.Michelson.Runtime.GState
import Morley.Michelson.TypeCheck
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Operation
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Core (ChainId, Mutez, Timestamp(..), dummyChainId, zeroMutez)
import Morley.Tezos.Crypto (KeyHash)
type RunCodeParameters :: T.T -> T.T -> T.T -> Type
data RunCodeParameters cp epArg st = RunCodeParameters
{ forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Contract cp st
rcScript :: T.Contract cp st
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Value st
rcStorage :: T.Value st
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Value epArg
rcInput :: T.Value epArg
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> EntrypointCallT cp epArg
rcEntryPoint :: T.EntrypointCallT cp epArg
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Mutez
rcAmount :: Mutez
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Mutez
rcBalance :: Mutez
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> ChainId
rcChainId :: ChainId
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Timestamp
rcNow :: Timestamp
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Natural
rcLevel :: Natural
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Natural
rcMinBlockTime :: Natural
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> L1Address
rcSource :: L1Address
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> L1Address
rcSender :: L1Address
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Map ContractAddress ContractState
rcKnownContracts :: Map ContractAddress ContractState
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Maybe ContractAddress
rcSelf :: Maybe ContractAddress
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> Maybe KeyHash
rcDelegate :: Maybe KeyHash
, forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st -> VotingPowers
rcVotingPowers :: VotingPowers
}
runCodeParameters
:: T.Contract cp st
-> T.Value st
-> T.EntrypointCallT cp epArg
-> T.Value epArg
-> RunCodeParameters cp epArg st
runCodeParameters :: forall (cp :: T) (st :: T) (epArg :: T).
Contract cp st
-> Value st
-> EntrypointCallT cp epArg
-> Value epArg
-> RunCodeParameters cp epArg st
runCodeParameters Contract cp st
rcScript Value st
rcStorage EntrypointCallT cp epArg
rcEntryPoint Value epArg
rcInput = RunCodeParameters :: forall (cp :: T) (epArg :: T) (st :: T).
Contract cp st
-> Value st
-> Value epArg
-> EntrypointCallT cp epArg
-> Mutez
-> Mutez
-> ChainId
-> Timestamp
-> Natural
-> Natural
-> L1Address
-> L1Address
-> Map ContractAddress ContractState
-> Maybe ContractAddress
-> Maybe KeyHash
-> VotingPowers
-> RunCodeParameters cp epArg st
RunCodeParameters
{ rcAmount :: Mutez
rcAmount = Mutez
zeroMutez
, rcBalance :: Mutez
rcBalance = Mutez
zeroMutez
, rcChainId :: ChainId
rcChainId = ChainId
dummyChainId
, rcNow :: Timestamp
rcNow = Timestamp
dummyNow
, rcLevel :: Natural
rcLevel = Natural
dummyLevel
, rcMinBlockTime :: Natural
rcMinBlockTime = Natural
dummyMinBlockTime
, rcSource :: L1Address
rcSource = KindedAddress 'AddressKindImplicit -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress 'AddressKindImplicit
genesisAddress
, rcSender :: L1Address
rcSender = KindedAddress 'AddressKindImplicit -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress 'AddressKindImplicit
genesisAddress
, rcKnownContracts :: Map ContractAddress ContractState
rcKnownContracts = Map ContractAddress ContractState
forall a. Monoid a => a
mempty
, rcSelf :: Maybe ContractAddress
rcSelf = Maybe ContractAddress
forall a. Maybe a
Nothing
, rcDelegate :: Maybe KeyHash
rcDelegate = Maybe KeyHash
forall a. Maybe a
Nothing
, rcVotingPowers :: VotingPowers
rcVotingPowers = VotingPowers
dummyVotingPowers
, EntrypointCallT cp epArg
Contract cp st
Value st
Value epArg
rcInput :: Value epArg
rcEntryPoint :: EntrypointCallT cp epArg
rcStorage :: Value st
rcScript :: Contract cp st
rcEntryPoint :: EntrypointCallT cp epArg
rcInput :: Value epArg
rcStorage :: Value st
rcScript :: Contract cp st
..
}
runCode
:: RunCodeParameters cp epArg st
-> Either (InterpretError Void) ([T.Operation], T.Value st)
runCode :: forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st
-> Either (InterpretError Void) ([Operation], Value st)
runCode (RunCodeParameters
rcScript :: Contract cp st
rcScript@T.Contract{}
Value st
rcStorage
Value epArg
rcInput
EntrypointCallT cp epArg
rcEntryPoint
Mutez
rcAmount
Mutez
rcBalance
ChainId
rcChainId
Timestamp
rcNow
Natural
rcLevel
Natural
rcMinBlockTime
L1Address
rcSource
L1Address
rcSender
Map ContractAddress ContractState
rcKnownContracts
Maybe ContractAddress
rcSelf
Maybe KeyHash
rcDelegate
VotingPowers
rcVotingPowers
) = (Either (MichelsonFailureWithStack Void) ([Operation], Value st),
(InterpreterState, MorleyLogs))
-> Either (InterpretError Void) ([Operation], Value st)
forall {p :: * -> * -> *} {ext} {c} {a}.
Bifunctor p =>
(p (MichelsonFailureWithStack ext) c, (a, MorleyLogs))
-> p (InterpretError ext) c
toInterpreterRes ((Either (MichelsonFailureWithStack Void) ([Operation], Value st),
(InterpreterState, MorleyLogs))
-> Either (InterpretError Void) ([Operation], Value st))
-> (Either
(MichelsonFailureWithStack Void) ([Operation], Value st),
(InterpreterState, MorleyLogs))
-> Either (InterpretError Void) ([Operation], Value st)
forall a b. (a -> b) -> a -> b
$
Contract cp st
-> EntrypointCallT cp epArg
-> Value epArg
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> (Either
(MichelsonFailureWithStack Void) ([Operation], Value st),
(InterpreterState, MorleyLogs))
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
rcScript EntrypointCallT cp epArg
rcEntryPoint Value epArg
input Value st
storage GlobalCounter
dummyGlobalCounter BigMapCounter
bigMapCtr ContractEnv
contractEnv
where
selfState :: ContractState
selfState = ContractState :: forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Mutez
-> Contract cp st -> Value st -> Maybe KeyHash -> ContractState
ContractState
{ csBalance :: Mutez
csBalance = Mutez
rcBalance
, csContract :: Contract cp st
csContract = Contract cp st
rcScript
, csStorage :: Value st
csStorage = Value st
rcStorage
, csDelegate :: Maybe KeyHash
csDelegate = Maybe KeyHash
rcDelegate
}
dummyOriginationHash :: OperationHash
dummyOriginationHash = OriginationOperation -> OperationHash
mkOriginationOperationHash (OriginationOperation -> OperationHash)
-> OriginationOperation -> OperationHash
forall a b. (a -> b) -> a -> b
$
Value st -> Contract cp st -> GlobalCounter -> OriginationOperation
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Value st -> Contract cp st -> GlobalCounter -> OriginationOperation
dummyOrigination Value st
rcStorage Contract cp st
rcScript GlobalCounter
dummyGlobalCounter
self :: ContractAddress
self = ContractAddress -> Maybe ContractAddress -> ContractAddress
forall a. a -> Maybe a -> a
fromMaybe
(OperationHash -> GlobalCounter -> ContractAddress
mkContractAddress OperationHash
dummyOriginationHash GlobalCounter
dummyGlobalCounter)
Maybe ContractAddress
rcSelf
((Value epArg
input, Value st
storage), BigMapCounter
bigMapCtr) = BigMapCounter
-> State BigMapCounter (Value epArg, Value st)
-> ((Value epArg, Value st), BigMapCounter)
forall s a. s -> State s a -> (a, s)
usingState BigMapCounter
dummyBigMapCounter (State BigMapCounter (Value epArg, Value st)
-> ((Value epArg, Value st), BigMapCounter))
-> State BigMapCounter (Value epArg, Value st)
-> ((Value epArg, Value st), BigMapCounter)
forall a b. (a -> b) -> a -> b
$
(,) (Value epArg -> Value st -> (Value epArg, Value st))
-> StateT BigMapCounter Identity (Value epArg)
-> StateT
BigMapCounter Identity (Value st -> (Value epArg, Value st))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Value epArg -> StateT BigMapCounter Identity (Value epArg)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Bool -> Value t -> m (Value t)
assignBigMapIds Bool
False Value epArg
rcInput StateT BigMapCounter Identity (Value st -> (Value epArg, Value st))
-> StateT BigMapCounter Identity (Value st)
-> State BigMapCounter (Value epArg, Value st)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Value st -> StateT BigMapCounter Identity (Value st)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Bool -> Value t -> m (Value t)
assignBigMapIds Bool
False Value st
rcStorage
toInterpreterRes :: (p (MichelsonFailureWithStack ext) c, (a, MorleyLogs))
-> p (InterpretError ext) c
toInterpreterRes (p (MichelsonFailureWithStack ext) c
eith, (a
_, MorleyLogs
logs)) = (MichelsonFailureWithStack ext -> InterpretError ext)
-> p (MichelsonFailureWithStack ext) c -> p (InterpretError ext) c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((MichelsonFailureWithStack ext, MorleyLogs) -> InterpretError ext
forall ext.
(MichelsonFailureWithStack ext, MorleyLogs) -> InterpretError ext
InterpretError ((MichelsonFailureWithStack ext, MorleyLogs) -> InterpretError ext)
-> (MichelsonFailureWithStack ext
-> (MichelsonFailureWithStack ext, MorleyLogs))
-> MichelsonFailureWithStack ext
-> InterpretError ext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, MorleyLogs
logs)) p (MichelsonFailureWithStack ext) c
eith
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
rcNow
, ceBalance :: Mutez
ceBalance = Mutez
rcBalance
, ceSelf :: ContractAddress
ceSelf = ContractAddress
self
, ceAmount :: Mutez
ceAmount = Mutez
rcAmount
, ceMinBlockTime :: Natural
ceMinBlockTime = Natural
rcMinBlockTime
, ceContracts :: Map ContractAddress ContractState
ceContracts = ContractAddress
-> ContractState
-> Map ContractAddress ContractState
-> Map ContractAddress ContractState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ContractAddress
self ContractState
selfState Map ContractAddress ContractState
rcKnownContracts
, ceMaxSteps :: RemainingSteps
ceMaxSteps = RemainingSteps
dummyMaxSteps
, ceSource :: L1Address
ceSource = L1Address
rcSource
, ceSender :: L1Address
ceSender = L1Address
rcSender
, ceChainId :: ChainId
ceChainId = ChainId
rcChainId
, ceOperationHash :: Maybe OperationHash
ceOperationHash = Maybe OperationHash
forall a. Maybe a
Nothing
, ceLevel :: Natural
ceLevel = Natural
rcLevel
, ceErrorSrcPos :: ErrorSrcPos
ceErrorSrcPos = ErrorSrcPos
forall a. Default a => a
def
, ceVotingPowers :: VotingPowers
ceVotingPowers = VotingPowers
rcVotingPowers
}
resolveRunCodeBigMaps
:: T.SingI t => BigMapFinder -> U.Value -> Either TcError (T.Value t)
resolveRunCodeBigMaps :: forall (t :: T).
SingI t =>
BigMapFinder -> Value -> Either TcError (Value t)
resolveRunCodeBigMaps = TypeCheckOptions
-> TypeCheckResult ExpandedOp (Value t) -> Either TcError (Value t)
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def{tcStrict :: Bool
tcStrict=Bool
False} (TypeCheckResult ExpandedOp (Value t) -> Either TcError (Value t))
-> (BigMapFinder -> Value -> TypeCheckResult ExpandedOp (Value t))
-> BigMapFinder
-> Value
-> Either TcError (Value t)
forall a b c. SuperComposition a b c => a -> b -> c
... BigMapFinder -> Value -> TypeCheckResult ExpandedOp (Value t)
forall (t :: T).
SingI t =>
BigMapFinder -> Value -> TypeCheckResult ExpandedOp (Value t)
typeCheckValueRunCodeCompat