module Test.Cleveland.Internal.Pure
( PureM(..)
, runEmulatedT
, PureState
, TestError(..)
, emulatedImpl
, clevelandOpsImpl
, clevelandMiscImpl
, initEnv
, failedInsideBranch
, moneybagAlias
, emptyScenarioBranch
, psSecretKeys
, psDefaultAliasesCounter
, psRefillableAddresses
, psNow
, psLevel
, psMinBlockTime
, psGState
) where
import Control.Lens (assign, at, each, makeLenses, modifying, to, (%=), (.=), (?=), (?~))
import Control.Lens.Unsound (lensProduct)
import Control.Monad.Catch.Pure (CatchT, runCatchT)
import Control.Monad.Writer (MonadWriter, WriterT, listen, runWriterT, tell)
import Data.Constraint (Dict(..), withDict, (\\))
import Data.Default (def)
import Data.Map qualified as Map
import Data.Ratio ((%))
import Data.Set qualified as Set
import Fmt (Buildable(..), Builder, build, pretty, unlinesF, (+|), (|+))
import Time (Second, toNum, toUnit)
import Lorentz (Mutez, NiceComparable, pattern DefEpName)
import Lorentz qualified as L
import Lorentz.Entrypoints (HasEntrypointArg, TrustEpName(..), useHasEntrypointArg)
import Morley.AsRPC (HasRPCRepr(AsRPC), notesAsRPC, rpcStorageScopeEvi, valueAsRPC)
import Morley.Client (OperationInfo(..))
import Morley.Michelson.Interpret
(InterpretError(..), InterpretResult(..), MichelsonFailed(..), MichelsonFailureWithStack(..))
import Morley.Michelson.Runtime hiding (ExecutorOp(..), transfer)
import Morley.Michelson.Runtime qualified as Runtime (ExecutorOp(..))
import Morley.Michelson.Runtime.Dummy
(dummyLevel, dummyMaxSteps, dummyMinBlockTime, dummyNow, dummyOrigination)
import Morley.Michelson.Runtime.GState
(GState(..), genesisAddress, genesisSecretKey, gsChainIdL, gsContractAddressAliasesL,
gsContractAddressesL, gsCounterL, gsImplicitAddressAliasesL, gsVotingPowersL, initGState,
lookupBalance)
import Morley.Michelson.TypeCheck
(BigMapFinder, TCError(..), TypeCheckOptions(..), typeCheckContractAndStorage,
typeCheckValueRunCodeCompat, typeCheckingWith)
import Morley.Michelson.Typed
(BigMapId(..), IsoValue, SingI, SomeAnnotatedValue(..), SomeConstrainedValue(SomeValue),
SomeVBigMap(..), SomeValue, ToT, Value, Value'(..), castM, dfsFoldMapValue, fromVal, toVal)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Operation
(EmitOperation(..), OriginationOperation(..), TransferOperation(..))
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core (Timestamp, timestampPlusSeconds, unsafeSubMutez, zeroMutez)
import Morley.Tezos.Crypto (SecretKey(..), detSecretKey, sign, toPublic)
import Morley.Util.MismatchError
import Morley.Util.Named
import Morley.Util.Bimap qualified as Bimap
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Exceptions (addCallStack, catchWithCallStack, throwWithCallStack)
import Test.Cleveland.Lorentz
import Test.Cleveland.Util (ceilingUnit)
data PureState = PureState
{ PureState -> Map ImplicitAddress SecretKey
_psSecretKeys :: Map ImplicitAddress SecretKey
, PureState -> DefaultAliasCounter
_psDefaultAliasesCounter :: DefaultAliasCounter
, PureState -> Set ImplicitAddress
_psRefillableAddresses :: Set ImplicitAddress
, PureState -> Timestamp
_psNow :: Timestamp
, PureState -> Natural
_psLevel :: Natural
, PureState -> Natural
_psMinBlockTime :: Natural
, PureState -> GState
_psGState :: GState
}
deriving stock (PureState -> PureState -> Bool
(PureState -> PureState -> Bool)
-> (PureState -> PureState -> Bool) -> Eq PureState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PureState -> PureState -> Bool
$c/= :: PureState -> PureState -> Bool
== :: PureState -> PureState -> Bool
$c== :: PureState -> PureState -> Bool
Eq, Int -> PureState -> ShowS
[PureState] -> ShowS
PureState -> String
(Int -> PureState -> ShowS)
-> (PureState -> String)
-> ([PureState] -> ShowS)
-> Show PureState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PureState] -> ShowS
$cshowList :: [PureState] -> ShowS
show :: PureState -> String
$cshow :: PureState -> String
showsPrec :: Int -> PureState -> ShowS
$cshowsPrec :: Int -> PureState -> ShowS
Show)
instance MonadState PureState PureM where
get :: PureM PureState
get = PureM (IORef PureState)
forall r (m :: * -> *). MonadReader r m => m r
ask PureM (IORef PureState)
-> (IORef PureState -> PureM PureState) -> PureM PureState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef PureState -> PureM PureState
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef
put :: PureState -> PureM ()
put = (PureM (IORef PureState)
forall r (m :: * -> *). MonadReader r m => m r
ask PureM (IORef PureState)
-> (IORef PureState -> PureM ()) -> PureM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) ((IORef PureState -> PureM ()) -> PureM ())
-> (PureState -> IORef PureState -> PureM ())
-> PureState
-> PureM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef PureState -> PureState -> PureM ())
-> PureState -> IORef PureState -> PureM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef PureState -> PureState -> PureM ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef
newtype PureM a = PureM
{ forall a.
PureM a
-> ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
unPureM :: ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
}
deriving newtype ((forall a b. (a -> b) -> PureM a -> PureM b)
-> (forall a b. a -> PureM b -> PureM a) -> Functor PureM
forall a b. a -> PureM b -> PureM a
forall a b. (a -> b) -> PureM a -> PureM 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 -> PureM b -> PureM a
$c<$ :: forall a b. a -> PureM b -> PureM a
fmap :: forall a b. (a -> b) -> PureM a -> PureM b
$cfmap :: forall a b. (a -> b) -> PureM a -> PureM b
Functor, Functor PureM
Functor PureM
-> (forall a. a -> PureM a)
-> (forall a b. PureM (a -> b) -> PureM a -> PureM b)
-> (forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c)
-> (forall a b. PureM a -> PureM b -> PureM b)
-> (forall a b. PureM a -> PureM b -> PureM a)
-> Applicative PureM
forall a. a -> PureM a
forall a b. PureM a -> PureM b -> PureM a
forall a b. PureM a -> PureM b -> PureM b
forall a b. PureM (a -> b) -> PureM a -> PureM b
forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. PureM a -> PureM b -> PureM a
$c<* :: forall a b. PureM a -> PureM b -> PureM a
*> :: forall a b. PureM a -> PureM b -> PureM b
$c*> :: forall a b. PureM a -> PureM b -> PureM b
liftA2 :: forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c
$cliftA2 :: forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c
<*> :: forall a b. PureM (a -> b) -> PureM a -> PureM b
$c<*> :: forall a b. PureM (a -> b) -> PureM a -> PureM b
pure :: forall a. a -> PureM a
$cpure :: forall a. a -> PureM a
Applicative, Applicative PureM
Applicative PureM
-> (forall a b. PureM a -> (a -> PureM b) -> PureM b)
-> (forall a b. PureM a -> PureM b -> PureM b)
-> (forall a. a -> PureM a)
-> Monad PureM
forall a. a -> PureM a
forall a b. PureM a -> PureM b -> PureM b
forall a b. PureM a -> (a -> PureM b) -> PureM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> PureM a
$creturn :: forall a. a -> PureM a
>> :: forall a b. PureM a -> PureM b -> PureM b
$c>> :: forall a b. PureM a -> PureM b -> PureM b
>>= :: forall a b. PureM a -> (a -> PureM b) -> PureM b
$c>>= :: forall a b. PureM a -> (a -> PureM b) -> PureM b
Monad, Monad PureM
Monad PureM -> (forall a. IO a -> PureM a) -> MonadIO PureM
forall a. IO a -> PureM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> PureM a
$cliftIO :: forall a. IO a -> PureM a
MonadIO, Monad PureM
Monad PureM
-> (forall e a. Exception e => e -> PureM a) -> MonadThrow PureM
forall e a. Exception e => e -> PureM a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> PureM a
$cthrowM :: forall e a. Exception e => e -> PureM a
MonadThrow, MonadThrow PureM
MonadThrow PureM
-> (forall e a.
Exception e =>
PureM a -> (e -> PureM a) -> PureM a)
-> MonadCatch PureM
forall e a. Exception e => PureM a -> (e -> PureM a) -> PureM a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a. Exception e => PureM a -> (e -> PureM a) -> PureM a
$ccatch :: forall e a. Exception e => PureM a -> (e -> PureM a) -> PureM a
MonadCatch,
MonadReader (IORef PureState), MonadWriter LogsInfo, Monad PureM
Monad PureM -> (forall a. String -> PureM a) -> MonadFail PureM
forall a. String -> PureM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> PureM a
$cfail :: forall a. String -> PureM a
MonadFail)
data TestError
= UnexpectedTypeCheckError TCError
| UnexpectedStorageType (MismatchError T.T)
| UnexpectedBigMapType Natural (MismatchError T.T)
| CustomTestError Text
deriving stock Int -> TestError -> ShowS
[TestError] -> ShowS
TestError -> String
(Int -> TestError -> ShowS)
-> (TestError -> String)
-> ([TestError] -> ShowS)
-> Show TestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestError] -> ShowS
$cshowList :: [TestError] -> ShowS
show :: TestError -> String
$cshow :: TestError -> String
showsPrec :: Int -> TestError -> ShowS
$cshowsPrec :: Int -> TestError -> ShowS
Show
makeLenses ''PureState
instance Buildable TestError where
build :: TestError -> Builder
build = \case
UnexpectedTypeCheckError TCError
tcErr ->
Builder
"Unexpected type check error. Reason: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TCError
tcErr TCError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
UnexpectedStorageType MismatchError T
merr ->
Builder
"Unexpected storage 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
""
UnexpectedBigMapType Natural
bigMapId MismatchError T
mismatchError ->
[Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"A big_map with the ID " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Natural
bigMapId Natural -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" was found, but it does not have the expected type."
, MismatchError T -> Builder
forall p. Buildable p => p -> Builder
build MismatchError T
mismatchError
]
CustomTestError Text
msg -> Text -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Text
msg
instance Exception TestError where
displayException :: TestError -> String
displayException = TestError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
moneybagAlias :: ImplicitAlias
moneybagAlias :: ImplicitAlias
moneybagAlias = Text -> ImplicitAlias
ImplicitAlias Text
"moneybag"
runEmulatedT :: ImplicitAlias -> EmulatedT PureM a -> IO a
runEmulatedT :: forall a. ImplicitAlias -> EmulatedT PureM a -> IO a
runEmulatedT ImplicitAlias
moneybagAlias' EmulatedT PureM a
scenario = do
let clevelandCaps :: ClevelandCaps PureM
clevelandCaps = ClevelandCaps :: forall (m :: * -> *).
Sender
-> Moneybag
-> ClevelandMiscImpl m
-> (Sender -> ClevelandOpsImpl m)
-> ClevelandCaps m
ClevelandCaps
{ ccSender :: Sender
ccSender = ImplicitAddress -> Sender
Sender ImplicitAddress
genesisAddress
, ccMoneybag :: Moneybag
ccMoneybag = ImplicitAddress -> Moneybag
Moneybag ImplicitAddress
genesisAddress
, ccMiscCap :: ClevelandMiscImpl PureM
ccMiscCap = ClevelandMiscImpl PureM
clevelandMiscImpl
, ccOpsCap :: Sender -> ClevelandOpsImpl PureM
ccOpsCap = Sender -> ClevelandOpsImpl PureM
clevelandOpsImpl
}
caps :: EmulatedCaps PureM
caps = EmulatedImpl PureM -> ClevelandCaps PureM -> EmulatedCaps PureM
forall (m :: * -> *).
EmulatedImpl m -> ClevelandCaps m -> EmulatedCaps m
EmulatedCaps EmulatedImpl PureM
emulatedImpl ClevelandCaps PureM
clevelandCaps
let pureM :: PureM a
pureM = EmulatedT PureM a -> EmulatedCaps PureM -> PureM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT EmulatedT PureM a
scenario EmulatedCaps PureM
caps
IORef PureState
env <- PureState -> IO (IORef PureState)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (ImplicitAlias -> PureState
initEnv ImplicitAlias
moneybagAlias')
(Either SomeException a
res, LogsInfo
_logs) <- WriterT LogsInfo IO (Either SomeException a)
-> IO (Either SomeException a, LogsInfo)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT LogsInfo IO (Either SomeException a)
-> IO (Either SomeException a, LogsInfo))
-> WriterT LogsInfo IO (Either SomeException a)
-> IO (Either SomeException a, LogsInfo)
forall a b. (a -> b) -> a -> b
$ CatchT (WriterT LogsInfo IO) a
-> WriterT LogsInfo IO (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (CatchT (WriterT LogsInfo IO) a
-> WriterT LogsInfo IO (Either SomeException a))
-> CatchT (WriterT LogsInfo IO) a
-> WriterT LogsInfo IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
-> IORef PureState -> CatchT (WriterT LogsInfo IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (PureM a
-> ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
forall a.
PureM a
-> ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
unPureM PureM a
pureM) IORef PureState
env
(SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> IO a) -> Either SomeException a -> IO a
forall a b. (a -> b) -> a -> b
$ Either SomeException a
res
emulatedImpl :: EmulatedImpl PureM
emulatedImpl :: EmulatedImpl PureM
emulatedImpl =
EmulatedImpl :: forall (m :: * -> *).
([(Text, m ())] -> m ())
-> (forall st addr.
(HasCallStack, ToStorageType st addr) =>
addr -> m st)
-> (forall a. m a -> m (LogsInfo, a))
-> (VotingPowers -> m ())
-> EmulatedImpl m
EmulatedImpl
{ eiBranchout :: [(Text, PureM ())] -> PureM ()
eiBranchout = \([(Text, PureM ())]
scenarios :: [(Text, PureM ())]) ->
[(Text, PureM ())]
-> (Element [(Text, PureM ())] -> PureM ()) -> PureM ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ [(Text, PureM ())]
scenarios ((Element [(Text, PureM ())] -> PureM ()) -> PureM ())
-> (Element [(Text, PureM ())] -> PureM ()) -> PureM ()
forall a b. (a -> b) -> a -> b
$ \(Text
name, PureM ()
scenario) -> do
PureState
aliasesState <- PureM PureState
forall s (m :: * -> *). MonadState s m => m s
get
IORef PureState
newRef <- PureState -> PureM (IORef PureState)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef PureState
aliasesState
(IORef PureState -> IORef PureState) -> PureM () -> PureM ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\IORef PureState
_ -> IORef PureState
newRef) PureM ()
scenario PureM ()
-> (Maybe CallStack -> SomeException -> PureM ()) -> PureM ()
forall e a (m :: * -> *).
(Exception e, MonadCatch m) =>
m a -> (Maybe CallStack -> e -> m a) -> m a
`catchWithCallStack` \Maybe CallStack
originalCallStackMb SomeException
err ->
(FailedInBranch -> PureM ())
-> (CallStack -> FailedInBranch -> PureM ())
-> Maybe CallStack
-> FailedInBranch
-> PureM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FailedInBranch -> PureM ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM CallStack -> FailedInBranch -> PureM ()
forall e a (m :: * -> *).
(MonadThrow m, Exception e) =>
CallStack -> e -> m a
throwWithCallStack Maybe CallStack
originalCallStackMb (FailedInBranch -> PureM ()) -> FailedInBranch -> PureM ()
forall a b. (a -> b) -> a -> b
$ Text -> SomeException -> FailedInBranch
failedInsideBranch Text
name SomeException
err
, eiGetStorage :: forall st addr.
(HasCallStack, ToStorageType st addr) =>
addr -> PureM st
eiGetStorage = PureM st -> PureM st
forall (m :: * -> *) a. (HasCallStack, MonadCatch m) => m a -> m a
addCallStack (PureM st -> PureM st) -> (addr -> PureM st) -> addr -> PureM st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureM st -> PureM st
forall a. PureM a -> PureM a
exceptionHandler (PureM st -> PureM st) -> (addr -> PureM st) -> addr -> PureM st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. addr -> PureM st
forall st addr. ToStorageType st addr => addr -> PureM st
getStorageImpl
, eiGetMorleyLogs :: forall a. PureM a -> PureM (LogsInfo, a)
eiGetMorleyLogs = forall a. PureM a -> PureM (LogsInfo, a)
getMorleyLogsImpl
, eiSetVotingPowers :: VotingPowers -> PureM ()
eiSetVotingPowers = ASetter PureState PureState VotingPowers VotingPowers
-> VotingPowers -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((GState -> Identity GState) -> PureState -> Identity PureState
Lens' PureState GState
psGState ((GState -> Identity GState) -> PureState -> Identity PureState)
-> ((VotingPowers -> Identity VotingPowers)
-> GState -> Identity GState)
-> ASetter PureState PureState VotingPowers VotingPowers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingPowers -> Identity VotingPowers)
-> GState -> Identity GState
Lens' GState VotingPowers
gsVotingPowersL)
}
clevelandOpsImpl :: Sender -> ClevelandOpsImpl PureM
clevelandOpsImpl :: Sender -> ClevelandOpsImpl PureM
clevelandOpsImpl (Sender ImplicitAddress
sender) =
(forall a. HasCallStack => PureM a -> PureM a)
-> ClevelandOpsImpl PureM -> ClevelandOpsImpl PureM
forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandOpsImpl m -> ClevelandOpsImpl m
mapClevelandOpsImplExceptions (PureM a -> PureM a
forall (m :: * -> *) a. (HasCallStack, MonadCatch m) => m a -> m a
addCallStack (PureM a -> PureM a) -> (PureM a -> PureM a) -> PureM a -> PureM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureM a -> PureM a
forall a. PureM a -> PureM a
exceptionHandler)
ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
[OperationInfo ClevelandInput]
-> m [OperationInfo ClevelandResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
{ coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput]
-> PureM [OperationInfo ClevelandResult]
coiRunOperationBatch = (OperationInfo ClevelandInput
-> PureM (OperationInfo ClevelandResult))
-> [OperationInfo ClevelandInput]
-> PureM [OperationInfo ClevelandResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM \case
OpOriginate UntypedOriginateData{Mutez
Contract
Value
ContractAlias
uodContract :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Contract
uodStorage :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Value
uodBalance :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Mutez
uodName :: forall (large :: LargeOrigination).
UntypedOriginateData large -> ContractAlias
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: ContractAlias
..} -> do
ContractAddress -> OperationInfo ClevelandResult
forall i. OriginationInfo i -> OperationInfo i
OpOriginate (ContractAddress -> OperationInfo ClevelandResult)
-> PureM ContractAddress -> PureM (OperationInfo ClevelandResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contract
-> ContractAlias -> Value -> Mutez -> PureM ContractAddress
originate Contract
uodContract ContractAlias
uodName Value
uodStorage Mutez
uodBalance
OpTransfer TransferData{v
addr
Mutez
EpName
tdParameter :: ()
tdEntrypoint :: TransferData -> EpName
tdAmount :: TransferData -> Mutez
tdTo :: ()
tdParameter :: v
tdEntrypoint :: EpName
tdAmount :: Mutez
tdTo :: addr
..} -> do
let fromAddr :: NamedF Identity ImplicitAddress "from"
fromAddr = IsLabel "from" (Name "from")
Name "from"
#from Name "from"
-> ImplicitAddress -> NamedF Identity ImplicitAddress "from"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! ImplicitAddress
sender
let toAddr :: NamedF Identity L1Address "to"
toAddr = IsLabel "to" (Name "to")
Name "to"
#to Name "to" -> L1Address -> NamedF Identity L1Address "to"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! addr -> L1Address
forall addr. ToL1Address addr => addr -> L1Address
toL1Address addr
tdTo
Bool
refillable <- ImplicitAddress -> PureM Bool
isAddressRefillable ImplicitAddress
sender
Bool -> PureM () -> PureM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
refillable (PureM () -> PureM ()) -> PureM () -> PureM ()
forall a b. (a -> b) -> a -> b
$ do
Mutez
balance <- ImplicitAddress -> PureM Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> PureM Mutez
getBalance ImplicitAddress
sender
Bool -> PureM () -> PureM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Mutez
balance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< Mutez
tdAmount) (PureM () -> PureM ()) -> PureM () -> PureM ()
forall a b. (a -> b) -> a -> b
$ do
let moneybag :: NamedF Identity ImplicitAddress "from"
moneybag = IsLabel "from" (Name "from")
Name "from"
#from Name "from"
-> ImplicitAddress -> NamedF Identity ImplicitAddress "from"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! ImplicitAddress
genesisAddress
toSender :: NamedF Identity ImplicitAddress "to"
toSender = IsLabel "to" (Name "to")
Name "to"
#to Name "to"
-> ImplicitAddress -> NamedF Identity ImplicitAddress "to"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! ImplicitAddress
sender
PureM [EmitOperation] -> PureM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PureM [EmitOperation] -> PureM ())
-> PureM [EmitOperation] -> PureM ()
forall a b. (a -> b) -> a -> b
$ forall cp vd epRef epArg addr.
(HasEntrypointArg cp epRef epArg, IsoValue epArg,
ToTAddress cp vd addr) =>
NamedF Identity ImplicitAddress "from"
-> ("to" :! addr)
-> Mutez
-> epRef
-> epArg
-> PureM [EmitOperation]
transfer @() NamedF Identity ImplicitAddress "from"
moneybag NamedF Identity ImplicitAddress "to"
toSender (HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
unsafeSubMutez Mutez
tdAmount Mutez
balance)
(EpName -> TrustEpName
TrustEpName EpName
DefEpName) ()
[EmitOperation]
emitOps <- forall cp vd epRef epArg addr.
(HasEntrypointArg cp epRef epArg, IsoValue epArg,
ToTAddress cp vd addr) =>
NamedF Identity ImplicitAddress "from"
-> ("to" :! addr)
-> Mutez
-> epRef
-> epArg
-> PureM [EmitOperation]
transfer @() NamedF Identity ImplicitAddress "from"
fromAddr NamedF Identity L1Address "to"
toAddr Mutez
tdAmount
(EpName -> TrustEpName
TrustEpName EpName
tdEntrypoint) v
tdParameter
return $ TransferInfo ClevelandResult -> OperationInfo ClevelandResult
forall i. TransferInfo i -> OperationInfo i
OpTransfer (TransferInfo ClevelandResult -> OperationInfo ClevelandResult)
-> TransferInfo ClevelandResult -> OperationInfo ClevelandResult
forall a b. (a -> b) -> a -> b
$ EmitOperation -> ContractEvent
emitOpToContractEvent (EmitOperation -> ContractEvent)
-> [EmitOperation] -> [ContractEvent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EmitOperation]
emitOps
OpReveal{} -> do
OperationInfo ClevelandResult
-> PureM (OperationInfo ClevelandResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (OperationInfo ClevelandResult
-> PureM (OperationInfo ClevelandResult))
-> OperationInfo ClevelandResult
-> PureM (OperationInfo ClevelandResult)
forall a b. (a -> b) -> a -> b
$ RevealInfo ClevelandResult -> OperationInfo ClevelandResult
forall i. RevealInfo i -> OperationInfo i
OpReveal ()
}
emitOpToContractEvent :: EmitOperation -> ContractEvent
emitOpToContractEvent :: EmitOperation -> ContractEvent
emitOpToContractEvent EmitOperation{eoEmit :: ()
eoEmit=T.Emit{Text
GlobalCounter
Notes t
Value' Instr t
emValue :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> Value' instr t
emTag :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Text
emNotes :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Notes t
emCounter :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> GlobalCounter
emCounter :: GlobalCounter
emValue :: Value' Instr t
emNotes :: Notes t
emTag :: Text
..},ContractAddress
eoSource :: EmitOperation -> ContractAddress
eoSource :: ContractAddress
..} = ContractEvent :: ContractAddress
-> Text -> Maybe SomeAnnotatedValue -> ContractEvent
ContractEvent
{ cePayload :: Maybe SomeAnnotatedValue
cePayload = case Notes t -> T
forall (t :: T). Notes t -> T
T.notesT Notes t
emNotes of
T
T.TUnit -> Maybe SomeAnnotatedValue
forall a. Maybe a
Nothing
T
_ -> SomeAnnotatedValue -> Maybe SomeAnnotatedValue
forall a. a -> Maybe a
Just (SomeAnnotatedValue -> Maybe SomeAnnotatedValue)
-> SomeAnnotatedValue -> Maybe SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$ Notes t -> Value' Instr t -> SomeAnnotatedValue
forall (t :: T).
SingI t =>
Notes t -> Value t -> SomeAnnotatedValue
SomeAnnotatedValue Notes t
emNotes Value' Instr t
emValue
, ceTag :: Text
ceTag = Text
emTag
, ceSource :: ContractAddress
ceSource = ContractAddress
eoSource
}
clevelandMiscImpl :: ClevelandMiscImpl PureM
clevelandMiscImpl :: ClevelandMiscImpl PureM
clevelandMiscImpl =
(forall a. HasCallStack => PureM a -> PureM a)
-> ClevelandMiscImpl PureM -> ClevelandMiscImpl PureM
forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandMiscImpl m -> ClevelandMiscImpl m
mapClevelandMiscImplExceptions (PureM a -> PureM a
forall (m :: * -> *) a. (HasCallStack, MonadCatch m) => m a -> m a
addCallStack (PureM a -> PureM a) -> (PureM a -> PureM a) -> PureM a -> PureM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureM a -> PureM a
forall a. PureM a -> PureM a
exceptionHandler)
ClevelandMiscImpl :: forall (m :: * -> *).
(forall res. HasCallStack => IO res -> m res)
-> (forall (kind :: AddressKind).
HasCallStack =>
Alias kind -> m (KindedAddress kind))
-> (HasCallStack => SpecificOrDefaultAlias -> m ImplicitAddress)
-> (HasCallStack => SpecificOrDefaultAlias -> m ImplicitAddress)
-> (HasCallStack => ByteString -> ImplicitAddress -> m Signature)
-> (HasCallStack =>
Sender -> UntypedOriginateData 'IsLarge -> m ContractAddress)
-> (HasCallStack => Text -> m ())
-> (HasCallStack => L1Address -> m Mutez)
-> (HasCallStack => ContractAddress -> m SomeAnnotatedValue)
-> (forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v))
-> (forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v]))
-> (HasCallStack => ImplicitAddress -> m PublicKey)
-> (HasCallStack => ContractAddress -> m (Maybe KeyHash))
-> (HasCallStack => ImplicitAddress -> m ())
-> (HasCallStack => m ChainId)
-> (forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ())
-> (HasCallStack => (Natural -> Natural) -> m ())
-> (HasCallStack => m Timestamp)
-> (HasCallStack => m Natural)
-> (forall a. HasCallStack => Builder -> m a)
-> (forall a. HasCallStack => SomeException -> m a)
-> (HasCallStack => m (Time Second))
-> (forall a e.
(Exception e, HasCallStack) =>
m a -> m (Either e a))
-> (ImplicitAddress -> m ())
-> m (Either (EmulatedImpl m) NetworkEnv)
-> (forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st))
-> ClevelandMiscImpl m
ClevelandMiscImpl
{ cmiRunIO :: forall res. HasCallStack => IO res -> PureM res
cmiRunIO = \IO res
action -> IO (Either SomeException res) -> PureM (Either SomeException res)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO res -> IO (Either SomeException res)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try IO res
action) PureM (Either SomeException res)
-> (Either SomeException res -> PureM res) -> PureM res
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right res
res -> res -> PureM res
forall (f :: * -> *) a. Applicative f => a -> f a
pure res
res
Left (SomeException
err :: SomeException) -> SomeException -> PureM res
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
err
, cmiResolveAddress :: forall (kind :: AddressKind).
HasCallStack =>
Alias kind -> PureM (KindedAddress kind)
cmiResolveAddress = \case
a :: Alias kind
a@ImplicitAlias{} -> ImplicitAlias -> PureM ImplicitAddress
resolveImplicit Alias kind
ImplicitAlias
a
a :: Alias kind
a@ContractAlias{} -> ContractAlias -> PureM ContractAddress
resolveContract Alias kind
ContractAlias
a
, cmiSignBytes :: HasCallStack => ByteString -> ImplicitAddress -> PureM Signature
cmiSignBytes = \ByteString
bs ImplicitAddress
addr -> do
SecretKey
sk <- ImplicitAddress -> PureM SecretKey
getSecretKey ImplicitAddress
addr
IO Signature -> PureM Signature
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Signature -> PureM Signature)
-> IO Signature -> PureM Signature
forall a b. (a -> b) -> a -> b
$ SecretKey -> ByteString -> IO Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign SecretKey
sk ByteString
bs
, cmiGenKey :: HasCallStack => SpecificOrDefaultAlias -> PureM ImplicitAddress
cmiGenKey = \SpecificOrDefaultAlias
sodAlias -> do
ImplicitAlias
alias <- SpecificOrDefaultAlias -> PureM ImplicitAlias
forall {m :: * -> *}.
MonadState PureState m =>
SpecificOrDefaultAlias -> m ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
Maybe ImplicitAddress -> ImplicitAlias -> PureM ImplicitAddress
smartGenKey Maybe ImplicitAddress
forall a. Maybe a
Nothing ImplicitAlias
alias
, cmiGenFreshKey :: HasCallStack => SpecificOrDefaultAlias -> PureM ImplicitAddress
cmiGenFreshKey =
\SpecificOrDefaultAlias
sodAlias -> do
ImplicitAlias
alias <- SpecificOrDefaultAlias -> PureM ImplicitAlias
forall {m :: * -> *}.
MonadState PureState m =>
SpecificOrDefaultAlias -> m ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
Maybe ImplicitAddress
existingAddr <- Getting (Maybe ImplicitAddress) PureState (Maybe ImplicitAddress)
-> PureM (Maybe ImplicitAddress)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Maybe ImplicitAddress) GState)
-> PureState -> Const (Maybe ImplicitAddress) PureState
Lens' PureState GState
psGState ((GState -> Const (Maybe ImplicitAddress) GState)
-> PureState -> Const (Maybe ImplicitAddress) PureState)
-> ((Maybe ImplicitAddress
-> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
-> GState -> Const (Maybe ImplicitAddress) GState)
-> Getting
(Maybe ImplicitAddress) PureState (Maybe ImplicitAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias ImplicitAddress
-> Const
(Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Const (Maybe ImplicitAddress) GState
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL ((Bimap ImplicitAlias ImplicitAddress
-> Const
(Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Const (Maybe ImplicitAddress) GState)
-> ((Maybe ImplicitAddress
-> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
-> Bimap ImplicitAlias ImplicitAddress
-> Const
(Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
-> (Maybe ImplicitAddress
-> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
-> GState
-> Const (Maybe ImplicitAddress) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias ImplicitAddress)
-> Lens'
(Bimap ImplicitAlias ImplicitAddress)
(Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ImplicitAlias ImplicitAddress)
ImplicitAlias
alias)
Maybe ImplicitAddress -> ImplicitAlias -> PureM ImplicitAddress
smartGenKey Maybe ImplicitAddress
existingAddr ImplicitAlias
alias
, cmiOriginateLargeUntyped :: HasCallStack =>
Sender -> UntypedOriginateData 'IsLarge -> PureM ContractAddress
cmiOriginateLargeUntyped = HasCallStack =>
Sender -> UntypedOriginateData 'IsLarge -> PureM ContractAddress
Sender -> UntypedOriginateData 'IsLarge -> PureM ContractAddress
originateUntyped
, cmiComment :: HasCallStack => Text -> PureM ()
cmiComment = PureM () -> Text -> PureM ()
forall a b. a -> b -> a
const PureM ()
forall (f :: * -> *). Applicative f => f ()
pass
, cmiGetPublicKey :: HasCallStack => ImplicitAddress -> PureM PublicKey
cmiGetPublicKey = \ImplicitAddress
addr -> do
SecretKey -> PublicKey
toPublic (SecretKey -> PublicKey) -> PureM SecretKey -> PureM PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImplicitAddress -> PureM SecretKey
getSecretKey ImplicitAddress
addr
, cmiGetDelegate :: HasCallStack => ContractAddress -> PureM (Maybe KeyHash)
cmiGetDelegate = \ContractAddress
addr -> do
ContractState Mutez
_ Contract cp st
_ Value st
_ Maybe KeyHash
delegate <- ContractAddress -> PureM ContractState
contractStorage ContractAddress
addr
Maybe KeyHash -> PureM (Maybe KeyHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe KeyHash
delegate
, cmiRegisterDelegate :: HasCallStack => ImplicitAddress -> PureM ()
cmiRegisterDelegate = PureM () -> ImplicitAddress -> PureM ()
forall a b. a -> b -> a
const PureM ()
forall (f :: * -> *). Applicative f => f ()
pass
, cmiGetChainId :: HasCallStack => PureM ChainId
cmiGetChainId = Getting ChainId PureState ChainId -> PureM ChainId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting ChainId PureState ChainId -> PureM ChainId)
-> Getting ChainId PureState ChainId -> PureM ChainId
forall a b. (a -> b) -> a -> b
$ (GState -> Const ChainId GState)
-> PureState -> Const ChainId PureState
Lens' PureState GState
psGState ((GState -> Const ChainId GState)
-> PureState -> Const ChainId PureState)
-> ((ChainId -> Const ChainId ChainId)
-> GState -> Const ChainId GState)
-> Getting ChainId PureState ChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainId -> Const ChainId ChainId)
-> GState -> Const ChainId GState
Lens' GState ChainId
gsChainIdL
, cmiAdvanceTime :: forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> PureM ()
cmiAdvanceTime = \Time unit
time -> do
ASetter PureState PureState Timestamp Timestamp
-> (Timestamp -> Timestamp) -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter PureState PureState Timestamp Timestamp
Lens' PureState Timestamp
psNow ((Timestamp -> Timestamp) -> PureM ())
-> (Integer -> Timestamp -> Timestamp) -> Integer -> PureM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Timestamp -> Integer -> Timestamp)
-> Integer -> Timestamp -> Timestamp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Timestamp -> Integer -> Timestamp
timestampPlusSeconds (Integer -> PureM ()) -> Integer -> PureM ()
forall a b. (a -> b) -> a -> b
$
forall (unitTo :: Rat) n (unit :: Rat).
(KnownDivRat unit unitTo, Num n) =>
Time unit -> n
toNum @Second @Integer (Time (1 :% 1) -> Integer) -> Time (1 :% 1) -> Integer
forall a b. (a -> b) -> a -> b
$ Time (1 :% 1) -> Time (1 :% 1)
forall (unit :: Rat). Time unit -> Time unit
ceilingUnit (Time (1 :% 1) -> Time (1 :% 1)) -> Time (1 :% 1) -> Time (1 :% 1)
forall a b. (a -> b) -> a -> b
$ forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second Time unit
time
, cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> PureM ()
cmiAdvanceToLevel = \Natural -> Natural
fn ->
ASetter PureState PureState Natural Natural
-> (Natural -> Natural) -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter PureState PureState Natural Natural
Lens' PureState Natural
psLevel (\Natural
cl -> Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max (Natural -> Natural
fn Natural
cl) Natural
cl)
, cmiGetNow :: HasCallStack => PureM Timestamp
cmiGetNow = Getting Timestamp PureState Timestamp -> PureM Timestamp
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Timestamp PureState Timestamp
Lens' PureState Timestamp
psNow
, cmiGetLevel :: HasCallStack => PureM Natural
cmiGetLevel = Getting Natural PureState Natural -> PureM Natural
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Natural PureState Natural
Lens' PureState Natural
psLevel
, cmiGetApproximateBlockInterval :: HasCallStack => PureM (Time Second)
cmiGetApproximateBlockInterval = RatioNat -> Time (1 :% 1)
RatioNat -> Time Second
sec (RatioNat -> Time (1 :% 1))
-> (Natural -> RatioNat) -> Natural -> Time (1 :% 1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> RatioNat
forall a. Integral a => a -> a -> Ratio a
% Natural
1) (Natural -> Time (1 :% 1))
-> PureM Natural -> PureM (Time (1 :% 1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Natural PureState Natural -> PureM Natural
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Natural PureState Natural
Lens' PureState Natural
psMinBlockTime
, cmiAttempt :: forall a e.
(Exception e, HasCallStack) =>
PureM a -> PureM (Either e a)
cmiAttempt = forall a e.
(Exception e, HasCallStack) =>
PureM a -> PureM (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try
, cmiThrow :: forall a. HasCallStack => SomeException -> PureM a
cmiThrow = forall a. HasCallStack => SomeException -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
, cmiMarkAddressRefillable :: ImplicitAddress -> PureM ()
cmiMarkAddressRefillable = ImplicitAddress -> PureM ()
forall {m :: * -> *}.
MonadState PureState m =>
ImplicitAddress -> m ()
setAddressRefillable
, cmiGetBalance :: HasCallStack => L1Address -> PureM Mutez
cmiGetBalance = \(MkConstrainedAddress KindedAddress kind
a) -> KindedAddress kind -> PureM Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> PureM Mutez
getBalance KindedAddress kind
a
, cmiUnderlyingImpl :: PureM (Either (EmulatedImpl PureM) NetworkEnv)
cmiUnderlyingImpl = Either (EmulatedImpl PureM) NetworkEnv
-> PureM (Either (EmulatedImpl PureM) NetworkEnv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (EmulatedImpl PureM) NetworkEnv
-> PureM (Either (EmulatedImpl PureM) NetworkEnv))
-> Either (EmulatedImpl PureM) NetworkEnv
-> PureM (Either (EmulatedImpl PureM) NetworkEnv)
forall a b. (a -> b) -> a -> b
$ EmulatedImpl PureM -> Either (EmulatedImpl PureM) NetworkEnv
forall a b. a -> Either a b
Left EmulatedImpl PureM
emulatedImpl
, cmiFailure :: forall a. HasCallStack => Builder -> PureM a
cmiFailure = forall a. HasCallStack => Builder -> PureM a
forall a. Builder -> PureM a
failure
, HasCallStack => ContractAddress -> PureM SomeAnnotatedValue
ContractAddress -> PureM SomeAnnotatedValue
forall {k} {v}.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> PureM (Maybe [v])
forall {k} {v}.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> PureM (Maybe [v])
forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
forall {cp} {st} {vd}.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiRunCode :: forall {cp} {st} {vd}.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiGetAllBigMapValuesMaybe :: forall {k} {v}.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> PureM (Maybe [v])
cmiGetBigMapValueMaybe :: forall {k} {v}.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
cmiGetSomeStorage :: HasCallStack => ContractAddress -> PureM SomeAnnotatedValue
cmiRunCode :: forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiGetSomeStorage :: ContractAddress -> PureM SomeAnnotatedValue
cmiGetAllBigMapValuesMaybe :: forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> PureM (Maybe [v])
cmiGetBigMapValueMaybe :: forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
..
}
where
setAddressRefillable :: ImplicitAddress -> m ()
setAddressRefillable ImplicitAddress
addr = (Set ImplicitAddress -> Identity (Set ImplicitAddress))
-> PureState -> Identity PureState
Lens' PureState (Set ImplicitAddress)
psRefillableAddresses ((Set ImplicitAddress -> Identity (Set ImplicitAddress))
-> PureState -> Identity PureState)
-> (Set ImplicitAddress -> Set ImplicitAddress) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ImplicitAddress -> Set ImplicitAddress -> Set ImplicitAddress
forall a. Ord a => a -> Set a -> Set a
Set.insert ImplicitAddress
addr
originateUntyped :: Sender -> UntypedOriginateData 'IsLarge -> PureM ContractAddress
originateUntyped :: Sender -> UntypedOriginateData 'IsLarge -> PureM ContractAddress
originateUntyped Sender
_ UntypedOriginateData {Mutez
Contract
Value
ContractAlias
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: ContractAlias
uodContract :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Contract
uodStorage :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Value
uodBalance :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Mutez
uodName :: forall (large :: LargeOrigination).
UntypedOriginateData large -> ContractAlias
..} = do
Contract
-> ContractAlias -> Value -> Mutez -> PureM ContractAddress
originate Contract
uodContract ContractAlias
uodName Value
uodStorage Mutez
uodBalance
cmiGetBigMapValueMaybe
:: forall k v.
(NiceComparable k, IsoValue v)
=> BigMapId k v
-> k
-> PureM (Maybe v)
cmiGetBigMapValueMaybe :: forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
cmiGetBigMapValueMaybe (BigMapId Natural
bmId) k
k = MaybeT PureM v -> PureM (Maybe v)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
VBigMap Maybe Natural
_ Map (Value' Instr k) (Value' Instr v)
bigMap <- forall (k :: T) (v :: T).
(SingI v, SingI k) =>
Natural -> MaybeT PureM (Value ('TBigMap k v))
findBigMapByIdMaybe @(ToT k) @(ToT v) Natural
bmId
Maybe v -> MaybeT PureM v
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe v -> MaybeT PureM v) -> Maybe v -> MaybeT PureM v
forall a b. (a -> b) -> a -> b
$ forall a. IsoValue a => Value (ToT a) -> a
fromVal @v (Value' Instr v -> v) -> Maybe (Value' Instr v) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value' Instr k
-> Map (Value' Instr k) (Value' Instr v) -> Maybe (Value' Instr v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k -> Value' Instr (ToT k)
forall a. IsoValue a => a -> Value (ToT a)
toVal k
k) Map (Value' Instr k) (Value' Instr v)
bigMap
cmiGetAllBigMapValuesMaybe
:: forall k v.
(NiceComparable k, IsoValue v)
=> BigMapId k v
-> PureM (Maybe [v])
cmiGetAllBigMapValuesMaybe :: forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> PureM (Maybe [v])
cmiGetAllBigMapValuesMaybe (BigMapId Natural
bmId) = MaybeT PureM [v] -> PureM (Maybe [v])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
VBigMap Maybe Natural
_ Map (Value' Instr k) (Value' Instr v)
bigMap <- forall (k :: T) (v :: T).
(SingI v, SingI k) =>
Natural -> MaybeT PureM (Value ('TBigMap k v))
findBigMapByIdMaybe @(ToT k) @(ToT v) Natural
bmId
[v] -> MaybeT PureM [v]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([v] -> MaybeT PureM [v]) -> [v] -> MaybeT PureM [v]
forall a b. (a -> b) -> a -> b
$ forall a. IsoValue a => Value (ToT a) -> a
fromVal @v (Value' Instr v -> v) -> [Value' Instr v] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (Value' Instr k) (Value' Instr v) -> [Value' Instr v]
forall k a. Map k a -> [a]
Map.elems Map (Value' Instr k) (Value' Instr v)
bigMap
cmiGetSomeStorage :: ContractAddress -> PureM SomeAnnotatedValue
cmiGetSomeStorage :: ContractAddress -> PureM SomeAnnotatedValue
cmiGetSomeStorage ContractAddress
addr = do
ContractState Mutez
_ Contract cp st
contract (Value st
storage :: Value t) Maybe KeyHash
_ <- ContractAddress -> PureM ContractState
contractStorage ContractAddress
addr
SomeAnnotatedValue -> PureM SomeAnnotatedValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeAnnotatedValue -> PureM SomeAnnotatedValue)
-> SomeAnnotatedValue -> PureM SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$
Notes (TAsRPC st) -> Value (TAsRPC st) -> SomeAnnotatedValue
forall (t :: T).
SingI t =>
Notes t -> Value t -> SomeAnnotatedValue
SomeAnnotatedValue
(Notes st -> Notes (TAsRPC st)
forall (t :: T). Notes t -> Notes (TAsRPC t)
notesAsRPC (Notes st -> Notes (TAsRPC st)) -> Notes st -> Notes (TAsRPC st)
forall a b. (a -> b) -> a -> b
$ Contract cp st -> Notes st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
T.cStoreNotes Contract cp st
contract)
(Value st -> Value (TAsRPC st)
forall (t :: T). HasCallStack => Value t -> Value (TAsRPC t)
valueAsRPC Value st
storage)
(StorageScope (TAsRPC st) => SomeAnnotatedValue)
-> (StorageScope st :- StorageScope (TAsRPC st))
-> SomeAnnotatedValue
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (t :: T). StorageScope t :- StorageScope (TAsRPC t)
rpcStorageScopeEvi @t
smartGenKey :: Maybe ImplicitAddress -> ImplicitAlias -> PureM ImplicitAddress
smartGenKey :: Maybe ImplicitAddress -> ImplicitAlias -> PureM ImplicitAddress
smartGenKey Maybe ImplicitAddress
existingAddr alias :: ImplicitAlias
alias@(ImplicitAlias Text
aliasTxt) = do
let
seed :: Text
seed = Text -> (ImplicitAddress -> Text) -> Maybe ImplicitAddress -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
aliasTxt (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
aliasTxt (Text -> Text)
-> (ImplicitAddress -> Text) -> ImplicitAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddress -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Maybe ImplicitAddress
existingAddr
sk :: SecretKey
sk = HasCallStack => ByteString -> SecretKey
ByteString -> SecretKey
detSecretKey (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
seed)
addr :: ImplicitAddress
addr = ByteString -> ImplicitAddress
detGenKeyAddress (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
seed)
(GState -> Identity GState) -> PureState -> Identity PureState
Lens' PureState GState
psGState ((GState -> Identity GState) -> PureState -> Identity PureState)
-> ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> GState -> Identity GState)
-> (Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> PureState
-> Identity PureState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias ImplicitAddress
-> Identity (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Identity GState
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL ((Bimap ImplicitAlias ImplicitAddress
-> Identity (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Identity GState)
-> ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> Bimap ImplicitAlias ImplicitAddress
-> Identity (Bimap ImplicitAlias ImplicitAddress))
-> (Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> GState
-> Identity GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias ImplicitAddress)
-> Lens'
(Bimap ImplicitAlias ImplicitAddress)
(Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ImplicitAlias ImplicitAddress)
ImplicitAlias
alias ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> PureState -> Identity PureState)
-> ImplicitAddress -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= ImplicitAddress
addr
(Map ImplicitAddress SecretKey
-> Identity (Map ImplicitAddress SecretKey))
-> PureState -> Identity PureState
Lens' PureState (Map ImplicitAddress SecretKey)
psSecretKeys ((Map ImplicitAddress SecretKey
-> Identity (Map ImplicitAddress SecretKey))
-> PureState -> Identity PureState)
-> ((Maybe SecretKey -> Identity (Maybe SecretKey))
-> Map ImplicitAddress SecretKey
-> Identity (Map ImplicitAddress SecretKey))
-> (Maybe SecretKey -> Identity (Maybe SecretKey))
-> PureState
-> Identity PureState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ImplicitAddress SecretKey)
-> Lens'
(Map ImplicitAddress SecretKey)
(Maybe (IxValue (Map ImplicitAddress SecretKey)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ImplicitAddress SecretKey)
ImplicitAddress
addr ((Maybe SecretKey -> Identity (Maybe SecretKey))
-> PureState -> Identity PureState)
-> Maybe SecretKey -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
sk
pure ImplicitAddress
addr
resolveSpecificOrDefaultAlias :: SpecificOrDefaultAlias -> m ImplicitAlias
resolveSpecificOrDefaultAlias (SpecificAlias ImplicitAlias
alias) =
ImplicitAlias -> m ImplicitAlias
forall (m :: * -> *) a. Monad m => a -> m a
return ImplicitAlias
alias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
DefaultAlias = do
DefaultAliasCounter Natural
counter <- Getting DefaultAliasCounter PureState DefaultAliasCounter
-> m DefaultAliasCounter
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting DefaultAliasCounter PureState DefaultAliasCounter
Lens' PureState DefaultAliasCounter
psDefaultAliasesCounter
(DefaultAliasCounter -> Identity DefaultAliasCounter)
-> PureState -> Identity PureState
Lens' PureState DefaultAliasCounter
psDefaultAliasesCounter ((DefaultAliasCounter -> Identity DefaultAliasCounter)
-> PureState -> Identity PureState)
-> (DefaultAliasCounter -> DefaultAliasCounter) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \(DefaultAliasCounter Natural
i) -> Natural -> DefaultAliasCounter
DefaultAliasCounter (Natural -> DefaultAliasCounter) -> Natural -> DefaultAliasCounter
forall a b. (a -> b) -> a -> b
$ Natural
i Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
return $ Natural -> ImplicitAlias
mkDefaultAlias Natural
counter
cmiRunCode
:: forall cp st vd. (HasRPCRepr st, T.IsoValue (AsRPC st))
=> Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiRunCode :: forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiRunCode (Sender ImplicitAddress
sender) (RunCode Contract cp st vd
rcContract Value
rcParameter Value
rcStorage Mutez
rcAmount Maybe Natural
rcLevel Maybe Timestamp
rcNow Mutez
rcBalance Maybe ImplicitAddress
rcSource) = do
L.Contract{} <- Contract cp st vd -> PureM (Contract cp st vd)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contract cp st vd
rcContract
Value (ToT cp)
param <- forall (t :: T). SingI t => Value -> PureM (Value t)
typeCheckVal @(ToT cp) Value
rcParameter
Value (ToT st)
storage <- forall (t :: T). SingI t => Value -> PureM (Value t)
typeCheckVal @(ToT st) Value
rcStorage
(Timestamp
now, Natural
level) <- Getting (Timestamp, Natural) PureState (Timestamp, Natural)
-> PureM (Timestamp, Natural)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Timestamp, Natural) PureState (Timestamp, Natural)
-> PureM (Timestamp, Natural))
-> Getting (Timestamp, Natural) PureState (Timestamp, Natural)
-> PureM (Timestamp, Natural)
forall a b. (a -> b) -> a -> b
$ (Timestamp -> Pretext (->) Timestamp Timestamp Timestamp)
-> PureState -> Pretext (->) Timestamp Timestamp PureState
Lens' PureState Timestamp
psNow ((Timestamp -> Pretext (->) Timestamp Timestamp Timestamp)
-> PureState -> Pretext (->) Timestamp Timestamp PureState)
-> ALens' PureState Natural
-> Getting (Timestamp, Natural) PureState (Timestamp, Natural)
forall s a b. ALens' s a -> ALens' s b -> Lens' s (a, b)
`lensProduct` ALens' PureState Natural
Lens' PureState Natural
psLevel
ASetter PureState PureState Timestamp Timestamp
Lens' PureState Timestamp
psNow ASetter PureState PureState Timestamp Timestamp
-> (Timestamp -> Timestamp) -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Timestamp -> Timestamp)
-> (Timestamp -> Timestamp -> Timestamp)
-> Maybe Timestamp
-> Timestamp
-> Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Timestamp -> Timestamp
forall a. a -> a
id Timestamp -> Timestamp -> Timestamp
forall a b. a -> b -> a
const Maybe Timestamp
rcNow
ASetter PureState PureState Natural Natural
Lens' PureState Natural
psLevel ASetter PureState PureState Natural Natural
-> (Natural -> Natural) -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Natural -> Natural)
-> (Natural -> Natural -> Natural)
-> Maybe Natural
-> Natural
-> Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Natural -> Natural
forall a. a -> a
id Natural -> Natural -> Natural
forall a b. a -> b -> a
const Maybe Natural
rcLevel
Either ExecutorError (ExecutorRes, ContractAddress)
res <- ExecutorM ContractAddress
-> PureM (Either ExecutorError (ExecutorRes, ContractAddress))
forall a.
ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret do
GlobalCounter
counter0 <- Getting GlobalCounter ExecutorState GlobalCounter
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
GlobalCounter
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting GlobalCounter ExecutorState GlobalCounter
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
GlobalCounter)
-> Getting GlobalCounter ExecutorState GlobalCounter
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
GlobalCounter
forall a b. (a -> b) -> a -> b
$ (GState -> Const GlobalCounter GState)
-> ExecutorState -> Const GlobalCounter ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const GlobalCounter GState)
-> ExecutorState -> Const GlobalCounter ExecutorState)
-> ((GlobalCounter -> Const GlobalCounter GlobalCounter)
-> GState -> Const GlobalCounter GState)
-> Getting GlobalCounter ExecutorState GlobalCounter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalCounter -> Const GlobalCounter GlobalCounter)
-> GState -> Const GlobalCounter GState
Lens' GState GlobalCounter
gsCounterL
ContractAddress
contractAddr <-
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 (OriginationOperation -> ExecutorM ContractAddress)
-> OriginationOperation -> ExecutorM ContractAddress
forall a b. (a -> b) -> a -> b
$
(Value (ToT st)
-> Contract (ToT cp) (ToT st)
-> GlobalCounter
-> OriginationOperation
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Value st -> Contract cp st -> GlobalCounter -> OriginationOperation
dummyOrigination Value (ToT st)
storage (Contract cp st vd -> Contract (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
L.toMichelsonContract Contract cp st vd
rcContract) GlobalCounter
counter0) { ooBalance :: Mutez
ooBalance = Mutez
zeroMutez }
(StorageScope (ToT st) => OriginationOperation)
-> (NiceStorage st :- StorageScope (ToT st))
-> OriginationOperation
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall a. NiceStorage a :- StorageScope (ToT a)
L.niceStorageEvi @st
(ParameterScope (ToT cp) => OriginationOperation)
-> (NiceParameter cp :- ParameterScope (ToT cp))
-> OriginationOperation
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall a. NiceParameter a :- ParameterScope (ToT a)
L.niceParameterEvi @cp
(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 ()
.= (ImplicitAddress -> L1Address
forall (ks :: [AddressKind]) (kind :: AddressKind).
ConstrainAddressKind ks kind =>
KindedAddress kind -> ConstrainedAddress ks
MkConstrainedAddress (ImplicitAddress -> L1Address)
-> Maybe ImplicitAddress -> Maybe L1Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ImplicitAddress
rcSource)
GlobalCounter
counter1 <- Getting GlobalCounter ExecutorState GlobalCounter
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
GlobalCounter
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting GlobalCounter ExecutorState GlobalCounter
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
GlobalCounter)
-> Getting GlobalCounter ExecutorState GlobalCounter
-> ReaderT
ExecutorEnv
(StateT ExecutorState (Except ExecutorError))
GlobalCounter
forall a b. (a -> b) -> a -> b
$ (GState -> Const GlobalCounter GState)
-> ExecutorState -> Const GlobalCounter ExecutorState
Lens' ExecutorState GState
esGState ((GState -> Const GlobalCounter GState)
-> ExecutorState -> Const GlobalCounter ExecutorState)
-> ((GlobalCounter -> Const GlobalCounter GlobalCounter)
-> GState -> Const GlobalCounter GState)
-> Getting GlobalCounter ExecutorState GlobalCounter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalCounter -> Const GlobalCounter GlobalCounter)
-> GState -> Const GlobalCounter GState
Lens' GState GlobalCounter
gsCounterL
let overrideContractBalance :: Maybe Mutez
overrideContractBalance = Mutez -> Maybe Mutez
forall a. a -> Maybe a
Just Mutez
rcBalance
NamedF Identity Bool "isGlobalOp"
-> Maybe Mutez
-> TypeCheckOptions
-> TransferOperation
-> ExecutorM [ExecutorOp]
executeTransfer (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) Maybe Mutez
overrideContractBalance TypeCheckOptions
forall a. Default a => a
def (TransferOperation -> ExecutorM [ExecutorOp])
-> TransferOperation -> ExecutorM [ExecutorOp]
forall a b. (a -> b) -> a -> b
$
TransferOperation :: Address -> TxData -> GlobalCounter -> TransferOperation
TransferOperation
{ toDestination :: Address
toDestination = ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
contractAddr
, toCounter :: GlobalCounter
toCounter = GlobalCounter
counter1
, toTxData :: TxData
toTxData = TxData :: L1Address -> TxParam -> EpName -> Mutez -> TxData
TxData
{ tdSenderAddress :: L1Address
tdSenderAddress = ImplicitAddress -> L1Address
forall (ks :: [AddressKind]) (kind :: AddressKind).
ConstrainAddressKind ks kind =>
KindedAddress kind -> ConstrainedAddress ks
MkConstrainedAddress ImplicitAddress
sender
, tdParameter :: TxParam
tdParameter = Value (ToT cp) -> TxParam
forall (t :: T). ParameterScope t => Value t -> TxParam
TxTypedParam Value (ToT cp)
param (ParameterScope (ToT cp) => TxParam)
-> (NiceParameter cp :- ParameterScope (ToT cp)) -> TxParam
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall a. NiceParameter a :- ParameterScope (ToT a)
L.niceParameterEvi @cp
, tdEntrypoint :: EpName
tdEntrypoint = EpName
DefEpName
, tdAmount :: Mutez
tdAmount = Mutez
rcAmount
}
}
pure ContractAddress
contractAddr
ASetter PureState PureState Timestamp Timestamp
Lens' PureState Timestamp
psNow ASetter PureState PureState Timestamp Timestamp
-> Timestamp -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Timestamp
now
ASetter PureState PureState Natural Natural
Lens' PureState Natural
psLevel ASetter PureState PureState Natural Natural -> Natural -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Natural
level
case Either ExecutorError (ExecutorRes, ContractAddress)
res of
Left ExecutorError
executorError -> ExecutorError -> PureM (AsRPC st)
forall a. ExecutorError -> PureM a
throwEE ExecutorError
executorError
Right (ExecutorRes
executorRes, ContractAddress
contractAddr) -> do
case ExecutorRes
executorRes ExecutorRes
-> Getting (Maybe ContractState) ExecutorRes (Maybe ContractState)
-> Maybe ContractState
forall s a. s -> Getting a s a -> a
^. (GState -> Const (Maybe ContractState) GState)
-> ExecutorRes -> Const (Maybe ContractState) ExecutorRes
Lens' ExecutorRes GState
erGState ((GState -> Const (Maybe ContractState) GState)
-> ExecutorRes -> Const (Maybe ContractState) ExecutorRes)
-> ((Maybe ContractState
-> Const (Maybe ContractState) (Maybe ContractState))
-> GState -> Const (Maybe ContractState) GState)
-> Getting (Maybe ContractState) ExecutorRes (Maybe ContractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ContractAddress ContractState
-> Const (Maybe ContractState) (Map ContractAddress ContractState))
-> GState -> Const (Maybe ContractState) GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL ((Map ContractAddress ContractState
-> Const (Maybe ContractState) (Map ContractAddress ContractState))
-> GState -> Const (Maybe ContractState) GState)
-> ((Maybe ContractState
-> Const (Maybe ContractState) (Maybe ContractState))
-> Map ContractAddress ContractState
-> Const (Maybe ContractState) (Map ContractAddress ContractState))
-> (Maybe ContractState
-> Const (Maybe ContractState) (Maybe ContractState))
-> GState
-> Const (Maybe ContractState) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ContractAddress ContractState)
-> Lens'
(Map ContractAddress ContractState)
(Maybe (IxValue (Map ContractAddress ContractState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ContractAddress ContractState)
ContractAddress
contractAddr of
Maybe ContractState
Nothing ->
Builder -> PureM (AsRPC st)
forall a. Builder -> PureM a
failure (Builder -> PureM (AsRPC st)) -> Builder -> PureM (AsRPC st)
forall a b. (a -> b) -> a -> b
$ Builder
"Internal error: failed to find contract: '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
contractAddr ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"'"
Just (ContractState Mutez
_ Contract cp st
_ (Value st
finalStorage :: Value actualSt) Maybe KeyHash
_) -> do
Value (ToT st)
finalStorage' <- 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)
castM @actualSt @(ToT st) Value st
finalStorage (TestError -> PureM x
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM x)
-> (MismatchError T -> TestError) -> MismatchError T -> PureM x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MismatchError T -> TestError
UnexpectedStorageType)
pure $ Value (ToT (AsRPC st)) -> AsRPC st
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Value (ToT (AsRPC st)) -> AsRPC st)
-> Value (ToT (AsRPC st)) -> AsRPC st
forall a b. (a -> b) -> a -> b
$ Value (ToT st) -> Value (TAsRPC (ToT st))
forall (t :: T). HasCallStack => Value t -> Value (TAsRPC t)
valueAsRPC Value (ToT st)
finalStorage'
where
typeCheckVal :: forall t. SingI t => U.Value -> PureM (Value t)
typeCheckVal :: forall (t :: T). SingI t => Value -> PureM (Value t)
typeCheckVal Value
untypedVal = do
BigMapFinder
bigMapFinder <- PureM BigMapFinder
mkBigMapFinder
let res :: Either TCError (Value t)
res =
TypeCheckOptions
-> TypeCheckResult (Value t) -> Either TCError (Value t)
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith (Bool -> Bool -> TypeCheckOptions
TypeCheckOptions Bool
False Bool
False) (TypeCheckResult (Value t) -> Either TCError (Value t))
-> TypeCheckResult (Value t) -> Either TCError (Value t)
forall a b. (a -> b) -> a -> b
$
BigMapFinder -> Value -> TypeCheckResult (Value t)
forall (t :: T).
SingI t =>
BigMapFinder -> Value -> TypeCheckResult (Value t)
typeCheckValueRunCodeCompat BigMapFinder
bigMapFinder Value
untypedVal
case Either TCError (Value t)
res of
Right Value t
val -> Value t -> PureM (Value t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value t
val
Left TCError
tcErr -> TestError -> PureM (Value t)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM (Value t)) -> TestError -> PureM (Value t)
forall a b. (a -> b) -> a -> b
$ TCError -> TestError
UnexpectedTypeCheckError TCError
tcErr
mkBigMapFinder :: PureM BigMapFinder
mkBigMapFinder :: PureM BigMapFinder
mkBigMapFinder = do
PureState
pureState <- PureM PureState
forall s (m :: * -> *). MonadState s m => m s
get
pure \Natural
bigMapId ->
PureState
pureState PureState
-> Getting (First SomeVBigMap) PureState SomeVBigMap
-> Maybe SomeVBigMap
forall s a. s -> Getting (First a) s a -> Maybe a
^?
(GState -> Const (First SomeVBigMap) GState)
-> PureState -> Const (First SomeVBigMap) PureState
Lens' PureState GState
psGState ((GState -> Const (First SomeVBigMap) GState)
-> PureState -> Const (First SomeVBigMap) PureState)
-> ((SomeVBigMap -> Const (First SomeVBigMap) SomeVBigMap)
-> GState -> Const (First SomeVBigMap) GState)
-> Getting (First SomeVBigMap) PureState 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 -> 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
SomeValue Value st
storage
getBigMapsWithId :: Natural -> SomeValue -> [SomeVBigMap]
getBigMapsWithId :: Natural -> SomeValue -> [SomeVBigMap]
getBigMapsWithId Natural
bigMapId (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
dfsFoldMapValue
(\Value t'
v -> case Value t'
v of
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
SomeVBigMap Value t'
Value ('TBigMap k v)
v]
Value t'
_ -> []
)
Value t
val
findBigMapByIdMaybe
::forall k v. (SingI v, SingI k)
=> Natural -> MaybeT PureM (Value ('T.TBigMap k v))
findBigMapByIdMaybe :: forall (k :: T) (v :: T).
(SingI v, SingI k) =>
Natural -> MaybeT PureM (Value ('TBigMap k v))
findBigMapByIdMaybe Natural
bigMapId = do
SomeVBigMap (v :: Value ('TBigMap k v)
v@VBigMap{} :: Value t) <- PureM (Maybe SomeVBigMap) -> MaybeT PureM SomeVBigMap
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (PureM (Maybe SomeVBigMap) -> MaybeT PureM SomeVBigMap)
-> PureM (Maybe SomeVBigMap) -> MaybeT PureM SomeVBigMap
forall a b. (a -> b) -> a -> b
$ PureM BigMapFinder
mkBigMapFinder PureM BigMapFinder -> PureM Natural -> PureM (Maybe SomeVBigMap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> PureM Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
bigMapId
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)
castM @t @('T.TBigMap k v) Value ('TBigMap k v)
v ((forall x. MismatchError T -> MaybeT PureM x)
-> MaybeT PureM (Value ('TBigMap k v)))
-> (forall x. MismatchError T -> MaybeT PureM x)
-> MaybeT PureM (Value ('TBigMap k v))
forall a b. (a -> b) -> a -> b
$ TestError -> MaybeT PureM x
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> MaybeT PureM x)
-> (MismatchError T -> TestError)
-> MismatchError T
-> MaybeT PureM x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> MismatchError T -> TestError
UnexpectedBigMapType Natural
bigMapId
isAddressRefillable :: ImplicitAddress -> PureM Bool
isAddressRefillable :: ImplicitAddress -> PureM Bool
isAddressRefillable ImplicitAddress
addr = ImplicitAddress -> Set ImplicitAddress -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ImplicitAddress
addr (Set ImplicitAddress -> Bool)
-> PureM (Set ImplicitAddress) -> PureM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Set ImplicitAddress) PureState (Set ImplicitAddress)
-> PureM (Set ImplicitAddress)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Set ImplicitAddress) PureState (Set ImplicitAddress)
Lens' PureState (Set ImplicitAddress)
psRefillableAddresses
getBalance :: L1AddressKind kind => KindedAddress kind -> PureM Mutez
getBalance :: forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> PureM Mutez
getBalance KindedAddress kind
addr = do
GState
gs <- Getting GState PureState GState -> PureM GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState PureState GState
Lens' PureState GState
psGState
pure $ Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe Mutez
zeroMutez (Maybe Mutez -> Mutez) -> Maybe Mutez -> Mutez
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> GState -> Maybe Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> GState -> Maybe Mutez
lookupBalance KindedAddress kind
addr GState
gs
exceptionHandler :: PureM a -> PureM a
exceptionHandler :: forall a. PureM a -> PureM a
exceptionHandler PureM a
action = PureM a -> PureM (Either (ExecutorError' AddressAndAlias) a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try PureM a
action PureM (Either (ExecutorError' AddressAndAlias) a)
-> (Either (ExecutorError' AddressAndAlias) a -> PureM a)
-> PureM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left ExecutorError' AddressAndAlias
err -> ExecutorError' AddressAndAlias -> PureM TransferFailure
exceptionToTransferFailure ExecutorError' AddressAndAlias
err PureM TransferFailure -> (TransferFailure -> PureM a) -> PureM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TransferFailure -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
Right a
res -> a -> PureM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
where
exceptionToTransferFailure :: ExecutorError' AddressAndAlias -> PureM TransferFailure
exceptionToTransferFailure :: ExecutorError' AddressAndAlias -> PureM TransferFailure
exceptionToTransferFailure ExecutorError' AddressAndAlias
err = case ExecutorError' AddressAndAlias
err of
EEZeroTransaction AddressAndAlias
addr -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
EmptyTransaction
EEIllTypedParameter AddressAndAlias
addr TCError
_ -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
BadParameter
EEUnexpectedParameterType AddressAndAlias
addr MismatchError T
_ -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
BadParameter
EEInterpreterFailed AddressAndAlias
addr (InterpretError (MichelsonFailureWithStack{ErrorSrcPos
MichelsonFailed
mfwsFailed :: MichelsonFailureWithStack -> MichelsonFailed
mfwsErrorSrcPos :: MichelsonFailureWithStack -> ErrorSrcPos
mfwsErrorSrcPos :: ErrorSrcPos
mfwsFailed :: MichelsonFailed
..}, MorleyLogs
_)) ->
case MichelsonFailed
mfwsFailed of
MichelsonFailedWith Value t
val -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr (TransferFailureReason -> TransferFailure)
-> TransferFailureReason -> TransferFailure
forall a b. (a -> b) -> a -> b
$
ExpressionOrTypedValue
-> Maybe ErrorSrcPos -> TransferFailureReason
FailedWith (Value t -> ExpressionOrTypedValue
forall (t :: T).
(SingI t, ConstantScope t) =>
Value t -> ExpressionOrTypedValue
EOTVTypedValue Value t
val) (ErrorSrcPos -> Maybe ErrorSrcPos
forall a. a -> Maybe a
Just ErrorSrcPos
mfwsErrorSrcPos)
MichelsonArithError (T.ShiftArithError{}) -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
ShiftOverflow
MichelsonArithError (T.MutezArithError MutezArithErrorType
errType Value n
_ Value m
_) -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr (TransferFailureReason -> TransferFailure)
-> TransferFailureReason -> TransferFailure
forall a b. (a -> b) -> a -> b
$ MutezArithErrorType -> TransferFailureReason
MutezArithError MutezArithErrorType
errType
MichelsonFailed
MichelsonGasExhaustion -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
GasExhaustion
MichelsonFailed
_ -> ExecutorError' AddressAndAlias -> PureM TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ExecutorError' AddressAndAlias
err
ExecutorError' AddressAndAlias
_ -> ExecutorError' AddressAndAlias -> PureM TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ExecutorError' AddressAndAlias
err
getMorleyLogsImpl :: PureM a -> PureM (LogsInfo, a)
getMorleyLogsImpl :: forall a. PureM a -> PureM (LogsInfo, a)
getMorleyLogsImpl PureM a
action = (a, LogsInfo) -> (LogsInfo, a)
forall a b. (a, b) -> (b, a)
swap ((a, LogsInfo) -> (LogsInfo, a))
-> PureM (a, LogsInfo) -> PureM (LogsInfo, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PureM a -> PureM (a, LogsInfo)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen PureM a
action
getStorageImpl
:: forall st addr. (ToStorageType st addr)
=> addr -> PureM st
getStorageImpl :: forall st addr. ToStorageType st addr => addr -> PureM st
getStorageImpl addr
addr = do
Dict
((SingI (ToT st), WellTyped (ToT st),
FailOnOperationFound (ContainsOp (ToT st)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
FailOnContractFound (ContainsContract (ToT st))),
KnownValue st)
-> (((SingI (ToT st), WellTyped (ToT st),
FailOnOperationFound (ContainsOp (ToT st)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
FailOnContractFound (ContainsContract (ToT st))),
KnownValue st) =>
PureM st)
-> PureM st
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (forall st addr.
ToStorageType st addr =>
addr -> Dict (NiceStorage st)
pickNiceStorage @st addr
addr) ((((SingI (ToT st), WellTyped (ToT st),
FailOnOperationFound (ContainsOp (ToT st)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
FailOnContractFound (ContainsContract (ToT st))),
KnownValue st) =>
PureM st)
-> PureM st)
-> (((SingI (ToT st), WellTyped (ToT st),
FailOnOperationFound (ContainsOp (ToT st)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
FailOnContractFound (ContainsContract (ToT st))),
KnownValue st) =>
PureM st)
-> PureM st
forall a b. (a -> b) -> a -> b
$ do
ContractState Mutez
_ Contract cp st
_ (Value st
storage :: Value actualT) Maybe KeyHash
_ <- ContractAddress -> PureM ContractState
contractStorage (addr -> ContractAddress
forall addr. ToContractAddress addr => addr -> ContractAddress
toContractAddress addr
addr)
Value' Instr (ToT st)
val <- 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)
castM @actualT @(ToT st) Value st
storage (TestError -> PureM x
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM x)
-> (MismatchError T -> TestError) -> MismatchError T -> PureM x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MismatchError T -> TestError
UnexpectedStorageType)
pure $ Value' Instr (ToT st) -> st
forall a. IsoValue a => Value (ToT a) -> a
T.fromVal Value' Instr (ToT st)
val
contractStorage :: ContractAddress -> PureM ContractState
contractStorage :: ContractAddress -> PureM ContractState
contractStorage ContractAddress
addr = do
GState{Map ImplicitAddress Mutez
Map ContractAddress ContractState
Map TxRollupAddress ()
GlobalCounter
ChainId
BigMapCounter
VotingPowers
Bimap ImplicitAlias ImplicitAddress
Bimap ContractAlias ContractAddress
gsVotingPowers :: GState -> VotingPowers
gsTxRollupAddresses :: GState -> Map TxRollupAddress ()
gsImplicitAddresses :: GState -> Map ImplicitAddress Mutez
gsImplicitAddressAliases :: GState -> Bimap ImplicitAlias ImplicitAddress
gsCounter :: GState -> GlobalCounter
gsContractAddresses :: GState -> Map ContractAddress ContractState
gsContractAddressAliases :: GState -> Bimap ContractAlias ContractAddress
gsChainId :: GState -> ChainId
gsBigMapCounter :: GState -> BigMapCounter
gsContractAddressAliases :: Bimap ContractAlias ContractAddress
gsImplicitAddressAliases :: Bimap ImplicitAlias ImplicitAddress
gsBigMapCounter :: BigMapCounter
gsCounter :: GlobalCounter
gsVotingPowers :: VotingPowers
gsTxRollupAddresses :: Map TxRollupAddress ()
gsContractAddresses :: Map ContractAddress ContractState
gsImplicitAddresses :: Map ImplicitAddress Mutez
gsChainId :: ChainId
..} <- Getting GState PureState GState -> PureM GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState PureState GState
Lens' PureState GState
psGState
case ContractAddress
-> Map ContractAddress ContractState -> Maybe ContractState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ContractAddress
addr Map ContractAddress ContractState
gsContractAddresses of
Just ContractState
contractState -> ContractState -> PureM ContractState
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractState
contractState
Maybe ContractState
Nothing -> ContractAddress -> PureM ContractState
forall (kind :: AddressKind) whatever.
KindedAddress kind -> PureM whatever
unknownAddress ContractAddress
addr
resolveImplicit :: ImplicitAlias -> PureM ImplicitAddress
resolveImplicit :: ImplicitAlias -> PureM ImplicitAddress
resolveImplicit ImplicitAlias
alias = do
Getting (Maybe ImplicitAddress) PureState (Maybe ImplicitAddress)
-> PureM (Maybe ImplicitAddress)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Maybe ImplicitAddress) GState)
-> PureState -> Const (Maybe ImplicitAddress) PureState
Lens' PureState GState
psGState ((GState -> Const (Maybe ImplicitAddress) GState)
-> PureState -> Const (Maybe ImplicitAddress) PureState)
-> ((Maybe ImplicitAddress
-> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
-> GState -> Const (Maybe ImplicitAddress) GState)
-> Getting
(Maybe ImplicitAddress) PureState (Maybe ImplicitAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias ImplicitAddress
-> Const
(Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Const (Maybe ImplicitAddress) GState
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL ((Bimap ImplicitAlias ImplicitAddress
-> Const
(Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Const (Maybe ImplicitAddress) GState)
-> ((Maybe ImplicitAddress
-> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
-> Bimap ImplicitAlias ImplicitAddress
-> Const
(Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
-> (Maybe ImplicitAddress
-> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
-> GState
-> Const (Maybe ImplicitAddress) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias ImplicitAddress)
-> Lens'
(Bimap ImplicitAlias ImplicitAddress)
(Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ImplicitAlias ImplicitAddress)
ImplicitAlias
alias) PureM (Maybe ImplicitAddress)
-> (Maybe ImplicitAddress -> PureM ImplicitAddress)
-> PureM ImplicitAddress
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PureM ImplicitAddress
-> (ImplicitAddress -> PureM ImplicitAddress)
-> Maybe ImplicitAddress
-> PureM ImplicitAddress
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ImplicitAlias -> PureM ImplicitAddress
forall (kind :: AddressKind) whatever. Alias kind -> PureM whatever
unknownAlias ImplicitAlias
alias) ImplicitAddress -> PureM ImplicitAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure
resolveContract :: ContractAlias -> PureM ContractAddress
resolveContract :: ContractAlias -> PureM ContractAddress
resolveContract ContractAlias
alias = do
Getting (Maybe ContractAddress) PureState (Maybe ContractAddress)
-> PureM (Maybe ContractAddress)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Maybe ContractAddress) GState)
-> PureState -> Const (Maybe ContractAddress) PureState
Lens' PureState GState
psGState ((GState -> Const (Maybe ContractAddress) GState)
-> PureState -> Const (Maybe ContractAddress) PureState)
-> ((Maybe ContractAddress
-> Const (Maybe ContractAddress) (Maybe ContractAddress))
-> GState -> Const (Maybe ContractAddress) GState)
-> Getting
(Maybe ContractAddress) PureState (Maybe ContractAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAlias ContractAddress
-> Const
(Maybe ContractAddress) (Bimap ContractAlias ContractAddress))
-> GState -> Const (Maybe ContractAddress) GState
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL ((Bimap ContractAlias ContractAddress
-> Const
(Maybe ContractAddress) (Bimap ContractAlias ContractAddress))
-> GState -> Const (Maybe ContractAddress) GState)
-> ((Maybe ContractAddress
-> Const (Maybe ContractAddress) (Maybe ContractAddress))
-> Bimap ContractAlias ContractAddress
-> Const
(Maybe ContractAddress) (Bimap ContractAlias ContractAddress))
-> (Maybe ContractAddress
-> Const (Maybe ContractAddress) (Maybe ContractAddress))
-> GState
-> Const (Maybe ContractAddress) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ContractAlias ContractAddress)
-> Lens'
(Bimap ContractAlias ContractAddress)
(Maybe (IxValue (Bimap ContractAlias ContractAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ContractAlias ContractAddress)
ContractAlias
alias) PureM (Maybe ContractAddress)
-> (Maybe ContractAddress -> PureM ContractAddress)
-> PureM ContractAddress
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PureM ContractAddress
-> (ContractAddress -> PureM ContractAddress)
-> Maybe ContractAddress
-> PureM ContractAddress
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ContractAlias -> PureM ContractAddress
forall (kind :: AddressKind) whatever. Alias kind -> PureM whatever
unknownAlias ContractAlias
alias) ContractAddress -> PureM ContractAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure
unknownAddress :: KindedAddress kind -> PureM whatever
unknownAddress :: forall (kind :: AddressKind) whatever.
KindedAddress kind -> PureM whatever
unknownAddress =
TestError -> PureM whatever
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM whatever)
-> (KindedAddress kind -> TestError)
-> KindedAddress kind
-> PureM whatever
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError)
-> (KindedAddress kind -> Text) -> KindedAddress kind -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"Unknown address provided: " (Text -> Text)
-> (KindedAddress kind -> Text) -> KindedAddress kind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
unknownAlias :: Alias kind -> PureM whatever
unknownAlias :: forall (kind :: AddressKind) whatever. Alias kind -> PureM whatever
unknownAlias =
TestError -> PureM whatever
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM whatever)
-> (Alias kind -> TestError) -> Alias kind -> PureM whatever
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError)
-> (Alias kind -> Text) -> Alias kind -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"Unknown address alias: " (Text -> Text) -> (Alias kind -> Text) -> Alias kind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias kind -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
emptyScenarioBranch :: ScenarioBranchName
emptyScenarioBranch :: ScenarioBranchName
emptyScenarioBranch = [Text] -> ScenarioBranchName
ScenarioBranchName []
appendScenarioBranch :: Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch :: Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
brName (ScenarioBranchName [Text]
branches) =
[Text] -> ScenarioBranchName
ScenarioBranchName (Text
brName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
branches)
failure :: forall a. Builder -> PureM a
failure :: forall a. Builder -> PureM a
failure = TestError -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM a)
-> (Builder -> TestError) -> Builder -> PureM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError) -> (Builder -> Text) -> Builder -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
getSecretKey :: ImplicitAddress -> PureM SecretKey
getSecretKey :: ImplicitAddress -> PureM SecretKey
getSecretKey ImplicitAddress
addr = do
Getting (Maybe SecretKey) PureState (Maybe SecretKey)
-> PureM (Maybe SecretKey)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Map ImplicitAddress SecretKey
-> Const (Maybe SecretKey) (Map ImplicitAddress SecretKey))
-> PureState -> Const (Maybe SecretKey) PureState
Lens' PureState (Map ImplicitAddress SecretKey)
psSecretKeys ((Map ImplicitAddress SecretKey
-> Const (Maybe SecretKey) (Map ImplicitAddress SecretKey))
-> PureState -> Const (Maybe SecretKey) PureState)
-> ((Maybe SecretKey -> Const (Maybe SecretKey) (Maybe SecretKey))
-> Map ImplicitAddress SecretKey
-> Const (Maybe SecretKey) (Map ImplicitAddress SecretKey))
-> Getting (Maybe SecretKey) PureState (Maybe SecretKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ImplicitAddress SecretKey)
-> Lens'
(Map ImplicitAddress SecretKey)
(Maybe (IxValue (Map ImplicitAddress SecretKey)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ImplicitAddress SecretKey)
ImplicitAddress
addr) PureM (Maybe SecretKey)
-> (Maybe SecretKey -> PureM SecretKey) -> PureM SecretKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe SecretKey
Nothing -> ImplicitAddress -> PureM SecretKey
forall (kind :: AddressKind) whatever.
KindedAddress kind -> PureM whatever
unknownAddress ImplicitAddress
addr
Just SecretKey
sk -> SecretKey -> PureM SecretKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecretKey
sk
initEnv :: ImplicitAlias -> PureState
initEnv :: ImplicitAlias -> PureState
initEnv ImplicitAlias
alias = PureState :: Map ImplicitAddress SecretKey
-> DefaultAliasCounter
-> Set ImplicitAddress
-> Timestamp
-> Natural
-> Natural
-> GState
-> PureState
PureState
{ _psSecretKeys :: Map ImplicitAddress SecretKey
_psSecretKeys = OneItem (Map ImplicitAddress SecretKey)
-> Map ImplicitAddress SecretKey
forall x. One x => OneItem x -> x
one (ImplicitAddress
genesisAddress, SecretKey
genesisSecretKey)
, _psDefaultAliasesCounter :: DefaultAliasCounter
_psDefaultAliasesCounter = Natural -> DefaultAliasCounter
DefaultAliasCounter Natural
0
, _psRefillableAddresses :: Set ImplicitAddress
_psRefillableAddresses = Set ImplicitAddress
forall a. Set a
Set.empty
, _psNow :: Timestamp
_psNow = Timestamp
dummyNow
, _psLevel :: Natural
_psLevel = Natural
dummyLevel
, _psGState :: GState
_psGState = GState
initGState GState -> (GState -> GState) -> GState
forall a b. a -> (a -> b) -> b
& (Bimap ImplicitAlias ImplicitAddress
-> Identity (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Identity GState
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL ((Bimap ImplicitAlias ImplicitAddress
-> Identity (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Identity GState)
-> ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> Bimap ImplicitAlias ImplicitAddress
-> Identity (Bimap ImplicitAlias ImplicitAddress))
-> (Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> GState
-> Identity GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias ImplicitAddress)
-> Lens'
(Bimap ImplicitAlias ImplicitAddress)
(Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ImplicitAlias ImplicitAddress)
ImplicitAlias
alias ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> GState -> Identity GState)
-> ImplicitAddress -> GState -> GState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ImplicitAddress
genesisAddress
, _psMinBlockTime :: Natural
_psMinBlockTime = Natural
dummyMinBlockTime
}
failedInsideBranch :: Text -> SomeException -> FailedInBranch
failedInsideBranch :: Text -> SomeException -> FailedInBranch
failedInsideBranch Text
name SomeException
err = case forall e. Exception e => SomeException -> Maybe e
fromException @FailedInBranch SomeException
err of
Just (FailedInBranch ScenarioBranchName
branch SomeException
exception) ->
ScenarioBranchName -> SomeException -> FailedInBranch
FailedInBranch (Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
name ScenarioBranchName
branch) SomeException
exception
Maybe FailedInBranch
Nothing ->
ScenarioBranchName -> SomeException -> FailedInBranch
FailedInBranch (Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
name ScenarioBranchName
emptyScenarioBranch) SomeException
err
transfer
:: forall cp vd epRef epArg addr.
(HasEntrypointArg cp epRef epArg, T.IsoValue epArg, L.ToTAddress cp vd addr)
=> "from" :! ImplicitAddress
-> "to" :! addr
-> Mutez
-> epRef
-> epArg
-> PureM [EmitOperation]
transfer :: forall cp vd epRef epArg addr.
(HasEntrypointArg cp epRef epArg, IsoValue epArg,
ToTAddress cp vd addr) =>
NamedF Identity ImplicitAddress "from"
-> ("to" :! addr)
-> Mutez
-> epRef
-> epArg
-> PureM [EmitOperation]
transfer (Name "from"
-> NamedF Identity ImplicitAddress "from" -> ImplicitAddress
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "from" (Name "from")
Name "from"
#from -> ImplicitAddress
from) (Name "to" -> ("to" :! addr) -> addr
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "to" (Name "to")
Name "to"
#to -> addr
toAddr) Mutez
money epRef
epRef epArg
param =
let L.TAddress Address
to' = forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
L.toTAddress @cp @vd addr
toAddr in
case forall {k} (cp :: k) name arg.
HasEntrypointArg cp name arg =>
name -> (Dict (ParameterScope (ToT arg)), EpName)
forall cp name arg.
HasEntrypointArg cp name arg =>
name -> (Dict (ParameterScope (ToT arg)), EpName)
useHasEntrypointArg @cp @epRef @epArg epRef
epRef of
(Dict (ParameterScope (ToT epArg))
Dict, EpName
epName) -> ExecutorM [EmitOperation] -> PureM [EmitOperation]
forall a. ExecutorM a -> PureM a
registerInterpretation do
TypeCheckOptions -> [ExecutorOp] -> ExecutorM [EmitOperation]
executeGlobalOperations TypeCheckOptions
forall a. Default a => a
def ([ExecutorOp] -> ExecutorM [EmitOperation])
-> [ExecutorOp] -> ExecutorM [EmitOperation]
forall a b. (a -> b) -> a -> b
$ OneItem [ExecutorOp] -> [ExecutorOp]
forall x. One x => OneItem x -> x
one (OneItem [ExecutorOp] -> [ExecutorOp])
-> OneItem [ExecutorOp] -> [ExecutorOp]
forall a b. (a -> b) -> a -> b
$
TransferOperation -> ExecutorOp
Runtime.TransferOp (TransferOperation -> ExecutorOp)
-> TransferOperation -> ExecutorOp
forall a b. (a -> b) -> a -> b
$ TransferOperation :: Address -> TxData -> GlobalCounter -> TransferOperation
TransferOperation
{ toDestination :: Address
toDestination = Address
to'
, toCounter :: GlobalCounter
toCounter = GlobalCounter
0
, toTxData :: TxData
toTxData = TxData :: L1Address -> TxParam -> EpName -> Mutez -> TxData
TxData
{ tdSenderAddress :: L1Address
tdSenderAddress = ImplicitAddress -> L1Address
forall (ks :: [AddressKind]) (kind :: AddressKind).
ConstrainAddressKind ks kind =>
KindedAddress kind -> ConstrainedAddress ks
MkConstrainedAddress ImplicitAddress
from
, tdParameter :: TxParam
tdParameter = ((SingI (ToT epArg), WellTyped (ToT epArg), () :: Constraint,
() :: Constraint)
:- ParameterScope (ToT epArg))
-> (ParameterScope (ToT epArg) => TxParam) -> TxParam
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (forall (t :: T). ProperParameterBetterErrors t :- ParameterScope t
T.properParameterEvi @(ToT epArg)) ((ParameterScope (ToT epArg) => TxParam) -> TxParam)
-> (ParameterScope (ToT epArg) => TxParam) -> TxParam
forall a b. (a -> b) -> a -> b
$
Value (ToT epArg) -> TxParam
forall (t :: T). ParameterScope t => Value t -> TxParam
TxTypedParam (epArg -> Value (ToT epArg)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal epArg
param)
, tdEntrypoint :: EpName
tdEntrypoint = EpName
epName
, tdAmount :: Mutez
tdAmount = Mutez
money
}
}
originate :: U.Contract -> ContractAlias -> U.Value -> Mutez -> PureM ContractAddress
originate :: Contract
-> ContractAlias -> Value -> Mutez -> PureM ContractAddress
originate Contract
uContract ContractAlias
alias Value
uStorage Mutez
balance =
case TypeCheckOptions
-> TypeCheckResult SomeContractAndStorage
-> Either TCError SomeContractAndStorage
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult SomeContractAndStorage
-> Either TCError SomeContractAndStorage)
-> TypeCheckResult SomeContractAndStorage
-> Either TCError SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ Contract -> Value -> TypeCheckResult SomeContractAndStorage
typeCheckContractAndStorage Contract
uContract Value
uStorage of
Left TCError
tcErr -> TestError -> PureM ContractAddress
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM ContractAddress)
-> TestError -> PureM ContractAddress
forall a b. (a -> b) -> a -> b
$ TCError -> TestError
UnexpectedTypeCheckError TCError
tcErr
Right (T.SomeContractAndStorage Contract cp st
contract Value st
storage) -> do
GlobalCounter
counter <- GState -> GlobalCounter
gsCounter (GState -> GlobalCounter) -> PureM GState -> PureM GlobalCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting GState PureState GState -> PureM GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState PureState GState
Lens' PureState GState
psGState
ExecutorM ContractAddress -> PureM ContractAddress
forall a. ExecutorM a -> PureM a
registerInterpretation (ExecutorM ContractAddress -> PureM ContractAddress)
-> (OriginationOperation -> ExecutorM ContractAddress)
-> OriginationOperation
-> PureM ContractAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination (OriginationOperation -> PureM ContractAddress)
-> OriginationOperation -> PureM ContractAddress
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
storage Contract cp st
contract GlobalCounter
counter)
{ ooBalance :: Mutez
ooBalance = Mutez
balance
, ooAlias :: Maybe ContractAlias
ooAlias = ContractAlias -> Maybe ContractAlias
forall a. a -> Maybe a
Just ContractAlias
alias
}
throwEE :: ExecutorError -> PureM a
throwEE :: forall a. ExecutorError -> PureM a
throwEE ExecutorError
err =
(Address -> PureM AddressAndAlias)
-> ExecutorError -> PureM (ExecutorError' AddressAndAlias)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Address -> PureM AddressAndAlias
addrToAddressAndAlias ExecutorError
err PureM (ExecutorError' AddressAndAlias)
-> (ExecutorError' AddressAndAlias -> PureM a) -> PureM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecutorError' AddressAndAlias -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
where
addrToAddressAndAlias :: Address -> PureM AddressAndAlias
addrToAddressAndAlias :: Address -> PureM AddressAndAlias
addrToAddressAndAlias addr :: Address
addr@(MkAddress KindedAddress kind
kindedAddr) =
case KindedAddress kind
kindedAddr of
ContractAddress{} ->
Getting AddressAndAlias PureState AddressAndAlias
-> PureM AddressAndAlias
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting AddressAndAlias PureState AddressAndAlias
-> PureM AddressAndAlias)
-> Getting AddressAndAlias PureState AddressAndAlias
-> PureM AddressAndAlias
forall a b. (a -> b) -> a -> b
$ (GState -> Const AddressAndAlias GState)
-> PureState -> Const AddressAndAlias PureState
Lens' PureState GState
psGState ((GState -> Const AddressAndAlias GState)
-> PureState -> Const AddressAndAlias PureState)
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> GState -> Const AddressAndAlias GState)
-> Getting AddressAndAlias PureState AddressAndAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAlias ContractAddress
-> Const AddressAndAlias (Bimap ContractAlias ContractAddress))
-> GState -> Const AddressAndAlias GState
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL ((Bimap ContractAlias ContractAddress
-> Const AddressAndAlias (Bimap ContractAlias ContractAddress))
-> GState -> Const AddressAndAlias GState)
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Bimap ContractAlias ContractAddress
-> Const AddressAndAlias (Bimap ContractAlias ContractAddress))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> GState
-> Const AddressAndAlias GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAddress ContractAlias
-> Const AddressAndAlias (Bimap ContractAddress ContractAlias))
-> Bimap ContractAlias ContractAddress
-> Const AddressAndAlias (Bimap ContractAlias ContractAddress)
forall a1 b1 a2 b2.
Iso (Bimap a1 b1) (Bimap a2 b2) (Bimap b1 a1) (Bimap b2 a2)
Bimap.flipped ((Bimap ContractAddress ContractAlias
-> Const AddressAndAlias (Bimap ContractAddress ContractAlias))
-> Bimap ContractAlias ContractAddress
-> Const AddressAndAlias (Bimap ContractAlias ContractAddress))
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Bimap ContractAddress ContractAlias
-> Const AddressAndAlias (Bimap ContractAddress ContractAlias))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Bimap ContractAlias ContractAddress
-> Const AddressAndAlias (Bimap ContractAlias ContractAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ContractAddress ContractAlias)
-> Lens'
(Bimap ContractAddress ContractAlias)
(Maybe (IxValue (Bimap ContractAddress ContractAlias)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ContractAddress ContractAlias)
KindedAddress kind
kindedAddr ((Maybe ContractAlias
-> Const AddressAndAlias (Maybe ContractAlias))
-> Bimap ContractAddress ContractAlias
-> Const AddressAndAlias (Bimap ContractAddress ContractAlias))
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Maybe ContractAlias
-> Const AddressAndAlias (Maybe ContractAlias))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Bimap ContractAddress ContractAlias
-> Const AddressAndAlias (Bimap ContractAddress ContractAlias)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ContractAlias -> AddressAndAlias)
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Maybe ContractAlias
-> Const AddressAndAlias (Maybe ContractAlias)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Address -> Maybe ContractAlias -> AddressAndAlias
AddressAndAlias Address
addr)
KindedAddress kind
_ ->
AddressAndAlias -> PureM AddressAndAlias
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddressAndAlias -> PureM AddressAndAlias)
-> AddressAndAlias -> PureM AddressAndAlias
forall a b. (a -> b) -> a -> b
$ Address -> Maybe ContractAlias -> AddressAndAlias
AddressAndAlias Address
addr Maybe ContractAlias
forall a. Maybe a
Nothing
registerInterpretation :: ExecutorM a -> PureM a
registerInterpretation :: forall a. ExecutorM a -> PureM a
registerInterpretation ExecutorM a
action = do
Either ExecutorError (ExecutorRes, a)
interpretedResult <- ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
forall a.
ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret ExecutorM a
action
LogsInfo -> PureM ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (LogsInfo -> PureM ()) -> LogsInfo -> PureM ()
forall a b. (a -> b) -> a -> b
$ Either ExecutorError (ExecutorRes, a) -> LogsInfo
forall a. Either ExecutorError (ExecutorRes, a) -> LogsInfo
extractLogs Either ExecutorError (ExecutorRes, a)
interpretedResult
case Either ExecutorError (ExecutorRes, a)
interpretedResult of
Right (ExecutorRes
executorRes, a
res) -> do
(GState -> Identity GState) -> PureState -> Identity PureState
Lens' PureState GState
psGState ((GState -> Identity GState) -> PureState -> Identity PureState)
-> GState -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorRes -> GState
_erGState ExecutorRes
executorRes
pure a
res
Left ExecutorError
executorError -> ExecutorError -> PureM a
forall a. ExecutorError -> PureM a
throwEE ExecutorError
executorError
where
extractLogs :: Either ExecutorError (ExecutorRes, a) -> [ScenarioLogs]
extractLogs :: forall a. Either ExecutorError (ExecutorRes, a) -> LogsInfo
extractLogs = \case
Left (EEInterpreterFailed Address
addr (InterpretError (MichelsonFailureWithStack, MorleyLogs)
e)) -> [Address -> MorleyLogs -> ScenarioLogs
ScenarioLogs Address
addr (MorleyLogs -> ScenarioLogs) -> MorleyLogs -> ScenarioLogs
forall a b. (a -> b) -> a -> b
$ (MichelsonFailureWithStack, MorleyLogs) -> MorleyLogs
forall a b. (a, b) -> b
snd (MichelsonFailureWithStack, MorleyLogs)
e]
Right (ExecutorRes
res, a
_) -> ExecutorRes
res ExecutorRes
-> Getting
[(Address, InterpretResult)]
ExecutorRes
[(Address, InterpretResult)]
-> [(Address, InterpretResult)]
forall s a. s -> Getting a s a -> a
^. Getting
[(Address, InterpretResult)]
ExecutorRes
[(Address, InterpretResult)]
Lens' ExecutorRes [(Address, InterpretResult)]
erInterpretResults [(Address, InterpretResult)]
-> ((Address, InterpretResult) -> ScenarioLogs) -> LogsInfo
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Address
addr, InterpretResult{[Operation]
Value st
InterpreterState
MorleyLogs
iurOps :: InterpretResult -> [Operation]
iurNewStorage :: ()
iurNewState :: InterpretResult -> InterpreterState
iurMorleyLogs :: InterpretResult -> MorleyLogs
iurMorleyLogs :: MorleyLogs
iurNewState :: InterpreterState
iurNewStorage :: Value st
iurOps :: [Operation]
..}) ->
Address -> MorleyLogs -> ScenarioLogs
ScenarioLogs Address
addr MorleyLogs
iurMorleyLogs
Either ExecutorError (ExecutorRes, a)
_ -> []
interpret :: ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret :: forall a.
ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret ExecutorM a
action = do
Timestamp
now <- Getting Timestamp PureState Timestamp -> PureM Timestamp
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Timestamp PureState Timestamp
Lens' PureState Timestamp
psNow
Natural
level <- Getting Natural PureState Natural -> PureM Natural
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Natural PureState Natural
Lens' PureState Natural
psLevel
GState
gState <- Getting GState PureState GState -> PureM GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState PureState GState
Lens' PureState GState
psGState
Natural
minBlockTime <- Getting Natural PureState Natural -> PureM Natural
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Natural PureState Natural
Lens' PureState Natural
psMinBlockTime
pure $ 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
minBlockTime RemainingSteps
dummyMaxSteps GState
gState ExecutorM a
action