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

{-# OPTIONS_HADDOCK not-home #-}

-- | Integration with integrational testing engine (pun intended).
module Test.Cleveland.Internal.Pure
  ( module Test.Cleveland.Internal.Pure
  ) where

import Unsafe qualified ((!!))

import Control.Lens (LensLike', assign, at, makeLenses, modifying, to, (%=), (.=), (?=), (?~))
import Control.Lens.At (At, Index, IxValue)
import Control.Lens.Unsound (lensProduct)
import Control.Monad.Catch.Pure (CatchT, runCatchT)
import Control.Monad.Writer (MonadWriter, WriterT, listen, runWriterT, tell)
import Crypto.Number.Serialize.LE (os2ip)
import Data.Constraint (withDict, (\\))
import Data.Default (def)
import Data.Map qualified as Map
import Data.Ratio ((%))
import Data.Set qualified as Set
import Data.Type.Equality (pattern Refl)
import Fmt (Buildable(..), Builder, build, pretty, unlinesF, (+|), (|+))
import Time (Second, toNum, toUnit)

import Lorentz (Mutez, NiceComparable, pattern DefEpName)
import Lorentz qualified as L
import Morley.AsRPC (HasRPCRepr(AsRPC), notesAsRPC, rpcStorageScopeEvi, valueAsRPC)
import Morley.Client (OperationInfo(..))
import Morley.Client.Types (AddressWithAlias(..))
import Morley.Michelson.Interpret
  (InterpretError(..), MichelsonFailed(..), MichelsonFailureWithStack(..), ResultStateLogs(..))
import Morley.Michelson.Runtime hiding (ExecutorOp(..), transfer)
import Morley.Michelson.Runtime qualified as Runtime
import Morley.Michelson.Runtime.Dummy
  (dummyLevel, dummyMaxSteps, dummyMinBlockTime, dummyNow, dummyOrigination)
import Morley.Michelson.Runtime.GState
  (AddressStateFam, GState(..), ImplicitState(..), addressesL, genesisAddress, genesisSecretKey,
  gsChainIdL, gsContractAddressAliasesL, gsContractAddressesL, gsImplicitAddressAliasesL,
  gsVotingPowersL, initGState, lookupBalance, toTicketKey)
import Morley.Michelson.TypeCheck (TcError)
import Morley.Michelson.Typed
  (BigMapId(..), IsoValue, SingI, SomeAnnotatedValue(..), SomeVBigMap(..), ToT, Value, Value'(..),
  castM, fromVal, toVal)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Operation
  (EmitOperation(..), OriginationOperation(..), SetDelegateOperation(..), TransferOperation(..))
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core (Timestamp, timestampPlusSeconds, unsafeSubMutez, zeroMutez)
import Morley.Tezos.Crypto (KeyHash, KeyType(..), SecretKey(..), detSecretKey', sign, toPublic)
import Morley.Util.Constrained
import Morley.Util.MismatchError
import Morley.Util.Named

import Morley.Util.Bimap qualified as Bimap
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Common
import Test.Cleveland.Internal.Exceptions
import Test.Cleveland.Lorentz
import Test.Cleveland.Util (ceilingUnit)

data PureState = PureState
  { PureState -> Map ImplicitAddress SecretKey
_psSecretKeys :: Map ImplicitAddress SecretKey
  , PureState -> DefaultAliasCounter
_psDefaultAliasesCounter :: DefaultAliasCounter
  , PureState -> Set ImplicitAddress
_psRefillableAddresses :: Set ImplicitAddress
  , PureState -> Timestamp
_psNow :: Timestamp
  , PureState -> Natural
_psLevel :: Natural
  , PureState -> Natural
_psMinBlockTime :: Natural
  , PureState -> GState
_psGState :: GState
  }
  deriving stock (PureState -> PureState -> Bool
(PureState -> PureState -> Bool)
-> (PureState -> PureState -> Bool) -> Eq PureState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PureState -> PureState -> Bool
$c/= :: PureState -> PureState -> Bool
== :: PureState -> PureState -> Bool
$c== :: PureState -> PureState -> Bool
Eq, Int -> PureState -> ShowS
[PureState] -> ShowS
PureState -> String
(Int -> PureState -> ShowS)
-> (PureState -> String)
-> ([PureState] -> ShowS)
-> Show PureState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PureState] -> ShowS
$cshowList :: [PureState] -> ShowS
show :: PureState -> String
$cshow :: PureState -> String
showsPrec :: Int -> PureState -> ShowS
$cshowsPrec :: Int -> PureState -> ShowS
Show)

instance MonadState PureState PureM where
  get :: PureM PureState
get = PureM (IORef PureState)
forall r (m :: * -> *). MonadReader r m => m r
ask PureM (IORef PureState)
-> (IORef PureState -> PureM PureState) -> PureM PureState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef PureState -> PureM PureState
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef
  put :: PureState -> PureM ()
put = (PureM (IORef PureState)
forall r (m :: * -> *). MonadReader r m => m r
ask PureM (IORef PureState)
-> (IORef PureState -> PureM ()) -> PureM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) ((IORef PureState -> PureM ()) -> PureM ())
-> (PureState -> IORef PureState -> PureM ())
-> PureState
-> PureM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef PureState -> PureState -> PureM ())
-> PureState -> IORef PureState -> PureM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef PureState -> PureState -> PureM ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef

newtype PureM a = PureM
  { forall a.
PureM a
-> ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
unPureM :: ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
  }
  deriving newtype ((forall a b. (a -> b) -> PureM a -> PureM b)
-> (forall a b. a -> PureM b -> PureM a) -> Functor PureM
forall a b. a -> PureM b -> PureM a
forall a b. (a -> b) -> PureM a -> PureM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PureM b -> PureM a
$c<$ :: forall a b. a -> PureM b -> PureM a
fmap :: forall a b. (a -> b) -> PureM a -> PureM b
$cfmap :: forall a b. (a -> b) -> PureM a -> PureM b
Functor, Functor PureM
Functor PureM
-> (forall a. a -> PureM a)
-> (forall a b. PureM (a -> b) -> PureM a -> PureM b)
-> (forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c)
-> (forall a b. PureM a -> PureM b -> PureM b)
-> (forall a b. PureM a -> PureM b -> PureM a)
-> Applicative PureM
forall a. a -> PureM a
forall a b. PureM a -> PureM b -> PureM a
forall a b. PureM a -> PureM b -> PureM b
forall a b. PureM (a -> b) -> PureM a -> PureM b
forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. PureM a -> PureM b -> PureM a
$c<* :: forall a b. PureM a -> PureM b -> PureM a
*> :: forall a b. PureM a -> PureM b -> PureM b
$c*> :: forall a b. PureM a -> PureM b -> PureM b
liftA2 :: forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c
$cliftA2 :: forall a b c. (a -> b -> c) -> PureM a -> PureM b -> PureM c
<*> :: forall a b. PureM (a -> b) -> PureM a -> PureM b
$c<*> :: forall a b. PureM (a -> b) -> PureM a -> PureM b
pure :: forall a. a -> PureM a
$cpure :: forall a. a -> PureM a
Applicative, Applicative PureM
Applicative PureM
-> (forall a b. PureM a -> (a -> PureM b) -> PureM b)
-> (forall a b. PureM a -> PureM b -> PureM b)
-> (forall a. a -> PureM a)
-> Monad PureM
forall a. a -> PureM a
forall a b. PureM a -> PureM b -> PureM b
forall a b. PureM a -> (a -> PureM b) -> PureM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> PureM a
$creturn :: forall a. a -> PureM a
>> :: forall a b. PureM a -> PureM b -> PureM b
$c>> :: forall a b. PureM a -> PureM b -> PureM b
>>= :: forall a b. PureM a -> (a -> PureM b) -> PureM b
$c>>= :: forall a b. PureM a -> (a -> PureM b) -> PureM b
Monad, Monad PureM
Monad PureM -> (forall a. IO a -> PureM a) -> MonadIO PureM
forall a. IO a -> PureM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> PureM a
$cliftIO :: forall a. IO a -> PureM a
MonadIO, Monad PureM
Monad PureM
-> (forall e a. Exception e => e -> PureM a) -> MonadThrow PureM
forall e a. Exception e => e -> PureM a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> PureM a
$cthrowM :: forall e a. Exception e => e -> PureM a
MonadThrow, MonadThrow PureM
MonadThrow PureM
-> (forall e a.
    Exception e =>
    PureM a -> (e -> PureM a) -> PureM a)
-> MonadCatch PureM
forall e a. Exception e => PureM a -> (e -> PureM a) -> PureM a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a. Exception e => PureM a -> (e -> PureM a) -> PureM a
$ccatch :: forall e a. Exception e => PureM a -> (e -> PureM a) -> PureM a
MonadCatch,
                    MonadReader (IORef PureState), MonadWriter LogsInfo, Monad PureM
Monad PureM -> (forall a. String -> PureM a) -> MonadFail PureM
forall a. String -> PureM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> PureM a
$cfail :: forall a. String -> PureM a
MonadFail)

data TestError
  = UnexpectedTypeCheckError TcError
  | UnexpectedStorageType (MismatchError T.T)
  | UnexpectedBigMapType Natural (MismatchError T.T)
  | CustomTestError Text
  deriving stock Int -> TestError -> ShowS
[TestError] -> ShowS
TestError -> String
(Int -> TestError -> ShowS)
-> (TestError -> String)
-> ([TestError] -> ShowS)
-> Show TestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestError] -> ShowS
$cshowList :: [TestError] -> ShowS
show :: TestError -> String
$cshow :: TestError -> String
showsPrec :: Int -> TestError -> ShowS
$cshowsPrec :: Int -> TestError -> ShowS
Show

makeLenses ''PureState

instance Buildable TestError where
  build :: TestError -> Builder
build = \case
    UnexpectedTypeCheckError TcError
tcErr ->
      Builder
"Unexpected type check error. Reason: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TcError
tcErr TcError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    UnexpectedStorageType MismatchError T
merr ->
      Builder
"Unexpected storage type.\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MismatchError T
merr MismatchError T -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    UnexpectedBigMapType Natural
bigMapId MismatchError T
mismatchError ->
      [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
        [ Builder
"A big_map with the ID " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Natural
bigMapId Natural -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" was found, but it does not have the expected type."
        , MismatchError T -> Builder
forall p. Buildable p => p -> Builder
build MismatchError T
mismatchError
        ]
    CustomTestError Text
msg -> Text -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Text
msg

instance Exception TestError where
  displayException :: TestError -> String
displayException = TestError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
  fromException :: SomeException -> Maybe TestError
fromException = SomeException -> Maybe TestError
forall e. Exception e => SomeException -> Maybe e
fromPossiblyAnnotatedException

moneybagAlias :: ImplicitAlias
moneybagAlias :: ImplicitAlias
moneybagAlias = Text -> ImplicitAlias
ImplicitAlias Text
"moneybag"

runEmulatedT :: ImplicitAlias -> EmulatedT PureM a -> IO a
runEmulatedT :: forall a. ImplicitAlias -> EmulatedT PureM a -> IO a
runEmulatedT ImplicitAlias
moneybagAlias' EmulatedT PureM a
scenario = do
  let clevelandCaps :: ClevelandCaps PureM
clevelandCaps = ClevelandCaps :: forall (m :: * -> *).
Sender
-> Moneybag
-> ClevelandMiscImpl m
-> (Sender -> ClevelandOpsImpl m)
-> ClevelandCaps m
ClevelandCaps
        { ccSender :: Sender
ccSender = ImplicitAddressWithAlias -> Sender
Sender ImplicitAddressWithAlias
awa
        , ccMoneybag :: Moneybag
ccMoneybag = ImplicitAddressWithAlias -> Moneybag
Moneybag ImplicitAddressWithAlias
awa
        , ccMiscCap :: ClevelandMiscImpl PureM
ccMiscCap = ClevelandMiscImpl PureM
clevelandMiscImpl
        , ccOpsCap :: Sender -> ClevelandOpsImpl PureM
ccOpsCap = Sender -> ClevelandOpsImpl PureM
clevelandOpsImpl
        }
      caps :: EmulatedCaps PureM
caps = EmulatedImpl PureM -> ClevelandCaps PureM -> EmulatedCaps PureM
forall (m :: * -> *).
EmulatedImpl m -> ClevelandCaps m -> EmulatedCaps m
EmulatedCaps EmulatedImpl PureM
emulatedImpl ClevelandCaps PureM
clevelandCaps
      awa :: ImplicitAddressWithAlias
awa = ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
AddressWithAlias ImplicitAddress
genesisAddress ImplicitAlias
"moneybag"
  let pureM :: PureM a
pureM = EmulatedT PureM a -> EmulatedCaps PureM -> PureM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT EmulatedT PureM a
scenario EmulatedCaps PureM
caps
  IORef PureState
env <- PureState -> IO (IORef PureState)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (ImplicitAlias -> PureState
initEnv ImplicitAlias
moneybagAlias')
  (Either SomeException a
res, LogsInfo
_logs) <- WriterT LogsInfo IO (Either SomeException a)
-> IO (Either SomeException a, LogsInfo)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT LogsInfo IO (Either SomeException a)
 -> IO (Either SomeException a, LogsInfo))
-> WriterT LogsInfo IO (Either SomeException a)
-> IO (Either SomeException a, LogsInfo)
forall a b. (a -> b) -> a -> b
$ CatchT (WriterT LogsInfo IO) a
-> WriterT LogsInfo IO (Either SomeException a)
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT (CatchT (WriterT LogsInfo IO) a
 -> WriterT LogsInfo IO (Either SomeException a))
-> CatchT (WriterT LogsInfo IO) a
-> WriterT LogsInfo IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
-> IORef PureState -> CatchT (WriterT LogsInfo IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (PureM a
-> ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
forall a.
PureM a
-> ReaderT (IORef PureState) (CatchT (WriterT LogsInfo IO)) a
unPureM PureM a
pureM) IORef PureState
env
  (SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> IO a) -> Either SomeException a -> IO a
forall a b. (a -> b) -> a -> b
$ Either SomeException a
res

emulatedImpl :: EmulatedImpl PureM
emulatedImpl :: EmulatedImpl PureM
emulatedImpl =
  EmulatedImpl :: forall (m :: * -> *).
([(Text, m ())] -> m ())
-> (forall st addr.
    (HasCallStack, ToStorageType st addr) =>
    addr -> m st)
-> (forall a. m a -> m (LogsInfo, a))
-> (VotingPowers -> m ())
-> EmulatedImpl m
EmulatedImpl
    { eiBranchout :: [(Text, PureM ())] -> PureM ()
eiBranchout = \([(Text, PureM ())]
scenarios :: [(Text, PureM ())]) ->
        [(Text, PureM ())]
-> (Element [(Text, PureM ())] -> PureM ()) -> PureM ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ [(Text, PureM ())]
scenarios ((Element [(Text, PureM ())] -> PureM ()) -> PureM ())
-> (Element [(Text, PureM ())] -> PureM ()) -> PureM ()
forall a b. (a -> b) -> a -> b
$ \(Text
name, PureM ()
scenario) -> do
          PureState
aliasesState <- PureM PureState
forall s (m :: * -> *). MonadState s m => m s
get
          IORef PureState
newRef <- PureState -> PureM (IORef PureState)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef PureState
aliasesState
          (IORef PureState -> IORef PureState) -> PureM () -> PureM ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\IORef PureState
_ -> IORef PureState
newRef) PureM ()
scenario PureM () -> (PureM () -> PureM ()) -> PureM ()
forall a b. a -> (a -> b) -> b
& ScenarioBranchName -> PureM () -> PureM ()
forall (m :: * -> *) a ann.
(MonadCatch m, Semigroup ann, ExceptionAnnotation ann) =>
ann -> m a -> m a
annotateExceptions ([Text] -> ScenarioBranchName
ScenarioBranchName [Text
name])
      , eiGetStorage :: forall st addr.
(HasCallStack, ToStorageType st addr) =>
addr -> PureM st
eiGetStorage = PureM st -> PureM st
forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => 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 (ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress -> ImplicitAddress
sender)) =
  (forall a. HasCallStack => PureM a -> PureM a)
-> ClevelandOpsImpl PureM -> ClevelandOpsImpl PureM
forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandOpsImpl m -> ClevelandOpsImpl m
mapClevelandOpsImplExceptions (PureM a -> PureM a
forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
addCallStack (PureM a -> PureM a) -> (PureM a -> PureM a) -> PureM a -> PureM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureM a -> PureM a
forall a. PureM a -> PureM a
exceptionHandler)
    ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
 [OperationInfo ClevelandInput]
 -> m [OperationInfo ClevelandResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
    { coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput]
-> PureM [OperationInfo ClevelandResult]
coiRunOperationBatch = (OperationInfo ClevelandInput
 -> PureM (OperationInfo ClevelandResult))
-> [OperationInfo ClevelandInput]
-> PureM [OperationInfo ClevelandResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM \case
        OpOriginate (SomeOriginateData OriginateData oty 'NotLarge
od) -> ContractAddress -> OperationInfo ClevelandResult
forall i. OriginationInfo i -> OperationInfo i
OpOriginate (ContractAddress -> OperationInfo ClevelandResult)
-> PureM ContractAddress -> PureM (OperationInfo ClevelandResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OriginateData oty 'NotLarge -> PureM ContractAddress
forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> PureM ContractAddress
originate OriginateData oty 'NotLarge
od
        OpTransfer TransferData{v
addr
Mutez
EpName
tdParameter :: ()
tdEntrypoint :: TransferData -> EpName
tdAmount :: TransferData -> Mutez
tdTo :: ()
tdParameter :: v
tdEntrypoint :: EpName
tdAmount :: Mutez
tdTo :: addr
..} ->
          [ContractEvent] -> OperationInfo ClevelandResult
forall i. TransferInfo i -> OperationInfo i
OpTransfer ([ContractEvent] -> OperationInfo ClevelandResult)
-> PureM [ContractEvent] -> PureM (OperationInfo ClevelandResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImplicitAddress
-> addr -> Mutez -> EpName -> v -> PureM [ContractEvent]
forall v addr.
(ParameterScope (ToT v), IsoValue v, ToL1Address addr) =>
ImplicitAddress
-> addr -> Mutez -> EpName -> v -> PureM [ContractEvent]
doTransfer ImplicitAddress
sender addr
tdTo Mutez
tdAmount EpName
tdEntrypoint v
tdParameter
        OpTransferTicket TransferTicketData{addr
EpName
Value ('TTicket t)
ttdParameter :: ()
ttdEntrypoint :: TransferTicketData -> EpName
ttdTo :: ()
ttdParameter :: Value ('TTicket t)
ttdEntrypoint :: EpName
ttdTo :: addr
..}
          | T.VTicket Address
_ (Value arg
_ :: T.Value t) Natural
_ <- Value ('TTicket t)
ttdParameter
          , ContainsOp arg :~: 'False
Refl <- forall (t :: T).
(SingI t, IsComparable t ~ 'True) =>
ContainsOp t :~: 'False
T.comparabilityImpliesNoOp @t
          -> [ContractEvent] -> OperationInfo ClevelandResult
forall i. TransferTicketInfo i -> OperationInfo i
OpTransferTicket ([ContractEvent] -> OperationInfo ClevelandResult)
-> PureM [ContractEvent] -> PureM (OperationInfo ClevelandResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ImplicitAddress
-> addr
-> Mutez
-> EpName
-> Value ('TTicket t)
-> PureM [ContractEvent]
forall v addr.
(ParameterScope (ToT v), IsoValue v, ToL1Address addr) =>
ImplicitAddress
-> addr -> Mutez -> EpName -> v -> PureM [ContractEvent]
doTransfer ImplicitAddress
sender addr
ttdTo Mutez
zeroMutez EpName
ttdEntrypoint Value ('TTicket t)
ttdParameter
        OpReveal{} -> do
          -- We do not care about reveals in our Morley runtime
          OperationInfo ClevelandResult
-> PureM (OperationInfo ClevelandResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (OperationInfo ClevelandResult
 -> PureM (OperationInfo ClevelandResult))
-> OperationInfo ClevelandResult
-> PureM (OperationInfo ClevelandResult)
forall a b. (a -> b) -> a -> b
$ RevealInfo ClevelandResult -> OperationInfo ClevelandResult
forall i. RevealInfo i -> OperationInfo i
OpReveal ()
        OpDelegation DelegationInfo ClevelandInput
mbAddress -> () -> OperationInfo ClevelandResult
forall i. DelegationInfo i -> OperationInfo i
OpDelegation (() -> OperationInfo ClevelandResult)
-> PureM () -> PureM (OperationInfo ClevelandResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImplicitAddress -> Maybe KeyHash -> PureM ()
setDelegate ImplicitAddress
sender Maybe KeyHash
DelegationInfo ClevelandInput
mbAddress
    }

doTransfer
  :: (T.ParameterScope (T.ToT v), IsoValue v, ToL1Address addr)
  => ImplicitAddress
  -> addr
  -> Mutez
  -> U.EpName
  -> v
  -> PureM [ContractEvent]
doTransfer :: forall v addr.
(ParameterScope (ToT v), IsoValue v, ToL1Address addr) =>
ImplicitAddress
-> addr -> Mutez -> EpName -> v -> PureM [ContractEvent]
doTransfer ImplicitAddress
sender addr
to' Mutez
amount EpName
entrypoint v
parameter = do
  let fromAddr :: NamedF Identity ImplicitAddress "from"
fromAddr = IsLabel "from" (Name "from")
Name "from"
#from Name "from"
-> ImplicitAddress -> NamedF Identity ImplicitAddress "from"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! ImplicitAddress
sender
  let toAddr :: NamedF Identity L1Address "to"
toAddr = IsLabel "to" (Name "to")
Name "to"
#to Name "to" -> L1Address -> NamedF Identity L1Address "to"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! addr -> L1Address
forall addr. ToL1Address addr => addr -> L1Address
toL1Address addr
to'
  Bool
refillable <- ImplicitAddress -> PureM Bool
isAddressRefillable ImplicitAddress
sender
  Bool -> PureM () -> PureM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
refillable (PureM () -> PureM ()) -> PureM () -> PureM ()
forall a b. (a -> b) -> a -> b
$ do
    Mutez
balance <- ImplicitAddress -> PureM Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> PureM Mutez
getBalance ImplicitAddress
sender
    Bool -> PureM () -> PureM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Mutez
balance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< Mutez
amount) (PureM () -> PureM ()) -> PureM () -> PureM ()
forall a b. (a -> b) -> a -> b
$ do
      let moneybag :: NamedF Identity ImplicitAddress "from"
moneybag = IsLabel "from" (Name "from")
Name "from"
#from Name "from"
-> ImplicitAddress -> NamedF Identity ImplicitAddress "from"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! ImplicitAddress
genesisAddress
          toSender :: NamedF Identity ImplicitAddress "to"
toSender = IsLabel "to" (Name "to")
Name "to"
#to Name "to"
-> ImplicitAddress -> NamedF Identity ImplicitAddress "to"
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! ImplicitAddress
sender
      PureM [EmitOperation] -> PureM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PureM [EmitOperation] -> PureM ())
-> PureM [EmitOperation] -> PureM ()
forall a b. (a -> b) -> a -> b
$ NamedF Identity ImplicitAddress "from"
-> NamedF Identity ImplicitAddress "to"
-> Mutez
-> EpName
-> ()
-> PureM [EmitOperation]
forall epArg addr.
(ParameterScope (ToT epArg), IsoValue epArg, ToAddress addr) =>
NamedF Identity ImplicitAddress "from"
-> ("to" :! addr)
-> Mutez
-> EpName
-> epArg
-> PureM [EmitOperation]
transfer NamedF Identity ImplicitAddress "from"
moneybag NamedF Identity ImplicitAddress "to"
toSender (HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
unsafeSubMutez Mutez
amount Mutez
balance) EpName
DefEpName ()
  [EmitOperation]
emitOps <- NamedF Identity ImplicitAddress "from"
-> NamedF Identity L1Address "to"
-> Mutez
-> EpName
-> v
-> PureM [EmitOperation]
forall epArg addr.
(ParameterScope (ToT epArg), IsoValue epArg, ToAddress addr) =>
NamedF Identity ImplicitAddress "from"
-> ("to" :! addr)
-> Mutez
-> EpName
-> epArg
-> PureM [EmitOperation]
transfer NamedF Identity ImplicitAddress "from"
fromAddr NamedF Identity L1Address "to"
toAddr Mutez
amount EpName
entrypoint v
parameter

  return $ EmitOperation -> ContractEvent
emitOpToContractEvent (EmitOperation -> ContractEvent)
-> [EmitOperation] -> [ContractEvent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EmitOperation]
emitOps

emitOpToContractEvent :: EmitOperation -> ContractEvent
emitOpToContractEvent :: EmitOperation -> ContractEvent
emitOpToContractEvent EmitOperation{eoEmit :: ()
eoEmit=T.Emit{Text
GlobalCounter
Notes t
Value' Instr t
emValue :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> Value' instr t
emTag :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Text
emNotes :: forall (instr :: [T] -> [T] -> *) (t :: T). Emit instr t -> Notes t
emCounter :: forall (instr :: [T] -> [T] -> *) (t :: T).
Emit instr t -> GlobalCounter
emCounter :: GlobalCounter
emValue :: Value' Instr t
emNotes :: Notes t
emTag :: Text
..},ContractAddress
eoSource :: EmitOperation -> ContractAddress
eoSource :: ContractAddress
..} = ContractEvent :: ContractAddress
-> Text -> Maybe SomeAnnotatedValue -> ContractEvent
ContractEvent
  { cePayload :: Maybe SomeAnnotatedValue
cePayload = case Notes t -> T
forall (t :: T). Notes t -> T
T.notesT Notes t
emNotes of
      -- A dirty hack to match reference
      T
T.TUnit -> Maybe SomeAnnotatedValue
forall a. Maybe a
Nothing
      T
_ -> SomeAnnotatedValue -> Maybe SomeAnnotatedValue
forall a. a -> Maybe a
Just (SomeAnnotatedValue -> Maybe SomeAnnotatedValue)
-> SomeAnnotatedValue -> Maybe SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$ Notes t -> Value' Instr t -> SomeAnnotatedValue
forall (t :: T).
SingI t =>
Notes t -> Value t -> SomeAnnotatedValue
SomeAnnotatedValue Notes t
emNotes Value' Instr t
emValue
  , ceTag :: Text
ceTag = Text
emTag
  , ceSource :: ContractAddress
ceSource = ContractAddress
eoSource
  }

clevelandMiscImpl :: ClevelandMiscImpl PureM
clevelandMiscImpl :: ClevelandMiscImpl PureM
clevelandMiscImpl =
  (forall a. HasCallStack => PureM a -> PureM a)
-> ClevelandMiscImpl PureM -> ClevelandMiscImpl PureM
forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandMiscImpl m -> ClevelandMiscImpl m
mapClevelandMiscImplExceptions (PureM a -> PureM a
forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
addCallStack (PureM a -> PureM a) -> (PureM a -> PureM a) -> PureM a -> PureM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureM a -> PureM a
forall a. PureM a -> PureM a
exceptionHandler)
    ClevelandMiscImpl :: forall (m :: * -> *).
(forall res. HasCallStack => IO res -> m res)
-> (forall (kind :: AddressKind).
    HasCallStack =>
    AddressOrAlias kind -> m (AddressWithAlias kind))
-> (HasCallStack =>
    SpecificOrDefaultAlias -> m ImplicitAddressWithAlias)
-> (HasCallStack =>
    SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias)
-> (HasCallStack =>
    SpecificOrDefaultAlias -> m ImplicitAddressWithAlias)
-> (HasCallStack =>
    ByteString -> ImplicitAddressWithAlias -> m Signature)
-> (forall (oty :: OriginationType).
    HasCallStack =>
    Sender -> OriginateData oty 'IsLarge -> m ContractAddress)
-> (HasCallStack => Text -> m ())
-> (HasCallStack => L1Address -> m Mutez)
-> (HasCallStack => ContractAddress -> m SomeAnnotatedValue)
-> (forall k v.
    (HasCallStack, NiceComparable k, NicePackedValue k,
     NiceUnpackedValue v) =>
    BigMapId k v -> k -> m (Maybe v))
-> (forall k v.
    (HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
    BigMapId k v -> m (Maybe [v]))
-> (HasCallStack => ImplicitAddressWithAlias -> m PublicKey)
-> (HasCallStack => L1Address -> m (Maybe KeyHash))
-> (HasCallStack => m ChainId)
-> (forall (unit :: Rat).
    (HasCallStack, KnownDivRat unit Second) =>
    Time unit -> m ())
-> (HasCallStack => (Natural -> Natural) -> m ())
-> (HasCallStack => m Timestamp)
-> (HasCallStack => m Natural)
-> (forall a. HasCallStack => Builder -> m a)
-> (forall a. HasCallStack => SomeException -> m a)
-> (HasCallStack => m (Time Second))
-> (forall a e.
    (Exception e, HasCallStack) =>
    m a -> m (Either e a))
-> (ImplicitAddress -> m ())
-> m (Either (EmulatedImpl m) NetworkEnv)
-> (forall cp st vd.
    (HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
    Sender -> RunCode cp st vd -> m (AsRPC st))
-> (forall (t :: T).
    (HasNoOp t, Comparable t) =>
    L1Address -> ContractAddress -> Value t -> m Natural)
-> (ContractAddress -> m [SomeTicket])
-> ClevelandMiscImpl m
ClevelandMiscImpl
    { cmiRunIO :: forall res. HasCallStack => IO res -> PureM res
cmiRunIO = \IO res
action -> IO (Either SomeException res) -> PureM (Either SomeException res)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO res -> IO (Either SomeException res)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try IO res
action) PureM (Either SomeException res)
-> (Either SomeException res -> PureM res) -> PureM res
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right res
res -> res -> PureM res
forall (f :: * -> *) a. Applicative f => a -> f a
pure res
res
        Left (SomeException
err :: SomeException) -> SomeException -> PureM res
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
err

    , cmiResolveAddress :: forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> PureM (AddressWithAlias kind)
cmiResolveAddress = \case
        AddressAlias Alias kind
a -> case Alias kind
a of
          ImplicitAlias{} -> LensLike'
  (Const (Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress))))
  GState
  (Bimap ImplicitAlias ImplicitAddress)
-> Alias kind -> PureM (AddressWithAlias kind)
forall x (kind :: AddressKind).
(At x, Index x ~ Alias kind, IxValue x ~ KindedAddress kind) =>
LensLike' (Const (Maybe (IxValue x))) GState x
-> Alias kind -> PureM (AddressWithAlias kind)
resolveAlias LensLike'
  (Const (Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress))))
  GState
  (Bimap ImplicitAlias ImplicitAddress)
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL Alias kind
a
          ContractAlias{} -> LensLike'
  (Const (Maybe (IxValue (Bimap ContractAlias ContractAddress))))
  GState
  (Bimap ContractAlias ContractAddress)
-> Alias kind -> PureM (AddressWithAlias kind)
forall x (kind :: AddressKind).
(At x, Index x ~ Alias kind, IxValue x ~ KindedAddress kind) =>
LensLike' (Const (Maybe (IxValue x))) GState x
-> Alias kind -> PureM (AddressWithAlias kind)
resolveAlias LensLike'
  (Const (Maybe (IxValue (Bimap ContractAlias ContractAddress))))
  GState
  (Bimap ContractAlias ContractAddress)
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL Alias kind
a
        AddressResolved KindedAddress kind
a -> case KindedAddress kind
a of
          ImplicitAddress{} -> LensLike'
  (Const (Maybe (Index (Bimap ImplicitAlias ImplicitAddress))))
  GState
  (Bimap ImplicitAlias ImplicitAddress)
-> KindedAddress kind -> PureM (AddressWithAlias kind)
forall x (kind :: AddressKind).
(x ~ Bimap (Alias kind) (KindedAddress kind)) =>
LensLike' (Const (Maybe (Index x))) GState x
-> KindedAddress kind -> PureM (AddressWithAlias kind)
resolveAddress LensLike'
  (Const (Maybe (Index (Bimap ImplicitAlias ImplicitAddress))))
  GState
  (Bimap ImplicitAlias ImplicitAddress)
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL KindedAddress kind
a
          ContractAddress{} -> LensLike'
  (Const (Maybe (Index (Bimap ContractAlias ContractAddress))))
  GState
  (Bimap ContractAlias ContractAddress)
-> KindedAddress kind -> PureM (AddressWithAlias kind)
forall x (kind :: AddressKind).
(x ~ Bimap (Alias kind) (KindedAddress kind)) =>
LensLike' (Const (Maybe (Index x))) GState x
-> KindedAddress kind -> PureM (AddressWithAlias kind)
resolveAddress LensLike'
  (Const (Maybe (Index (Bimap ContractAlias ContractAddress))))
  GState
  (Bimap ContractAlias ContractAddress)
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL KindedAddress kind
a

    , cmiSignBytes :: HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> PureM Signature
cmiSignBytes = \ByteString
bs ImplicitAddressWithAlias
addr -> do
        SecretKey
sk <- ImplicitAddress -> PureM SecretKey
getSecretKey (ImplicitAddress -> PureM SecretKey)
-> ImplicitAddress -> PureM SecretKey
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress ImplicitAddressWithAlias
addr
        IO Signature -> PureM Signature
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Signature -> PureM Signature)
-> IO Signature -> PureM Signature
forall a b. (a -> b) -> a -> b
$ SecretKey -> ByteString -> IO Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign SecretKey
sk ByteString
bs

    , cmiGenKey :: HasCallStack =>
SpecificOrDefaultAlias -> PureM ImplicitAddressWithAlias
cmiGenKey = \SpecificOrDefaultAlias
sodAlias -> do
      ImplicitAlias
alias <- SpecificOrDefaultAlias -> PureM ImplicitAlias
forall {m :: * -> *}.
MonadState PureState m =>
SpecificOrDefaultAlias -> m ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
      (ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias)
-> ImplicitAlias -> ImplicitAddress -> ImplicitAddressWithAlias
forall a b c. (a -> b -> c) -> b -> a -> c
flip ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
AddressWithAlias ImplicitAlias
alias (ImplicitAddress -> ImplicitAddressWithAlias)
-> PureM ImplicitAddress -> PureM ImplicitAddressWithAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ImplicitAddress -> ImplicitAlias -> PureM ImplicitAddress
smartGenKey Maybe ImplicitAddress
forall a. Maybe a
Nothing ImplicitAlias
alias

    , cmiImportKey :: HasCallStack =>
SecretKey
-> SpecificOrDefaultAlias -> PureM ImplicitAddressWithAlias
cmiImportKey = \SecretKey
key SpecificOrDefaultAlias
sodAlias -> do
        ImplicitAlias
alias <- SpecificOrDefaultAlias -> PureM ImplicitAlias
forall {m :: * -> *}.
MonadState PureState m =>
SpecificOrDefaultAlias -> m ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
        (ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias)
-> ImplicitAlias -> ImplicitAddress -> ImplicitAddressWithAlias
forall a b c. (a -> b -> c) -> b -> a -> c
flip ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
AddressWithAlias ImplicitAlias
alias (ImplicitAddress -> ImplicitAddressWithAlias)
-> PureM ImplicitAddress -> PureM ImplicitAddressWithAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SecretKey -> ImplicitAlias -> PureM ImplicitAddress
importSecretKey SecretKey
key ImplicitAlias
alias

    , cmiGenFreshKey :: HasCallStack =>
SpecificOrDefaultAlias -> PureM ImplicitAddressWithAlias
cmiGenFreshKey =
        \SpecificOrDefaultAlias
sodAlias -> do
          ImplicitAlias
alias <- SpecificOrDefaultAlias -> PureM ImplicitAlias
forall {m :: * -> *}.
MonadState PureState m =>
SpecificOrDefaultAlias -> m ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
          Maybe ImplicitAddress
existingAddr <- Getting (Maybe ImplicitAddress) PureState (Maybe ImplicitAddress)
-> PureM (Maybe ImplicitAddress)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Maybe ImplicitAddress) GState)
-> PureState -> Const (Maybe ImplicitAddress) PureState
Lens' PureState GState
psGState ((GState -> Const (Maybe ImplicitAddress) GState)
 -> PureState -> Const (Maybe ImplicitAddress) PureState)
-> ((Maybe ImplicitAddress
     -> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
    -> GState -> Const (Maybe ImplicitAddress) GState)
-> Getting
     (Maybe ImplicitAddress) PureState (Maybe ImplicitAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias ImplicitAddress
 -> Const
      (Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Const (Maybe ImplicitAddress) GState
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL ((Bimap ImplicitAlias ImplicitAddress
  -> Const
       (Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
 -> GState -> Const (Maybe ImplicitAddress) GState)
-> ((Maybe ImplicitAddress
     -> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
    -> Bimap ImplicitAlias ImplicitAddress
    -> Const
         (Maybe ImplicitAddress) (Bimap ImplicitAlias ImplicitAddress))
-> (Maybe ImplicitAddress
    -> Const (Maybe ImplicitAddress) (Maybe ImplicitAddress))
-> GState
-> Const (Maybe ImplicitAddress) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias ImplicitAddress)
-> Lens'
     (Bimap ImplicitAlias ImplicitAddress)
     (Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ImplicitAlias ImplicitAddress)
ImplicitAlias
alias)
          (ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias)
-> ImplicitAlias -> ImplicitAddress -> ImplicitAddressWithAlias
forall a b c. (a -> b -> c) -> b -> a -> c
flip ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
AddressWithAlias ImplicitAlias
alias (ImplicitAddress -> ImplicitAddressWithAlias)
-> PureM ImplicitAddress -> PureM ImplicitAddressWithAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ImplicitAddress -> ImplicitAlias -> PureM ImplicitAddress
smartGenKey Maybe ImplicitAddress
existingAddr ImplicitAlias
alias

    , cmiOriginateLargeUntyped :: forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> PureM ContractAddress
cmiOriginateLargeUntyped = forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> PureM ContractAddress
forall (oty :: OriginationType).
Sender -> OriginateData oty 'IsLarge -> PureM ContractAddress
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 => ImplicitAddressWithAlias -> PureM PublicKey
cmiGetPublicKey = (SecretKey -> PublicKey) -> PureM SecretKey -> PureM PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> PublicKey
toPublic (PureM SecretKey -> PureM PublicKey)
-> (ImplicitAddressWithAlias -> PureM SecretKey)
-> ImplicitAddressWithAlias
-> PureM PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddress -> PureM SecretKey
getSecretKey (ImplicitAddress -> PureM SecretKey)
-> (ImplicitAddressWithAlias -> ImplicitAddress)
-> ImplicitAddressWithAlias
-> PureM SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress
    , cmiGetDelegate :: HasCallStack => L1Address -> PureM (Maybe KeyHash)
cmiGetDelegate = \(Constrained KindedAddress a
addr) -> KindedAddress a -> PureM (AddressStateFam a)
forall (kind :: AddressKind).
KindedAddress kind -> PureM (AddressStateFam kind)
addressState KindedAddress a
addr PureM (AddressStateFam a)
-> (AddressStateFam a -> Maybe KeyHash) -> PureM (Maybe KeyHash)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> case KindedAddress a
addr of
        ContractAddress{} -> ContractState -> Maybe KeyHash
AddressStateFam a -> Maybe KeyHash
csDelegate
        ImplicitAddress{} -> AddressStateFam a -> Maybe KeyHash
ImplicitState -> Maybe KeyHash
isDelegate
    , cmiGetChainId :: HasCallStack => PureM ChainId
cmiGetChainId = Getting ChainId PureState ChainId -> PureM ChainId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting ChainId PureState ChainId -> PureM ChainId)
-> Getting ChainId PureState ChainId -> PureM ChainId
forall a b. (a -> b) -> a -> b
$ (GState -> Const ChainId GState)
-> PureState -> Const ChainId PureState
Lens' PureState GState
psGState ((GState -> Const ChainId GState)
 -> PureState -> Const ChainId PureState)
-> ((ChainId -> Const ChainId ChainId)
    -> GState -> Const ChainId GState)
-> Getting ChainId PureState ChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainId -> Const ChainId ChainId)
-> GState -> Const ChainId GState
Lens' GState ChainId
gsChainIdL
    , cmiAdvanceTime :: forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> PureM ()
cmiAdvanceTime = \Time unit
time -> do
        ASetter PureState PureState Timestamp Timestamp
-> (Timestamp -> Timestamp) -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter PureState PureState Timestamp Timestamp
Lens' PureState Timestamp
psNow ((Timestamp -> Timestamp) -> PureM ())
-> (Integer -> Timestamp -> Timestamp) -> Integer -> PureM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Timestamp -> Integer -> Timestamp)
-> Integer -> Timestamp -> Timestamp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Timestamp -> Integer -> Timestamp
timestampPlusSeconds (Integer -> PureM ()) -> Integer -> PureM ()
forall a b. (a -> b) -> a -> b
$
          forall (unitTo :: Rat) n (unit :: Rat).
(KnownDivRat unit unitTo, Num n) =>
Time unit -> n
toNum @Second @Integer (Time (1 :% 1) -> Integer) -> Time (1 :% 1) -> Integer
forall a b. (a -> b) -> a -> b
$ Time (1 :% 1) -> Time (1 :% 1)
forall (unit :: Rat). Time unit -> Time unit
ceilingUnit (Time (1 :% 1) -> Time (1 :% 1)) -> Time (1 :% 1) -> Time (1 :% 1)
forall a b. (a -> b) -> a -> b
$ forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second Time unit
time

    , cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> PureM ()
cmiAdvanceToLevel = \Natural -> Natural
fn ->
        -- 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 = RatioNat -> Time (1 :% 1)
RatioNat -> Time Second
sec (RatioNat -> Time (1 :% 1))
-> (Natural -> RatioNat) -> Natural -> Time (1 :% 1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Natural -> RatioNat
forall a. Integral a => a -> a -> Ratio a
% Natural
1) (Natural -> Time (1 :% 1))
-> PureM Natural -> PureM (Time (1 :% 1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Natural PureState Natural -> PureM Natural
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Natural PureState Natural
Lens' PureState Natural
psMinBlockTime
    , cmiAttempt :: forall a e.
(Exception e, HasCallStack) =>
PureM a -> PureM (Either e a)
cmiAttempt = forall a e.
(Exception e, HasCallStack) =>
PureM a -> PureM (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try
    , cmiThrow :: forall a. HasCallStack => SomeException -> PureM a
cmiThrow = forall a. HasCallStack => SomeException -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
    , cmiMarkAddressRefillable :: ImplicitAddress -> PureM ()
cmiMarkAddressRefillable = ImplicitAddress -> PureM ()
forall {m :: * -> *}.
MonadState PureState m =>
ImplicitAddress -> m ()
setAddressRefillable
    , cmiGetBalance :: HasCallStack => L1Address -> PureM Mutez
cmiGetBalance = (forall (kind :: AddressKind).
 L1AddressKind kind =>
 KindedAddress kind -> PureM Mutez)
-> L1Address -> PureM Mutez
forall {k} (c :: k -> Constraint) (f :: k -> *) r.
(forall (t :: k). c t => f t -> r) -> Constrained c f -> r
foldConstrained forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> PureM Mutez
getBalance
    , cmiUnderlyingImpl :: PureM (Either (EmulatedImpl PureM) NetworkEnv)
cmiUnderlyingImpl = Either (EmulatedImpl PureM) NetworkEnv
-> PureM (Either (EmulatedImpl PureM) NetworkEnv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (EmulatedImpl PureM) NetworkEnv
 -> PureM (Either (EmulatedImpl PureM) NetworkEnv))
-> Either (EmulatedImpl PureM) NetworkEnv
-> PureM (Either (EmulatedImpl PureM) NetworkEnv)
forall a b. (a -> b) -> a -> b
$ EmulatedImpl PureM -> Either (EmulatedImpl PureM) NetworkEnv
forall a b. a -> Either a b
Left EmulatedImpl PureM
emulatedImpl
    , cmiFailure :: forall a. HasCallStack => Builder -> PureM a
cmiFailure = forall a. HasCallStack => Builder -> PureM a
forall a. Builder -> PureM a
failure
    , HasCallStack => ContractAddress -> PureM SomeAnnotatedValue
ContractAddress -> PureM [SomeTicket]
ContractAddress -> PureM SomeAnnotatedValue
forall {k} {v}.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> PureM (Maybe [v])
forall {k} {v}.
(HasCallStack, NiceComparable k, NicePackedValue k,
 NiceUnpackedValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> PureM (Maybe [v])
forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
forall {cp} {st} {vd}.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
forall (t :: T).
(HasNoOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> PureM Natural
cmiAllTicketBalances :: ContractAddress -> PureM [SomeTicket]
cmiTicketBalance :: forall (t :: T).
(HasNoOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> PureM Natural
cmiRunCode :: forall {cp} {st} {vd}.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiGetAllBigMapValuesMaybe :: forall {k} {v}.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> PureM (Maybe [v])
cmiGetBigMapValueMaybe :: forall {k} {v}.
(HasCallStack, NiceComparable k, NicePackedValue k,
 NiceUnpackedValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
cmiGetSomeStorage :: HasCallStack => ContractAddress -> PureM SomeAnnotatedValue
cmiRunCode :: forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiAllTicketBalances :: ContractAddress -> PureM [SomeTicket]
cmiTicketBalance :: forall (t :: T).
(HasNoOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> PureM Natural
cmiGetSomeStorage :: ContractAddress -> PureM SomeAnnotatedValue
cmiGetAllBigMapValuesMaybe :: forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> PureM (Maybe [v])
cmiGetBigMapValueMaybe :: forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
..
    }
  where
    setAddressRefillable :: ImplicitAddress -> m ()
setAddressRefillable ImplicitAddress
addr = (Set ImplicitAddress -> Identity (Set ImplicitAddress))
-> PureState -> Identity PureState
Lens' PureState (Set ImplicitAddress)
psRefillableAddresses ((Set ImplicitAddress -> Identity (Set ImplicitAddress))
 -> PureState -> Identity PureState)
-> (Set ImplicitAddress -> Set ImplicitAddress) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ImplicitAddress -> Set ImplicitAddress -> Set ImplicitAddress
forall a. Ord a => a -> Set a -> Set a
Set.insert ImplicitAddress
addr

    originateUntyped :: Sender -> OriginateData oty 'IsLarge -> PureM ContractAddress
    originateUntyped :: forall (oty :: OriginationType).
Sender -> OriginateData oty 'IsLarge -> PureM ContractAddress
originateUntyped Sender
_ = OriginateData oty 'IsLarge -> PureM ContractAddress
forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> PureM ContractAddress
originate

    cmiGetBigMapValueMaybe
      :: forall k v.
         (NiceComparable k, IsoValue v)
      => BigMapId k v
      -> k
      -> PureM (Maybe v)
    cmiGetBigMapValueMaybe :: forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> k -> PureM (Maybe v)
cmiGetBigMapValueMaybe (BigMapId Natural
bmId) k
k = MaybeT PureM v -> PureM (Maybe v)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      -- 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.
      VBigMap Maybe Natural
_ Map (Value' Instr k) (Value' Instr v)
bigMap <- forall (k :: T) (v :: T).
(SingI v, SingI k) =>
Natural -> MaybeT PureM (Value ('TBigMap k v))
findBigMapByIdMaybe @(ToT k) @(ToT v) Natural
bmId
      Maybe v -> MaybeT PureM v
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe v -> MaybeT PureM v) -> Maybe v -> MaybeT PureM v
forall a b. (a -> b) -> a -> b
$ forall a. IsoValue a => Value (ToT a) -> a
fromVal @v (Value' Instr v -> v) -> Maybe (Value' Instr v) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value' Instr k
-> Map (Value' Instr k) (Value' Instr v) -> Maybe (Value' Instr v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k -> Value' Instr (ToT k)
forall a. IsoValue a => a -> Value (ToT a)
toVal k
k) Map (Value' Instr k) (Value' Instr v)
bigMap

    cmiGetAllBigMapValuesMaybe
      :: forall k v.
         (NiceComparable k, IsoValue v)
      => BigMapId k v
      -> PureM (Maybe [v])
    cmiGetAllBigMapValuesMaybe :: forall k v.
(NiceComparable k, IsoValue v) =>
BigMapId k v -> PureM (Maybe [v])
cmiGetAllBigMapValuesMaybe (BigMapId Natural
bmId) = MaybeT PureM [v] -> PureM (Maybe [v])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      VBigMap Maybe Natural
_ Map (Value' Instr k) (Value' Instr v)
bigMap <- forall (k :: T) (v :: T).
(SingI v, SingI k) =>
Natural -> MaybeT PureM (Value ('TBigMap k v))
findBigMapByIdMaybe @(ToT k) @(ToT v) Natural
bmId
      [v] -> MaybeT PureM [v]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([v] -> MaybeT PureM [v]) -> [v] -> MaybeT PureM [v]
forall a b. (a -> b) -> a -> b
$ forall a. IsoValue a => Value (ToT a) -> a
fromVal @v (Value' Instr v -> v) -> [Value' Instr v] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (Value' Instr k) (Value' Instr v) -> [Value' Instr v]
forall k a. Map k a -> [a]
Map.elems Map (Value' Instr k) (Value' Instr v)
bigMap

    -- 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 :: ContractAddress -> PureM SomeAnnotatedValue
    cmiGetSomeStorage :: ContractAddress -> PureM SomeAnnotatedValue
cmiGetSomeStorage ContractAddress
addr = do
      ContractState Mutez
_ Contract cp st
contract (Value st
storage :: Value t) Maybe KeyHash
_ <- ContractAddress -> PureM (AddressStateFam 'AddressKindContract)
forall (kind :: AddressKind).
KindedAddress kind -> PureM (AddressStateFam kind)
addressState ContractAddress
addr
      SomeAnnotatedValue -> PureM SomeAnnotatedValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeAnnotatedValue -> PureM SomeAnnotatedValue)
-> SomeAnnotatedValue -> PureM SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$
        Notes (TAsRPC st) -> Value (TAsRPC st) -> SomeAnnotatedValue
forall (t :: T).
SingI t =>
Notes t -> Value t -> SomeAnnotatedValue
SomeAnnotatedValue
          (Notes st -> Notes (TAsRPC st)
forall (t :: T). Notes t -> Notes (TAsRPC t)
notesAsRPC (Notes st -> Notes (TAsRPC st)) -> Notes st -> Notes (TAsRPC st)
forall a b. (a -> b) -> a -> b
$ Contract cp st -> Notes st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
T.cStoreNotes Contract cp st
contract)
          (Value st -> Value (TAsRPC st)
forall (t :: T). HasCallStack => Value t -> Value (TAsRPC t)
valueAsRPC Value st
storage)
          (StorageScope (TAsRPC st) => SomeAnnotatedValue)
-> (StorageScope st :- StorageScope (TAsRPC st))
-> SomeAnnotatedValue
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (t :: T). StorageScope t :- StorageScope (TAsRPC t)
rpcStorageScopeEvi @t

    cmiTicketBalance
      :: forall t. (T.HasNoOp t, T.Comparable t)
      => L1Address -> ContractAddress -> T.Value t -> PureM Natural
    cmiTicketBalance :: forall (t :: T).
(HasNoOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> PureM Natural
cmiTicketBalance (Constrained KindedAddress a
owner) ContractAddress
ticketer Value t
value = case KindedAddress a
owner of
      ContractAddress{} -> do
        ContractState Mutez
_ Contract cp st
_ Value st
storage Maybe KeyHash
_ <- KindedAddress a -> PureM (AddressStateFam a)
forall (kind :: AddressKind).
KindedAddress kind -> PureM (AddressStateFam kind)
addressState KindedAddress a
owner
        Natural -> PureM Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> PureM Natural)
-> (Sum Natural -> Natural) -> Sum Natural -> PureM Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum Natural -> Natural
forall a. Sum a -> a
getSum (Sum Natural -> PureM Natural) -> Sum Natural -> PureM Natural
forall a b. (a -> b) -> a -> b
$ ((forall (t' :: T). Value t' -> Sum Natural)
-> Value st -> Sum Natural
forall x (t :: T).
Monoid x =>
(forall (t' :: T). Value t' -> x) -> Value t -> x
`T.dfsFoldMapValue` Value st
storage) \case
          VTicket Address
ticketer' (Value arg
value' :: Value arg) Natural
amount
            | Address
ticketer' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== ContractAddress -> Address
forall a. ToAddress a => a -> Address
toAddress ContractAddress
ticketer
            , Value t -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
T.SomeValue Value t
value SomeValue -> SomeValue -> Bool
forall a. Eq a => a -> a -> Bool
== Value arg -> SomeValue
forall (t :: T). SingI t => Value t -> SomeValue
T.SomeValue Value arg
value'
            -> Natural -> Sum Natural
forall a. a -> Sum a
Sum Natural
amount
          Value t'
_ -> Sum Natural
forall a. Monoid a => a
mempty
      ImplicitAddress{} -> do
        ImplicitState{Maybe KeyHash
HashMap TicketKey Natural
Mutez
isTickets :: ImplicitState -> HashMap TicketKey Natural
isBalance :: ImplicitState -> Mutez
isDelegate :: Maybe KeyHash
isTickets :: HashMap TicketKey Natural
isBalance :: Mutez
isDelegate :: ImplicitState -> Maybe KeyHash
..} <- KindedAddress a -> PureM (AddressStateFam a)
forall (kind :: AddressKind).
KindedAddress kind -> PureM (AddressStateFam kind)
addressState KindedAddress a
owner
        Natural -> PureM Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> PureM Natural)
-> (Maybe Natural -> Natural) -> Maybe Natural -> PureM Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
0 (Maybe Natural -> PureM Natural) -> Maybe Natural -> PureM Natural
forall a b. (a -> b) -> a -> b
$
          HashMap TicketKey Natural
isTickets HashMap TicketKey Natural
-> Getting
     (Maybe Natural) (HashMap TicketKey Natural) (Maybe Natural)
-> Maybe Natural
forall s a. s -> Getting a s a -> a
^. Index (HashMap TicketKey Natural)
-> Lens'
     (HashMap TicketKey Natural)
     (Maybe (IxValue (HashMap TicketKey Natural)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at ((TicketKey, Natural) -> TicketKey
forall a b. (a, b) -> a
fst ((TicketKey, Natural) -> TicketKey)
-> (Value ('TTicket t) -> (TicketKey, Natural))
-> Value ('TTicket t)
-> TicketKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value ('TTicket t) -> (TicketKey, Natural)
forall (t :: T).
HasNoOp t =>
Value ('TTicket t) -> (TicketKey, Natural)
toTicketKey (Value ('TTicket t) -> TicketKey)
-> Value ('TTicket t) -> TicketKey
forall a b. (a -> b) -> a -> b
$ Address -> Value t -> Natural -> Value ('TTicket t)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
T.VTicket (ContractAddress -> Address
forall a. ToAddress a => a -> Address
toAddress ContractAddress
ticketer) Value t
value Natural
0)

    cmiAllTicketBalances :: ContractAddress -> PureM [SomeTicket]
    cmiAllTicketBalances :: ContractAddress -> PureM [SomeTicket]
cmiAllTicketBalances ContractAddress
owner = do
      ContractState Mutez
_ Contract cp st
_ Value st
storage Maybe KeyHash
_ <- ContractAddress -> PureM (AddressStateFam 'AddressKindContract)
forall (kind :: AddressKind).
KindedAddress kind -> PureM (AddressStateFam kind)
addressState ContractAddress
owner
      [SomeTicket] -> PureM [SomeTicket]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SomeTicket] -> PureM [SomeTicket])
-> [SomeTicket] -> PureM [SomeTicket]
forall a b. (a -> b) -> a -> b
$ ((forall (t' :: T). Value t' -> [SomeTicket])
-> Value st -> [SomeTicket]
forall x (t :: T).
Monoid x =>
(forall (t' :: T). Value t' -> x) -> Value t -> x
`T.dfsFoldMapValue` Value st
storage) \case
        VTicket Address
tTicketer Value' Instr arg
tData Natural
tAmount -> [Ticket (Value' Instr arg) -> SomeTicket
forall (t :: T). SingI t => Ticket (Value t) -> SomeTicket
SomeTicket Ticket :: forall arg. Address -> arg -> Natural -> Ticket arg
T.Ticket{Natural
Address
Value' Instr arg
tTicketer :: Address
tData :: Value' Instr arg
tAmount :: Natural
tAmount :: Natural
tData :: Value' Instr arg
tTicketer :: Address
..}]
        Value t'
_ -> [SomeTicket]
forall a. Monoid a => a
mempty

    -- Generate a fresh address for a given alias.
    --
    -- If this alias is not yet associated with any address,
    -- we use the alias as the seed for generating a brand new address.
    --
    -- If this alias is already associated with an address,
    -- then we have to use a _different_ seed to guarantee we'll get a brand new address.
    -- Therefore, we concatenate the alias with the existing address and use the
    -- result as a seed for generating a brand new address.
    smartGenKey :: Maybe ImplicitAddress -> ImplicitAlias -> PureM ImplicitAddress
    smartGenKey :: Maybe ImplicitAddress -> ImplicitAlias -> PureM ImplicitAddress
smartGenKey Maybe ImplicitAddress
existingAddr alias :: ImplicitAlias
alias@(ImplicitAlias Text
aliasTxt) = do
      let
        seed :: Text
seed = Text -> (ImplicitAddress -> Text) -> Maybe ImplicitAddress -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
aliasTxt (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
aliasTxt (Text -> Text)
-> (ImplicitAddress -> Text) -> ImplicitAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddress -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) Maybe ImplicitAddress
existingAddr
        -- octez-client will only generate tz1 keys (unless explicitly
        -- instructed otherwise); we're a bit more lenient here, but we still
        -- exclude tz4 keys, as those can't be used as delegates.
        seedBytes :: ByteString
seedBytes = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
seed
        seedInt :: Integer
seedInt = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
seedBytes
        keyTypes :: [KeyType]
keyTypes = (KeyType -> Bool) -> [KeyType] -> [KeyType]
forall a. (a -> Bool) -> [a] -> [a]
filter (KeyType -> KeyType -> Bool
forall a. Eq a => a -> a -> Bool
/= KeyType
KeyTypeBLS) [KeyType
forall a. Bounded a => a
minBound..]
        keyType :: KeyType
keyType = [KeyType]
keyTypes [KeyType] -> Int -> KeyType
forall a. [a] -> Int -> a
Unsafe.!!
          (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralOverflowing (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
seedInt Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Int -> Integer
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral ([KeyType] -> Int
forall t. Container t => t -> Int
length [KeyType]
keyTypes))
        sk :: SecretKey
sk = KeyType -> ByteString -> SecretKey
detSecretKey' KeyType
keyType ByteString
seedBytes

      SecretKey -> ImplicitAlias -> PureM ImplicitAddress
importSecretKey SecretKey
sk ImplicitAlias
alias

    importSecretKey :: SecretKey -> ImplicitAlias -> PureM ImplicitAddress
    importSecretKey :: SecretKey -> ImplicitAlias -> PureM ImplicitAddress
importSecretKey SecretKey
sk ImplicitAlias
alias = do
      let addr :: ImplicitAddress
addr = PublicKey -> ImplicitAddress
mkKeyAddress (SecretKey -> PublicKey
toPublic SecretKey
sk)

      -- Save alias/address association.
      (GState -> Identity GState) -> PureState -> Identity PureState
Lens' PureState GState
psGState ((GState -> Identity GState) -> PureState -> Identity PureState)
-> ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
    -> GState -> Identity GState)
-> (Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> PureState
-> Identity PureState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias ImplicitAddress
 -> Identity (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Identity GState
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL ((Bimap ImplicitAlias ImplicitAddress
  -> Identity (Bimap ImplicitAlias ImplicitAddress))
 -> GState -> Identity GState)
-> ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
    -> Bimap ImplicitAlias ImplicitAddress
    -> Identity (Bimap ImplicitAlias ImplicitAddress))
-> (Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> GState
-> Identity GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias ImplicitAddress)
-> Lens'
     (Bimap ImplicitAlias ImplicitAddress)
     (Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ImplicitAlias ImplicitAddress)
ImplicitAlias
alias ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
 -> PureState -> Identity PureState)
-> ImplicitAddress -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= ImplicitAddress
addr
      -- Save the address's secret key.
      (Map ImplicitAddress SecretKey
 -> Identity (Map ImplicitAddress SecretKey))
-> PureState -> Identity PureState
Lens' PureState (Map ImplicitAddress SecretKey)
psSecretKeys ((Map ImplicitAddress SecretKey
  -> Identity (Map ImplicitAddress SecretKey))
 -> PureState -> Identity PureState)
-> ((Maybe SecretKey -> Identity (Maybe SecretKey))
    -> Map ImplicitAddress SecretKey
    -> Identity (Map ImplicitAddress SecretKey))
-> (Maybe SecretKey -> Identity (Maybe SecretKey))
-> PureState
-> Identity PureState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ImplicitAddress SecretKey)
-> Lens'
     (Map ImplicitAddress SecretKey)
     (Maybe (IxValue (Map ImplicitAddress SecretKey)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ImplicitAddress SecretKey)
ImplicitAddress
addr ((Maybe SecretKey -> Identity (Maybe SecretKey))
 -> PureState -> Identity PureState)
-> Maybe SecretKey -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
sk
      pure ImplicitAddress
addr

    resolveSpecificOrDefaultAlias :: SpecificOrDefaultAlias -> m ImplicitAlias
resolveSpecificOrDefaultAlias (SpecificAlias ImplicitAlias
alias) =
      ImplicitAlias -> m ImplicitAlias
forall (m :: * -> *) a. Monad m => a -> m a
return ImplicitAlias
alias
    resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
DefaultAlias = do
      DefaultAliasCounter Natural
counter <- Getting DefaultAliasCounter PureState DefaultAliasCounter
-> m DefaultAliasCounter
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting DefaultAliasCounter PureState DefaultAliasCounter
Lens' PureState DefaultAliasCounter
psDefaultAliasesCounter
      (DefaultAliasCounter -> Identity DefaultAliasCounter)
-> PureState -> Identity PureState
Lens' PureState DefaultAliasCounter
psDefaultAliasesCounter ((DefaultAliasCounter -> Identity DefaultAliasCounter)
 -> PureState -> Identity PureState)
-> (DefaultAliasCounter -> DefaultAliasCounter) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \(DefaultAliasCounter Natural
i) -> Natural -> DefaultAliasCounter
DefaultAliasCounter (Natural -> DefaultAliasCounter) -> Natural -> DefaultAliasCounter
forall a b. (a -> b) -> a -> b
$ Natural
i Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1
      return $ Natural -> ImplicitAlias
mkDefaultAlias Natural
counter

    cmiRunCode
      :: forall cp st vd. (HasRPCRepr st, T.IsoValue (AsRPC st))
      => Sender -> RunCode cp st vd -> PureM (AsRPC st)
    cmiRunCode :: forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> PureM (AsRPC st)
cmiRunCode (Sender (ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress -> ImplicitAddress
sender)) (RunCode Contract cp st vd
rcContract Value
rcParameter Value
rcStorage Mutez
rcAmount Maybe Natural
rcLevel Maybe Timestamp
rcNow Mutez
rcBalance Maybe ImplicitAddress
rcSource) = do
      contract :: Contract' Instr (ToT cp) (ToT st)
contract@T.Contract{Notes (ToT st)
ContractCode' Instr (ToT cp) (ToT st)
ViewsSet' Instr (ToT st)
EntriesOrder
ParamNotes (ToT cp)
cViews :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cParamNotes :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
cEntriesOrder :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> EntriesOrder
cCode :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cEntriesOrder :: EntriesOrder
cViews :: ViewsSet' Instr (ToT st)
cStoreNotes :: Notes (ToT st)
cParamNotes :: ParamNotes (ToT cp)
cCode :: ContractCode' Instr (ToT cp) (ToT st)
cStoreNotes :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
..} <- Contract' Instr (ToT cp) (ToT st)
-> PureM (Contract' Instr (ToT cp) (ToT st))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Contract' Instr (ToT cp) (ToT st)
 -> PureM (Contract' Instr (ToT cp) (ToT st)))
-> Contract' Instr (ToT cp) (ToT st)
-> PureM (Contract' Instr (ToT cp) (ToT st))
forall a b. (a -> b) -> a -> b
$ Contract cp st vd -> Contract' Instr (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
L.toMichelsonContract Contract cp st vd
rcContract
      T.MkEntrypointCallRes Notes arg
_ (EntrypointCallT (ToT cp) arg
epc :: T.EntrypointCallT (T.ToT cp) arg) <- MkEntrypointCallRes (ToT cp)
-> PureM (MkEntrypointCallRes (ToT cp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MkEntrypointCallRes (ToT cp)
 -> PureM (MkEntrypointCallRes (ToT cp)))
-> MkEntrypointCallRes (ToT cp)
-> PureM (MkEntrypointCallRes (ToT cp))
forall a b. (a -> b) -> a -> b
$
        ParamNotes (ToT cp) -> MkEntrypointCallRes (ToT cp)
forall (param :: T).
ParameterScope param =>
ParamNotes param -> MkEntrypointCallRes param
T.mkDefEntrypointCall ParamNotes (ToT cp)
cParamNotes

      (Timestamp
now, Natural
level) <- Getting (Timestamp, Natural) PureState (Timestamp, Natural)
-> PureM (Timestamp, Natural)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Timestamp, Natural) PureState (Timestamp, Natural)
 -> PureM (Timestamp, Natural))
-> Getting (Timestamp, Natural) PureState (Timestamp, Natural)
-> PureM (Timestamp, Natural)
forall a b. (a -> b) -> a -> b
$ (Timestamp -> Pretext (->) Timestamp Timestamp Timestamp)
-> PureState -> Pretext (->) Timestamp Timestamp PureState
Lens' PureState Timestamp
psNow ((Timestamp -> Pretext (->) Timestamp Timestamp Timestamp)
 -> PureState -> Pretext (->) Timestamp Timestamp PureState)
-> ALens' PureState Natural
-> Getting (Timestamp, Natural) PureState (Timestamp, Natural)
forall s a b. ALens' s a -> ALens' s b -> Lens' s (a, b)
`lensProduct` ALens' PureState Natural
Lens' PureState Natural
psLevel
      Map ContractAddress ContractState
knownContracts <- Getting
  (Map ContractAddress ContractState)
  PureState
  (Map ContractAddress ContractState)
-> PureM (Map ContractAddress ContractState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (Map ContractAddress ContractState)
   PureState
   (Map ContractAddress ContractState)
 -> PureM (Map ContractAddress ContractState))
-> Getting
     (Map ContractAddress ContractState)
     PureState
     (Map ContractAddress ContractState)
-> PureM (Map ContractAddress ContractState)
forall a b. (a -> b) -> a -> b
$ (GState -> Const (Map ContractAddress ContractState) GState)
-> PureState -> Const (Map ContractAddress ContractState) PureState
Lens' PureState GState
psGState ((GState -> Const (Map ContractAddress ContractState) GState)
 -> PureState
 -> Const (Map ContractAddress ContractState) PureState)
-> ((Map ContractAddress ContractState
     -> Const
          (Map ContractAddress ContractState)
          (Map ContractAddress ContractState))
    -> GState -> Const (Map ContractAddress ContractState) GState)
-> Getting
     (Map ContractAddress ContractState)
     PureState
     (Map ContractAddress ContractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ContractAddress ContractState
 -> Const
      (Map ContractAddress ContractState)
      (Map ContractAddress ContractState))
-> GState -> Const (Map ContractAddress ContractState) GState
Lens' GState (Map ContractAddress ContractState)
gsContractAddressesL
      BigMapFinder
bigMapFinder <- ExecutorM BigMapFinder -> PureM BigMapFinder
forall a. ExecutorM a -> PureM a
registerInterpretation ExecutorM BigMapFinder
Runtime.mkBigMapFinder
      let tcBm :: forall (t :: T.T). T.SingI t => U.Value -> PureM (T.Value t)
          tcBm :: forall (t :: T). SingI t => Value -> PureM (Value t)
tcBm = (TcError -> PureM (Value t))
-> (Value t -> PureM (Value t))
-> Either TcError (Value t)
-> PureM (Value t)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError -> PureM (Value t)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Value t -> PureM (Value t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TcError (Value t) -> PureM (Value t))
-> (Value -> Either TcError (Value t)) -> Value -> PureM (Value t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            BigMapFinder -> Value -> Either TcError (Value t)
forall (t :: T).
SingI t =>
BigMapFinder -> Value -> Either TcError (Value t)
resolveRunCodeBigMaps BigMapFinder
bigMapFinder
      Value arg
rcParameterT <- Value -> PureM (Value arg)
forall (t :: T). SingI t => Value -> PureM (Value t)
tcBm Value
rcParameter
      Value (ToT st)
rcStorageT <- Value -> PureM (Value (ToT st))
forall (t :: T). SingI t => Value -> PureM (Value t)
tcBm Value
rcStorage
      ([Operation]
_, Value (ToT st)
finalStorage) <- (InterpretError Void -> PureM ([Operation], Value (ToT st)))
-> (([Operation], Value (ToT st))
    -> PureM ([Operation], Value (ToT st)))
-> Either (InterpretError Void) ([Operation], Value (ToT st))
-> PureM ([Operation], Value (ToT st))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ExecutorError -> PureM ([Operation], Value (ToT st))
forall a. ExecutorError -> PureM a
throwEE (ExecutorError -> PureM ([Operation], Value (ToT st)))
-> (InterpretError Void -> ExecutorError)
-> InterpretError Void
-> PureM ([Operation], Value (ToT st))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> InterpretError Void -> ExecutorError
forall a. a -> InterpretError Void -> ExecutorError' a
EEInterpreterFailed (ImplicitAddress -> Address
forall a. ToAddress a => a -> Address
toAddress ImplicitAddress
sender)) ([Operation], Value (ToT st))
-> PureM ([Operation], Value (ToT st))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (InterpretError Void) ([Operation], Value (ToT st))
 -> PureM ([Operation], Value (ToT st)))
-> Either (InterpretError Void) ([Operation], Value (ToT st))
-> PureM ([Operation], Value (ToT st))
forall a b. (a -> b) -> a -> b
$
        RunCodeParameters (ToT cp) arg (ToT st)
-> Either (InterpretError Void) ([Operation], Value (ToT st))
forall (cp :: T) (epArg :: T) (st :: T).
RunCodeParameters cp epArg st
-> Either (InterpretError Void) ([Operation], Value st)
Runtime.runCode
          (Contract' Instr (ToT cp) (ToT st)
-> Value (ToT st)
-> EntrypointCallT (ToT cp) arg
-> Value arg
-> RunCodeParameters (ToT cp) arg (ToT st)
forall (cp :: T) (st :: T) (epArg :: T).
Contract cp st
-> Value st
-> EntrypointCallT cp epArg
-> Value epArg
-> RunCodeParameters cp epArg st
Runtime.runCodeParameters Contract' Instr (ToT cp) (ToT st)
contract Value (ToT st)
rcStorageT EntrypointCallT (ToT cp) arg
epc Value arg
rcParameterT)
            { rcAmount :: Mutez
Runtime.rcAmount = Mutez
rcAmount
            , rcLevel :: Natural
Runtime.rcLevel = Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
level Maybe Natural
rcLevel
            , rcNow :: Timestamp
Runtime.rcNow = Timestamp -> Maybe Timestamp -> Timestamp
forall a. a -> Maybe a -> a
fromMaybe Timestamp
now Maybe Timestamp
rcNow
            , rcBalance :: Mutez
Runtime.rcBalance = Mutez
rcBalance
            , rcSource :: L1Address
Runtime.rcSource = ImplicitAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained (ImplicitAddress -> L1Address) -> ImplicitAddress -> L1Address
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> Maybe ImplicitAddress -> ImplicitAddress
forall a. a -> Maybe a -> a
fromMaybe ImplicitAddress
genesisAddress Maybe ImplicitAddress
rcSource
            , rcKnownContracts :: Map ContractAddress ContractState
Runtime.rcKnownContracts = Map ContractAddress ContractState
knownContracts
            , rcSender :: L1Address
Runtime.rcSender = ImplicitAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ImplicitAddress
sender
            }
      AsRPC st -> PureM (AsRPC st)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AsRPC st -> PureM (AsRPC st)) -> AsRPC st -> PureM (AsRPC st)
forall a b. (a -> b) -> a -> b
$ Value (ToT (AsRPC st)) -> AsRPC st
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Value (ToT (AsRPC st)) -> AsRPC st)
-> Value (ToT (AsRPC st)) -> AsRPC st
forall a b. (a -> b) -> a -> b
$ Value (ToT st) -> Value (TAsRPC (ToT st))
forall (t :: T). HasCallStack => Value t -> Value (TAsRPC t)
valueAsRPC Value (ToT st)
finalStorage

-- | Traverse storage values of all contracts and looks for a big_map with the given ID.
findBigMapByIdMaybe
  ::forall k v. (SingI v, SingI k)
  => Natural -> MaybeT PureM (Value ('T.TBigMap k v))
findBigMapByIdMaybe :: forall (k :: T) (v :: T).
(SingI v, SingI k) =>
Natural -> MaybeT PureM (Value ('TBigMap k v))
findBigMapByIdMaybe Natural
bigMapId = do
  SomeVBigMap (v :: Value ('TBigMap k v)
v@VBigMap{} :: Value t) <- PureM (Maybe SomeVBigMap) -> MaybeT PureM SomeVBigMap
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (PureM (Maybe SomeVBigMap) -> MaybeT PureM SomeVBigMap)
-> PureM (Maybe SomeVBigMap) -> MaybeT PureM SomeVBigMap
forall a b. (a -> b) -> a -> b
$
    ExecutorM BigMapFinder -> PureM BigMapFinder
forall a. ExecutorM a -> PureM a
registerInterpretation ExecutorM BigMapFinder
Runtime.mkBigMapFinder PureM BigMapFinder -> PureM Natural -> PureM (Maybe SomeVBigMap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> PureM Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
bigMapId
  forall (a :: T) (b :: T) (t :: T -> *) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
t a -> (forall x. MismatchError T -> m x) -> m (t b)
castM @t @('T.TBigMap k v) Value ('TBigMap k v)
v ((forall x. MismatchError T -> MaybeT PureM x)
 -> MaybeT PureM (Value ('TBigMap k v)))
-> (forall x. MismatchError T -> MaybeT PureM x)
-> MaybeT PureM (Value ('TBigMap k v))
forall a b. (a -> b) -> a -> b
$ TestError -> MaybeT PureM x
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> MaybeT PureM x)
-> (MismatchError T -> TestError)
-> MismatchError T
-> MaybeT PureM x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> MismatchError T -> TestError
UnexpectedBigMapType Natural
bigMapId

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

getBalance :: L1AddressKind kind => KindedAddress kind -> PureM Mutez
getBalance :: forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> PureM Mutez
getBalance KindedAddress kind
addr = do
  GState
gs <- Getting GState PureState GState -> PureM GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState PureState GState
Lens' PureState GState
psGState
  pure $ Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe Mutez
zeroMutez (Maybe Mutez -> Mutez) -> Maybe Mutez -> Mutez
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> GState -> Maybe Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> GState -> Maybe Mutez
lookupBalance KindedAddress kind
addr GState
gs

exceptionHandler :: PureM a -> PureM a
exceptionHandler :: forall a. PureM a -> PureM a
exceptionHandler PureM a
action = PureM a -> PureM (Either (ExecutorError' AddressAndAlias) a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try PureM a
action PureM (Either (ExecutorError' AddressAndAlias) a)
-> (Either (ExecutorError' AddressAndAlias) a -> PureM a)
-> PureM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ExecutorError' AddressAndAlias
err -> ExecutorError' AddressAndAlias -> PureM TransferFailure
exceptionToTransferFailure ExecutorError' AddressAndAlias
err PureM TransferFailure -> (TransferFailure -> PureM a) -> PureM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TransferFailure -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
  Right a
res -> a -> PureM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
  where
    exceptionToTransferFailure :: ExecutorError' AddressAndAlias -> PureM TransferFailure
    exceptionToTransferFailure :: ExecutorError' AddressAndAlias -> PureM TransferFailure
exceptionToTransferFailure ExecutorError' AddressAndAlias
err = case ExecutorError' AddressAndAlias
err of
      EEZeroTransaction AddressAndAlias
addr -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
        AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
EmptyTransaction
      EEIllTypedParameter AddressAndAlias
addr TcError
_ -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
        AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
BadParameter
      EEUnexpectedParameterType AddressAndAlias
addr MismatchError T
_ -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
        AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
BadParameter
      EEInterpreterFailed AddressAndAlias
addr (InterpretError{ieFailure :: forall ext. InterpretError ext -> MichelsonFailureWithStack ext
ieFailure=MichelsonFailureWithStack{ErrorSrcPos
MichelsonFailed Void
mfwsFailed :: forall ext. MichelsonFailureWithStack ext -> MichelsonFailed ext
mfwsErrorSrcPos :: forall ext. MichelsonFailureWithStack ext -> ErrorSrcPos
mfwsErrorSrcPos :: ErrorSrcPos
mfwsFailed :: MichelsonFailed Void
..}}) ->
        case MichelsonFailed Void
mfwsFailed of
          MichelsonFailedWith Value t
val -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
            AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr (TransferFailureReason -> TransferFailure)
-> TransferFailureReason -> TransferFailure
forall a b. (a -> b) -> a -> b
$
              ExpressionOrTypedValue
-> Maybe ErrorSrcPos -> TransferFailureReason
FailedWith (Value t -> ExpressionOrTypedValue
forall (t :: T).
(SingI t, ConstantScope t) =>
Value t -> ExpressionOrTypedValue
EOTVTypedValue Value t
val) (ErrorSrcPos -> Maybe ErrorSrcPos
forall a. a -> Maybe a
Just ErrorSrcPos
mfwsErrorSrcPos)
          MichelsonArithError (T.ShiftArithError{}) -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
            AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
ShiftOverflow
          MichelsonArithError (T.MutezArithError MutezArithErrorType
errType Value n
_ Value m
_) -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
            AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr (TransferFailureReason -> TransferFailure)
-> TransferFailureReason -> TransferFailure
forall a b. (a -> b) -> a -> b
$ MutezArithErrorType -> TransferFailureReason
MutezArithError MutezArithErrorType
errType
          MichelsonFailed Void
MichelsonGasExhaustion -> TransferFailure -> PureM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> PureM TransferFailure)
-> TransferFailure -> PureM TransferFailure
forall a b. (a -> b) -> a -> b
$
            AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr TransferFailureReason
GasExhaustion
          MichelsonFailed Void
_ -> ExecutorError' AddressAndAlias -> PureM TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ExecutorError' AddressAndAlias
err
      ExecutorError' AddressAndAlias
_ -> ExecutorError' AddressAndAlias -> PureM TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ExecutorError' AddressAndAlias
err


getMorleyLogsImpl :: PureM a -> PureM (LogsInfo, a)
getMorleyLogsImpl :: forall a. PureM a -> PureM (LogsInfo, a)
getMorleyLogsImpl PureM a
action = (a, LogsInfo) -> (LogsInfo, a)
forall a b. (a, b) -> (b, a)
swap ((a, LogsInfo) -> (LogsInfo, a))
-> PureM (a, LogsInfo) -> PureM (LogsInfo, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PureM a -> PureM (a, LogsInfo)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen PureM a
action

getStorageImpl
  :: forall st addr. (ToStorageType st addr)
  => addr -> PureM st
getStorageImpl :: forall st addr. ToStorageType st addr => addr -> PureM st
getStorageImpl addr
addr = do
  Dict
  ((SingI (ToT st), WellTyped (ToT st),
    (FailWhenElsePoly
       (Not (DefaultEq (ContainsOp (ToT st)) 'False))
       ('Text "Operations are not allowed in this scope")
       (() :: Constraint),
     ContainsOp (ToT st) ~ 'False),
    (FailWhenElsePoly
       (Not (DefaultEq (ContainsNestedBigMaps (ToT st)) 'False))
       ('Text "Nested BigMaps are not allowed")
       (() :: Constraint),
     ContainsNestedBigMaps (ToT st) ~ 'False),
    (FailWhenElsePoly
       (Not (DefaultEq (ContainsContract (ToT st)) 'False))
       ('Text "Type `contract` is not allowed in this scope")
       (() :: Constraint),
     ContainsContract (ToT st) ~ 'False)),
   KnownValue st)
-> (((SingI (ToT st), WellTyped (ToT st),
      (FailWhenElsePoly
         (Not (DefaultEq (ContainsOp (ToT st)) 'False))
         ('Text "Operations are not allowed in this scope")
         (() :: Constraint),
       ContainsOp (ToT st) ~ 'False),
      (FailWhenElsePoly
         (Not (DefaultEq (ContainsNestedBigMaps (ToT st)) 'False))
         ('Text "Nested BigMaps are not allowed")
         (() :: Constraint),
       ContainsNestedBigMaps (ToT st) ~ 'False),
      (FailWhenElsePoly
         (Not (DefaultEq (ContainsContract (ToT st)) 'False))
         ('Text "Type `contract` is not allowed in this scope")
         (() :: Constraint),
       ContainsContract (ToT st) ~ 'False)),
     KnownValue st) =>
    PureM st)
-> PureM st
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (forall st addr.
ToStorageType st addr =>
addr -> Dict (NiceStorage st)
pickNiceStorage @st addr
addr) ((((SingI (ToT st), WellTyped (ToT st),
    (FailWhenElsePoly
       (Not (DefaultEq (ContainsOp (ToT st)) 'False))
       ('Text "Operations are not allowed in this scope")
       (() :: Constraint),
     ContainsOp (ToT st) ~ 'False),
    (FailWhenElsePoly
       (Not (DefaultEq (ContainsNestedBigMaps (ToT st)) 'False))
       ('Text "Nested BigMaps are not allowed")
       (() :: Constraint),
     ContainsNestedBigMaps (ToT st) ~ 'False),
    (FailWhenElsePoly
       (Not (DefaultEq (ContainsContract (ToT st)) 'False))
       ('Text "Type `contract` is not allowed in this scope")
       (() :: Constraint),
     ContainsContract (ToT st) ~ 'False)),
   KnownValue st) =>
  PureM st)
 -> PureM st)
-> (((SingI (ToT st), WellTyped (ToT st),
      (FailWhenElsePoly
         (Not (DefaultEq (ContainsOp (ToT st)) 'False))
         ('Text "Operations are not allowed in this scope")
         (() :: Constraint),
       ContainsOp (ToT st) ~ 'False),
      (FailWhenElsePoly
         (Not (DefaultEq (ContainsNestedBigMaps (ToT st)) 'False))
         ('Text "Nested BigMaps are not allowed")
         (() :: Constraint),
       ContainsNestedBigMaps (ToT st) ~ 'False),
      (FailWhenElsePoly
         (Not (DefaultEq (ContainsContract (ToT st)) 'False))
         ('Text "Type `contract` is not allowed in this scope")
         (() :: Constraint),
       ContainsContract (ToT st) ~ 'False)),
     KnownValue st) =>
    PureM st)
-> PureM st
forall a b. (a -> b) -> a -> b
$ do
    ContractState Mutez
_ Contract cp st
_ (Value st
storage :: Value actualT) Maybe KeyHash
_ <- ContractAddress -> PureM (AddressStateFam 'AddressKindContract)
forall (kind :: AddressKind).
KindedAddress kind -> PureM (AddressStateFam kind)
addressState (addr -> ContractAddress
forall addr. ToContractAddress addr => addr -> ContractAddress
toContractAddress addr
addr)
    Value' Instr (ToT st)
val <- forall (a :: T) (b :: T) (t :: T -> *) (m :: * -> *).
(SingI a, SingI b, Monad m) =>
t a -> (forall x. MismatchError T -> m x) -> m (t b)
castM @actualT @(ToT st) Value st
storage (TestError -> PureM x
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM x)
-> (MismatchError T -> TestError) -> MismatchError T -> PureM x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MismatchError T -> TestError
UnexpectedStorageType)
    pure $ Value' Instr (ToT st) -> st
forall a. IsoValue a => Value (ToT a) -> a
T.fromVal Value' Instr (ToT st)
val

addressState :: KindedAddress kind -> PureM (AddressStateFam kind)
addressState :: forall (kind :: AddressKind).
KindedAddress kind -> PureM (AddressStateFam kind)
addressState KindedAddress kind
addr = PureM (AddressStateFam kind)
-> (AddressStateFam kind -> PureM (AddressStateFam kind))
-> Maybe (AddressStateFam kind)
-> PureM (AddressStateFam kind)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (KindedAddress kind -> PureM (AddressStateFam kind)
forall (kind :: AddressKind) whatever.
KindedAddress kind -> PureM whatever
unknownAddress KindedAddress kind
addr) AddressStateFam kind -> PureM (AddressStateFam kind)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (AddressStateFam kind) -> PureM (AddressStateFam kind))
-> PureM (Maybe (AddressStateFam kind))
-> PureM (AddressStateFam kind)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  Getting
  (Maybe (AddressStateFam kind))
  PureState
  (Maybe (AddressStateFam kind))
-> PureM (Maybe (AddressStateFam kind))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Maybe (AddressStateFam kind)) GState)
-> PureState -> Const (Maybe (AddressStateFam kind)) PureState
Lens' PureState GState
psGState ((GState -> Const (Maybe (AddressStateFam kind)) GState)
 -> PureState -> Const (Maybe (AddressStateFam kind)) PureState)
-> ((Maybe (AddressStateFam kind)
     -> Const
          (Maybe (AddressStateFam kind)) (Maybe (AddressStateFam kind)))
    -> GState -> Const (Maybe (AddressStateFam kind)) GState)
-> Getting
     (Maybe (AddressStateFam kind))
     PureState
     (Maybe (AddressStateFam kind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
forall (kind :: AddressKind).
KindedAddress kind
-> Lens' GState (Map (KindedAddress kind) (AddressStateFam kind))
addressesL KindedAddress kind
addr ((Map (KindedAddress kind) (AddressStateFam kind)
  -> Const
       (Maybe (AddressStateFam kind))
       (Map (KindedAddress kind) (AddressStateFam kind)))
 -> GState -> Const (Maybe (AddressStateFam kind)) GState)
-> ((Maybe (AddressStateFam kind)
     -> Const
          (Maybe (AddressStateFam kind)) (Maybe (AddressStateFam kind)))
    -> Map (KindedAddress kind) (AddressStateFam kind)
    -> Const
         (Maybe (AddressStateFam kind))
         (Map (KindedAddress kind) (AddressStateFam kind)))
-> (Maybe (AddressStateFam kind)
    -> Const
         (Maybe (AddressStateFam kind)) (Maybe (AddressStateFam kind)))
-> GState
-> Const (Maybe (AddressStateFam kind)) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map (KindedAddress kind) (AddressStateFam kind))
-> Lens'
     (Map (KindedAddress kind) (AddressStateFam kind))
     (Maybe (IxValue (Map (KindedAddress kind) (AddressStateFam kind))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (KindedAddress kind) (AddressStateFam kind))
KindedAddress kind
addr)

resolveLens
  :: (MonadState PureState m, At x)
  => LensLike' (Const (Maybe (IxValue x))) GState x
  -> (Index x -> m b)
  -> (Index x -> IxValue x -> b)
  -> Index x
  -> m b
resolveLens :: forall (m :: * -> *) x b.
(MonadState PureState m, At x) =>
LensLike' (Const (Maybe (IxValue x))) GState x
-> (Index x -> m b)
-> (Index x -> IxValue x -> b)
-> Index x
-> m b
resolveLens LensLike' (Const (Maybe (IxValue x))) GState x
f Index x -> m b
e Index x -> IxValue x -> b
c Index x
x = Getting (Maybe (IxValue x)) PureState (Maybe (IxValue x))
-> m (Maybe (IxValue x))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((GState -> Const (Maybe (IxValue x)) GState)
-> PureState -> Const (Maybe (IxValue x)) PureState
Lens' PureState GState
psGState ((GState -> Const (Maybe (IxValue x)) GState)
 -> PureState -> Const (Maybe (IxValue x)) PureState)
-> ((Maybe (IxValue x)
     -> Const (Maybe (IxValue x)) (Maybe (IxValue x)))
    -> GState -> Const (Maybe (IxValue x)) GState)
-> Getting (Maybe (IxValue x)) PureState (Maybe (IxValue x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike' (Const (Maybe (IxValue x))) GState x
f LensLike' (Const (Maybe (IxValue x))) GState x
-> ((Maybe (IxValue x)
     -> Const (Maybe (IxValue x)) (Maybe (IxValue x)))
    -> x -> Const (Maybe (IxValue x)) x)
-> (Maybe (IxValue x)
    -> Const (Maybe (IxValue x)) (Maybe (IxValue x)))
-> GState
-> Const (Maybe (IxValue x)) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index x -> Lens' x (Maybe (IxValue x))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index x
x) m (Maybe (IxValue x)) -> (Maybe (IxValue x) -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m b -> (IxValue x -> m b) -> Maybe (IxValue x) -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Index x -> m b
e Index x
x) (b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> m b) -> (IxValue x -> b) -> IxValue x -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index x -> IxValue x -> b
c Index x
x)

resolveAlias
  :: (At x, Index x ~ Alias kind, IxValue x ~ KindedAddress kind)
  => LensLike' (Const (Maybe (IxValue x))) GState x
  -> Alias kind
  -> PureM (AddressWithAlias kind)
resolveAlias :: forall x (kind :: AddressKind).
(At x, Index x ~ Alias kind, IxValue x ~ KindedAddress kind) =>
LensLike' (Const (Maybe (IxValue x))) GState x
-> Alias kind -> PureM (AddressWithAlias kind)
resolveAlias LensLike' (Const (Maybe (IxValue x))) GState x
f = LensLike' (Const (Maybe (IxValue x))) GState x
-> (Index x -> PureM (AddressWithAlias kind))
-> (Index x -> IxValue x -> AddressWithAlias kind)
-> Index x
-> PureM (AddressWithAlias kind)
forall (m :: * -> *) x b.
(MonadState PureState m, At x) =>
LensLike' (Const (Maybe (IxValue x))) GState x
-> (Index x -> m b)
-> (Index x -> IxValue x -> b)
-> Index x
-> m b
resolveLens LensLike' (Const (Maybe (IxValue x))) GState x
f Index x -> PureM (AddressWithAlias kind)
forall (kind :: AddressKind) whatever. Alias kind -> PureM whatever
unknownAlias ((Index x -> IxValue x -> AddressWithAlias kind)
 -> Index x -> PureM (AddressWithAlias kind))
-> (Index x -> IxValue x -> AddressWithAlias kind)
-> Index x
-> PureM (AddressWithAlias kind)
forall a b. (a -> b) -> a -> b
$ (KindedAddress kind -> Alias kind -> AddressWithAlias kind)
-> Alias kind -> KindedAddress kind -> AddressWithAlias kind
forall a b c. (a -> b -> c) -> b -> a -> c
flip KindedAddress kind -> Alias kind -> AddressWithAlias kind
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
AddressWithAlias

resolveAddress
  :: ( x ~ Bimap.Bimap (Alias kind) (KindedAddress kind))
  => LensLike' (Const (Maybe (Index x))) GState x
  -> KindedAddress kind
  -> PureM (AddressWithAlias kind)
resolveAddress :: forall x (kind :: AddressKind).
(x ~ Bimap (Alias kind) (KindedAddress kind)) =>
LensLike' (Const (Maybe (Index x))) GState x
-> KindedAddress kind -> PureM (AddressWithAlias kind)
resolveAddress LensLike' (Const (Maybe (Index x))) GState x
f = LensLike'
  (Const (Maybe (IxValue (Bimap (KindedAddress kind) (Alias kind)))))
  GState
  (Bimap (KindedAddress kind) (Alias kind))
-> (Index (Bimap (KindedAddress kind) (Alias kind))
    -> PureM (AddressWithAlias kind))
-> (Index (Bimap (KindedAddress kind) (Alias kind))
    -> IxValue (Bimap (KindedAddress kind) (Alias kind))
    -> AddressWithAlias kind)
-> Index (Bimap (KindedAddress kind) (Alias kind))
-> PureM (AddressWithAlias kind)
forall (m :: * -> *) x b.
(MonadState PureState m, At x) =>
LensLike' (Const (Maybe (IxValue x))) GState x
-> (Index x -> m b)
-> (Index x -> IxValue x -> b)
-> Index x
-> m b
resolveLens (LensLike' (Const (Maybe (Index x))) GState x
(Bimap (Alias kind) (KindedAddress kind)
 -> Const
      (Maybe (Alias kind)) (Bimap (Alias kind) (KindedAddress kind)))
-> GState -> Const (Maybe (Alias kind)) GState
f ((Bimap (Alias kind) (KindedAddress kind)
  -> Const
       (Maybe (Alias kind)) (Bimap (Alias kind) (KindedAddress kind)))
 -> GState -> Const (Maybe (Alias kind)) GState)
-> ((Bimap (KindedAddress kind) (Alias kind)
     -> Const
          (Maybe (Alias kind)) (Bimap (KindedAddress kind) (Alias kind)))
    -> Bimap (Alias kind) (KindedAddress kind)
    -> Const
         (Maybe (Alias kind)) (Bimap (Alias kind) (KindedAddress kind)))
-> (Bimap (KindedAddress kind) (Alias kind)
    -> Const
         (Maybe (Alias kind)) (Bimap (KindedAddress kind) (Alias kind)))
-> GState
-> Const (Maybe (Alias kind)) GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap (KindedAddress kind) (Alias kind)
 -> Const
      (Maybe (Alias kind)) (Bimap (KindedAddress kind) (Alias kind)))
-> Bimap (Alias kind) (KindedAddress kind)
-> Const
     (Maybe (Alias kind)) (Bimap (Alias kind) (KindedAddress kind))
forall a1 b1 a2 b2.
Iso (Bimap a1 b1) (Bimap a2 b2) (Bimap b1 a1) (Bimap b2 a2)
Bimap.flipped) Index (Bimap (KindedAddress kind) (Alias kind))
-> PureM (AddressWithAlias kind)
forall (kind :: AddressKind) whatever.
KindedAddress kind -> PureM whatever
unknownAddress Index (Bimap (KindedAddress kind) (Alias kind))
-> IxValue (Bimap (KindedAddress kind) (Alias kind))
-> AddressWithAlias kind
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
AddressWithAlias

unknownAddress :: KindedAddress kind -> PureM whatever
unknownAddress :: forall (kind :: AddressKind) whatever.
KindedAddress kind -> PureM whatever
unknownAddress =
  TestError -> PureM whatever
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM whatever)
-> (KindedAddress kind -> TestError)
-> KindedAddress kind
-> PureM whatever
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError)
-> (KindedAddress kind -> Text) -> KindedAddress kind -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"Unknown address provided: " (Text -> Text)
-> (KindedAddress kind -> Text) -> KindedAddress kind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

unknownAlias :: Alias kind -> PureM whatever
unknownAlias :: forall (kind :: AddressKind) whatever. Alias kind -> PureM whatever
unknownAlias =
  TestError -> PureM whatever
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM whatever)
-> (Alias kind -> TestError) -> Alias kind -> PureM whatever
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError)
-> (Alias kind -> Text) -> Alias kind -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"Unknown address alias: " (Text -> Text) -> (Alias kind -> Text) -> Alias kind -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias kind -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

failure :: forall a. Builder -> PureM a
failure :: forall a. Builder -> PureM a
failure = TestError -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM a)
-> (Builder -> TestError) -> Builder -> PureM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError) -> (Builder -> Text) -> Builder -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

getSecretKey :: ImplicitAddress -> PureM SecretKey
getSecretKey :: ImplicitAddress -> PureM SecretKey
getSecretKey ImplicitAddress
addr = do
  Getting (Maybe SecretKey) PureState (Maybe SecretKey)
-> PureM (Maybe SecretKey)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Map ImplicitAddress SecretKey
 -> Const (Maybe SecretKey) (Map ImplicitAddress SecretKey))
-> PureState -> Const (Maybe SecretKey) PureState
Lens' PureState (Map ImplicitAddress SecretKey)
psSecretKeys ((Map ImplicitAddress SecretKey
  -> Const (Maybe SecretKey) (Map ImplicitAddress SecretKey))
 -> PureState -> Const (Maybe SecretKey) PureState)
-> ((Maybe SecretKey -> Const (Maybe SecretKey) (Maybe SecretKey))
    -> Map ImplicitAddress SecretKey
    -> Const (Maybe SecretKey) (Map ImplicitAddress SecretKey))
-> Getting (Maybe SecretKey) PureState (Maybe SecretKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ImplicitAddress SecretKey)
-> Lens'
     (Map ImplicitAddress SecretKey)
     (Maybe (IxValue (Map ImplicitAddress SecretKey)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ImplicitAddress SecretKey)
ImplicitAddress
addr) PureM (Maybe SecretKey)
-> (Maybe SecretKey -> PureM SecretKey) -> PureM SecretKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe SecretKey
Nothing -> ImplicitAddress -> PureM SecretKey
forall (kind :: AddressKind) whatever.
KindedAddress kind -> PureM whatever
unknownAddress ImplicitAddress
addr
    Just SecretKey
sk -> SecretKey -> PureM SecretKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecretKey
sk

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

initEnv :: ImplicitAlias -> PureState
initEnv :: ImplicitAlias -> PureState
initEnv ImplicitAlias
alias = PureState :: Map ImplicitAddress SecretKey
-> DefaultAliasCounter
-> Set ImplicitAddress
-> Timestamp
-> Natural
-> Natural
-> GState
-> PureState
PureState
  { _psSecretKeys :: Map ImplicitAddress SecretKey
_psSecretKeys = OneItem (Map ImplicitAddress SecretKey)
-> Map ImplicitAddress SecretKey
forall x. One x => OneItem x -> x
one (ImplicitAddress
genesisAddress, SecretKey
genesisSecretKey)
  , _psDefaultAliasesCounter :: DefaultAliasCounter
_psDefaultAliasesCounter = Natural -> DefaultAliasCounter
DefaultAliasCounter Natural
0
  , _psRefillableAddresses :: Set ImplicitAddress
_psRefillableAddresses = Set ImplicitAddress
forall a. Set a
Set.empty
  , _psNow :: Timestamp
_psNow = Timestamp
dummyNow
  , _psLevel :: Natural
_psLevel = Natural
dummyLevel
  , _psGState :: GState
_psGState = GState
initGState GState -> (GState -> GState) -> GState
forall a b. a -> (a -> b) -> b
& (Bimap ImplicitAlias ImplicitAddress
 -> Identity (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Identity GState
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL ((Bimap ImplicitAlias ImplicitAddress
  -> Identity (Bimap ImplicitAlias ImplicitAddress))
 -> GState -> Identity GState)
-> ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
    -> Bimap ImplicitAlias ImplicitAddress
    -> Identity (Bimap ImplicitAlias ImplicitAddress))
-> (Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
-> GState
-> Identity GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAlias ImplicitAddress)
-> Lens'
     (Bimap ImplicitAlias ImplicitAddress)
     (Maybe (IxValue (Bimap ImplicitAlias ImplicitAddress)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ImplicitAlias ImplicitAddress)
ImplicitAlias
alias ((Maybe ImplicitAddress -> Identity (Maybe ImplicitAddress))
 -> GState -> Identity GState)
-> ImplicitAddress -> GState -> GState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ImplicitAddress
genesisAddress
  , _psMinBlockTime :: Natural
_psMinBlockTime = Natural
dummyMinBlockTime
  }

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

transfer
  :: (T.ParameterScope (T.ToT epArg), T.IsoValue epArg, L.ToAddress addr)
  => "from" :! ImplicitAddress
  -> "to" :! addr
  -> Mutez
  -> U.EpName
  -> epArg
  -> PureM [EmitOperation]
transfer :: forall epArg addr.
(ParameterScope (ToT epArg), IsoValue epArg, ToAddress addr) =>
NamedF Identity ImplicitAddress "from"
-> ("to" :! addr)
-> Mutez
-> EpName
-> epArg
-> PureM [EmitOperation]
transfer (Name "from"
-> NamedF Identity ImplicitAddress "from" -> ImplicitAddress
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "from" (Name "from")
Name "from"
#from -> ImplicitAddress
from) (Name "to" -> ("to" :! addr) -> addr
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "to" (Name "to")
Name "to"
#to -> addr
toAddr) Mutez
money EpName
epName epArg
param = do
  ExecutorM [EmitOperation] -> PureM [EmitOperation]
forall a. ExecutorM a -> PureM a
registerInterpretation (ExecutorM [EmitOperation] -> PureM [EmitOperation])
-> ExecutorM [EmitOperation] -> PureM [EmitOperation]
forall a b. (a -> b) -> a -> b
$ [ExecutorOp] -> ExecutorM [EmitOperation]
executeGlobalOperations ([ExecutorOp] -> ExecutorM [EmitOperation])
-> [ExecutorOp] -> ExecutorM [EmitOperation]
forall a b. (a -> b) -> a -> b
$ OneItem [ExecutorOp] -> [ExecutorOp]
forall x. One x => OneItem x -> x
one (OneItem [ExecutorOp] -> [ExecutorOp])
-> OneItem [ExecutorOp] -> [ExecutorOp]
forall a b. (a -> b) -> a -> b
$ TransferOperation -> ExecutorOp
Runtime.TransferOp TransferOperation :: Address -> TxData -> GlobalCounter -> TransferOperation
TransferOperation
    { toDestination :: Address
toDestination = addr -> Address
forall a. ToAddress a => a -> Address
L.toAddress addr
toAddr
    , toCounter :: GlobalCounter
toCounter = GlobalCounter
0
    , toTxData :: TxData
toTxData = TxData :: L1Address -> TxParam -> EpName -> Mutez -> TxData
TxData
      { tdSenderAddress :: L1Address
tdSenderAddress = ImplicitAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ImplicitAddress
from
      , tdParameter :: TxParam
tdParameter = 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 :: OriginateData oty large -> PureM ContractAddress
originate :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> PureM ContractAddress
originate OriginateData{Maybe KeyHash
Mutez
ContractAlias
ODContractAndStorage oty
odContractAndStorage :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> ODContractAndStorage oty
odDelegate :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Maybe KeyHash
odBalance :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Mutez
odName :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> ContractAlias
odContractAndStorage :: ODContractAndStorage oty
odDelegate :: Maybe KeyHash
odBalance :: Mutez
odName :: ContractAlias
..} = do
  T.SomeContractAndStorage Contract cp st
contract Value st
storage <- (TcError -> PureM SomeContractAndStorage)
-> (SomeContractAndStorage -> PureM SomeContractAndStorage)
-> Either TcError SomeContractAndStorage
-> PureM SomeContractAndStorage
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TestError -> PureM SomeContractAndStorage
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> PureM SomeContractAndStorage)
-> (TcError -> TestError)
-> TcError
-> PureM SomeContractAndStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcError -> TestError
UnexpectedTypeCheckError) SomeContractAndStorage -> PureM SomeContractAndStorage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TcError SomeContractAndStorage
 -> PureM SomeContractAndStorage)
-> Either TcError SomeContractAndStorage
-> PureM SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$
    ODContractAndStorage oty -> Either TcError SomeContractAndStorage
forall (oty :: OriginationType).
ODContractAndStorage oty -> Either TcError SomeContractAndStorage
typeCheckODContractAndStorageIfNeeded ODContractAndStorage oty
odContractAndStorage
  GlobalCounter
counter <- GState -> GlobalCounter
gsCounter (GState -> GlobalCounter) -> PureM GState -> PureM GlobalCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting GState PureState GState -> PureM GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState PureState GState
Lens' PureState GState
psGState
  ExecutorM ContractAddress -> PureM ContractAddress
forall a. ExecutorM a -> PureM a
registerInterpretation (ExecutorM ContractAddress -> PureM ContractAddress)
-> (OriginationOperation -> ExecutorM ContractAddress)
-> OriginationOperation
-> PureM ContractAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginationOperation -> ExecutorM ContractAddress
executeGlobalOrigination (OriginationOperation -> PureM ContractAddress)
-> OriginationOperation -> PureM ContractAddress
forall a b. (a -> b) -> a -> b
$
    (Value st -> Contract cp st -> GlobalCounter -> OriginationOperation
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Value st -> Contract cp st -> GlobalCounter -> OriginationOperation
dummyOrigination Value st
storage Contract cp st
contract GlobalCounter
counter)
      { ooBalance :: Mutez
ooBalance = Mutez
odBalance
      , ooAlias :: Maybe ContractAlias
ooAlias = ContractAlias -> Maybe ContractAlias
forall a. a -> Maybe a
Just ContractAlias
odName
      , ooDelegate :: Maybe KeyHash
ooDelegate = Maybe KeyHash
odDelegate
      }

throwEE :: ExecutorError -> PureM a
throwEE :: forall a. ExecutorError -> PureM a
throwEE ExecutorError
err =
  -- Replace all `Address`es with `AddressAndAlias` in the error and throw it.
  (Address -> PureM AddressAndAlias)
-> ExecutorError -> PureM (ExecutorError' AddressAndAlias)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Address -> PureM AddressAndAlias
addrToAddressAndAlias ExecutorError
err PureM (ExecutorError' AddressAndAlias)
-> (ExecutorError' AddressAndAlias -> PureM a) -> PureM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecutorError' AddressAndAlias -> PureM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
  where
    addrToAddressAndAlias :: Address -> PureM AddressAndAlias
    addrToAddressAndAlias :: Address -> PureM AddressAndAlias
addrToAddressAndAlias (MkAddress KindedAddress kind
kindedAddr) =
      case KindedAddress kind
kindedAddr of
        ContractAddress{} ->
          Getting AddressAndAlias PureState AddressAndAlias
-> PureM AddressAndAlias
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting AddressAndAlias PureState AddressAndAlias
 -> PureM AddressAndAlias)
-> Getting AddressAndAlias PureState AddressAndAlias
-> PureM AddressAndAlias
forall a b. (a -> b) -> a -> b
$ (GState -> Const AddressAndAlias GState)
-> PureState -> Const AddressAndAlias PureState
Lens' PureState GState
psGState ((GState -> Const AddressAndAlias GState)
 -> PureState -> Const AddressAndAlias PureState)
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
    -> GState -> Const AddressAndAlias GState)
-> Getting AddressAndAlias PureState AddressAndAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAlias ContractAddress
 -> Const AddressAndAlias (Bimap ContractAlias ContractAddress))
-> GState -> Const AddressAndAlias GState
Lens' GState (Bimap ContractAlias ContractAddress)
gsContractAddressAliasesL ((Bimap ContractAlias ContractAddress
  -> Const AddressAndAlias (Bimap ContractAlias ContractAddress))
 -> GState -> Const AddressAndAlias GState)
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
    -> Bimap ContractAlias ContractAddress
    -> Const AddressAndAlias (Bimap ContractAlias ContractAddress))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> GState
-> Const AddressAndAlias GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ContractAddress ContractAlias
 -> Const AddressAndAlias (Bimap ContractAddress ContractAlias))
-> Bimap ContractAlias ContractAddress
-> Const AddressAndAlias (Bimap ContractAlias ContractAddress)
forall a1 b1 a2 b2.
Iso (Bimap a1 b1) (Bimap a2 b2) (Bimap b1 a1) (Bimap b2 a2)
Bimap.flipped ((Bimap ContractAddress ContractAlias
  -> Const AddressAndAlias (Bimap ContractAddress ContractAlias))
 -> Bimap ContractAlias ContractAddress
 -> Const AddressAndAlias (Bimap ContractAlias ContractAddress))
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
    -> Bimap ContractAddress ContractAlias
    -> Const AddressAndAlias (Bimap ContractAddress ContractAlias))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Bimap ContractAlias ContractAddress
-> Const AddressAndAlias (Bimap ContractAlias ContractAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ContractAddress ContractAlias)
-> Lens'
     (Bimap ContractAddress ContractAlias)
     (Maybe (IxValue (Bimap ContractAddress ContractAlias)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ContractAddress ContractAlias)
KindedAddress kind
kindedAddr ((Maybe (Alias kind) -> Const AddressAndAlias (Maybe (Alias kind)))
 -> Bimap ContractAddress ContractAlias
 -> Const AddressAndAlias (Bimap ContractAddress ContractAlias))
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
    -> Maybe (Alias kind)
    -> Const AddressAndAlias (Maybe (Alias kind)))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Bimap ContractAddress ContractAlias
-> Const AddressAndAlias (Bimap ContractAddress ContractAlias)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Alias kind) -> AddressAndAlias)
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Maybe (Alias kind)
-> Const AddressAndAlias (Maybe (Alias kind))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
AddressAndAlias KindedAddress kind
kindedAddr)
        ImplicitAddress{} ->
          Getting AddressAndAlias PureState AddressAndAlias
-> PureM AddressAndAlias
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting AddressAndAlias PureState AddressAndAlias
 -> PureM AddressAndAlias)
-> Getting AddressAndAlias PureState AddressAndAlias
-> PureM AddressAndAlias
forall a b. (a -> b) -> a -> b
$ (GState -> Const AddressAndAlias GState)
-> PureState -> Const AddressAndAlias PureState
Lens' PureState GState
psGState ((GState -> Const AddressAndAlias GState)
 -> PureState -> Const AddressAndAlias PureState)
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
    -> GState -> Const AddressAndAlias GState)
-> Getting AddressAndAlias PureState AddressAndAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAlias ImplicitAddress
 -> Const AddressAndAlias (Bimap ImplicitAlias ImplicitAddress))
-> GState -> Const AddressAndAlias GState
Lens' GState (Bimap ImplicitAlias ImplicitAddress)
gsImplicitAddressAliasesL ((Bimap ImplicitAlias ImplicitAddress
  -> Const AddressAndAlias (Bimap ImplicitAlias ImplicitAddress))
 -> GState -> Const AddressAndAlias GState)
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
    -> Bimap ImplicitAlias ImplicitAddress
    -> Const AddressAndAlias (Bimap ImplicitAlias ImplicitAddress))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> GState
-> Const AddressAndAlias GState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bimap ImplicitAddress ImplicitAlias
 -> Const AddressAndAlias (Bimap ImplicitAddress ImplicitAlias))
-> Bimap ImplicitAlias ImplicitAddress
-> Const AddressAndAlias (Bimap ImplicitAlias ImplicitAddress)
forall a1 b1 a2 b2.
Iso (Bimap a1 b1) (Bimap a2 b2) (Bimap b1 a1) (Bimap b2 a2)
Bimap.flipped ((Bimap ImplicitAddress ImplicitAlias
  -> Const AddressAndAlias (Bimap ImplicitAddress ImplicitAlias))
 -> Bimap ImplicitAlias ImplicitAddress
 -> Const AddressAndAlias (Bimap ImplicitAlias ImplicitAddress))
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
    -> Bimap ImplicitAddress ImplicitAlias
    -> Const AddressAndAlias (Bimap ImplicitAddress ImplicitAlias))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Bimap ImplicitAlias ImplicitAddress
-> Const AddressAndAlias (Bimap ImplicitAlias ImplicitAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Bimap ImplicitAddress ImplicitAlias)
-> Lens'
     (Bimap ImplicitAddress ImplicitAlias)
     (Maybe (IxValue (Bimap ImplicitAddress ImplicitAlias)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Bimap ImplicitAddress ImplicitAlias)
KindedAddress kind
kindedAddr ((Maybe (Alias kind) -> Const AddressAndAlias (Maybe (Alias kind)))
 -> Bimap ImplicitAddress ImplicitAlias
 -> Const AddressAndAlias (Bimap ImplicitAddress ImplicitAlias))
-> ((AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
    -> Maybe (Alias kind)
    -> Const AddressAndAlias (Maybe (Alias kind)))
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Bimap ImplicitAddress ImplicitAlias
-> Const AddressAndAlias (Bimap ImplicitAddress ImplicitAlias)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Alias kind) -> AddressAndAlias)
-> (AddressAndAlias -> Const AddressAndAlias AddressAndAlias)
-> Maybe (Alias kind)
-> Const AddressAndAlias (Maybe (Alias kind))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
AddressAndAlias KindedAddress kind
kindedAddr)
        SmartRollupAddress{} ->
          AddressAndAlias -> PureM AddressAndAlias
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddressAndAlias -> PureM AddressAndAlias)
-> AddressAndAlias -> PureM AddressAndAlias
forall a b. (a -> b) -> a -> b
$ KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
AddressAndAlias KindedAddress kind
kindedAddr Maybe (Alias kind)
forall a. Maybe a
Nothing

-- | Runs a set of operations and updates the engine's state.
registerInterpretation :: ExecutorM a -> PureM a
registerInterpretation :: forall a. ExecutorM a -> PureM a
registerInterpretation ExecutorM a
action = do
  Either ExecutorError (ExecutorRes, a)
interpretedResult <- ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
forall a.
ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret ExecutorM a
action
  LogsInfo -> PureM ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (LogsInfo -> PureM ()) -> LogsInfo -> PureM ()
forall a b. (a -> b) -> a -> b
$ Either ExecutorError (ExecutorRes, a) -> LogsInfo
forall a. Either ExecutorError (ExecutorRes, a) -> LogsInfo
extractLogs Either ExecutorError (ExecutorRes, a)
interpretedResult

  case Either ExecutorError (ExecutorRes, a)
interpretedResult of
    Right (ExecutorRes
executorRes, a
res) -> do
      (GState -> Identity GState) -> PureState -> Identity PureState
Lens' PureState GState
psGState ((GState -> Identity GState) -> PureState -> Identity PureState)
-> GState -> PureM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorRes -> GState
_erGState ExecutorRes
executorRes
      pure a
res
    Left ExecutorError
executorError -> ExecutorError -> PureM a
forall a. ExecutorError -> PureM a
throwEE ExecutorError
executorError

  where
    extractLogs :: Either ExecutorError (ExecutorRes, a) -> [ScenarioLogs]
    extractLogs :: forall a. Either ExecutorError (ExecutorRes, a) -> LogsInfo
extractLogs = \case
      Left (EEInterpreterFailed Address
addr InterpretError{MichelsonFailureWithStack Void
MorleyLogs
ieLogs :: forall ext. InterpretError ext -> MorleyLogs
ieFailure :: MichelsonFailureWithStack Void
ieLogs :: MorleyLogs
ieFailure :: forall ext. InterpretError ext -> MichelsonFailureWithStack ext
..}) -> [Address -> MorleyLogs -> ScenarioLogs
ScenarioLogs Address
addr MorleyLogs
ieLogs]
      Right (ExecutorRes
res, a
_) -> ExecutorRes
res ExecutorRes
-> Getting
     [(Address, SomeInterpretResult)]
     ExecutorRes
     [(Address, SomeInterpretResult)]
-> [(Address, SomeInterpretResult)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Address, SomeInterpretResult)]
  ExecutorRes
  [(Address, SomeInterpretResult)]
Lens' ExecutorRes [(Address, SomeInterpretResult)]
erInterpretResults [(Address, SomeInterpretResult)]
-> ((Address, SomeInterpretResult) -> ScenarioLogs) -> LogsInfo
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \(Address
addr, SomeInterpretResult ResultStateLogs{Value st
InterpreterState
MorleyLogs
rslState :: forall res. ResultStateLogs res -> InterpreterState
rslResult :: forall res. ResultStateLogs res -> res
rslLogs :: forall res. ResultStateLogs res -> MorleyLogs
rslLogs :: MorleyLogs
rslState :: InterpreterState
rslResult :: Value st
..}) -> Address -> MorleyLogs -> ScenarioLogs
ScenarioLogs Address
addr MorleyLogs
rslLogs
      Either ExecutorError (ExecutorRes, a)
_ -> []

-- | Interpret an action and return the result _without_ updating the engine's state.
interpret :: ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret :: forall a.
ExecutorM a -> PureM (Either ExecutorError (ExecutorRes, a))
interpret ExecutorM a
action = do
  Timestamp
now <- Getting Timestamp PureState Timestamp -> PureM Timestamp
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Timestamp PureState Timestamp
Lens' PureState Timestamp
psNow
  Natural
level <- Getting Natural PureState Natural -> PureM Natural
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Natural PureState Natural
Lens' PureState Natural
psLevel
  GState
gState <- Getting GState PureState GState -> PureM GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState PureState GState
Lens' PureState GState
psGState
  Natural
minBlockTime <- Getting Natural PureState Natural -> PureM Natural
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Natural PureState Natural
Lens' PureState Natural
psMinBlockTime
  pure $ Timestamp
-> Natural
-> Natural
-> RemainingSteps
-> TypeCheckOptions
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
forall a.
Timestamp
-> Natural
-> Natural
-> RemainingSteps
-> TypeCheckOptions
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now Natural
level Natural
minBlockTime RemainingSteps
dummyMaxSteps TypeCheckOptions
forall a. Default a => a
def GState
gState ExecutorM a
action

setDelegate :: ImplicitAddress -> Maybe KeyHash -> PureM ()
setDelegate :: ImplicitAddress -> Maybe KeyHash -> PureM ()
setDelegate ImplicitAddress
addr Maybe KeyHash
mbKh = PureM [EmitOperation] -> PureM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PureM [EmitOperation] -> PureM ())
-> PureM [EmitOperation] -> PureM ()
forall a b. (a -> b) -> a -> b
$ ExecutorM [EmitOperation] -> PureM [EmitOperation]
forall a. ExecutorM a -> PureM a
registerInterpretation (ExecutorM [EmitOperation] -> PureM [EmitOperation])
-> ExecutorM [EmitOperation] -> PureM [EmitOperation]
forall a b. (a -> b) -> a -> b
$
  [ExecutorOp] -> ExecutorM [EmitOperation]
executeGlobalOperations ([ExecutorOp] -> ExecutorM [EmitOperation])
-> [ExecutorOp] -> ExecutorM [EmitOperation]
forall a b. (a -> b) -> a -> b
$ OneItem [ExecutorOp] -> [ExecutorOp]
forall x. One x => OneItem x -> x
one (OneItem [ExecutorOp] -> [ExecutorOp])
-> OneItem [ExecutorOp] -> [ExecutorOp]
forall a b. (a -> b) -> a -> b
$
    SetDelegateOperation -> ExecutorOp
Runtime.SetDelegateOp SetDelegateOperation :: L1Address -> Maybe KeyHash -> GlobalCounter -> SetDelegateOperation
SetDelegateOperation
      { sdoContract :: L1Address
sdoContract = ImplicitAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ImplicitAddress
addr
      , sdoDelegate :: Maybe KeyHash
sdoDelegate = Maybe KeyHash
mbKh
      , sdoCounter :: GlobalCounter
sdoCounter = GlobalCounter
0
      }