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

-- | 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
  , psExecutorResult
  , psContractsNames
  ) where

import Control.Lens (assign, 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 qualified Data.Map as Map
import Data.Monoid (Ap(..))
import qualified Data.Set as Set
import Data.Type.Equality (type (:~:)(Refl))
import Fmt (Buildable(..), Builder, indentF, pretty, unlinesF, (+|), (|+))
import Time (Second, toNum, toUnit)

import Lorentz (Mutez, NiceComparable, pattern DefEpName)
import Lorentz.Entrypoints (HasEntrypointArg, TrustEpName(..), useHasEntrypointArg)
import qualified Lorentz.Value as L (TAddress(..), ToTAddress(..))
import Morley.Client (Alias, mkAlias)
import Morley.Client.RPC.AsRPC (notesAsRPC, rpcStorageScopeEvi, valueAsRPC)
import Morley.Client.TezosClient.Types (unsafeCoerceAliasHintToAlias, unsafeGetAliasHintText)
import Morley.Michelson.Interpret
  (InterpretError(..), InterpretResult(..), MichelsonFailed(..), MichelsonFailureWithStack(..))
import Morley.Michelson.Runtime hiding (ExecutorOp(..), transfer)
import qualified Morley.Michelson.Runtime as Runtime (ExecutorOp(..))
import Morley.Michelson.Runtime.Dummy (dummyLevel, dummyMaxSteps, dummyNow, dummyOrigination)
import Morley.Michelson.Runtime.GState
  (GState(..), asBalance, genesisAddress, genesisSecretKey, gsAddressesL, gsChainIdL,
  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 qualified Morley.Michelson.Typed as T
import Morley.Michelson.Typed.Operation (OriginationOperation(..), TransferOperation(..))
import qualified Morley.Michelson.Untyped 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.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 -> Maybe ExecutorRes
_psExecutorResult :: Maybe ExecutorRes
  -- ^ Store the most recent result of interpreted operations.
  , PureState -> Map Address Text
_psContractsNames :: Map Address Text
  -- ^ Map from contracts addresses to human-readable names.
  }

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)

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
  }

data TestError
  = UnexpectedTypeCheckError TCError
  | UnexpectedStorageType T.T T.T
  | UnexpectedBigMapKeyType T.T T.T
  | UnexpectedBigMapValueType T.T 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 T
actualT T
expectedT) = [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
    [ Builder
"Expected storage to be of type:"
    , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ T -> Builder
forall p. Buildable p => p -> Builder
build (T -> Builder) -> T -> Builder
forall a b. (a -> b) -> a -> b
$ T
expectedT
    , Builder
"But its type was:"
    , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ T -> Builder
forall p. Buildable p => p -> Builder
build (T -> Builder) -> T -> Builder
forall a b. (a -> b) -> a -> b
$ T
actualT
    ]
  build (UnexpectedBigMapKeyType T
actualT T
expectedT) = [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
    [ Builder
"Expected big_map's key type to be: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> T -> Builder
forall p. Buildable p => p -> Builder
build T
expectedT
    , Builder
"But its type was:                  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> T -> Builder
forall p. Buildable p => p -> Builder
build T
actualT
    ]
  build (UnexpectedBigMapValueType T
actualT T
expectedT) = [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
    [ Builder
"Expected big_map's value type to be:"
    , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ T -> Builder
forall p. Buildable p => p -> Builder
build T
expectedT
    , Builder
"But its type was:"
    , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ T -> Builder
forall p. Buildable p => p -> Builder
build T
actualT
    ]
  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
    let emulatedCaps :: EmulatedCaps PureM
emulatedCaps = EmulatedImpl PureM -> ClevelandCaps PureM -> EmulatedCaps PureM
forall (m :: * -> *).
EmulatedImpl m -> ClevelandCaps m -> EmulatedCaps m
EmulatedCaps EmulatedImpl PureM
emulatedImpl ClevelandCaps PureM
clevelandCaps
    PureM a -> ClevelandT PureM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PureM a -> ClevelandT PureM a) -> PureM a -> ClevelandT PureM a
forall a b. (a -> b) -> a -> b
$ 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
emulatedCaps

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 => [BaseOperationData] -> m [BaseOperationResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
    { coiRunOperationBatch :: HasCallStack => [BaseOperationData] -> PureM [BaseOperationResult]
coiRunOperationBatch = (BaseOperationData -> PureM BaseOperationResult)
-> [BaseOperationData] -> PureM [BaseOperationResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM \case
        OriginateOp UntypedOriginateData{Contract
Value
Mutez
AliasHint
uodContract :: UntypedOriginateData -> Contract
uodStorage :: UntypedOriginateData -> Value
uodBalance :: UntypedOriginateData -> Mutez
uodName :: UntypedOriginateData -> AliasHint
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: 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
          Address -> BaseOperationResult
OriginateResult (Address -> BaseOperationResult)
-> PureM Address -> PureM BaseOperationResult
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
        TransferOp TransferData{v
addr
EpName
Mutez
tdParameter :: ()
tdEntrypoint :: TransferData -> EpName
tdAmount :: TransferData -> Mutez
tdTo :: ()
tdParameter :: v
tdEntrypoint :: EpName
tdAmount :: Mutez
tdTo :: addr
..} -> 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 BaseOperationResult
TransferResult
    }

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 => Alias -> 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, NicePackedValue 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 ())
-> 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 => Alias -> PureM Address
cmiResolveAddress = HasCallStack => Alias -> PureM Address
Alias -> 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 ->
            TestError -> PureM Signature
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM Signature)
-> (Alias -> TestError) -> Alias -> PureM Signature
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
"Given address doesn't have known associated secret key: " (Text -> Text) -> (Alias -> Text) -> Alias -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> Text
forall b a. (Show a, IsString b) => a -> b
show (Alias -> PureM Signature) -> Alias -> PureM Signature
forall a b. (a -> b) -> a -> b
$ 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 ->
            TestError -> PureM PublicKey
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM PublicKey)
-> (Address -> TestError) -> Address -> PureM PublicKey
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
"Given address doesn't have known associated public key: " (Text -> Text) -> (Address -> Text) -> Address -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Text
forall b a. (Show a, IsString b) => a -> b
show (Address -> PureM PublicKey) -> Address -> PureM PublicKey
forall a b. (a -> b) -> a -> b
$ 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
    , cmiFailure :: forall a. HasCallStack => 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
    , 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
    , HasCallStack => Address -> PureM SomeAnnotatedValue
Address -> PureM SomeAnnotatedValue
forall k v.
(HasCallStack, NiceComparable k, NicePackedValue 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)
cmiGetAllBigMapValuesMaybe :: forall k v.
(HasCallStack, NiceComparable k, NicePackedValue 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
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)
..
    }
  where
    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 {Contract
Value
Mutez
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 k v
bmId k
k = do
      Maybe (Map (Value (ToT k)) (Value (ToT v)))
mbBigMap <- BigMapId k v -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
findBigMapById BigMapId k v
bmId
      case Maybe (Map (Value (ToT k)) (Value (ToT v)))
mbBigMap of
        Maybe (Map (Value (ToT k)) (Value (ToT v)))
Nothing      -> Maybe v -> PureM (Maybe v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing
        Just Map (Value (ToT k)) (Value (ToT v))
bigMap  -> Maybe v -> PureM (Maybe v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe v -> PureM (Maybe v)) -> Maybe v -> PureM (Maybe 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 (ToT v) -> v) -> Maybe (Value (ToT v)) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (ToT k)
-> Map (Value (ToT k)) (Value (ToT v)) -> Maybe (Value (ToT 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 (ToT k)) (Value (ToT 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 k v
bmId = do
      Maybe (Map (Value (ToT k)) (Value (ToT v)))
mbBigMap <- BigMapId k v -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
findBigMapById BigMapId k v
bmId
      case Maybe (Map (Value (ToT k)) (Value (ToT v)))
mbBigMap of
        Maybe (Map (Value (ToT k)) (Value (ToT v)))
Nothing     -> Maybe [v] -> PureM (Maybe [v])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [v]
forall a. Maybe a
Nothing
        Just Map (Value (ToT k)) (Value (ToT v))
bigMap -> Maybe [v] -> PureM (Maybe [v])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [v] -> PureM (Maybe [v])) -> Maybe [v] -> PureM (Maybe [v])
forall a b. (a -> b) -> a -> b
$ [v] -> Maybe [v]
forall a. a -> Maybe a
Just ([v] -> Maybe [v]) -> [v] -> Maybe [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 (ToT v) -> v) -> [Value (ToT v)] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (Value (ToT k)) (Value (ToT v)) -> [Value (ToT v)]
forall k a. Map k a -> [a]
Map.elems Map (Value (ToT k)) (Value (ToT v))
bigMap

    -- | 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.
    findBigMapById
      :: forall k v.
         (NiceComparable k, IsoValue v)
      => BigMapId k v
      -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
    findBigMapById :: BigMapId k v -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
findBigMapById (BigMapId Natural
bigMapId) = 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 [Map (Value (ToT k)) (Value (ToT v))]
result =
            ((AddressState
  -> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT v))])
 -> [AddressState]
 -> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT v))])
-> [AddressState]
-> (AddressState
    -> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT v))])
-> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT v))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (AddressState
 -> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT v))])
-> [AddressState]
-> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT 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) [Map (Value (ToT k)) (Value (ToT v))]
forall (k :: T) (v :: T) (st :: T).
(SingI k, SingI v) =>
Value st
-> Natural -> Ap (Either TestError) [Map (Value k) (Value v)]
findBigMapInStorage Value st
csStorage Natural
bigMapId
              ASSimple {} -> Either TestError [Map (Value (ToT k)) (Value (ToT v))]
-> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT v))]
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Either TestError [Map (Value (ToT k)) (Value (ToT v))]
 -> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT v))])
-> Either TestError [Map (Value (ToT k)) (Value (ToT v))]
-> Ap (Either TestError) [Map (Value (ToT k)) (Value (ToT v))]
forall a b. (a -> b) -> a -> b
$ [Map (Value (ToT k)) (Value (ToT v))]
-> Either TestError [Map (Value (ToT k)) (Value (ToT v))]
forall a b. b -> Either a b
Right []

      case Either TestError [Map (Value (ToT k)) (Value (ToT 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 (Map (Value (ToT k)) (Value (ToT v)))
-> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Map (Value (ToT k)) (Value (ToT v)))
forall a. Maybe a
Nothing
        Right [Map (Value (ToT k)) (Value (ToT v))
bigMap] -> Maybe (Map (Value (ToT k)) (Value (ToT v)))
-> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Map (Value (ToT k)) (Value (ToT v)))
 -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v)))))
-> Maybe (Map (Value (ToT k)) (Value (ToT v)))
-> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
forall a b. (a -> b) -> a -> b
$ Map (Value (ToT k)) (Value (ToT v))
-> Maybe (Map (Value (ToT k)) (Value (ToT v)))
forall a. a -> Maybe a
Just Map (Value (ToT k)) (Value (ToT v))
bigMap
        Right [Map (Value (ToT k)) (Value (ToT v))]
bigMaps ->
          Text -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v))))
forall a. HasCallStack => Text -> a
error (Text -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT v)))))
-> Text -> PureM (Maybe (Map (Value (ToT k)) (Value (ToT 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
+| [Map (Value (ToT k)) (Value (ToT v))] -> Int
forall t. Container t => t -> Int
length [Map (Value (ToT k)) (Value (ToT 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 (Map (Value (ToT k)) (Value (ToT 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) [Map (Value k) (Value v)]
    findBigMapInStorage :: Value st
-> Natural -> Ap (Either TestError) [Map (Value k) (Value v)]
findBigMapInStorage Value st
storage Natural
bigMapId =
      (forall (t' :: T).
 Value t' -> Ap (Either TestError) [Map (Value k) (Value v)])
-> Value st -> Ap (Either TestError) [Map (Value k) (Value v)]
forall x (t :: T).
Monoid x =>
(forall (t' :: T). Value t' -> x) -> Value t -> x
dfsFoldMapValue
        (\case
            VBigMap (Just Natural
bigMapId') (Map (Value k) (Value v)
bigMap :: 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. Demote T -> Demote T -> Ap (Either TestError) x)
-> Ap (Either TestError) (k :~: k)
forall (a :: T) (b :: T) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
(forall x. Demote T -> Demote 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)
-> (T -> T -> TestError) -> T -> T -> Ap (Either TestError) x
forall a b c. SuperComposition a b c => a -> b -> c
... T -> T -> TestError
UnexpectedBigMapKeyType)
                  v :~: v
Refl <- (forall x. Demote T -> Demote T -> Ap (Either TestError) x)
-> Ap (Either TestError) (v :~: v)
forall (a :: T) (b :: T) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
(forall x. Demote T -> Demote 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)
-> (T -> T -> TestError) -> T -> T -> Ap (Either TestError) x
forall a b c. SuperComposition a b c => a -> b -> c
... T -> T -> TestError
UnexpectedBigMapValueType)
                  [Map (Value k) (Value v)]
-> Ap (Either TestError) [Map (Value k) (Value v)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Map (Value k) (Value v)
bigMap]
            Value t'
_ -> Either TestError [Map (Value k) (Value v)]
-> Ap (Either TestError) [Map (Value k) (Value v)]
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Either TestError [Map (Value k) (Value v)]
 -> Ap (Either TestError) [Map (Value k) (Value v)])
-> Either TestError [Map (Value k) (Value v)]
-> Ap (Either TestError) [Map (Value k) (Value v)]
forall a b. (a -> b) -> a -> b
$ [Map (Value k) (Value v)]
-> Either TestError [Map (Value k) (Value 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 (AsRPC st) -> Value (AsRPC st) -> SomeAnnotatedValue
forall (t :: T).
SingI t =>
Notes t -> Value t -> SomeAnnotatedValue
SomeAnnotatedValue
          (Notes st -> Notes (AsRPC st)
forall (t :: T). Notes t -> Notes (AsRPC t)
notesAsRPC (Notes st -> Notes (AsRPC st)) -> Notes st -> Notes (AsRPC 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 (AsRPC st)
forall (t :: T). HasCallStack => Value t -> Value (AsRPC t)
valueAsRPC Value st
storage)
          (StorageScope (AsRPC st) => SomeAnnotatedValue)
-> (StorageScope st :- StorageScope (AsRPC st))
-> SomeAnnotatedValue
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ StorageScope st :- StorageScope (AsRPC st)
forall (t :: T). StorageScope t :- StorageScope (AsRPC 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

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
ChainId
GlobalCounter
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 T
_ 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' instr n
_ Value' instr 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), FailOnOperationFound (ContainsOp (ToT st)),
    FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
    FailOnContractFound (ContainsContract (ToT st))),
   HasAnnotation st, KnownValue st)
-> (((SingI (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
      FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
      FailOnContractFound (ContainsContract (ToT st))),
     HasAnnotation 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), FailOnOperationFound (ContainsOp (ToT st)),
       FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
       FailOnContractFound (ContainsContract (ToT st))),
      HasAnnotation st, KnownValue st)
forall st addr.
ToStorageType st addr =>
addr -> Dict (NiceStorage st)
pickNiceStorage @st addr
addr) ((((SingI (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
    FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
    FailOnContractFound (ContainsContract (ToT st))),
   HasAnnotation st, KnownValue st) =>
  PureM st)
 -> PureM st)
-> (((SingI (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
      FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
      FailOnContractFound (ContainsContract (ToT st))),
     HasAnnotation 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. Demote T -> Demote 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. Demote T -> Demote 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)
-> (T -> T -> TestError) -> T -> T -> PureM x
forall a b c. SuperComposition a b c => a -> b -> c
... T -> 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
ChainId
GlobalCounter
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 b a. (Show a, IsString b) => a -> b
show Address
addr
    Maybe AddressState
Nothing -> Address -> PureM ContractState
forall whatever. Address -> PureM whatever
unknownAddress Address
addr

resolve :: Alias -> PureM Address
resolve :: Alias -> PureM Address
resolve 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
-> Maybe ExecutorRes
-> 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
  , _psExecutorResult :: Maybe ExecutorRes
_psExecutorResult = Maybe ExecutorRes
forall a. Maybe a
Nothing
  , _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 (N Address
from) (N 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) -> [ExecutorOp] -> PureM ()
registerInterpretation ([ExecutorOp] -> PureM ())
-> (TransferOperation -> [ExecutorOp])
-> TransferOperation
-> PureM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutorOp -> [ExecutorOp]
forall x. One x => OneItem x -> x
one (ExecutorOp -> [ExecutorOp])
-> (TransferOperation -> ExecutorOp)
-> TransferOperation
-> [ExecutorOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransferOperation -> ExecutorOp
Runtime.TransferOp (TransferOperation -> PureM ()) -> TransferOperation -> PureM ()
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), () :: 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
      Either ExecutorError (ExecutorRes, Address)
result <- ExecutorM Address
-> PureM (Either ExecutorError (ExecutorRes, Address))
forall a.
ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret (ExecutorM Address
 -> PureM (Either ExecutorError (ExecutorRes, Address)))
-> (OriginationOperation -> ExecutorM Address)
-> OriginationOperation
-> PureM (Either ExecutorError (ExecutorRes, Address))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginationOperation -> ExecutorM Address
executeGlobalOrigination (OriginationOperation
 -> PureM (Either ExecutorError (ExecutorRes, Address)))
-> OriginationOperation
-> PureM (Either ExecutorError (ExecutorRes, 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 }
      Either ExecutorError ExecutorRes -> PureM ()
putResult (Either ExecutorError ExecutorRes -> PureM ())
-> Either ExecutorError ExecutorRes -> PureM ()
forall a b. (a -> b) -> a -> b
$ ((ExecutorRes, Address) -> ExecutorRes)
-> Either ExecutorError (ExecutorRes, Address)
-> Either ExecutorError ExecutorRes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, Address) -> ExecutorRes
forall a b. (a, b) -> a
fst Either ExecutorError (ExecutorRes, Address)
result
      Address
address <- (ExecutorError -> PureM Address)
-> ((ExecutorRes, Address) -> PureM Address)
-> Either ExecutorError (ExecutorRes, Address)
-> PureM Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExecutorError -> PureM Address
forall a. ExecutorError -> PureM a
throwEE (Address -> PureM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> PureM Address)
-> ((ExecutorRes, Address) -> Address)
-> (ExecutorRes, Address)
-> PureM Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExecutorRes, Address) -> Address
forall a b. (a, b) -> b
snd) (Either ExecutorError (ExecutorRes, Address) -> PureM Address)
-> Either ExecutorError (ExecutorRes, Address) -> PureM Address
forall a b. (a -> b) -> a -> b
$ Either ExecutorError (ExecutorRes, Address)
result

      (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

-- | Put an interpreted result to InternalState.
putResult :: Either ExecutorError ExecutorRes -> PureM ()
putResult :: Either ExecutorError ExecutorRes -> PureM ()
putResult Either ExecutorError ExecutorRes
resOrErr = do
  let
    logs :: LogsInfo
logs = case Either ExecutorError ExecutorRes
resOrErr of
      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 -> 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
_ -> []
  LogsInfo -> PureM ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell LogsInfo
logs
  case Either ExecutorError ExecutorRes
resOrErr of
    Right ExecutorRes
res -> (Maybe ExecutorRes -> Identity (Maybe ExecutorRes))
-> PureState -> Identity PureState
Lens' PureState (Maybe ExecutorRes)
psExecutorResult ((Maybe ExecutorRes -> Identity (Maybe ExecutorRes))
 -> PureState -> Identity PureState)
-> Maybe ExecutorRes -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorRes -> Maybe ExecutorRes
forall a. a -> Maybe a
Just ExecutorRes
res
    Left ExecutorError
err -> ExecutorError -> PureM ()
forall a. ExecutorError -> PureM a
throwEE ExecutorError
err

-- | Helper function which provides the results of the given operations.
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
  let interpretedResult :: Either ExecutorError (ExecutorRes, a)
interpretedResult = 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
  Either ExecutorError (ExecutorRes, a)
-> ((ExecutorRes, a) -> PureM ()) -> PureM ()
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (r -> f ()) -> f ()
whenRight Either ExecutorError (ExecutorRes, a)
interpretedResult (((ExecutorRes, a) -> PureM ()) -> PureM ())
-> ((ExecutorRes, a) -> PureM ()) -> PureM ()
forall a b. (a -> b) -> a -> b
$ \(ExecutorRes
result, a
_) -> (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
result
  return Either ExecutorError (ExecutorRes, a)
interpretedResult

-- | Interprets provided list of operations.
registerInterpretation :: [Runtime.ExecutorOp] -> PureM ()
registerInterpretation :: [ExecutorOp] -> PureM ()
registerInterpretation [ExecutorOp]
ops =
  ExecutorM () -> PureM (Either ExecutorError (ExecutorRes, ()))
forall a.
ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret (TypeCheckOptions -> [ExecutorOp] -> ExecutorM ()
executeGlobalOperations TypeCheckOptions
forall a. Default a => a
def [ExecutorOp]
ops) PureM (Either ExecutorError (ExecutorRes, ()))
-> (Either ExecutorError (ExecutorRes, ())
    -> Either ExecutorError ExecutorRes)
-> PureM (Either ExecutorError ExecutorRes)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ExecutorRes, ()) -> ExecutorRes)
-> Either ExecutorError (ExecutorRes, ())
-> Either ExecutorError ExecutorRes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, ()) -> ExecutorRes
forall a b. (a, b) -> a
fst PureM (Either ExecutorError ExecutorRes)
-> (Either ExecutorError ExecutorRes -> PureM ()) -> PureM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ExecutorError ExecutorRes -> PureM ()
putResult

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