-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Integration with integrational testing engine (pun intended).
module Test.Cleveland.Internal.Pure
  ( PureM(..)
  , runClevelandT
  , runEmulatedT

  -- * Capability implementations
  , PureState
  , TestError(..)
  , emulatedImpl
  , clevelandOpsImpl
  , clevelandMiscImpl

  -- * Initial environment for Emulated tests
  , initEnv

  -- * Support functions
  , failedInsideBranch
  , moneybagAlias
  , emptyScenarioBranch

  -- * Optics
  , psAliases
  , psDefaultAliasesCounter
  , psRefillableAddresses
  , psNow
  , psLevel
  , psGState
  , psContractsNames
  ) where

import Control.Lens (assign, at, makeLenses, modifying, to, (%=), (.=))
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.Monoid (Ap(..))
import Data.Set qualified as Set
import Data.Singletons (sing)
import Data.Type.Equality (type (:~:)(Refl))
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), MaybeRPC(..), notesAsRPC, replaceBigMapIds, rpcStorageScopeEvi, valueAsRPC)
import Morley.Client (Alias, OperationInfo(..), mkAlias)
import Morley.Client.TezosClient.Types (unsafeCoerceAliasHintToAlias, unsafeGetAliasHintText)
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, dummyNow, dummyOrigination)
import Morley.Michelson.Runtime.GState
  (GState(..), asBalance, genesisAddress, genesisSecretKey, gsAddressesL, gsChainIdL, gsCounterL,
  gsVotingPowersL, initGState)
import Morley.Michelson.TypeCheck (TCError(..), typeCheckContractAndStorage, typeCheckingWith)
import Morley.Michelson.Typed
  (BigMapId(..), IsoValue, SingI, SomeAnnotatedValue(..), ToT, Value, Value'(..), castM,
  dfsFoldMapValue, fromVal, requireEq, toVal)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Operation (OriginationOperation(..), TransferOperation(..))
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address (Address, detGenKeyAddress)
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 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 -> Aliases
_psAliases :: Aliases
  , PureState -> DefaultAliasCounter
_psDefaultAliasesCounter :: DefaultAliasCounter
  , PureState -> Set Address
_psRefillableAddresses :: Set Address
  , PureState -> Timestamp
_psNow :: Timestamp
  , PureState -> Natural
_psLevel :: Natural
  , PureState -> GState
_psGState :: GState
  , PureState -> Map Address Text
_psContractsNames :: Map Address Text
  -- ^ Map from contracts addresses to human-readable names.
  }
  deriving stock 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

data AddressName = AddressName (Maybe Text) Address deriving stock (Int -> AddressName -> ShowS
[AddressName] -> ShowS
AddressName -> String
(Int -> AddressName -> ShowS)
-> (AddressName -> String)
-> ([AddressName] -> ShowS)
-> Show AddressName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressName] -> ShowS
$cshowList :: [AddressName] -> ShowS
show :: AddressName -> String
$cshow :: AddressName -> String
showsPrec :: Int -> AddressName -> ShowS
$cshowsPrec :: Int -> AddressName -> ShowS
Show)

newtype PureM a = PureM
  { PureM a
-> ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
unPureM :: ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
  }
  deriving newtype (a -> PureM b -> PureM a
(a -> b) -> PureM a -> PureM b
(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
<$ :: a -> PureM b -> PureM a
$c<$ :: forall a b. a -> PureM b -> PureM a
fmap :: (a -> b) -> PureM a -> PureM b
$cfmap :: forall a b. (a -> b) -> PureM a -> PureM b
Functor, Functor PureM
a -> PureM a
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
PureM a -> PureM b -> PureM b
PureM a -> PureM b -> PureM a
PureM (a -> b) -> PureM a -> PureM b
(a -> b -> c) -> PureM a -> PureM b -> PureM c
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
<* :: PureM a -> PureM b -> PureM a
$c<* :: forall a b. PureM a -> PureM b -> PureM a
*> :: PureM a -> PureM b -> PureM b
$c*> :: forall a b. PureM a -> PureM b -> PureM b
liftA2 :: (a -> b -> c) -> PureM a -> PureM b -> PureM c
$cliftA2 :: forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c
<*> :: PureM (a -> b) -> PureM a -> PureM b
$c<*> :: forall a b. PureM (a -> b) -> PureM a -> PureM b
pure :: a -> PureM a
$cpure :: forall a. a -> PureM a
$cp1Applicative :: Functor PureM
Applicative, Applicative PureM
a -> PureM a
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
PureM a -> (a -> PureM b) -> PureM b
PureM a -> PureM b -> PureM b
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 :: a -> PureM a
$creturn :: forall a. a -> PureM a
>> :: PureM a -> PureM b -> PureM b
$c>> :: forall a b. PureM a -> PureM b -> PureM b
>>= :: PureM a -> (a -> PureM b) -> PureM b
$c>>= :: forall a b. PureM a -> (a -> PureM b) -> PureM b
$cp1Monad :: Applicative PureM
Monad, Monad PureM
Monad PureM -> (forall a. IO a -> PureM a) -> MonadIO PureM
IO a -> PureM a
forall a. IO a -> PureM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> PureM a
$cliftIO :: forall a. IO a -> PureM a
$cp1MonadIO :: Monad PureM
MonadIO, Monad PureM
e -> PureM a
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 :: e -> PureM a
$cthrowM :: forall e a. Exception e => e -> PureM a
$cp1MonadThrow :: Monad PureM
MonadThrow, MonadThrow PureM
MonadThrow PureM
-> (forall e a.
    Exception e =>
    PureM a -> (e -> PureM a) -> PureM a)
-> MonadCatch PureM
PureM a -> (e -> PureM a) -> PureM a
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 :: PureM a -> (e -> PureM a) -> PureM a
$ccatch :: forall e a. Exception e => PureM a -> (e -> PureM a) -> PureM a
$cp1MonadCatch :: MonadThrow PureM
MonadCatch,
                    MonadReader (IORef PureState), MonadWriter LogsInfo, Monad PureM
Monad PureM -> (forall a. String -> PureM a) -> MonadFail PureM
String -> PureM a
forall a. String -> PureM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> PureM a
$cfail :: forall a. String -> PureM a
$cp1MonadFail :: Monad PureM
MonadFail)

type Aliases = Map Alias AliasData

-- | Datatype to store alias data, we store optional 'SecretKey' in addition
-- to 'Address' in order to support bytes signing.
data AliasData = AliasData
  { AliasData -> Address
adAddress :: Address
  , AliasData -> Maybe SecretKey
adMbSecretKey :: Maybe SecretKey
  }
  deriving stock Int -> AliasData -> ShowS
[AliasData] -> ShowS
AliasData -> String
(Int -> AliasData -> ShowS)
-> (AliasData -> String)
-> ([AliasData] -> ShowS)
-> Show AliasData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AliasData] -> ShowS
$cshowList :: [AliasData] -> ShowS
show :: AliasData -> String
$cshow :: AliasData -> String
showsPrec :: Int -> AliasData -> ShowS
$cshowsPrec :: Int -> AliasData -> ShowS
Show

data TestError
  = UnexpectedTypeCheckError TCError
  | UnexpectedStorageType (MismatchError T.T)
  | UnexpectedBigMapKeyType (MismatchError T.T)
  | UnexpectedBigMapValueType (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 AddressName where
  build :: AddressName -> Builder
build (AddressName Maybe Text
mbName Address
addr) =
    Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder -> (Text -> Builder) -> Maybe Text -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (\Text
cName -> Builder
" (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Text
cName Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")") Maybe Text
mbName

instance Buildable TestError where
  build :: TestError -> Builder
build (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
""
  build (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
""
  build (UnexpectedBigMapKeyType MismatchError T
merr) =
    Builder
"Unexpected big map key 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
""
  build (UnexpectedBigMapValueType MismatchError T
merr) =
    Builder
"Unexpected big map value 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
""
  build (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

-- In this implementation we do not prefix aliases, so 'Alias' and 'AliasHint'
-- are identical and conversions between them are safe.
hintToAlias :: AliasHint -> Alias
hintToAlias :: AliasHint -> Alias
hintToAlias = AliasHint -> Alias
unsafeCoerceAliasHintToAlias

moneybagAlias :: Alias
moneybagAlias :: Alias
moneybagAlias = Text -> Alias
mkAlias Text
"moneybag"

runEmulatedT :: Alias -> EmulatedT PureM a -> IO a
runEmulatedT :: Alias -> EmulatedT PureM a -> IO a
runEmulatedT Alias
moneybagAlias' EmulatedT PureM a
scenario =
  Alias -> ClevelandT PureM a -> IO a
forall a. Alias -> ClevelandT PureM a -> IO a
runClevelandT Alias
moneybagAlias' do
    ClevelandCaps PureM
clevelandCaps <- ReaderT (ClevelandCaps PureM) PureM (ClevelandCaps PureM)
forall r (m :: * -> *). MonadReader r m => m r
ask
    PureM a -> ClevelandT PureM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PureM a -> ClevelandT PureM a)
-> (EmulatedCaps PureM -> PureM a)
-> EmulatedCaps PureM
-> ClevelandT PureM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> ClevelandT PureM a)
-> EmulatedCaps PureM -> ClevelandT PureM a
forall a b. (a -> b) -> a -> b
$ EmulatedImpl PureM -> ClevelandCaps PureM -> EmulatedCaps PureM
forall (m :: * -> *).
EmulatedImpl m -> ClevelandCaps m -> EmulatedCaps m
EmulatedCaps EmulatedImpl PureM
emulatedImpl ClevelandCaps PureM
clevelandCaps

runClevelandT :: Alias -> ClevelandT PureM a -> IO a
runClevelandT :: Alias -> ClevelandT PureM a -> IO a
runClevelandT Alias
moneybagAlias' ClevelandT PureM a
scenario = do
  let caps :: ClevelandCaps PureM
caps = ClevelandCaps :: forall (m :: * -> *).
Sender
-> Moneybag
-> ClevelandMiscImpl m
-> (Sender -> ClevelandOpsImpl m)
-> ClevelandCaps m
ClevelandCaps
        { ccSender :: Sender
ccSender = Address -> Sender
Sender Address
genesisAddress
        , ccMoneybag :: Moneybag
ccMoneybag = Address -> Moneybag
Moneybag Address
genesisAddress
        , ccMiscCap :: ClevelandMiscImpl PureM
ccMiscCap = ClevelandMiscImpl PureM
clevelandMiscImpl
        , ccOpsCap :: Sender -> ClevelandOpsImpl PureM
ccOpsCap = Sender -> ClevelandOpsImpl PureM
clevelandOpsImpl
        }
  let pureM :: PureM a
pureM = ClevelandT PureM a -> ClevelandCaps PureM -> PureM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ClevelandT PureM a
scenario ClevelandCaps PureM
caps
  IORef PureState
env <- PureState -> IO (IORef PureState)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Alias -> PureState
initEnv Alias
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
$ \(name, 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 Address
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 Result])
-> ClevelandOpsImpl m
ClevelandOpsImpl
    { coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput] -> PureM [OperationInfo Result]
coiRunOperationBatch = (OperationInfo ClevelandInput -> PureM (OperationInfo Result))
-> [OperationInfo ClevelandInput] -> PureM [OperationInfo Result]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM \case
        OpOriginate UntypedOriginateData{..} -> do
          Address
ref <- Contract -> Text -> Value -> Mutez -> PureM Address
originate Contract
uodContract (AliasHint -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AliasHint
uodName) Value
uodStorage Mutez
uodBalance
          Address -> OperationInfo Result
forall i. OriginationInfo i -> OperationInfo i
OpOriginate (Address -> OperationInfo Result)
-> PureM Address -> PureM (OperationInfo Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AliasHint -> Address -> Maybe SecretKey -> PureM Address
saveAlias AliasHint
uodName (Address -> Address
forall a. ToAddress a => a -> Address
toAddress Address
ref) Maybe SecretKey
forall a. Maybe a
Nothing
        OpTransfer TransferData{..} -> do
          let fromAddr :: NamedF Identity Address "from"
fromAddr = IsLabel "from" (Name "from")
Name "from"
#from Name "from" -> Address -> NamedF Identity Address "from"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Address
sender
          let toAddr :: NamedF Identity Address "to"
toAddr = IsLabel "to" (Name "to")
Name "to"
#to Name "to" -> Address -> NamedF Identity Address "to"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! addr -> Address
forall a. ToAddress a => a -> Address
toAddress addr
tdTo
          Bool
refillable <- Address -> PureM Bool
isAddressRefillable Address
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 <- Address -> PureM Mutez
getBalance Address
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 Address "from"
moneybag = IsLabel "from" (Name "from")
Name "from"
#from Name "from" -> Address -> NamedF Identity Address "from"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Address
genesisAddress
                  toSender :: NamedF Identity Address "to"
toSender = IsLabel "to" (Name "to")
Name "to"
#to Name "to" -> Address -> NamedF Identity Address "to"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Address
sender
              NamedF Identity Address "from"
-> NamedF Identity Address "to"
-> Mutez
-> TrustEpName
-> ()
-> PureM ()
forall cp vd epRef epArg addr.
(HasEntrypointArg cp epRef epArg, IsoValue epArg,
 ToTAddress cp vd addr) =>
NamedF Identity Address "from"
-> ("to" :! addr) -> Mutez -> epRef -> epArg -> PureM ()
transfer @() NamedF Identity Address "from"
moneybag NamedF Identity Address "to"
toSender (HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
unsafeSubMutez Mutez
tdAmount Mutez
balance)
                (EpName -> TrustEpName
TrustEpName EpName
DefEpName) ()
          -- Here @toAddr@ is 'Address', so we can not check anything
          -- about it and assume that entrypoint is correct. We pass
          -- unit as contract parameter because it won't be checked
          -- anyway.
          NamedF Identity Address "from"
-> NamedF Identity Address "to"
-> Mutez
-> TrustEpName
-> v
-> PureM ()
forall cp vd epRef epArg addr.
(HasEntrypointArg cp epRef epArg, IsoValue epArg,
 ToTAddress cp vd addr) =>
NamedF Identity Address "from"
-> ("to" :! addr) -> Mutez -> epRef -> epArg -> PureM ()
transfer @() NamedF Identity Address "from"
fromAddr NamedF Identity Address "to"
toAddr Mutez
tdAmount
            (EpName -> TrustEpName
TrustEpName EpName
tdEntrypoint) v
tdParameter

          return $ TransferInfo Result -> OperationInfo Result
forall i. TransferInfo i -> OperationInfo i
OpTransfer ()
        OpReveal{} -> do
          -- We do not care about reveals in our Morley runtime
          OperationInfo Result -> PureM (OperationInfo Result)
forall (m :: * -> *) a. Monad m => a -> m a
return (OperationInfo Result -> PureM (OperationInfo Result))
-> OperationInfo Result -> PureM (OperationInfo Result)
forall a b. (a -> b) -> a -> b
$ RevealInfo Result -> OperationInfo Result
forall i. RevealInfo i -> OperationInfo i
OpReveal ()
    }

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)
-> (HasCallStack => AliasHint -> m Address)
-> (HasCallStack => SpecificOrDefaultAliasHint -> m Address)
-> (HasCallStack => SpecificOrDefaultAliasHint -> m Address)
-> (HasCallStack => ByteString -> Address -> m Signature)
-> (HasCallStack => Sender -> UntypedOriginateData -> m Address)
-> (HasCallStack => Text -> m ())
-> (HasCallStack => Address -> m Mutez)
-> (HasCallStack => Address -> 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 => Address -> m PublicKey)
-> (HasCallStack => Address -> m (Maybe KeyHash))
-> (HasCallStack => Address -> 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))
-> (Address -> m ())
-> m (Maybe (EmulatedImpl m))
-> (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 :: HasCallStack => AliasHint -> PureM Address
cmiResolveAddress = HasCallStack => AliasHint -> PureM Address
AliasHint -> PureM Address
resolve

    , cmiSignBytes :: HasCallStack => ByteString -> Address -> PureM Signature
cmiSignBytes = \ByteString
bs Address
addr -> do
        -- TODO [#248]: make sure this performs fast
        Alias
alias <- Address -> PureM Alias
getAlias Address
addr
        Aliases
aliases <- Getting Aliases PureState Aliases -> PureM Aliases
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Aliases PureState Aliases
Lens' PureState Aliases
psAliases
        let mbMbSk :: Maybe AliasData
mbMbSk = Alias -> Aliases -> Maybe AliasData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Alias
alias Aliases
aliases
        Maybe SecretKey
mbSk <- PureM (Maybe SecretKey)
-> (AliasData -> PureM (Maybe SecretKey))
-> Maybe AliasData
-> PureM (Maybe SecretKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Alias -> PureM (Maybe SecretKey)
forall whatever. Alias -> PureM whatever
unknownAlias Alias
alias) (Maybe SecretKey -> PureM (Maybe SecretKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SecretKey -> PureM (Maybe SecretKey))
-> (AliasData -> Maybe SecretKey)
-> AliasData
-> PureM (Maybe SecretKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AliasData -> Maybe SecretKey
adMbSecretKey) Maybe AliasData
mbMbSk
        case Maybe SecretKey
mbSk of
          Maybe SecretKey
Nothing ->
            Builder -> PureM Signature
forall a. Builder -> PureM a
cmiFailure (Builder -> PureM Signature) -> Builder -> PureM Signature
forall a b. (a -> b) -> a -> b
$
            Builder
"Given address doesn't have known associated secret key: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Alias -> Builder
forall p. Buildable p => p -> Builder
build Alias
alias
          Just SecretKey
sk -> 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 => SpecificOrDefaultAliasHint -> PureM Address
cmiGenKey = \SpecificOrDefaultAliasHint
alias -> do
      AliasHint
aliasHint <- SpecificOrDefaultAliasHint -> PureM AliasHint
forall (m :: * -> *).
MonadState PureState m =>
SpecificOrDefaultAliasHint -> m AliasHint
resolveSpecificOrDefaultAliasHint SpecificOrDefaultAliasHint
alias
      Maybe Address -> AliasHint -> PureM Address
smartGenKey Maybe Address
forall a. Maybe a
Nothing AliasHint
aliasHint

    , cmiGenFreshKey :: HasCallStack => SpecificOrDefaultAliasHint -> PureM Address
cmiGenFreshKey =
        \SpecificOrDefaultAliasHint
alias -> do
          AliasHint
aliasHint <- SpecificOrDefaultAliasHint -> PureM AliasHint
forall (m :: * -> *).
MonadState PureState m =>
SpecificOrDefaultAliasHint -> m AliasHint
resolveSpecificOrDefaultAliasHint SpecificOrDefaultAliasHint
alias
          Aliases
aliases <- Getting Aliases PureState Aliases -> PureM Aliases
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Aliases PureState Aliases
Lens' PureState Aliases
psAliases
          let mbSk :: Maybe AliasData
mbSk = Alias -> Aliases -> Maybe AliasData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (AliasHint -> Alias
hintToAlias AliasHint
aliasHint) Aliases
aliases
          Maybe Address -> AliasHint -> PureM Address
smartGenKey (AliasData -> Address
adAddress (AliasData -> Address) -> Maybe AliasData -> Maybe Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AliasData
mbSk) AliasHint
aliasHint

    , cmiOriginateLargeUntyped :: HasCallStack => Sender -> UntypedOriginateData -> PureM Address
cmiOriginateLargeUntyped = HasCallStack => Sender -> UntypedOriginateData -> PureM Address
Sender -> UntypedOriginateData -> PureM Address
originateUntyped

    -- Comments are not supported by integrational testing engine (yet).
    , cmiComment :: HasCallStack => Text -> PureM ()
cmiComment = PureM () -> Text -> PureM ()
forall a b. a -> b -> a
const PureM ()
forall (f :: * -> *). Applicative f => f ()
pass
    , cmiGetPublicKey :: HasCallStack => Address -> PureM PublicKey
cmiGetPublicKey = \Address
addr -> do
        Aliases
aliases <- Getting Aliases PureState Aliases -> PureM Aliases
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Aliases PureState Aliases
Lens' PureState Aliases
psAliases
        let mbAliasInfo :: Maybe AliasData
mbAliasInfo = ((Alias, AliasData) -> AliasData)
-> Maybe (Alias, AliasData) -> Maybe AliasData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Alias, AliasData) -> AliasData
forall a b. (a, b) -> b
snd (Maybe (Alias, AliasData) -> Maybe AliasData)
-> Maybe (Alias, AliasData) -> Maybe AliasData
forall a b. (a -> b) -> a -> b
$ (Element [(Alias, AliasData)] -> Bool)
-> [(Alias, AliasData)] -> Maybe (Element [(Alias, AliasData)])
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\(_, AliasData addr' _) -> Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr') (Aliases -> [(Alias, AliasData)]
forall k a. Map k a -> [(k, a)]
Map.toList Aliases
aliases)
        AliasData
aliasInfo <- PureM AliasData
-> (AliasData -> PureM AliasData)
-> Maybe AliasData
-> PureM AliasData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Address -> PureM AliasData
forall whatever. Address -> PureM whatever
unknownAddress Address
addr) AliasData -> PureM AliasData
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe AliasData
mbAliasInfo
        case AliasData -> Maybe SecretKey
adMbSecretKey AliasData
aliasInfo of
          Maybe SecretKey
Nothing ->
            Builder -> PureM PublicKey
forall a. Builder -> PureM a
cmiFailure (Builder -> PureM PublicKey) -> Builder -> PureM PublicKey
forall a b. (a -> b) -> a -> b
$
            Builder
"Given address doesn't have known associated public key: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr
          Just SecretKey
sk -> PublicKey -> PureM PublicKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> PureM PublicKey) -> PublicKey -> PureM PublicKey
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey
toPublic SecretKey
sk
    , cmiGetDelegate :: HasCallStack => Address -> PureM (Maybe KeyHash)
cmiGetDelegate = \Address
addr -> do
        ContractState Mutez
_ Contract cp st
_ Value st
_ Maybe KeyHash
delegate <- Address -> PureM ContractState
contractStorage Address
addr
        Maybe KeyHash -> PureM (Maybe KeyHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe KeyHash
delegate
    , cmiRegisterDelegate :: HasCallStack => Address -> PureM ()
cmiRegisterDelegate = PureM () -> Address -> 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 (unit :: Rat).
(KnownDivRat unit Second, Num Integer) =>
Time unit -> Integer
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
$ Time unit -> Time Second
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 ->
        -- do not go back in levels
        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 = Time (1 :% 1) -> PureM (Time (1 :% 1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time (1 :% 1) -> PureM (Time (1 :% 1)))
-> Time (1 :% 1) -> PureM (Time (1 :% 1))
forall a b. (a -> b) -> a -> b
$ RatioNat -> Time Second
sec RatioNat
1
    , 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 :: Address -> PureM ()
cmiMarkAddressRefillable = Address -> PureM ()
forall (m :: * -> *). MonadState PureState m => Address -> m ()
setAddressRefillable
    , cmiGetBalance :: HasCallStack => Address -> PureM Mutez
cmiGetBalance = HasCallStack => Address -> PureM Mutez
Address -> PureM Mutez
getBalance
    , cmiEmulatedImpl :: PureM (Maybe (EmulatedImpl PureM))
cmiEmulatedImpl = Maybe (EmulatedImpl PureM) -> PureM (Maybe (EmulatedImpl PureM))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EmulatedImpl PureM) -> PureM (Maybe (EmulatedImpl PureM)))
-> Maybe (EmulatedImpl PureM) -> PureM (Maybe (EmulatedImpl PureM))
forall a b. (a -> b) -> a -> b
$ EmulatedImpl PureM -> Maybe (EmulatedImpl PureM)
forall a. a -> Maybe a
Just EmulatedImpl PureM
emulatedImpl
    , HasCallStack => Address -> PureM SomeAnnotatedValue
Address -> PureM SomeAnnotatedValue
forall a. HasCallStack => Builder -> PureM a
forall a. Builder -> PureM a
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)
cmiFailure :: forall a. HasCallStack => Builder -> PureM a
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 => Address -> PureM SomeAnnotatedValue
cmiRunCode :: forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiGetSomeStorage :: Address -> 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)
cmiFailure :: forall a. Builder -> PureM a
..
    }
  where
    cmiFailure :: forall a. Builder -> PureM a
    cmiFailure :: Builder -> PureM a
cmiFailure = 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

    setAddressRefillable :: Address -> m ()
setAddressRefillable Address
addr = (Set Address -> Identity (Set Address))
-> PureState -> Identity PureState
Lens' PureState (Set Address)
psRefillableAddresses ((Set Address -> Identity (Set Address))
 -> PureState -> Identity PureState)
-> (Set Address -> Set Address) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Address -> Set Address -> Set Address
forall a. Ord a => a -> Set a -> Set a
Set.insert Address
addr

    originateUntyped :: Sender -> UntypedOriginateData -> PureM Address
    originateUntyped :: Sender -> UntypedOriginateData -> PureM Address
originateUntyped Sender
_ UntypedOriginateData {Mutez
Value
Contract
AliasHint
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: AliasHint
uodContract :: UntypedOriginateData -> Contract
uodStorage :: UntypedOriginateData -> Value
uodBalance :: UntypedOriginateData -> Mutez
uodName :: UntypedOriginateData -> AliasHint
..} = do
      Address
ref <- Contract -> Text -> Value -> Mutez -> PureM Address
originate Contract
uodContract (AliasHint -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AliasHint
uodName) Value
uodStorage Mutez
uodBalance
      AliasHint -> Address -> Maybe SecretKey -> PureM Address
saveAlias AliasHint
uodName (Address -> Address
forall a. ToAddress a => a -> Address
toAddress Address
ref) Maybe SecretKey
forall a. Maybe a
Nothing

    cmiGetBigMapValueMaybe
      :: forall k v.
         (NiceComparable k, IsoValue v)
      => BigMapId k v
      -> k
      -> PureM (Maybe v)
    cmiGetBigMapValueMaybe :: 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 <- Natural -> MaybeT PureM (Value' Instr ('TBigMap (ToT k) (ToT v)))
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
$ IsoValue v => Value (ToT v) -> v
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 (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 :: 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 <- Natural -> MaybeT PureM (Value' Instr ('TBigMap (ToT k) (ToT v)))
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
$ IsoValue v => Value (ToT v) -> v
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

    findBigMapById
      :: forall k v. (SingI v, SingI k)
      => Natural -> PureM (Value ('T.TBigMap k v))
    findBigMapById :: Natural -> PureM (Value ('TBigMap k v))
findBigMapById Natural
bigMapId =
      MaybeT PureM (Value ('TBigMap k v))
-> PureM (Maybe (Value ('TBigMap k v)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (Natural -> MaybeT PureM (Value ('TBigMap k v))
forall (k :: T) (v :: T).
(SingI v, SingI k) =>
Natural -> MaybeT PureM (Value ('TBigMap k v))
findBigMapByIdMaybe @k @v Natural
bigMapId) PureM (Maybe (Value ('TBigMap k v)))
-> (Maybe (Value ('TBigMap k v)) -> PureM (Value ('TBigMap k v)))
-> PureM (Value ('TBigMap k v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PureM (Value ('TBigMap k v))
-> (Value ('TBigMap k v) -> PureM (Value ('TBigMap k v)))
-> Maybe (Value ('TBigMap k v))
-> PureM (Value ('TBigMap k v))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PureM (Value ('TBigMap k v))
notFound Value ('TBigMap k v) -> PureM (Value ('TBigMap k v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      where
        notFound :: PureM (Value ('TBigMap k v))
notFound = Builder -> PureM (Value ('TBigMap k v))
forall a. Builder -> PureM a
cmiFailure (Builder -> PureM (Value ('TBigMap k v)))
-> Builder -> PureM (Value ('TBigMap k v))
forall a b. (a -> b) -> a -> b
$ Builder
"BigMap with ID " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
forall p. Buildable p => p -> Builder
build Natural
bigMapId Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" not found."


    -- | Traverse storage values of all contracts and looks for a big_map with the given ID.
    -- If multiple big_maps with the given ID are found, it fails with error.
    findBigMapByIdMaybe
      :: forall k v. (SingI v, SingI k)
      => Natural -> MaybeT PureM (Value ('T.TBigMap k v))
    findBigMapByIdMaybe :: Natural -> MaybeT PureM (Value ('TBigMap k v))
findBigMapByIdMaybe Natural
bigMapId = PureM (Maybe (Value ('TBigMap k v)))
-> MaybeT PureM (Value ('TBigMap k v))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT do
      [AddressState]
addresses <- Getting [AddressState] PureState [AddressState]
-> PureM [AddressState]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting [AddressState] PureState [AddressState]
 -> PureM [AddressState])
-> Getting [AddressState] PureState [AddressState]
-> PureM [AddressState]
forall a b. (a -> b) -> a -> b
$ (GState -> Const [AddressState] GState)
-> PureState -> Const [AddressState] PureState
Lens' PureState GState
psGState ((GState -> Const [AddressState] GState)
 -> PureState -> Const [AddressState] PureState)
-> (([AddressState] -> Const [AddressState] [AddressState])
    -> GState -> Const [AddressState] GState)
-> Getting [AddressState] PureState [AddressState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Address AddressState
 -> Const [AddressState] (Map Address AddressState))
-> GState -> Const [AddressState] GState
Lens' GState (Map Address AddressState)
gsAddressesL ((Map Address AddressState
  -> Const [AddressState] (Map Address AddressState))
 -> GState -> Const [AddressState] GState)
-> (([AddressState] -> Const [AddressState] [AddressState])
    -> Map Address AddressState
    -> Const [AddressState] (Map Address AddressState))
-> ([AddressState] -> Const [AddressState] [AddressState])
-> GState
-> Const [AddressState] GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Address AddressState -> [AddressState])
-> ([AddressState] -> Const [AddressState] [AddressState])
-> Map Address AddressState
-> Const [AddressState] (Map Address AddressState)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Map Address AddressState -> [AddressState]
forall k a. Map k a -> [a]
Map.elems

      let Ap Either TestError [Value ('TBigMap k v)]
result =
            ((AddressState -> Ap (Either TestError) [Value ('TBigMap k v)])
 -> [AddressState] -> Ap (Either TestError) [Value ('TBigMap k v)])
-> [AddressState]
-> (AddressState -> Ap (Either TestError) [Value ('TBigMap k v)])
-> Ap (Either TestError) [Value ('TBigMap k v)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (AddressState -> Ap (Either TestError) [Value ('TBigMap k v)])
-> [AddressState] -> Ap (Either TestError) [Value ('TBigMap k v)]
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap [AddressState]
addresses \case
              ASContract ContractState{Value st
csStorage :: ()
csStorage :: Value st
csStorage} ->
                Value st -> Natural -> Ap (Either TestError) [Value ('TBigMap k v)]
forall (k :: T) (v :: T) (st :: T).
(SingI k, SingI v) =>
Value st -> Natural -> Ap (Either TestError) [Value ('TBigMap k v)]
findBigMapInStorage Value st
csStorage Natural
bigMapId
              ASSimple {} -> Either TestError [Value ('TBigMap k v)]
-> Ap (Either TestError) [Value ('TBigMap k v)]
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Either TestError [Value ('TBigMap k v)]
 -> Ap (Either TestError) [Value ('TBigMap k v)])
-> Either TestError [Value ('TBigMap k v)]
-> Ap (Either TestError) [Value ('TBigMap k v)]
forall a b. (a -> b) -> a -> b
$ [Value ('TBigMap k v)] -> Either TestError [Value ('TBigMap k v)]
forall a b. b -> Either a b
Right []

      case Either TestError [Value ('TBigMap k v)]
result of
        -- The RPC does not distinguish between "the bigmap does not exist"
        -- and "the bigmap exists, but the key doesn't", so we mimic the RPC's behaviour here.
        -- We simply return `Nothing` in both cases.
        Right [] -> Maybe (Value ('TBigMap k v))
-> PureM (Maybe (Value ('TBigMap k v)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Value ('TBigMap k v))
forall a. Maybe a
Nothing
        Right [Value ('TBigMap k v)
bigMap] -> Maybe (Value ('TBigMap k v))
-> PureM (Maybe (Value ('TBigMap k v)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Value ('TBigMap k v))
 -> PureM (Maybe (Value ('TBigMap k v))))
-> Maybe (Value ('TBigMap k v))
-> PureM (Maybe (Value ('TBigMap k v)))
forall a b. (a -> b) -> a -> b
$ Value ('TBigMap k v) -> Maybe (Value ('TBigMap k v))
forall a. a -> Maybe a
Just Value ('TBigMap k v)
bigMap
        Right [Value ('TBigMap k v)]
bigMaps ->
          Text -> PureM (Maybe (Value ('TBigMap k v)))
forall a. HasCallStack => Text -> a
error (Text -> PureM (Maybe (Value ('TBigMap k v))))
-> Text -> PureM (Maybe (Value ('TBigMap k v)))
forall a b. (a -> b) -> a -> b
$ Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF @_ @Builder
            [ Builder
"Expected all big_maps to have unique IDs, but found " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| [Value ('TBigMap k v)] -> Int
forall t. Container t => t -> Int
length [Value ('TBigMap k v)]
bigMaps Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" big_maps 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
"."
            , Builder
"This is most likely a bug."
            ]
        Left (TestError
err :: TestError) -> TestError -> PureM (Maybe (Value ('TBigMap k v)))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TestError
err

    -- | Traverse a storage value and looks for a big_map with the given ID.
    -- If multiple big_maps with the given ID are found, they'll all be returned.
    findBigMapInStorage
      :: forall k v st. (SingI k, SingI v)
      => Value st -> Natural -> Ap (Either TestError) [Value ('T.TBigMap k v)]
    findBigMapInStorage :: Value st -> Natural -> Ap (Either TestError) [Value ('TBigMap k v)]
findBigMapInStorage Value st
storage Natural
bigMapId =
      (forall (t' :: T).
 Value t' -> Ap (Either TestError) [Value ('TBigMap k v)])
-> Value st -> Ap (Either TestError) [Value ('TBigMap k v)]
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 k) (Value v)
_ :: Map (Value k') (Value v'))
              | Natural
bigMapId Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
bigMapId' -> do
                  k :~: k
Refl <- (forall x. MismatchError T -> Ap (Either TestError) x)
-> Ap (Either TestError) (k :~: k)
forall (a :: T) (b :: T) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
(forall x. MismatchError T -> m x) -> m (a :~: b)
requireEq @k' @k (Either TestError x -> Ap (Either TestError) x
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Either TestError x -> Ap (Either TestError) x)
-> (TestError -> Either TestError x)
-> TestError
-> Ap (Either TestError) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestError -> Either TestError x
forall a b. a -> Either a b
Left (TestError -> Ap (Either TestError) x)
-> (MismatchError T -> TestError)
-> MismatchError T
-> Ap (Either TestError) x
forall a b c. SuperComposition a b c => a -> b -> c
... MismatchError T -> TestError
UnexpectedBigMapKeyType)
                  v :~: v
Refl <- (forall x. MismatchError T -> Ap (Either TestError) x)
-> Ap (Either TestError) (v :~: v)
forall (a :: T) (b :: T) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
(forall x. MismatchError T -> m x) -> m (a :~: b)
requireEq @v' @v (Either TestError x -> Ap (Either TestError) x
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Either TestError x -> Ap (Either TestError) x)
-> (TestError -> Either TestError x)
-> TestError
-> Ap (Either TestError) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestError -> Either TestError x
forall a b. a -> Either a b
Left (TestError -> Ap (Either TestError) x)
-> (MismatchError T -> TestError)
-> MismatchError T
-> Ap (Either TestError) x
forall a b c. SuperComposition a b c => a -> b -> c
... MismatchError T -> TestError
UnexpectedBigMapValueType)
                  [Value t'] -> Ap (Either TestError) [Value t']
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value t'
v]
            Value t'
_ -> Either TestError [Value ('TBigMap k v)]
-> Ap (Either TestError) [Value ('TBigMap k v)]
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Either TestError [Value ('TBigMap k v)]
 -> Ap (Either TestError) [Value ('TBigMap k v)])
-> Either TestError [Value ('TBigMap k v)]
-> Ap (Either TestError) [Value ('TBigMap k v)]
forall a b. (a -> b) -> a -> b
$ [Value ('TBigMap k v)] -> Either TestError [Value ('TBigMap k v)]
forall a b. b -> Either a b
Right []
        )
        Value st
storage

    -- | In a real chain, when we retrieve a contract's storage via the Tezos RPC,
    -- the storage expression will have all the big_maps replaced with their respective big_map IDs.
    --
    -- Here, we mimic the RPC's behaviour.
    --
    -- We expect all big_maps in the storage to already have an ID.
    -- IDs are assigned to big_maps by the interpreter/runtime when:
    --   * A contract with big_maps in its storage is originated
    --   * A transfer is made and the parameter contains big_maps
    --   * A contract's code is run and it calls `EMPTY_BIG_MAP`, `DUP` or `DUP n`.
    cmiGetSomeStorage :: Address -> PureM SomeAnnotatedValue
    cmiGetSomeStorage :: Address -> PureM SomeAnnotatedValue
cmiGetSomeStorage Address
addr = do
      ContractState Mutez
_ Contract cp st
contract (Value st
storage :: Value t) Maybe KeyHash
_ <- Address -> PureM ContractState
contractStorage Address
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
\\ StorageScope st :- StorageScope (TAsRPC st)
forall (t :: T). StorageScope t :- StorageScope (TAsRPC t)
rpcStorageScopeEvi @t

    getAlias :: Address -> PureM Alias
    getAlias :: Address -> PureM Alias
getAlias Address
addr = do
      Aliases
aliases <- Getting Aliases PureState Aliases -> PureM Aliases
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Aliases PureState Aliases
Lens' PureState Aliases
psAliases
      let maybeAlias :: Maybe Alias
maybeAlias = (((Alias, AliasData) -> Alias)
-> Maybe (Alias, AliasData) -> Maybe Alias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Alias, AliasData) -> Alias
forall a b. (a, b) -> a
fst (Maybe (Alias, AliasData) -> Maybe Alias)
-> (Aliases -> Maybe (Alias, AliasData)) -> Aliases -> Maybe Alias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element [(Alias, AliasData)] -> Bool)
-> [(Alias, AliasData)] -> Maybe (Element [(Alias, AliasData)])
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\(_, AliasData addr' _) -> Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr') ([(Alias, AliasData)] -> Maybe (Alias, AliasData))
-> (Aliases -> [(Alias, AliasData)])
-> Aliases
-> Maybe (Alias, AliasData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aliases -> [(Alias, AliasData)]
forall k a. Map k a -> [(k, a)]
Map.toList) Aliases
aliases
      PureM Alias -> (Alias -> PureM Alias) -> Maybe Alias -> PureM Alias
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Address -> PureM Alias
forall whatever. Address -> PureM whatever
unknownAddress Address
addr) Alias -> PureM Alias
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Alias
maybeAlias

    -- Generate a fresh address which was never generated for given alias.
    -- If the address is not saved, we use the alias as its seed.
    -- Otherwise we concatenate the alias with the saved address.
    smartGenKey :: Maybe Address -> AliasHint -> PureM Address
    smartGenKey :: Maybe Address -> AliasHint -> PureM Address
smartGenKey Maybe Address
existingAddr aliasHint :: AliasHint
aliasHint@(AliasHint -> Text
unsafeGetAliasHintText -> Text
aliasTxt) =
      let
        seed :: Text
seed = Text -> (Address -> Text) -> Maybe Address -> 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) -> (Address -> Text) -> Address -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Maybe Address
existingAddr
        sk :: SecretKey
sk = HasCallStack => ByteString -> SecretKey
ByteString -> SecretKey
detSecretKey (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
seed)
        addr :: Address
addr = ByteString -> Address
detGenKeyAddress (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
seed)
       in AliasHint -> Address -> Maybe SecretKey -> PureM Address
saveAlias AliasHint
aliasHint Address
addr (Maybe SecretKey -> PureM Address)
-> Maybe SecretKey -> PureM Address
forall a b. (a -> b) -> a -> b
$ SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
sk

    resolveSpecificOrDefaultAliasHint :: SpecificOrDefaultAliasHint -> m AliasHint
resolveSpecificOrDefaultAliasHint (SpecificAliasHint AliasHint
aliasHint) =
      AliasHint -> m AliasHint
forall (m :: * -> *) a. Monad m => a -> m a
return AliasHint
aliasHint
    resolveSpecificOrDefaultAliasHint (SpecificOrDefaultAliasHint
DefaultAliasHint) = 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 -> AliasHint
mkDefaultAlias Natural
counter

    cmiRunCode
      :: forall cp st vd. (HasRPCRepr st, T.IsoValue (AsRPC st))
      => Sender -> RunCode cp st vd -> PureM (AsRPC st)
    cmiRunCode :: Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiRunCode (Sender Address
sender) (RunCode Contract cp st vd
rcContract MaybeRPC st
rcStorage MaybeRPC cp
rcParameter Mutez
rcAmount Mutez
rcBalance Maybe Address
rcSource) = do
      -- Pattern match on the contract constructor to reveal
      -- a proof of `NiceParameter cp` and `NiceStorage st`
      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 <- MaybeRPC cp -> PureM (Value (ToT cp))
forall v. MaybeRPC v -> PureM (Value (ToT v))
maybeRPCToVal MaybeRPC cp
rcParameter
      Value (ToT st)
storage <- MaybeRPC st -> PureM (Value (ToT st))
forall v. MaybeRPC v -> PureM (Value (ToT v))
maybeRPCToVal MaybeRPC st
rcStorage

      Either ExecutorError (ExecutorRes, Address)
res <- ExecutorM Address
-> PureM (Either ExecutorError (ExecutorRes, Address))
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
        Address
contractAddr <-
          ("isGlobalOp" :! Bool) -> OriginationOperation -> ExecutorM Address
executeOrigination (("isGlobalOp" :! Bool)
 -> OriginationOperation -> ExecutorM Address)
-> Param ("isGlobalOp" :! Bool)
-> OriginationOperation
-> ExecutorM Address
forall p fn fn'. WithParam p fn fn' => fn -> Param p -> fn'
! IsLabel "isGlobalOp" (Bool -> Param ("isGlobalOp" :! Bool))
Bool -> Param ("isGlobalOp" :! Bool)
#isGlobalOp Bool
True (OriginationOperation -> ExecutorM Address)
-> OriginationOperation -> ExecutorM Address
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)
-> (((SingI (ToT st), WellTyped (ToT st),
      FailOnOperationFound (ContainsOp (ToT st)),
      FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
      FailOnContractFound (ContainsContract (ToT st))),
     KnownValue st)
    :- StorageScope (ToT st))
-> OriginationOperation
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT st), WellTyped (ToT st),
  FailOnOperationFound (ContainsOp (ToT st)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
  FailOnContractFound (ContainsContract (ToT st))),
 KnownValue st)
:- StorageScope (ToT st)
forall a. NiceStorage a :- StorageScope (ToT a)
L.niceStorageEvi @st
              (ParameterScope (ToT cp) => OriginationOperation)
-> (((SingI (ToT cp), WellTyped (ToT cp),
      FailOnOperationFound (ContainsOp (ToT cp)),
      FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))),
     KnownValue cp)
    :- ParameterScope (ToT cp))
-> OriginationOperation
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT cp), WellTyped (ToT cp),
  FailOnOperationFound (ContainsOp (ToT cp)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))),
 KnownValue cp)
:- ParameterScope (ToT cp)
forall a. NiceParameter a :- ParameterScope (ToT a)
L.niceParameterEvi @cp

        (Maybe Address -> Identity (Maybe Address))
-> ExecutorState -> Identity ExecutorState
Lens' ExecutorState (Maybe Address)
esSourceAddress ((Maybe Address -> Identity (Maybe Address))
 -> ExecutorState -> Identity ExecutorState)
-> Maybe Address
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Address
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
        ("isGlobalOp" :! Bool)
-> Maybe Mutez
-> TypeCheckOptions
-> TransferOperation
-> ExecutorM [ExecutorOp]
executeTransfer (IsLabel "isGlobalOp" (Name "isGlobalOp")
Name "isGlobalOp"
#isGlobalOp Name "isGlobalOp" -> Bool -> "isGlobalOp" :! Bool
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Bool
False) 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 = Address
contractAddr
            , toCounter :: GlobalCounter
toCounter = GlobalCounter
counter1
            , toTxData :: TxData
toTxData = TxData :: Address -> TxParam -> EpName -> Mutez -> TxData
TxData
              { tdSenderAddress :: Address
tdSenderAddress = Address
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)
-> (((SingI (ToT cp), WellTyped (ToT cp),
      FailOnOperationFound (ContainsOp (ToT cp)),
      FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))),
     KnownValue cp)
    :- ParameterScope (ToT cp))
-> TxParam
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT cp), WellTyped (ToT cp),
  FailOnOperationFound (ContainsOp (ToT cp)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))),
 KnownValue cp)
:- ParameterScope (ToT cp)
forall a. NiceParameter a :- ParameterScope (ToT a)
L.niceParameterEvi @cp
              , tdEntrypoint :: EpName
tdEntrypoint = EpName
DefEpName
              , tdAmount :: Mutez
tdAmount = Mutez
rcAmount
              }
            }
        pure Address
contractAddr
      case Either ExecutorError (ExecutorRes, Address)
res of
        Left ExecutorError
executorError -> ExecutorError -> PureM (AsRPC st)
forall a. ExecutorError -> PureM a
throwEE ExecutorError
executorError
        Right (ExecutorRes
executorRes, Address
contractAddr) -> do
          -- Find the storage of the contract and return it in its RPC representation.
          case ExecutorRes
executorRes ExecutorRes
-> Getting (Maybe AddressState) ExecutorRes (Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. (GState -> Const (Maybe AddressState) GState)
-> ExecutorRes -> Const (Maybe AddressState) ExecutorRes
Lens' ExecutorRes GState
erGState ((GState -> Const (Maybe AddressState) GState)
 -> ExecutorRes -> Const (Maybe AddressState) ExecutorRes)
-> ((Maybe AddressState
     -> Const (Maybe AddressState) (Maybe AddressState))
    -> GState -> Const (Maybe AddressState) GState)
-> Getting (Maybe AddressState) ExecutorRes (Maybe AddressState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Address AddressState
 -> Const (Maybe AddressState) (Map Address AddressState))
-> GState -> Const (Maybe AddressState) GState
Lens' GState (Map Address AddressState)
gsAddressesL ((Map Address AddressState
  -> Const (Maybe AddressState) (Map Address AddressState))
 -> GState -> Const (Maybe AddressState) GState)
-> ((Maybe AddressState
     -> Const (Maybe AddressState) (Maybe AddressState))
    -> Map Address AddressState
    -> Const (Maybe AddressState) (Map Address AddressState))
-> (Maybe AddressState
    -> Const (Maybe AddressState) (Maybe AddressState))
-> GState
-> Const (Maybe AddressState) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Address AddressState)
-> Lens'
     (Map Address AddressState)
     (Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
contractAddr of
            Maybe AddressState
Nothing ->
              Builder -> PureM (AsRPC st)
forall a. Builder -> PureM a
cmiFailure (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
+| Address
contractAddr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"'"
            Just (ASSimple {}) ->
              Builder -> PureM (AsRPC st)
forall a. Builder -> PureM a
cmiFailure (Builder -> PureM (AsRPC st)) -> Builder -> PureM (AsRPC st)
forall a b. (a -> b) -> a -> b
$ Builder
"Internal error: expected address to belong to a contract: '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
contractAddr Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"'"
            Just (ASContract (ContractState Mutez
_ Contract cp st
_ (Value st
finalStorage :: Value actualSt) Maybe KeyHash
_)) -> do
              Value (ToT st)
finalStorage' <- Value st
-> (forall x. MismatchError T -> PureM x) -> PureM (Value (ToT st))
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
        maybeRPCToVal :: MaybeRPC v -> PureM (Value (ToT v))
        maybeRPCToVal :: MaybeRPC v -> PureM (Value (ToT v))
maybeRPCToVal = \case
          NotRPC v
v -> Value (ToT v) -> PureM (Value (ToT v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value (ToT v) -> PureM (Value (ToT v)))
-> Value (ToT v) -> PureM (Value (ToT v))
forall a b. (a -> b) -> a -> b
$ v -> Value (ToT v)
forall a. IsoValue a => a -> Value (ToT a)
toVal v
v
          IsRPC AsRPC v
v -> (forall (k :: T) (v :: T).
 (SingI k, SingI v) =>
 Natural -> PureM (Value ('TBigMap k v)))
-> Sing (ToT v) -> Value (TAsRPC (ToT v)) -> PureM (Value (ToT v))
forall (t :: T) (m :: * -> *).
Monad m =>
(forall (k :: T) (v :: T).
 (SingI k, SingI v) =>
 Natural -> m (Value ('TBigMap k v)))
-> Sing t -> Value (TAsRPC t) -> m (Value t)
replaceBigMapIds forall (k :: T) (v :: T).
(SingI k, SingI v) =>
Natural -> PureM (Value ('TBigMap k v))
forall (k :: T) (v :: T).
(SingI v, SingI k) =>
Natural -> PureM (Value ('TBigMap k v))
findBigMapById Sing (ToT v)
forall k (a :: k). SingI a => Sing a
sing (Value (TAsRPC (ToT v)) -> PureM (Value (ToT v)))
-> Value (TAsRPC (ToT v)) -> PureM (Value (ToT v))
forall a b. (a -> b) -> a -> b
$ AsRPC v -> Value (ToT (AsRPC v))
forall a. IsoValue a => a -> Value (ToT a)
toVal AsRPC v
v

isAddressRefillable :: Address -> PureM Bool
isAddressRefillable :: Address -> PureM Bool
isAddressRefillable Address
addr = Address -> Set Address -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Address
addr (Set Address -> Bool) -> PureM (Set Address) -> PureM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Set Address) PureState (Set Address)
-> PureM (Set Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Set Address) PureState (Set Address)
Lens' PureState (Set Address)
psRefillableAddresses

getBalance :: Address -> PureM Mutez
getBalance :: Address -> PureM Mutez
getBalance Address
addr = do
  GState{Map Address AddressState
GlobalCounter
ChainId
BigMapCounter
VotingPowers
gsVotingPowers :: GState -> VotingPowers
gsCounter :: GState -> GlobalCounter
gsChainId :: GState -> ChainId
gsBigMapCounter :: GState -> BigMapCounter
gsAddresses :: GState -> Map Address AddressState
gsBigMapCounter :: BigMapCounter
gsCounter :: GlobalCounter
gsVotingPowers :: VotingPowers
gsAddresses :: Map Address AddressState
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
  Mutez -> PureM Mutez
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutez -> PureM Mutez) -> Mutez -> PureM Mutez
forall a b. (a -> b) -> a -> b
$ Mutez -> (AddressState -> Mutez) -> Maybe AddressState -> Mutez
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mutez
zeroMutez AddressState -> Mutez
asBalance (Maybe AddressState -> Mutez) -> Maybe AddressState -> Mutez
forall a b. (a -> b) -> a -> b
$ Address -> Map Address AddressState -> Maybe AddressState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Address
addr Map Address AddressState
gsAddresses

saveAlias :: AliasHint -> Address -> Maybe SecretKey -> PureM Address
saveAlias :: AliasHint -> Address -> Maybe SecretKey -> PureM Address
saveAlias AliasHint
name Address
addr Maybe SecretKey
mbSk = do
  (Aliases -> Identity Aliases) -> PureState -> Identity PureState
Lens' PureState Aliases
psAliases ((Aliases -> Identity Aliases) -> PureState -> Identity PureState)
-> (Aliases -> Aliases) -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Alias -> AliasData -> Aliases -> Aliases
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (AliasHint -> Alias
hintToAlias AliasHint
name) (Address -> Maybe SecretKey -> AliasData
AliasData Address
addr Maybe SecretKey
mbSk)
  pure Address
addr

exceptionHandler :: PureM a -> PureM a
exceptionHandler :: PureM a -> PureM a
exceptionHandler PureM a
action = PureM a -> PureM (Either (ExecutorError' AddressName) a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try PureM a
action PureM (Either (ExecutorError' AddressName) a)
-> (Either (ExecutorError' AddressName) a -> PureM a) -> PureM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ExecutorError' AddressName
err -> ExecutorError' AddressName -> PureM TransferFailure
exceptionToTransferFailure ExecutorError' AddressName
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' AddressName -> PureM TransferFailure
    exceptionToTransferFailure :: ExecutorError' AddressName -> PureM TransferFailure
exceptionToTransferFailure ExecutorError' AddressName
err = case ExecutorError' AddressName
err of
      EEZeroTransaction AddressName
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure (AddressName -> Address
addrNameToAddr AddressName
addr) TransferFailureReason
EmptyTransaction
      EEIllTypedParameter AddressName
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure (AddressName -> Address
addrNameToAddr AddressName
addr) TransferFailureReason
BadParameter
      EEUnexpectedParameterType AddressName
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure (AddressName -> Address
addrNameToAddr AddressName
addr) TransferFailureReason
BadParameter
      EEInterpreterFailed AddressName
addr (InterpretError (MichelsonFailureWithStack{InstrCallStack
MichelsonFailed
mfwsInstrCallStack :: MichelsonFailureWithStack -> InstrCallStack
mfwsFailed :: MichelsonFailureWithStack -> MichelsonFailed
mfwsInstrCallStack :: InstrCallStack
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure (AddressName -> Address
addrNameToAddr AddressName
addr) (TransferFailureReason -> TransferFailure)
-> TransferFailureReason -> TransferFailure
forall a b. (a -> b) -> a -> b
$ ExpressionOrTypedValue
-> Maybe InstrCallStack -> TransferFailureReason
FailedWith (Value t -> ExpressionOrTypedValue
forall (t :: T).
(SingI t, ConstantScope t) =>
Value t -> ExpressionOrTypedValue
EOTVTypedValue Value t
val) (InstrCallStack -> Maybe InstrCallStack
forall a. a -> Maybe a
Just InstrCallStack
mfwsInstrCallStack)
          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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure (AddressName -> Address
addrNameToAddr AddressName
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure (AddressName -> Address
addrNameToAddr AddressName
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure (AddressName -> Address
addrNameToAddr AddressName
addr) TransferFailureReason
GasExhaustion
          MichelsonFailed
_ -> ExecutorError' AddressName -> PureM TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ExecutorError' AddressName
err
      ExecutorError' AddressName
_ -> ExecutorError' AddressName -> PureM TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ExecutorError' AddressName
err


getMorleyLogsImpl :: PureM a -> PureM (LogsInfo, a)
getMorleyLogsImpl :: 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 :: 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 (addr
-> Dict
     ((SingI (ToT st), WellTyped (ToT st),
       FailOnOperationFound (ContainsOp (ToT st)),
       FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
       FailOnContractFound (ContainsContract (ToT st))),
      KnownValue st)
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
_ <- Address -> PureM ContractState
contractStorage (addr -> Address
forall a. ToAddress a => a -> Address
toAddress addr
addr)
    Value' Instr (ToT st)
val <- Value st
-> (forall x. MismatchError T -> PureM x)
-> PureM (Value' Instr (ToT st))
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

-- Attempt to retrieve a ContractState given for the given address. Fails if the
-- address is unknown or the address is a simple address (contract without
-- code and storage).
contractStorage :: Address -> PureM ContractState
contractStorage :: Address -> PureM ContractState
contractStorage Address
addr = do
  GState{Map Address AddressState
GlobalCounter
ChainId
BigMapCounter
VotingPowers
gsBigMapCounter :: BigMapCounter
gsCounter :: GlobalCounter
gsVotingPowers :: VotingPowers
gsAddresses :: Map Address AddressState
gsChainId :: ChainId
gsVotingPowers :: GState -> VotingPowers
gsCounter :: GState -> GlobalCounter
gsChainId :: GState -> ChainId
gsBigMapCounter :: GState -> BigMapCounter
gsAddresses :: GState -> Map Address AddressState
..} <- 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 Address -> Map Address AddressState -> Maybe AddressState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Address
addr Map Address AddressState
gsAddresses of
    Just (ASContract ContractState
contractState) -> ContractState -> PureM ContractState
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractState
contractState
    Just (ASSimple {}) -> TestError -> PureM ContractState
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM ContractState)
-> (Text -> TestError) -> Text -> PureM ContractState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> PureM ContractState) -> Text -> PureM ContractState
forall a b. (a -> b) -> a -> b
$
      Text
"Expected address to be contract with storage, but it's a simple address: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Address
addr
    Maybe AddressState
Nothing -> Address -> PureM ContractState
forall whatever. Address -> PureM whatever
unknownAddress Address
addr

resolve :: AliasHint -> PureM Address
resolve :: AliasHint -> PureM Address
resolve (AliasHint -> Alias
hintToAlias -> Alias
name) = do
  Aliases
aliases <- Getting Aliases PureState Aliases -> PureM Aliases
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Aliases PureState Aliases
Lens' PureState Aliases
psAliases
  let maybeAddress :: Maybe AliasData
maybeAddress = Alias -> Aliases -> Maybe AliasData
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Alias
name Aliases
aliases
  PureM Address
-> (AliasData -> PureM Address) -> Maybe AliasData -> PureM Address
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Alias -> PureM Address
forall whatever. Alias -> PureM whatever
unknownAlias Alias
name) (Address -> PureM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> PureM Address)
-> (AliasData -> Address) -> AliasData -> PureM Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AliasData -> Address
adAddress) Maybe AliasData
maybeAddress

unknownAddress :: Address -> PureM whatever
unknownAddress :: Address -> PureM whatever
unknownAddress =
  TestError -> PureM whatever
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM whatever)
-> (Address -> TestError) -> Address -> PureM whatever
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError) -> (Address -> Text) -> Address -> 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) -> (Address -> Text) -> Address -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

unknownAlias :: Alias -> PureM whatever
unknownAlias :: Alias -> PureM whatever
unknownAlias =
  TestError -> PureM whatever
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM whatever)
-> (Alias -> TestError) -> Alias -> PureM whatever
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError) -> (Alias -> Text) -> Alias -> 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 -> Text) -> Alias -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

-- | Make branch names for a case when we are not within any branch.
emptyScenarioBranch :: ScenarioBranchName
emptyScenarioBranch :: ScenarioBranchName
emptyScenarioBranch = [Text] -> ScenarioBranchName
ScenarioBranchName []

-- | Add a new branch element to names provided by inner
-- 'Test.Cleveland.branchout' calls.
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)

----------------------------------------------------------------------------
-- Support functions
----------------------------------------------------------------------------

initAliases :: Alias -> Aliases
initAliases :: Alias -> Aliases
initAliases Alias
alias = OneItem Aliases -> Aliases
forall x. One x => OneItem x -> x
one ( Alias
alias
                        , Address -> Maybe SecretKey -> AliasData
AliasData Address
genesisAddress (Maybe SecretKey -> AliasData) -> Maybe SecretKey -> AliasData
forall a b. (a -> b) -> a -> b
$
                          SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just (SecretKey -> Maybe SecretKey) -> SecretKey -> Maybe SecretKey
forall a b. (a -> b) -> a -> b
$ SecretKey
genesisSecretKey
                        )

initEnv :: Alias -> PureState
initEnv :: Alias -> PureState
initEnv Alias
alias = PureState :: Aliases
-> DefaultAliasCounter
-> Set Address
-> Timestamp
-> Natural
-> GState
-> Map Address Text
-> PureState
PureState
  { _psAliases :: Aliases
_psAliases = Alias -> Aliases
initAliases Alias
alias
  , _psDefaultAliasesCounter :: DefaultAliasCounter
_psDefaultAliasesCounter = Natural -> DefaultAliasCounter
DefaultAliasCounter Natural
0
  , _psRefillableAddresses :: Set Address
_psRefillableAddresses = Set Address
forall a. Set a
Set.empty
  , _psNow :: Timestamp
_psNow = Timestamp
dummyNow
  , _psLevel :: Natural
_psLevel = Natural
dummyLevel
  , _psGState :: GState
_psGState = GState
initGState
  , _psContractsNames :: Map Address Text
_psContractsNames = Map Address Text
forall k a. Map k a
Map.empty
  }

failedInsideBranch :: Text -> SomeException -> FailedInBranch
failedInsideBranch :: Text -> SomeException -> FailedInBranch
failedInsideBranch Text
name SomeException
err = case SomeException -> Maybe FailedInBranch
forall e. Exception e => SomeException -> Maybe e
fromException @FailedInBranch SomeException
err of
  Just (FailedInBranch ScenarioBranchName
branch SomeException
failure) ->
    ScenarioBranchName -> SomeException -> FailedInBranch
FailedInBranch (Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
name ScenarioBranchName
branch) SomeException
failure
  Maybe FailedInBranch
Nothing ->
    ScenarioBranchName -> SomeException -> FailedInBranch
FailedInBranch (Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
name ScenarioBranchName
emptyScenarioBranch) SomeException
err

----------------------------------------------------------------------------
-- Emulator internals
----------------------------------------------------------------------------

transfer
  :: forall cp vd epRef epArg addr.
     (HasEntrypointArg cp epRef epArg, T.IsoValue epArg, L.ToTAddress cp vd addr)
  => "from" :! Address
  -> "to" :! addr
  -> Mutez
  -> epRef
  -> epArg
  -> PureM ()
transfer :: NamedF Identity Address "from"
-> ("to" :! addr) -> Mutez -> epRef -> epArg -> PureM ()
transfer (Name "from" -> NamedF Identity Address "from" -> Address
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "from" (Name "from")
Name "from"
#from -> Address
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' = addr -> TAddress cp vd
forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
L.toTAddress @cp @vd addr
toAddr in
  case epRef -> (Dict (ParameterScope (ToT epArg)), EpName)
forall k (cp :: k) 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) -> ReaderT
  ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
-> PureM ()
forall a. ExecutorM a -> PureM a
registerInterpretation do
      TypeCheckOptions
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
executeGlobalOperations TypeCheckOptions
forall a. Default a => a
def ([ExecutorOp]
 -> ReaderT
      ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ())
-> [ExecutorOp]
-> ReaderT
     ExecutorEnv (StateT ExecutorState (Except ExecutorError)) ()
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 :: Address -> TxParam -> EpName -> Mutez -> TxData
TxData
            { tdSenderAddress :: Address
tdSenderAddress = Address
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 (ProperParameterBetterErrors (ToT epArg)
:- ParameterScope (ToT epArg)
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 a contract with given initial storage and balance. Its
-- address is returned.
originate :: U.Contract -> Text -> U.Value -> Mutez -> PureM Address
originate :: Contract -> Text -> Value -> Mutez -> PureM Address
originate Contract
uContract Text
contractName 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 Address
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM Address) -> TestError -> PureM Address
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
      Address
address <- ExecutorM Address -> PureM Address
forall a. ExecutorM a -> PureM a
registerInterpretation (ExecutorM Address -> PureM Address)
-> (OriginationOperation -> ExecutorM Address)
-> OriginationOperation
-> PureM Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginationOperation -> ExecutorM Address
executeGlobalOrigination (OriginationOperation -> PureM Address)
-> OriginationOperation -> PureM Address
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 }

      (Map Address Text -> Identity (Map Address Text))
-> PureState -> Identity PureState
Lens' PureState (Map Address Text)
psContractsNames ((Map Address Text -> Identity (Map Address Text))
 -> PureState -> Identity PureState)
-> (Map Address Text -> Map Address Text) -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Address -> Text -> Map Address Text -> Map Address Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Address
address Text
contractName
      return Address
address

throwEE :: ExecutorError -> PureM a
throwEE :: ExecutorError -> PureM a
throwEE ExecutorError
err = do
  PureState
st <- PureM PureState
forall s (m :: * -> *). MonadState s m => m s
get
  ExecutorError' AddressName -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ExecutorError' AddressName -> PureM a)
-> ExecutorError' AddressName -> PureM a
forall a b. (a -> b) -> a -> b
$ (Address -> PureState -> AddressName)
-> PureState -> Address -> AddressName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Address -> PureState -> AddressName
addrToAddrName PureState
st (Address -> AddressName)
-> ExecutorError -> ExecutorError' AddressName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExecutorError
err

-- | Runs a set of operations and updates the engine's state.
registerInterpretation :: ExecutorM a -> PureM a
registerInterpretation :: 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 :: 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 an action and return the result _without_ updating the engine's state.
interpret :: ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret :: 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
  pure $ Timestamp
-> Natural
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
forall a.
Timestamp
-> Natural
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now Natural
level RemainingSteps
dummyMaxSteps GState
gState ExecutorM a
action

addrToAddrName :: Address -> PureState -> AddressName
addrToAddrName :: Address -> PureState -> AddressName
addrToAddrName Address
addr PureState
iState =
  Maybe Text -> Address -> AddressName
AddressName (Address -> Map Address Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Address
addr (PureState
iState PureState
-> Getting (Map Address Text) PureState (Map Address Text)
-> Map Address Text
forall s a. s -> Getting a s a -> a
^. Getting (Map Address Text) PureState (Map Address Text)
Lens' PureState (Map Address Text)
psContractsNames)) Address
addr

addrNameToAddr :: AddressName -> Address
addrNameToAddr :: AddressName -> Address
addrNameToAddr (AddressName Maybe Text
_ Address
addr) = Address
addr