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

{-# OPTIONS_HADDOCK not-home #-}

-- | Abstract cleveland interface not bound to a particular
-- implementation.
--
-- The interface may look a bit untyped and unsafe in some places.
-- For example, in order to call a contract one should supply a
-- simple address rather than a contract ref, so it is easy to pass
-- a value of wrong type. Also it is easy to call a non-existing entrypoint.
--
-- Subjectively, it makes writing test scenarios easier because you
-- have to prove less to the compiler. It also makes implementation of
-- cleveland engine a bit easier. Of course, it also makes it easier
-- to make certain mistakes. However, we expect users of this interface
-- to also use the functionality of the "Test.Cleveland.Internal.Pure" module
-- and convert cleveland scenarios to purely testable scenarios for
-- integrational testing engine. In this case errors should be detected
-- almost as quickly as they would reported by the compiler, at least
-- before trying to run scenario on a live network.
--
-- Also this interface uses 'Address' rather than 'EpAddress'.
-- I (\@gromak) concluded that 'EpAddress' can not be passed to @octez-client@.
-- For key addresses it just does not make sense and for contract addresses
-- I get such errors:
--
-- @
--   bad contract notation
--   Invalid contract notation "KT1VrFpBPwBTm3hsK7DB7SPmY8fTHJ3vY6sJ%mint"
-- @
module Test.Cleveland.Internal.Abstract
  ( module Test.Cleveland.Internal.Abstract
  ) where

import Control.Lens (Each, each, filtered, makeLenses, makeLensesFor, makeLensesWith)
import Data.Constraint (Bottom(..), (\\))
import Data.Default (Default(..))
import Data.Type.Equality (pattern Refl)
import Fmt (Buildable(..), Builder, pretty, (+|), (|+))
import Prelude hiding (Each)
import Time (KnownDivRat, Second, Time)

import Lorentz (Contract(..))
import Lorentz.Constraints
import Lorentz.Entrypoints.Core (EntrypointRef(..), NiceEntrypointName, eprName)
import Morley.AsRPC (HasRPCRepr(AsRPC))
import Morley.Client (MorleyClientEnv, Result)
import Morley.Client.Types
import Morley.Micheline (Expression, fromExpression)
import Morley.Michelson.ErrorPos (ErrorSrcPos)
import Morley.Michelson.Interpret (MorleyLogs(..))
import Morley.Michelson.Runtime (VotingPowers)
import Morley.Michelson.Typed (BigMapId)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.AnnotatedValue (SomeAnnotatedValue)
import Morley.Michelson.Typed.Entrypoints
import Morley.Michelson.Typed.Scope (ConstantScope)
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core (ChainId, Mutez, Timestamp)
import Morley.Tezos.Crypto
import Morley.Tezos.Crypto qualified as Crypto
import Morley.Util.Batching
import Morley.Util.Lens (postfixLFields)
import Morley.Util.Sing (eqI)
import Morley.Util.TypeLits
import Test.Cleveland.Internal.Exceptions
import Test.Cleveland.Lorentz.Types

-- | Whether this contract should be originated in
-- a single origination operation or, if it goes over
-- the origination size limit, in multiple operations.
data LargeOrigination = IsLarge | NotLarge

data OriginationType where
  OTTypedLorentz :: Type -> Type -> Type -> OriginationType
  OTTypedMorley :: Type -> Type -> Type -> OriginationType
  OTUntyped :: OriginationType

-- | Data common for all origination types.
type OriginateData :: OriginationType -> LargeOrigination -> Type
data OriginateData oty large = OriginateData
  { forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> ContractAlias
odName :: ContractAlias
  -- ^ Alias for the originated contract.
  , forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Mutez
odBalance :: Mutez
  -- ^ Initial balance.
  , forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Maybe KeyHash
odDelegate :: Maybe KeyHash
  -- ^ Contract delegate.
  , forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> ODContractAndStorage oty
odContractAndStorage :: ODContractAndStorage oty
  }

type ODContractAndStorage :: OriginationType -> Type
data ODContractAndStorage oty where
  -- | Lorentz contract and storage.
  ODContractAndStorageLorentz ::
    { forall st vd cp.
ODContractAndStorage ('OTTypedLorentz vd st cp) -> st
odStorage :: st
    -- ^ Initial storage.
    , forall st vd cp.
ODContractAndStorage ('OTTypedLorentz vd st cp)
-> Contract vd st cp
odContract :: Contract param st vd
    -- ^ The contract itself.
    --
    -- We are using Lorentz version here which is convenient. However, keep in
    -- mind that if someone wants to test a contract from @.tz@ file, they should use
    -- 'OTUntyped' origination type.
    } -> ODContractAndStorage ('OTTypedLorentz param st vd)

  -- | Untyped contract and storage.
  ODContractAndStorageUntyped ::
    { ODContractAndStorage 'OTUntyped -> Value
uodStorage :: U.Value
    -- ^ Initial storage.
    , ODContractAndStorage 'OTUntyped -> Contract
uodContract :: U.Contract
    -- ^ The contract itself.
    } -> ODContractAndStorage 'OTUntyped

  -- | Typed Morley contract and storage.
  ODContractAndStorageTyped :: (NiceStorage st, NiceViewsDescriptor vd, NiceParameter cp) =>
    { forall st vd cp.
ODContractAndStorage ('OTTypedMorley cp st vd) -> st
todStorage :: st
    -- ^ Initial storage.
    , forall st vd cp.
ODContractAndStorage ('OTTypedMorley cp st vd)
-> Contract (ToT cp) (ToT st)
todContract :: T.Contract (T.ToT cp) (T.ToT st)
    -- ^ The contract itself.
    } -> ODContractAndStorage ('OTTypedMorley cp st vd)

-- | Information about transfer operation.
data TransferData =
  forall v addr. (NiceParameter v, ToL1Address addr) => TransferData
  { ()
tdTo :: addr
  -- ^ Receiver address for this transaction.
  , TransferData -> Mutez
tdAmount :: Mutez
  -- ^ Amount to be transferred.
  , TransferData -> EpName
tdEntrypoint :: EpName
  -- ^ An entrypoint to be called. Consider using 'ep' in testing
  -- scenarios.
  , ()
tdParameter :: v
  -- ^ Parameter that will be used for a contract call. Set to @()@
  -- for transfers to key addresses.
  }

-- | Information about transfer operation.
data TransferTicketData =
  forall t addr. (T.WellTyped t, ToL1Address addr) => TransferTicketData
  { ()
ttdTo :: addr
  -- ^ Receiver address for this transaction.
  , TransferTicketData -> EpName
ttdEntrypoint :: EpName
  -- ^ An entrypoint to be called.
  , ()
ttdParameter :: T.Value ('T.TTicket t)
  -- ^ Ticket and amount to transfer.
  }

-- | A wrapper around t'T.Contract' to reduce awkwardness
type TypedContract :: Type -> Type -> Type -> Type
newtype TypedContract cp st vd = TypedContract (T.Contract (T.ToT cp) (T.ToT st))

-- | 'OriginateData' existential over 'OriginationType'.
data SomeOriginateData large where
  SomeOriginateData :: OriginateData oty large -> SomeOriginateData large

-- | Designates an operation input.
data ClevelandInput
instance OperationInfoDescriptor ClevelandInput where
  type TransferInfo ClevelandInput = TransferData
  type TransferTicketInfo ClevelandInput = TransferTicketData
  type OriginationInfo ClevelandInput = SomeOriginateData 'NotLarge
  type RevealInfo ClevelandInput = PublicKey
  type DelegationInfo ClevelandInput = Maybe KeyHash

-- | Data structure representing a contract event.
data ContractEvent = ContractEvent
  { ContractEvent -> ContractAddress
ceSource :: ContractAddress
  , ContractEvent -> Text
ceTag :: Text
  , ContractEvent -> Maybe SomeAnnotatedValue
cePayload :: Maybe SomeAnnotatedValue
  }

-- | Designates an operation result.
data ClevelandResult
instance OperationInfoDescriptor ClevelandResult where
  type TransferInfo ClevelandResult = [ContractEvent]
  type TransferTicketInfo ClevelandResult = [ContractEvent]
  type OriginationInfo ClevelandResult = OriginationInfo Result
  type RevealInfo ClevelandResult = RevealInfo Result
  type DelegationInfo ClevelandResult = DelegationInfo Result

-- | A batch returned invalid output, e.g. origination address when transaction
-- was supplied.
data BatchResultMismatch
  = BatchResultMismatch Text  -- ^ Carries expected operation type in lowercase

instance Buildable BatchResultMismatch where
  build :: BatchResultMismatch -> Builder
build = \case
    BatchResultMismatch Text
expected ->
      Builder
"For " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
expected Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" operation received inappropriate result"

-- | Designates the special sender address.
--
-- Transfers and some other operations will occur on behalf of this address.
-- This is initialized to @moneybag@ address and then can be locally modified.
--
-- Operations in `ClevelandOpsImpl` are affected by this address.
newtype Sender = Sender { Sender -> ImplicitAddressWithAlias
unSender :: ImplicitAddressWithAlias }

-- | Designates the address that gifts money to new addresses.
--
-- Once a new address is allocated in a test scenario, we have to transfer some
-- money to it so that it is able to serve as transactions sender. 'Moneybag'
-- serves as a source of that money.
--
-- We do not use 'Sender' for this purpose because in most situations changing
-- moneybag is not necessary. If a user wraps a large piece of their script with
-- 'Test.Cleveland.withSender' call and that changes the moneybag - this behaviour may be
-- undesired and unexpected to the user.
newtype Moneybag = Moneybag { Moneybag -> ImplicitAddressWithAlias
unMoneybag :: ImplicitAddressWithAlias }

-- | An alias with default value that can be used to define unique alias
-- automatically.
data SpecificOrDefaultAlias
  = SpecificAlias ImplicitAlias
  | DefaultAlias
  deriving stock (Int -> SpecificOrDefaultAlias -> ShowS
[SpecificOrDefaultAlias] -> ShowS
SpecificOrDefaultAlias -> String
(Int -> SpecificOrDefaultAlias -> ShowS)
-> (SpecificOrDefaultAlias -> String)
-> ([SpecificOrDefaultAlias] -> ShowS)
-> Show SpecificOrDefaultAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecificOrDefaultAlias] -> ShowS
$cshowList :: [SpecificOrDefaultAlias] -> ShowS
show :: SpecificOrDefaultAlias -> String
$cshow :: SpecificOrDefaultAlias -> String
showsPrec :: Int -> SpecificOrDefaultAlias -> ShowS
$cshowsPrec :: Int -> SpecificOrDefaultAlias -> ShowS
Show)

instance IsString SpecificOrDefaultAlias where
  fromString :: String -> SpecificOrDefaultAlias
fromString = ImplicitAlias -> SpecificOrDefaultAlias
SpecificAlias (ImplicitAlias -> SpecificOrDefaultAlias)
-> (String -> ImplicitAlias) -> String -> SpecificOrDefaultAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ImplicitAlias
ImplicitAlias (Text -> ImplicitAlias)
-> (String -> Text) -> String -> ImplicitAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

instance Default SpecificOrDefaultAlias where
  def :: SpecificOrDefaultAlias
def = SpecificOrDefaultAlias
DefaultAlias

mkDefaultAlias :: Natural -> ImplicitAlias
mkDefaultAlias :: Natural -> ImplicitAlias
mkDefaultAlias Natural
counter =
  Text -> ImplicitAlias
ImplicitAlias (Text -> ImplicitAlias)
-> (String -> Text) -> String -> ImplicitAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString (String -> ImplicitAlias) -> String -> ImplicitAlias
forall a b. (a -> b) -> a -> b
$ (String
"default_cleveland_alias" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Natural
counter)

-- | Helper to use automatically determined unique alias.
auto :: SpecificOrDefaultAlias
auto :: SpecificOrDefaultAlias
auto = SpecificOrDefaultAlias
forall a. Default a => a
def

-- | Counter which is used to provide different default aliases.
newtype DefaultAliasCounter = DefaultAliasCounter {DefaultAliasCounter -> Natural
unDefaultAliasCounter :: Natural}
  deriving stock (DefaultAliasCounter -> DefaultAliasCounter -> Bool
(DefaultAliasCounter -> DefaultAliasCounter -> Bool)
-> (DefaultAliasCounter -> DefaultAliasCounter -> Bool)
-> Eq DefaultAliasCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultAliasCounter -> DefaultAliasCounter -> Bool
$c/= :: DefaultAliasCounter -> DefaultAliasCounter -> Bool
== :: DefaultAliasCounter -> DefaultAliasCounter -> Bool
$c== :: DefaultAliasCounter -> DefaultAliasCounter -> Bool
Eq, Int -> DefaultAliasCounter -> ShowS
[DefaultAliasCounter] -> ShowS
DefaultAliasCounter -> String
(Int -> DefaultAliasCounter -> ShowS)
-> (DefaultAliasCounter -> String)
-> ([DefaultAliasCounter] -> ShowS)
-> Show DefaultAliasCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultAliasCounter] -> ShowS
$cshowList :: [DefaultAliasCounter] -> ShowS
show :: DefaultAliasCounter -> String
$cshow :: DefaultAliasCounter -> String
showsPrec :: Int -> DefaultAliasCounter -> ShowS
$cshowsPrec :: Int -> DefaultAliasCounter -> ShowS
Show)

-- | A record data type with operations creating primitives.
data ClevelandOpsImpl m = ClevelandOpsImpl
  { forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
   [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch
      :: HasCallStack => [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
  -- ^ Perform a batch of operations.
  }

-- | A record data type with all base methods one can use during a cleveland test.
data ClevelandMiscImpl m = ClevelandMiscImpl
  { forall (m :: * -> *).
ClevelandMiscImpl m -> forall res. HasCallStack => IO res -> m res
cmiRunIO :: forall res. HasCallStack => IO res -> m res
  -- ^ Runs an 'IO' action.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (kind :: AddressKind).
   HasCallStack =>
   AddressOrAlias kind -> m (AddressWithAlias kind)
cmiResolveAddress :: forall kind. HasCallStack => AddressOrAlias kind -> m (AddressWithAlias kind)
  -- ^ Get the address of the implicit account / contract associated with the given alias.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey :: HasCallStack => SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
  -- ^ Generate a secret key and store it with given alias.
  -- If a key with this alias already exists, the corresponding address
  -- will be returned and no state will be changed.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey :: HasCallStack => SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
  -- ^ Import a given secret key.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenFreshKey :: HasCallStack => SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
  -- ^ Generate a secret key and store it with given alias.
  -- Unlike 'cmiGenKey' this function overwrites the existing key when
  -- given alias is already stored.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   ByteString -> ImplicitAddressWithAlias -> m Signature
cmiSignBytes :: HasCallStack => ByteString -> ImplicitAddressWithAlias -> m Crypto.Signature
  -- ^ Get the signature of the preapplied operation.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (oty :: OriginationType).
   HasCallStack =>
   Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiOriginateLargeUntyped
      :: forall oty. HasCallStack
      => Sender
      -> OriginateData oty 'IsLarge
      -> m ContractAddress
  -- ^ Originate a new raw Michelson contract that doesn't fit into the
  -- origination size limit, by executing multiple operation steps.
  --
  -- Note that this is not part of 'ClevelandOpsImpl' because large origination is
  -- _not_ a primitive operation. Also, it cannot appear in a batch (it simply
  -- may not fit).
  , forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Text -> m ()
cmiComment :: HasCallStack => Text -> m ()
  -- ^ Print the given string verbatim as a comment.
  -- At the moment, this is a no-op in emulator tests.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => L1Address -> m Mutez
cmiGetBalance :: HasCallStack => L1Address -> m Mutez
  -- ^ Get the balance of the given address.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetSomeStorage :: HasCallStack => ContractAddress -> m SomeAnnotatedValue
  -- Retrieves the contract's storage.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
   (HasCallStack, NiceComparable k, NicePackedValue k,
    NiceUnpackedValue v) =>
   BigMapId k v -> k -> m (Maybe v)
cmiGetBigMapValueMaybe
      :: forall k v. (HasCallStack, NiceComparable k, NicePackedValue k, NiceUnpackedValue v)
      => BigMapId k v -> k -> m (Maybe v)
  -- ^ Retrieve a big_map value, given a big_map ID and a key.
  -- Returns 'Nothing' when the big_map ID does not exist, or it exists but
  -- does not contain the given key.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
   (HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
   BigMapId k v -> m (Maybe [v])
cmiGetAllBigMapValuesMaybe
      :: forall k v. (HasCallStack, NiceComparable k, NiceUnpackedValue v)
      => BigMapId k v -> m (Maybe [v])
  -- ^ Retrieve all big_map values, given a big_map ID.
  -- Returns 'Nothing' when the big_map ID does not exist.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetPublicKey :: HasCallStack => ImplicitAddressWithAlias -> m Crypto.PublicKey
  -- ^ Get the public key associated with the given address.
  -- Fail if the given address is not an implicit account.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetDelegate :: HasCallStack => L1Address -> m (Maybe Crypto.KeyHash)
  -- ^ Get the delegate for the given contract. Fails on implicit contracts.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m ChainId
cmiGetChainId :: HasCallStack => m ChainId
  -- ^ Get the chain's @ChainId@.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (unit :: Rat).
   (HasCallStack, KnownDivRat unit Second) =>
   Time unit -> m ()
cmiAdvanceTime :: forall unit. (HasCallStack, KnownDivRat unit Second) => Time unit -> m ()
  -- ^ Advance at least the given amount of time, or until a new block is baked,
  -- whichever happens last.
  --
  -- On a real network, this is implemented using @threadDelay@, so it's advisable
  -- to use small amounts of time only.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> m ()
  -- ^ Advance at least to the level returned by the callback, accepting current level.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Timestamp
cmiGetNow :: HasCallStack => m Timestamp
  -- ^ Get the timestamp observed by the last block to be baked.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Natural
cmiGetLevel :: HasCallStack => m Natural
  -- ^ Get the current level observed by the last block to be baked.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> forall a. HasCallStack => Builder -> m a
cmiFailure :: forall a. HasCallStack => Builder -> m a
  -- ^ Fails the test with the given error message.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a. HasCallStack => SomeException -> m a
cmiThrow :: forall a. HasCallStack => SomeException -> m a
  -- ^ Rethrow arbitrary error without affecting the call stack. Used
  -- internally. You probably want to use 'cmiFailure'
  , forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m (Time Second)
cmiGetApproximateBlockInterval :: HasCallStack => m (Time Second)
  -- ^ Get approximate block interval in seconds. Note, that this value
  -- is minimal bound and real intervals can be larger.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiAttempt :: forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
  -- ^ Attempts to perform an action, returning either the result of the action or an exception.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> ImplicitAddress -> m ()
cmiMarkAddressRefillable :: ImplicitAddress -> m ()
  -- ^ Marks a given address as "refillable", i.e. if the address lacks funds for the next operation,
  -- some funds will automatically be transferred to it.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> m (Either (EmulatedImpl m) NetworkEnv)
cmiUnderlyingImpl :: m (Either (EmulatedImpl m) NetworkEnv)
  -- ^ Produce underlying implementation specific data. Used to run
  -- emulation-only or network-only actions in a polymorphic context.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall cp st vd.
   (HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
   Sender -> RunCode cp st vd -> m (AsRPC st)
cmiRunCode
      :: forall cp st vd. (HasCallStack, HasRPCRepr st, T.IsoValue (AsRPC st))
      => Sender -> RunCode cp st vd -> m (AsRPC st)
  -- ^ Execute a contract's code without originating it.
  -- The chain's state will not be modified.
  , forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (t :: T).
   (HasNoOp t, Comparable t) =>
   L1Address -> ContractAddress -> Value t -> m Natural
cmiTicketBalance
    :: forall t. (T.HasNoOp t, T.Comparable t)
    => L1Address -> ContractAddress -> T.Value t -> m Natural
  -- ^ Get balance for a praticular ticket.
  , forall (m :: * -> *).
ClevelandMiscImpl m -> ContractAddress -> m [SomeTicket]
cmiAllTicketBalances :: ContractAddress -> m [SomeTicket]
  -- ^ Get balance for all tickets by scanning the contract's storage.
  }

data SomeTicket where
  SomeTicket :: T.SingI t => T.Ticket (T.Value t) -> SomeTicket

instance Buildable SomeTicket where
  build :: SomeTicket -> Builder
build (SomeTicket T.Ticket{Natural
Address
Value t
tTicketer :: forall arg. Ticket arg -> Address
tData :: forall arg. Ticket arg -> arg
tAmount :: forall arg. Ticket arg -> Natural
tAmount :: Natural
tData :: Value t
tTicketer :: Address
..}) =
     Builder
"Ticket with ticketer " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
tTicketer
    Address -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", value " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value t
tData
    Value t -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", amount " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Natural
tAmount
    Natural -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

instance Eq SomeTicket where
  (SomeTicket (Ticket (Value t)
val1 :: T.Ticket (T.Value t1))) == :: SomeTicket -> SomeTicket -> Bool
== (SomeTicket (Ticket (Value t)
val2 :: T.Ticket (T.Value t2)))
    | Just t :~: t
Refl <- forall {k} (a :: k) (b :: k).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
forall (a :: T) (b :: T).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
eqI @t1 @t2 = Ticket (Value t)
val1 Ticket (Value t) -> Ticket (Value t) -> Bool
forall a. Eq a => a -> a -> Bool
== Ticket (Value t)
Ticket (Value t)
val2
    | Bool
otherwise = Bool
False

-- | The data needed to call the @/run_code@ RPC endpoint.
data RunCode cp st vd = RunCode
  { forall cp st vd. RunCode cp st vd -> Contract cp st vd
rcContract :: Contract cp st vd
  , forall cp st vd. RunCode cp st vd -> Value
rcParameter :: U.Value
  -- ^ The parameter value should have the same "structure" as @cp@, except it _may_ also have big_map IDs.
  -- E.g. if the contract's parameter is @pair (big_map string string) (big_map string string)@,
  -- then 'rcParameter' may be one of:
  --
  -- * @pair (big_map string string) (big_map string string)@
  -- * @pair nat (big_map string string)@
  -- * @pair (big_map string string) nat@
  -- * @pair nat nat@
  --
  -- ... where @nat@ represents a big_map ID.
  , forall cp st vd. RunCode cp st vd -> Value
rcStorage :: U.Value
  -- ^ The storage value should have the same "structure" as @st@, except it _may_ also have big_map IDs.
  -- See the documentation of 'rcParameter'.
  , forall cp st vd. RunCode cp st vd -> Mutez
rcAmount :: Mutez
  -- ^ The value that will be returned by the @AMOUNT@ instruction.
  , forall cp st vd. RunCode cp st vd -> Maybe Natural
rcLevel :: Maybe Natural
  -- ^ The value that will be returned by the @LEVEL@ instruction.
  , forall cp st vd. RunCode cp st vd -> Maybe Timestamp
rcNow :: Maybe Timestamp
  -- ^ The value that will be returned by the @NOW@ instruction.
  , forall cp st vd. RunCode cp st vd -> Mutez
rcBalance :: Mutez
  -- ^ The balance that will be returned by the @BALANCE@ instruction.
  , forall cp st vd. RunCode cp st vd -> Maybe ImplicitAddress
rcSource :: Maybe ImplicitAddress
  -- ^ The value that will be returned by the @SOURCE@ instruction.
  }

-- | A record data type with all base methods one can use during cleveland, but which are available
-- only when running on an emulated environment (e.g. "Morley.Michelson.Runtime") and not on a real network.
data EmulatedImpl m = EmulatedImpl
  { forall (m :: * -> *). EmulatedImpl m -> [(Text, m ())] -> m ()
eiBranchout :: [(Text, m ())] -> m ()
  -- ^ Execute multiple testing scenarios independently.
  --
  -- * Actions performed before 'eiBranchout' will be observed by all branches.
  -- * Actions performed in branches will _not_ be observed by any actions performed after 'eiBranchout'.
  -- * Actions performed in one branch will _not_ be observed by another branch.
  -- * The test succeeds IFF all branches succeed.
  -- * If any branch fails, the test ends immediately and the remaining branches
  --    won't be executed.
  --
  -- The following property holds:
  --
  -- > pre >> branchout [a, b, c] = branchout [pre >> a, pre >> b, pre >> c]
  --
  -- The list of branches must be non-empty.
  , forall (m :: * -> *).
EmulatedImpl m
-> forall st addr.
   (HasCallStack, ToStorageType st addr) =>
   addr -> m st
eiGetStorage
      :: forall st addr. (HasCallStack, ToStorageType st addr)
      => addr -> m st
  -- ^ Retrieve a contract's full storage, including the contents of its big_maps.
  -- This function can only be used in emulator-only tests.
  , forall (m :: * -> *).
EmulatedImpl m -> forall a. m a -> m (LogsInfo, a)
eiGetMorleyLogs :: forall a. m a -> m (LogsInfo, a)
  -- ^ Returns the result of the action with the logs it produced
  , forall (m :: * -> *). EmulatedImpl m -> VotingPowers -> m ()
eiSetVotingPowers :: VotingPowers -> m ()
  -- ^ Change voting power distribution.
  }

data NetworkEnv = NetworkEnv
  { NetworkEnv -> MorleyClientEnv
neMorleyClientEnv :: MorleyClientEnv
  , NetworkEnv -> Maybe SecretKey
neSecretKey :: Maybe Crypto.SecretKey
  , NetworkEnv -> ImplicitAlias
neMoneybagAlias :: ImplicitAlias
  , NetworkEnv -> Bool
neExplicitDataDir :: Bool
  , NetworkEnv -> Word
neVerbosity :: Word
  }

----------------------------------------------------------------------------
-- Log helpers
----------------------------------------------------------------------------

data ScenarioLogs = ScenarioLogs
  { ScenarioLogs -> Address
_slAddr :: Address
  , ScenarioLogs -> MorleyLogs
_slLog :: MorleyLogs
  } deriving stock (ScenarioLogs -> ScenarioLogs -> Bool
(ScenarioLogs -> ScenarioLogs -> Bool)
-> (ScenarioLogs -> ScenarioLogs -> Bool) -> Eq ScenarioLogs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScenarioLogs -> ScenarioLogs -> Bool
$c/= :: ScenarioLogs -> ScenarioLogs -> Bool
== :: ScenarioLogs -> ScenarioLogs -> Bool
$c== :: ScenarioLogs -> ScenarioLogs -> Bool
Eq, Int -> ScenarioLogs -> ShowS
LogsInfo -> ShowS
ScenarioLogs -> String
(Int -> ScenarioLogs -> ShowS)
-> (ScenarioLogs -> String)
-> (LogsInfo -> ShowS)
-> Show ScenarioLogs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: LogsInfo -> ShowS
$cshowList :: LogsInfo -> ShowS
show :: ScenarioLogs -> String
$cshow :: ScenarioLogs -> String
showsPrec :: Int -> ScenarioLogs -> ShowS
$cshowsPrec :: Int -> ScenarioLogs -> ShowS
Show)

type LogsInfo = [ScenarioLogs]

makeLenses ''ScenarioLogs
makeLensesWith postfixLFields ''NetworkEnv

-- | An alias for 'slLog' with a clearer name
logsL :: Lens' ScenarioLogs MorleyLogs
logsL :: Lens' ScenarioLogs MorleyLogs
logsL = (MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs
Lens' ScenarioLogs MorleyLogs
slLog

-- | Lens combinator specified for filtering logs by address from 'LogsInfo'
filterLogsByAddrL
  :: (ToAddress addr, Applicative f)
  => addr
  -> (MorleyLogs -> f MorleyLogs)
  -> ScenarioLogs
  -> f ScenarioLogs
filterLogsByAddrL :: forall addr (f :: * -> *).
(ToAddress addr, Applicative f) =>
addr
-> (MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs
filterLogsByAddrL (addr -> Address
forall a. ToAddress a => a -> Address
toAddress -> Address
addr) = (ScenarioLogs -> Bool) -> Optic' (->) f ScenarioLogs ScenarioLogs
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\(ScenarioLogs Address
a MorleyLogs
_) -> Address
a Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr) Optic' (->) f ScenarioLogs ScenarioLogs
-> ((MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs)
-> (MorleyLogs -> f MorleyLogs)
-> ScenarioLogs
-> f ScenarioLogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs
Lens' ScenarioLogs MorleyLogs
logsL

-- | Get logs for a given address from 'LogsInfo'
logsForAddress
  :: ( Each s s ScenarioLogs ScenarioLogs
     , ToAddress addr
     )
  => addr
  -> s
  -> [MorleyLogs]
logsForAddress :: forall s addr.
(Each s s ScenarioLogs ScenarioLogs, ToAddress addr) =>
addr -> s -> [MorleyLogs]
logsForAddress addr
addr = (s -> Getting (Endo [MorleyLogs]) s MorleyLogs -> [MorleyLogs]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (ScenarioLogs -> Const (Endo [MorleyLogs]) ScenarioLogs)
-> s -> Const (Endo [MorleyLogs]) s
forall s t a b. Each s t a b => Traversal s t a b
each ((ScenarioLogs -> Const (Endo [MorleyLogs]) ScenarioLogs)
 -> s -> Const (Endo [MorleyLogs]) s)
-> ((MorleyLogs -> Const (Endo [MorleyLogs]) MorleyLogs)
    -> ScenarioLogs -> Const (Endo [MorleyLogs]) ScenarioLogs)
-> Getting (Endo [MorleyLogs]) s MorleyLogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. addr
-> (MorleyLogs -> Const (Endo [MorleyLogs]) MorleyLogs)
-> ScenarioLogs
-> Const (Endo [MorleyLogs]) ScenarioLogs
forall addr (f :: * -> *).
(ToAddress addr, Applicative f) =>
addr
-> (MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs
filterLogsByAddrL addr
addr)

-- | Collect logs produced by all contracts into the single list
collectLogs :: LogsInfo -> MorleyLogs
collectLogs :: LogsInfo -> MorleyLogs
collectLogs = (Element LogsInfo -> MorleyLogs) -> LogsInfo -> MorleyLogs
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element LogsInfo -> MorleyLogs
ScenarioLogs -> MorleyLogs
_slLog

----------------------------------------------------------------------------
-- Batched operations
----------------------------------------------------------------------------

-- | Where the batched operations occur.
--
-- Note that this is not a 'Monad', rather an 'Applicative' - use
-- @-XApplicativeDo@ extension for nicer experience.
newtype ClevelandOpsBatch a = ClevelandOpsBatch
  { forall a.
ClevelandOpsBatch a
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     Void
     a
unClevelandOpsBatch
      :: BatchingM (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) Void a
  } deriving newtype ((forall a b.
 (a -> b) -> ClevelandOpsBatch a -> ClevelandOpsBatch b)
-> (forall a b. a -> ClevelandOpsBatch b -> ClevelandOpsBatch a)
-> Functor ClevelandOpsBatch
forall a b. a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
forall a b. (a -> b) -> ClevelandOpsBatch a -> ClevelandOpsBatch 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 -> ClevelandOpsBatch b -> ClevelandOpsBatch a
$c<$ :: forall a b. a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
fmap :: forall a b. (a -> b) -> ClevelandOpsBatch a -> ClevelandOpsBatch b
$cfmap :: forall a b. (a -> b) -> ClevelandOpsBatch a -> ClevelandOpsBatch b
Functor, Functor ClevelandOpsBatch
Functor ClevelandOpsBatch
-> (forall a. a -> ClevelandOpsBatch a)
-> (forall a b.
    ClevelandOpsBatch (a -> b)
    -> ClevelandOpsBatch a -> ClevelandOpsBatch b)
-> (forall a b c.
    (a -> b -> c)
    -> ClevelandOpsBatch a
    -> ClevelandOpsBatch b
    -> ClevelandOpsBatch c)
-> (forall a b.
    ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch b)
-> (forall a b.
    ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch a)
-> Applicative ClevelandOpsBatch
forall a. a -> ClevelandOpsBatch a
forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch b
forall a b.
ClevelandOpsBatch (a -> b)
-> ClevelandOpsBatch a -> ClevelandOpsBatch b
forall a b c.
(a -> b -> c)
-> ClevelandOpsBatch a
-> ClevelandOpsBatch b
-> ClevelandOpsBatch 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.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
$c<* :: forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
*> :: forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch b
$c*> :: forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch b
liftA2 :: forall a b c.
(a -> b -> c)
-> ClevelandOpsBatch a
-> ClevelandOpsBatch b
-> ClevelandOpsBatch c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ClevelandOpsBatch a
-> ClevelandOpsBatch b
-> ClevelandOpsBatch c
<*> :: forall a b.
ClevelandOpsBatch (a -> b)
-> ClevelandOpsBatch a -> ClevelandOpsBatch b
$c<*> :: forall a b.
ClevelandOpsBatch (a -> b)
-> ClevelandOpsBatch a -> ClevelandOpsBatch b
pure :: forall a. a -> ClevelandOpsBatch a
$cpure :: forall a. a -> ClevelandOpsBatch a
Applicative)

instance
  ( Bottom
  , TypeError
        ( 'Text "Attempt to use monad capabilities within a batch" ':$$:
          'Text "In case you are using a do-block, make sure that" ':$$:
          'Text "• `ApplicativeDo` extension is enabled" ':$$:
          'Text "• there is a return statement in the end" ':$$:
          'Text "• returned value picks variables in the order in which they are defined"
        )
  ) => Monad ClevelandOpsBatch where
    >>= :: forall a b.
ClevelandOpsBatch a
-> (a -> ClevelandOpsBatch b) -> ClevelandOpsBatch b
(>>=) = forall a. Bottom => a
ClevelandOpsBatch a
-> (a -> ClevelandOpsBatch b) -> ClevelandOpsBatch b
no

{- | Run a series of operations within a batch.

Example:

@
contract <- runBatched impl $ do
  -- this block is executed within 'ClevelandOpsBatch'
  contract <- runSingleOperation batchedOpsImpl "origination" ...
  for_ [1..3] \i ->
    runSingleOperation batchedOpsImpl "transfer" ...
  return contract
@

See 'ClevelandOpsBatch' for some precautions.
-}
runBatched
  :: (HasCallStack, Functor m)
  => ClevelandOpsImpl m
  -> ClevelandOpsBatch a
  -> m a
runBatched :: forall (m :: * -> *) a.
(HasCallStack, Functor m) =>
ClevelandOpsImpl m -> ClevelandOpsBatch a -> m a
runBatched ClevelandOpsImpl m
impl =
  Proxy Void
-> ClevelandOpsImpl m
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     Void
     a
-> m a
forall e (m :: * -> *) a.
(HasCallStack, Buildable e, Functor m) =>
Proxy e
-> ClevelandOpsImpl m
-> BatchingM
     (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
runOperationBatchM (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Void) ClevelandOpsImpl m
impl (BatchingM
   (OperationInfo ClevelandInput)
   (OperationInfo ClevelandResult)
   Void
   a
 -> m a)
-> (ClevelandOpsBatch a
    -> BatchingM
         (OperationInfo ClevelandInput)
         (OperationInfo ClevelandResult)
         Void
         a)
-> ClevelandOpsBatch a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClevelandOpsBatch a
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     Void
     a
forall a.
ClevelandOpsBatch a
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     Void
     a
unClevelandOpsBatch

-- | 'ClevelandOpsImpl' suitable for methods executed within a batch.
batchedOpsImpl :: ClevelandOpsImpl ClevelandOpsBatch
batchedOpsImpl :: ClevelandOpsImpl ClevelandOpsBatch
batchedOpsImpl = ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
 [OperationInfo ClevelandInput]
 -> m [OperationInfo ClevelandResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
  { coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput]
-> ClevelandOpsBatch [OperationInfo ClevelandResult]
coiRunOperationBatch = BatchingM
  (OperationInfo ClevelandInput)
  (OperationInfo ClevelandResult)
  Void
  [OperationInfo ClevelandResult]
-> ClevelandOpsBatch [OperationInfo ClevelandResult]
forall a.
BatchingM
  (OperationInfo ClevelandInput)
  (OperationInfo ClevelandResult)
  Void
  a
-> ClevelandOpsBatch a
ClevelandOpsBatch (BatchingM
   (OperationInfo ClevelandInput)
   (OperationInfo ClevelandResult)
   Void
   [OperationInfo ClevelandResult]
 -> ClevelandOpsBatch [OperationInfo ClevelandResult])
-> ([OperationInfo ClevelandInput]
    -> BatchingM
         (OperationInfo ClevelandInput)
         (OperationInfo ClevelandResult)
         Void
         [OperationInfo ClevelandResult])
-> [OperationInfo ClevelandInput]
-> ClevelandOpsBatch [OperationInfo ClevelandResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OperationInfo ClevelandInput
 -> BatchingM
      (OperationInfo ClevelandInput)
      (OperationInfo ClevelandResult)
      Void
      (OperationInfo ClevelandResult))
-> [OperationInfo ClevelandInput]
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     Void
     [OperationInfo ClevelandResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OperationInfo ClevelandInput
-> (OperationInfo ClevelandResult
    -> Either Void (OperationInfo ClevelandResult))
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     Void
     (OperationInfo ClevelandResult)
forall i o e a. i -> (o -> Either e a) -> BatchingM i o e a
`submitThenParse` OperationInfo ClevelandResult
-> Either Void (OperationInfo ClevelandResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  }

-- | Version of 'coiRunOperationBatch' that uses 'BatchingM'.
--
-- This is an internal function.
--
-- Invariant: all errors described by @e@ must be internal and should not occur
-- in practice (we require @e@ type to be specified explicitly to hinder
-- incorrect usage).
runOperationBatchM
  :: (HasCallStack, Buildable e, Functor m)
  => Proxy e
  -> ClevelandOpsImpl m
  -> BatchingM (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
  -> m a
runOperationBatchM :: forall e (m :: * -> *) a.
(HasCallStack, Buildable e, Functor m) =>
Proxy e
-> ClevelandOpsImpl m
-> BatchingM
     (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
runOperationBatchM Proxy e
_ ClevelandOpsImpl m
impl =
  (((), a) -> a) -> m ((), a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), a) -> a
forall a b. (a, b) -> b
snd (m ((), a) -> m a)
-> (BatchingM
      (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
    -> m ((), a))
-> BatchingM
     (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([OperationInfo ClevelandInput]
 -> m ((), [OperationInfo ClevelandResult]))
-> BatchingM
     (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m ((), a)
forall (m :: * -> *) e i r o a.
(Functor m, Buildable e) =>
([i] -> m (r, [o])) -> BatchingM i o e a -> m (r, a)
unsafeRunBatching (([OperationInfo ClevelandResult]
 -> ((), [OperationInfo ClevelandResult]))
-> m [OperationInfo ClevelandResult]
-> m ((), [OperationInfo ClevelandResult])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), ) (m [OperationInfo ClevelandResult]
 -> m ((), [OperationInfo ClevelandResult]))
-> ([OperationInfo ClevelandInput]
    -> m [OperationInfo ClevelandResult])
-> [OperationInfo ClevelandInput]
-> m ((), [OperationInfo ClevelandResult])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClevelandOpsImpl m
-> HasCallStack =>
   [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
   [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch ClevelandOpsImpl m
impl)

-- | Helper that runs a single operation using 'ClevelandOpsImpl'.
runSingleOperation
  :: (HasCallStack, Functor m)
  => ClevelandOpsImpl m
  -> Text
  -> OperationInfo ClevelandInput
  -> (OperationInfo ClevelandResult -> Maybe a)
  -> m a
runSingleOperation :: forall (m :: * -> *) a.
(HasCallStack, Functor m) =>
ClevelandOpsImpl m
-> Text
-> OperationInfo ClevelandInput
-> (OperationInfo ClevelandResult -> Maybe a)
-> m a
runSingleOperation ClevelandOpsImpl m
impl Text
desc OperationInfo ClevelandInput
opData OperationInfo ClevelandResult -> Maybe a
parseRes =
  Proxy BatchResultMismatch
-> ClevelandOpsImpl m
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     BatchResultMismatch
     a
-> m a
forall e (m :: * -> *) a.
(HasCallStack, Buildable e, Functor m) =>
Proxy e
-> ClevelandOpsImpl m
-> BatchingM
     (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
runOperationBatchM (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BatchResultMismatch) ClevelandOpsImpl m
impl (BatchingM
   (OperationInfo ClevelandInput)
   (OperationInfo ClevelandResult)
   BatchResultMismatch
   a
 -> m a)
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     BatchResultMismatch
     a
-> m a
forall a b. (a -> b) -> a -> b
$
    OperationInfo ClevelandInput
opData OperationInfo ClevelandInput
-> (OperationInfo ClevelandResult -> Either BatchResultMismatch a)
-> BatchingM
     (OperationInfo ClevelandInput)
     (OperationInfo ClevelandResult)
     BatchResultMismatch
     a
forall i o e a. i -> (o -> Either e a) -> BatchingM i o e a
`submitThenParse` BatchResultMismatch -> Maybe a -> Either BatchResultMismatch a
forall l r. l -> Maybe r -> Either l r
maybeToRight (Text -> BatchResultMismatch
BatchResultMismatch Text
desc) (Maybe a -> Either BatchResultMismatch a)
-> (OperationInfo ClevelandResult -> Maybe a)
-> OperationInfo ClevelandResult
-> Either BatchResultMismatch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationInfo ClevelandResult -> Maybe a
parseRes

----------------------------------------------------------------------------
-- Validation
----------------------------------------------------------------------------

-- | Representation of Expression we got from the RPC or a typed value we
-- got from the emulator.
data ExpressionOrTypedValue where
  EOTVExpression :: Expression -> ExpressionOrTypedValue
  EOTVTypedValue :: (T.SingI t, ConstantScope t) => T.Value t -> ExpressionOrTypedValue

deriving stock instance Show ExpressionOrTypedValue
instance Eq ExpressionOrTypedValue where
  == :: ExpressionOrTypedValue -> ExpressionOrTypedValue -> Bool
(==) (EOTVExpression Expression
x) (EOTVExpression Expression
y) = Expression
x Expression -> Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Expression
y
  (==) (EOTVTypedValue (Value t
x :: T.Value t)) (EOTVTypedValue (Value t
y :: T.Value u))
    = case forall {k} (a :: k) (b :: k).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
forall (a :: T) (b :: T).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
eqI @t @u of
      Just t :~: t
Refl -> Value t
x Value t -> Value t -> Bool
forall a. Eq a => a -> a -> Bool
== Value t
Value t
y
      Maybe (t :~: t)
Nothing -> Bool
False
  (==) ExpressionOrTypedValue
_ ExpressionOrTypedValue
_ = Bool
False

instance Buildable ExpressionOrTypedValue where
  build :: ExpressionOrTypedValue -> Builder
build = \case
    EOTVExpression Expression
e -> (FromExpressionError -> Builder)
-> (Value -> Builder)
-> Either FromExpressionError Value
-> Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Builder -> FromExpressionError -> Builder
forall a b. a -> b -> a
const (Builder -> FromExpressionError -> Builder)
-> Builder -> FromExpressionError -> Builder
forall a b. (a -> b) -> a -> b
$ Expression -> Builder
forall p. Buildable p => p -> Builder
build Expression
e) Value -> Builder
forall p. Buildable p => p -> Builder
build (Either FromExpressionError Value -> Builder)
-> Either FromExpressionError Value -> Builder
forall a b. (a -> b) -> a -> b
$ forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @U.Value Expression
e
    EOTVTypedValue Value t
v -> Value t -> Builder
forall p. Buildable p => p -> Builder
build Value t
v

data AddressAndAlias = forall kind. AddressAndAlias (KindedAddress kind) (Maybe (Alias kind))

deriving stock instance Show AddressAndAlias

instance Eq AddressAndAlias where
  (AddressAndAlias (KindedAddress kind
addr1 :: KindedAddress kind1) Maybe (Alias kind)
_) == :: AddressAndAlias -> AddressAndAlias -> Bool
==
    (AddressAndAlias (KindedAddress kind
addr2 :: KindedAddress kind2) Maybe (Alias kind)
_) =
      Bool -> ((kind :~: kind) -> Bool) -> Maybe (kind :~: kind) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\kind :~: kind
Refl -> KindedAddress kind
addr1 KindedAddress kind -> KindedAddress kind -> Bool
forall a. Eq a => a -> a -> Bool
== KindedAddress kind
KindedAddress kind
addr2) (Maybe (kind :~: kind) -> Bool) -> Maybe (kind :~: kind) -> Bool
forall a b. (a -> b) -> a -> b
$
        forall {k} (a :: k) (b :: k).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
forall (a :: AddressKind) (b :: AddressKind).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
eqI @kind1 @kind2 (SingI kind => Maybe (kind :~: kind))
-> Dict (SingI kind) -> Maybe (kind :~: kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress kind -> Dict (SingI kind)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress kind
addr1 (SingI kind => Maybe (kind :~: kind))
-> Dict (SingI kind) -> Maybe (kind :~: kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress kind -> Dict (SingI kind)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress kind
addr2

instance ToAddress AddressAndAlias where
  toAddress :: AddressAndAlias -> Address
toAddress (AddressAndAlias KindedAddress kind
a Maybe (Alias kind)
_) = KindedAddress kind -> Address
forall a. ToAddress a => a -> Address
toAddress KindedAddress kind
a

instance Buildable AddressAndAlias where
  build :: AddressAndAlias -> Builder
build (AddressAndAlias KindedAddress kind
addr Maybe (Alias kind)
mbAlias) =
    KindedAddress kind -> Builder
forall p. Buildable p => p -> Builder
build KindedAddress kind
addr Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder -> (Alias kind -> Builder) -> Maybe (Alias kind) -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (\Alias kind
alias -> Builder
" (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias kind
alias Alias kind -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")") Maybe (Alias kind)
mbAlias

-- | Failures that could be expected in the execution of a transfer.
-- These can be caught and handled with 'Test.Cleveland.attempt'.
data TransferFailure = TransferFailure
  { TransferFailure -> AddressAndAlias
tfAddressAndAlias :: AddressAndAlias
  , TransferFailure -> TransferFailureReason
tfReason :: TransferFailureReason
  } deriving stock (Int -> TransferFailure -> ShowS
[TransferFailure] -> ShowS
TransferFailure -> String
(Int -> TransferFailure -> ShowS)
-> (TransferFailure -> String)
-> ([TransferFailure] -> ShowS)
-> Show TransferFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferFailure] -> ShowS
$cshowList :: [TransferFailure] -> ShowS
show :: TransferFailure -> String
$cshow :: TransferFailure -> String
showsPrec :: Int -> TransferFailure -> ShowS
$cshowsPrec :: Int -> TransferFailure -> ShowS
Show, TransferFailure -> TransferFailure -> Bool
(TransferFailure -> TransferFailure -> Bool)
-> (TransferFailure -> TransferFailure -> Bool)
-> Eq TransferFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransferFailure -> TransferFailure -> Bool
$c/= :: TransferFailure -> TransferFailure -> Bool
== :: TransferFailure -> TransferFailure -> Bool
$c== :: TransferFailure -> TransferFailure -> Bool
Eq)

data TransferFailureReason
  = FailedWith ExpressionOrTypedValue (Maybe ErrorSrcPos)
  -- ^ Expect that interpretation of contract with the given address ended
  -- with @FAILWITH@.
  | EmptyTransaction
  -- ^ Expect failure due to an attempt to transfer 0tz towards a simple address.
  | BadParameter
  -- ^ Expect failure due to an attempt to call a contract with an invalid parameter.
  | MutezArithError T.MutezArithErrorType
  -- ^ Expect failure due to an arithmetic over-/underflow
  | ShiftOverflow
  -- ^ Expect that interpretation of contract with the given address ended
  -- with an overflow error.
  | GasExhaustion
  -- TODO [#284]: add more errors here!
  deriving stock (Int -> TransferFailureReason -> ShowS
[TransferFailureReason] -> ShowS
TransferFailureReason -> String
(Int -> TransferFailureReason -> ShowS)
-> (TransferFailureReason -> String)
-> ([TransferFailureReason] -> ShowS)
-> Show TransferFailureReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferFailureReason] -> ShowS
$cshowList :: [TransferFailureReason] -> ShowS
show :: TransferFailureReason -> String
$cshow :: TransferFailureReason -> String
showsPrec :: Int -> TransferFailureReason -> ShowS
$cshowsPrec :: Int -> TransferFailureReason -> ShowS
Show, TransferFailureReason -> TransferFailureReason -> Bool
(TransferFailureReason -> TransferFailureReason -> Bool)
-> (TransferFailureReason -> TransferFailureReason -> Bool)
-> Eq TransferFailureReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransferFailureReason -> TransferFailureReason -> Bool
$c/= :: TransferFailureReason -> TransferFailureReason -> Bool
== :: TransferFailureReason -> TransferFailureReason -> Bool
$c== :: TransferFailureReason -> TransferFailureReason -> Bool
Eq)

instance Buildable TransferFailure where
  build :: TransferFailure -> Builder
build (TransferFailure AddressAndAlias
addr TransferFailureReason
reason) = case TransferFailureReason
reason of
    TransferFailureReason
EmptyTransaction -> TransferFailureReason
reason TransferFailureReason -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
": " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressAndAlias
addr AddressAndAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    TransferFailureReason
BadParameter -> Builder
"Attempted to call contract " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressAndAlias
addr AddressAndAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" with a " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TransferFailureReason
reason TransferFailureReason -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    FailedWith{} -> Builder
"Contract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressAndAlias
addr AddressAndAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TransferFailureReason
reason TransferFailureReason -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    TransferFailureReason
_ -> Builder
"Contract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressAndAlias
addr AddressAndAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" failed due to a " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TransferFailureReason
reason TransferFailureReason -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

instance Buildable TransferFailureReason where
  build :: TransferFailureReason -> Builder
build = \case
    FailedWith ExpressionOrTypedValue
expr Maybe ErrorSrcPos
loc -> Builder
"failed with: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ExpressionOrTypedValue
expr ExpressionOrTypedValue -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder -> (ErrorSrcPos -> Builder) -> Maybe ErrorSrcPos -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" ((Builder
" at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|) (Builder -> Builder)
-> (ErrorSrcPos -> Builder) -> ErrorSrcPos -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorSrcPos -> Builder
forall p. Buildable p => p -> Builder
build) Maybe ErrorSrcPos
loc
    TransferFailureReason
EmptyTransaction -> Builder
"Attempted to transfer 0tz to a simple address"
    TransferFailureReason
BadParameter -> Builder
"parameter of the wrong type"
    MutezArithError MutezArithErrorType
typ -> Builder
"mutez " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MutezArithErrorType
typ MutezArithErrorType -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    TransferFailureReason
ShiftOverflow -> Builder
"overflow error"
    TransferFailureReason
GasExhaustion -> Builder
"gas exhaustion"

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

instance Buildable GenericTestError where
  build :: GenericTestError -> Builder
build = \case
    GenericTestError
UnexpectedSuccess ->
      Builder
"Expected an exception to be thrown, but it wasn't"

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

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

----------------------------------------------------------------------------
-- Other helpers
----------------------------------------------------------------------------

class NiceEntrypointName epName => EntrypointNameConstructor (epName :: Symbol) a where
  -- | A short partial constructor for 'EpName' or 'EntrypointRef'. It accepts a
  -- type-level string as its type argument. The programmer is responsible for
  -- validity. And this code is for tests anyway, so each failure is a
  -- programmer mistake.
  --
  -- Note that entrypoint names should be capitalized, e.g.
  --
  -- > ep @"Entrypoint"
  --
  -- corresponds to @entrypoint@, etc.
  --
  -- It is intentionally here and not in some deeper module because the name is
  -- really short and more suitable for writing scenarios.
  --
  -- For 'EpName', an instance is provided accepting a value-level t'Text'
  -- instead of a type-level symbol. This is mostly for cases where the
  -- type-level symbol doesn't work. Note that value-level string will be used
  -- verbatim, hence capitalization is arbitrary.
  --
  -- > ep "entrypoint"
  ep :: a

instance (NiceEntrypointName epName, mname ~ 'Just epName)
  => EntrypointNameConstructor epName (EntrypointRef mname) where
  ep :: EntrypointRef mname
ep = EntrypointRef mname
forall (name :: Symbol).
NiceEntrypointName name =>
EntrypointRef ('Just name)
Call

instance NiceEntrypointName epName => EntrypointNameConstructor epName EpName where
  ep :: EpName
ep = EntrypointRef ('Just epName) -> EpName
forall (mname :: Maybe Symbol). EntrypointRef mname -> EpName
eprName (EntrypointRef ('Just epName) -> EpName)
-> EntrypointRef ('Just epName) -> EpName
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol).
NiceEntrypointName name =>
EntrypointRef ('Just name)
Call @epName

instance (any ~ "", t ~ Text) => EntrypointNameConstructor any (t -> EpName) where
  ep :: t -> EpName
ep = Either String EpName -> EpName
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either String EpName -> EpName)
-> (Text -> Either String EpName) -> Text -> EpName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String EpName
U.buildEpName

-- | Runs a handler over every action.
mapClevelandOpsImplExceptions
  :: (forall a. HasCallStack => m a -> m a)
  -> ClevelandOpsImpl m -> ClevelandOpsImpl m
mapClevelandOpsImplExceptions :: forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandOpsImpl m -> ClevelandOpsImpl m
mapClevelandOpsImplExceptions forall a. HasCallStack => m a -> m a
f ClevelandOpsImpl{HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch :: forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
   [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
..} = ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
 [OperationInfo ClevelandInput]
 -> m [OperationInfo ClevelandResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
    { coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch = \[OperationInfo ClevelandInput]
op -> m [OperationInfo ClevelandResult]
-> m [OperationInfo ClevelandResult]
forall a. HasCallStack => m a -> m a
f (m [OperationInfo ClevelandResult]
 -> m [OperationInfo ClevelandResult])
-> m [OperationInfo ClevelandResult]
-> m [OperationInfo ClevelandResult]
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch [OperationInfo ClevelandInput]
op
    }

-- | Runs a handler over every action (except 'cmiAttempt' and 'cmiThrow'),
-- possibly transforming exceptions thrown by those actions.
mapClevelandMiscImplExceptions
  :: (forall a. HasCallStack => m a -> m a)
  -> ClevelandMiscImpl m -> ClevelandMiscImpl m
mapClevelandMiscImplExceptions :: forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandMiscImpl m -> ClevelandMiscImpl m
mapClevelandMiscImplExceptions forall a. HasCallStack => m a -> m a
f ClevelandMiscImpl{m (Either (EmulatedImpl m) NetworkEnv)
HasCallStack => m Natural
HasCallStack => m (Time Second)
HasCallStack => m ChainId
HasCallStack => m Timestamp
HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
HasCallStack => Text -> m ()
HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
HasCallStack => ContractAddress -> m SomeAnnotatedValue
HasCallStack => L1Address -> m (Maybe KeyHash)
HasCallStack => L1Address -> m Mutez
HasCallStack => ImplicitAddressWithAlias -> m PublicKey
HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
HasCallStack => (Natural -> Natural) -> m ()
ImplicitAddress -> m ()
ContractAddress -> m [SomeTicket]
forall res. HasCallStack => IO res -> m res
forall a. HasCallStack => SomeException -> m a
forall a. HasCallStack => Builder -> m a
forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
 NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
forall (t :: T).
(HasNoOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiAllTicketBalances :: ContractAddress -> m [SomeTicket]
cmiTicketBalance :: forall (t :: T).
(HasNoOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
cmiRunCode :: forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
cmiUnderlyingImpl :: m (Either (EmulatedImpl m) NetworkEnv)
cmiMarkAddressRefillable :: ImplicitAddress -> m ()
cmiAttempt :: forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiGetApproximateBlockInterval :: HasCallStack => m (Time Second)
cmiThrow :: forall a. HasCallStack => SomeException -> m a
cmiFailure :: forall a. HasCallStack => Builder -> m a
cmiGetLevel :: HasCallStack => m Natural
cmiGetNow :: HasCallStack => m Timestamp
cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceTime :: forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
cmiGetChainId :: HasCallStack => m ChainId
cmiGetDelegate :: HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetPublicKey :: HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetAllBigMapValuesMaybe :: forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
cmiGetBigMapValueMaybe :: forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
 NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
cmiGetSomeStorage :: HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetBalance :: HasCallStack => L1Address -> m Mutez
cmiComment :: HasCallStack => Text -> m ()
cmiOriginateLargeUntyped :: forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiSignBytes :: HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
cmiGenFreshKey :: HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey :: HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey :: HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiResolveAddress :: forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
cmiRunIO :: forall res. HasCallStack => IO res -> m res
cmiAllTicketBalances :: forall (m :: * -> *).
ClevelandMiscImpl m -> ContractAddress -> m [SomeTicket]
cmiTicketBalance :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (t :: T).
   (HasNoOp t, Comparable t) =>
   L1Address -> ContractAddress -> Value t -> m Natural
cmiRunCode :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall cp st vd.
   (HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
   Sender -> RunCode cp st vd -> m (AsRPC st)
cmiUnderlyingImpl :: forall (m :: * -> *).
ClevelandMiscImpl m -> m (Either (EmulatedImpl m) NetworkEnv)
cmiMarkAddressRefillable :: forall (m :: * -> *).
ClevelandMiscImpl m -> ImplicitAddress -> m ()
cmiAttempt :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiGetApproximateBlockInterval :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m (Time Second)
cmiThrow :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a. HasCallStack => SomeException -> m a
cmiFailure :: forall (m :: * -> *).
ClevelandMiscImpl m -> forall a. HasCallStack => Builder -> m a
cmiGetLevel :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Natural
cmiGetNow :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Timestamp
cmiAdvanceToLevel :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceTime :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (unit :: Rat).
   (HasCallStack, KnownDivRat unit Second) =>
   Time unit -> m ()
cmiGetChainId :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m ChainId
cmiGetDelegate :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetPublicKey :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetAllBigMapValuesMaybe :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
   (HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
   BigMapId k v -> m (Maybe [v])
cmiGetBigMapValueMaybe :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
   (HasCallStack, NiceComparable k, NicePackedValue k,
    NiceUnpackedValue v) =>
   BigMapId k v -> k -> m (Maybe v)
cmiGetSomeStorage :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetBalance :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => L1Address -> m Mutez
cmiComment :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Text -> m ()
cmiOriginateLargeUntyped :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (oty :: OriginationType).
   HasCallStack =>
   Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiSignBytes :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   ByteString -> ImplicitAddressWithAlias -> m Signature
cmiGenFreshKey :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiResolveAddress :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (kind :: AddressKind).
   HasCallStack =>
   AddressOrAlias kind -> m (AddressWithAlias kind)
cmiRunIO :: forall (m :: * -> *).
ClevelandMiscImpl m -> forall res. HasCallStack => IO res -> m res
..} = 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 -> m res
cmiRunIO = \IO res
action -> m res -> m res
forall a. HasCallStack => m a -> m a
f (m res -> m res) -> m res -> m res
forall a b. (a -> b) -> a -> b
$ IO res -> m res
forall res. HasCallStack => IO res -> m res
cmiRunIO IO res
action
    , cmiResolveAddress :: forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
cmiResolveAddress = \AddressOrAlias kind
address -> m (AddressWithAlias kind) -> m (AddressWithAlias kind)
forall a. HasCallStack => m a -> m a
f (m (AddressWithAlias kind) -> m (AddressWithAlias kind))
-> m (AddressWithAlias kind) -> m (AddressWithAlias kind)
forall a b. (a -> b) -> a -> b
$ AddressOrAlias kind -> m (AddressWithAlias kind)
forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
cmiResolveAddress AddressOrAlias kind
address
    , cmiSignBytes :: HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
cmiSignBytes = \ByteString
bs ImplicitAddressWithAlias
alias -> m Signature -> m Signature
forall a. HasCallStack => m a -> m a
f (m Signature -> m Signature) -> m Signature -> m Signature
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
ByteString -> ImplicitAddressWithAlias -> m Signature
cmiSignBytes ByteString
bs ImplicitAddressWithAlias
alias
    , cmiGenKey :: HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey = \SpecificOrDefaultAlias
alias -> m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a. HasCallStack => m a -> m a
f (m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias)
-> m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey SpecificOrDefaultAlias
alias
    , cmiImportKey :: HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey = m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a. HasCallStack => m a -> m a
f (m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias)
-> (SecretKey
    -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias)
-> SecretKey
-> SpecificOrDefaultAlias
-> m ImplicitAddressWithAlias
forall a b c. SuperComposition a b c => a -> b -> c
... HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey
    , cmiGenFreshKey :: HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenFreshKey = \SpecificOrDefaultAlias
alias -> m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a. HasCallStack => m a -> m a
f (m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias)
-> m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenFreshKey SpecificOrDefaultAlias
alias
    , cmiOriginateLargeUntyped :: forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiOriginateLargeUntyped = \Sender
sender OriginateData oty 'IsLarge
uodata -> m ContractAddress -> m ContractAddress
forall a. HasCallStack => m a -> m a
f (m ContractAddress -> m ContractAddress)
-> m ContractAddress -> m ContractAddress
forall a b. (a -> b) -> a -> b
$ Sender -> OriginateData oty 'IsLarge -> m ContractAddress
forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiOriginateLargeUntyped Sender
sender OriginateData oty 'IsLarge
uodata
    , cmiComment :: HasCallStack => Text -> m ()
cmiComment = \Text
t -> m () -> m ()
forall a. HasCallStack => m a -> m a
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> m ()
Text -> m ()
cmiComment Text
t
    , cmiGetBalance :: HasCallStack => L1Address -> m Mutez
cmiGetBalance = \L1Address
addr -> m Mutez -> m Mutez
forall a. HasCallStack => m a -> m a
f (m Mutez -> m Mutez) -> m Mutez -> m Mutez
forall a b. (a -> b) -> a -> b
$ HasCallStack => L1Address -> m Mutez
L1Address -> m Mutez
cmiGetBalance L1Address
addr
    , cmiGetSomeStorage :: HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetSomeStorage = \ContractAddress
addr -> m SomeAnnotatedValue -> m SomeAnnotatedValue
forall a. HasCallStack => m a -> m a
f (m SomeAnnotatedValue -> m SomeAnnotatedValue)
-> m SomeAnnotatedValue -> m SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$ HasCallStack => ContractAddress -> m SomeAnnotatedValue
ContractAddress -> m SomeAnnotatedValue
cmiGetSomeStorage ContractAddress
addr
    , cmiGetBigMapValueMaybe :: forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
 NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
cmiGetBigMapValueMaybe = \BigMapId k v
bmId k
k -> m (Maybe v) -> m (Maybe v)
forall a. HasCallStack => m a -> m a
f (m (Maybe v) -> m (Maybe v)) -> m (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ BigMapId k v -> k -> m (Maybe v)
forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
 NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
cmiGetBigMapValueMaybe BigMapId k v
bmId k
k
    , cmiGetAllBigMapValuesMaybe :: forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
cmiGetAllBigMapValuesMaybe = \BigMapId k v
bmId -> m (Maybe [v]) -> m (Maybe [v])
forall a. HasCallStack => m a -> m a
f (m (Maybe [v]) -> m (Maybe [v])) -> m (Maybe [v]) -> m (Maybe [v])
forall a b. (a -> b) -> a -> b
$ BigMapId k v -> m (Maybe [v])
forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
cmiGetAllBigMapValuesMaybe BigMapId k v
bmId
    , cmiGetPublicKey :: HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetPublicKey = \ImplicitAddressWithAlias
addr -> m PublicKey -> m PublicKey
forall a. HasCallStack => m a -> m a
f (m PublicKey -> m PublicKey) -> m PublicKey -> m PublicKey
forall a b. (a -> b) -> a -> b
$ HasCallStack => ImplicitAddressWithAlias -> m PublicKey
ImplicitAddressWithAlias -> m PublicKey
cmiGetPublicKey ImplicitAddressWithAlias
addr
    , cmiGetDelegate :: HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetDelegate = m (Maybe KeyHash) -> m (Maybe KeyHash)
forall a. HasCallStack => m a -> m a
f (m (Maybe KeyHash) -> m (Maybe KeyHash))
-> (L1Address -> m (Maybe KeyHash))
-> L1Address
-> m (Maybe KeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => L1Address -> m (Maybe KeyHash)
L1Address -> m (Maybe KeyHash)
cmiGetDelegate
    , cmiGetChainId :: HasCallStack => m ChainId
cmiGetChainId = m ChainId -> m ChainId
forall a. HasCallStack => m a -> m a
f (m ChainId -> m ChainId) -> m ChainId -> m ChainId
forall a b. (a -> b) -> a -> b
$ m ChainId
HasCallStack => m ChainId
cmiGetChainId
    , cmiAdvanceTime :: forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
cmiAdvanceTime = \Time unit
time -> m () -> m ()
forall a. HasCallStack => m a -> m a
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Time unit -> m ()
forall {unit :: Rat}.
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
cmiAdvanceTime Time unit
time
    , cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceToLevel = \Natural -> Natural
level -> m () -> m ()
forall a. HasCallStack => m a -> m a
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Natural -> Natural) -> m ()
(Natural -> Natural) -> m ()
cmiAdvanceToLevel Natural -> Natural
level
    , cmiGetNow :: HasCallStack => m Timestamp
cmiGetNow = m Timestamp -> m Timestamp
forall a. HasCallStack => m a -> m a
f (m Timestamp -> m Timestamp) -> m Timestamp -> m Timestamp
forall a b. (a -> b) -> a -> b
$ m Timestamp
HasCallStack => m Timestamp
cmiGetNow
    , cmiGetLevel :: HasCallStack => m Natural
cmiGetLevel = m Natural -> m Natural
forall a. HasCallStack => m a -> m a
f (m Natural -> m Natural) -> m Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ m Natural
HasCallStack => m Natural
cmiGetLevel
    , cmiFailure :: forall a. HasCallStack => Builder -> m a
cmiFailure = \Builder
builder -> m a -> m a
forall a. HasCallStack => m a -> m a
f (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Builder -> m a
forall a. HasCallStack => Builder -> m a
cmiFailure Builder
builder
    , cmiGetApproximateBlockInterval :: HasCallStack => m (Time Second)
cmiGetApproximateBlockInterval = m (Time (1 :% 1)) -> m (Time (1 :% 1))
forall a. HasCallStack => m a -> m a
f (m (Time (1 :% 1)) -> m (Time (1 :% 1)))
-> m (Time (1 :% 1)) -> m (Time (1 :% 1))
forall a b. (a -> b) -> a -> b
$ m (Time (1 :% 1))
HasCallStack => m (Time Second)
cmiGetApproximateBlockInterval
    , cmiAttempt :: forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiAttempt = \m a
action -> m a -> m (Either e a)
forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiAttempt m a
action
    , cmiMarkAddressRefillable :: ImplicitAddress -> m ()
cmiMarkAddressRefillable = m () -> m ()
forall a. HasCallStack => m a -> m a
f (m () -> m ())
-> (ImplicitAddress -> m ()) -> ImplicitAddress -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddress -> m ()
cmiMarkAddressRefillable
    , cmiThrow :: forall a. HasCallStack => SomeException -> m a
cmiThrow = forall a. HasCallStack => SomeException -> m a
cmiThrow
    , cmiUnderlyingImpl :: m (Either (EmulatedImpl m) NetworkEnv)
cmiUnderlyingImpl = m (Either (EmulatedImpl m) NetworkEnv)
-> m (Either (EmulatedImpl m) NetworkEnv)
forall a. HasCallStack => m a -> m a
f (m (Either (EmulatedImpl m) NetworkEnv)
 -> m (Either (EmulatedImpl m) NetworkEnv))
-> m (Either (EmulatedImpl m) NetworkEnv)
-> m (Either (EmulatedImpl m) NetworkEnv)
forall a b. (a -> b) -> a -> b
$ m (Either (EmulatedImpl m) NetworkEnv)
cmiUnderlyingImpl
    , cmiRunCode :: forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
cmiRunCode = m (AsRPC st) -> m (AsRPC st)
forall a. HasCallStack => m a -> m a
f (m (AsRPC st) -> m (AsRPC st))
-> (Sender -> RunCode cp st vd -> m (AsRPC st))
-> Sender
-> RunCode cp st vd
-> m (AsRPC st)
forall a b c. SuperComposition a b c => a -> b -> c
... Sender -> RunCode cp st vd -> m (AsRPC st)
forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
cmiRunCode
    , cmiTicketBalance :: forall (t :: T).
(HasNoOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
cmiTicketBalance = m Natural -> m Natural
forall a. HasCallStack => m a -> m a
f (m Natural -> m Natural)
-> (L1Address -> ContractAddress -> Value t -> m Natural)
-> L1Address
-> ContractAddress
-> Value t
-> m Natural
forall a b c. SuperComposition a b c => a -> b -> c
... L1Address -> ContractAddress -> Value t -> m Natural
forall (t :: T).
(HasNoOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
cmiTicketBalance
    , cmiAllTicketBalances :: ContractAddress -> m [SomeTicket]
cmiAllTicketBalances = m [SomeTicket] -> m [SomeTicket]
forall a. HasCallStack => m a -> m a
f (m [SomeTicket] -> m [SomeTicket])
-> (ContractAddress -> m [SomeTicket])
-> ContractAddress
-> m [SomeTicket]
forall a b c. SuperComposition a b c => a -> b -> c
... ContractAddress -> m [SomeTicket]
cmiAllTicketBalances
    }

-- | A record with all the capabilities available to any cleveland test.
data ClevelandCaps m = ClevelandCaps
  { forall (m :: * -> *). ClevelandCaps m -> Sender
ccSender :: Sender
  , forall (m :: * -> *). ClevelandCaps m -> Moneybag
ccMoneybag :: Moneybag
  , forall (m :: * -> *). ClevelandCaps m -> ClevelandMiscImpl m
ccMiscCap :: ClevelandMiscImpl m
  , forall (m :: * -> *).
ClevelandCaps m -> Sender -> ClevelandOpsImpl m
ccOpsCap :: Sender -> ClevelandOpsImpl m
  }

-- | A record with all the capabilities available to a cleveland test on the emulator.
data EmulatedCaps m = EmulatedCaps
  { forall (m :: * -> *). EmulatedCaps m -> EmulatedImpl m
ecEmulatedCap :: EmulatedImpl m
  , forall (m :: * -> *). EmulatedCaps m -> ClevelandCaps m
ecClevelandCaps :: ClevelandCaps m
  }

-- | A record with all the capabilities available to a cleveland test on the network.
data NetworkCaps m = NetworkCaps
  { forall (m :: * -> *). NetworkCaps m -> NetworkEnv
ncNetworkEnv :: NetworkEnv
  , forall (m :: * -> *). NetworkCaps m -> ClevelandCaps m
ncClevelandCaps :: ClevelandCaps m
  }

makeLensesFor [("ccSender", "ccSenderL"), ("ccMoneybag", "ccMoneybagL")] ''ClevelandCaps
makeLensesFor [("ecClevelandCaps", "ecClevelandCapsL")] ''EmulatedCaps
makeLensesFor [("ncClevelandCaps", "ncClevelandCapsL")] ''NetworkCaps

-- | A proof that the given @caps@ record contains
-- the basic cleveland capabilities.
class Monad (ClevelandBaseMonad caps) => HasClevelandCaps caps where
  -- | This will be either @PureM@ or @ClientM@.
  type ClevelandBaseMonad caps :: Type -> Type
  clevelandCapsL :: Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))

-- | A proof that the given @caps@ record contains
-- the basic cleveland capabilities + the emulator capabilities.
class HasClevelandCaps caps => HasEmulatedCaps caps where
  getEmulatedCap :: caps -> EmulatedImpl (ClevelandBaseMonad caps)

instance Monad m => HasClevelandCaps (ClevelandCaps m) where
  type ClevelandBaseMonad (ClevelandCaps m) = m
  clevelandCapsL :: Lens'
  (ClevelandCaps m)
  (ClevelandCaps (ClevelandBaseMonad (ClevelandCaps m)))
clevelandCapsL = (ClevelandCaps (ClevelandBaseMonad (ClevelandCaps m))
 -> f (ClevelandCaps (ClevelandBaseMonad (ClevelandCaps m))))
-> ClevelandCaps m -> f (ClevelandCaps m)
forall a. a -> a
id

instance Monad m => HasClevelandCaps (EmulatedCaps m) where
  type ClevelandBaseMonad (EmulatedCaps m) = m
  clevelandCapsL :: Lens'
  (EmulatedCaps m)
  (ClevelandCaps (ClevelandBaseMonad (EmulatedCaps m)))
clevelandCapsL = (ClevelandCaps (ClevelandBaseMonad (EmulatedCaps m))
 -> f (ClevelandCaps (ClevelandBaseMonad (EmulatedCaps m))))
-> EmulatedCaps m -> f (EmulatedCaps m)
forall (m :: * -> *). Lens' (EmulatedCaps m) (ClevelandCaps m)
ecClevelandCapsL

senderL :: HasClevelandCaps caps => Lens' caps Sender
senderL :: forall caps. HasClevelandCaps caps => Lens' caps Sender
senderL = (ClevelandCaps (ClevelandBaseMonad caps)
 -> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> caps -> f caps
forall caps.
HasClevelandCaps caps =>
Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
clevelandCapsL ((ClevelandCaps (ClevelandBaseMonad caps)
  -> f (ClevelandCaps (ClevelandBaseMonad caps)))
 -> caps -> f caps)
-> ((Sender -> f Sender)
    -> ClevelandCaps (ClevelandBaseMonad caps)
    -> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> (Sender -> f Sender)
-> caps
-> f caps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sender -> f Sender)
-> ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps))
forall (m :: * -> *). Lens' (ClevelandCaps m) Sender
ccSenderL

moneybagL :: HasClevelandCaps caps => Lens' caps Moneybag
moneybagL :: forall caps. HasClevelandCaps caps => Lens' caps Moneybag
moneybagL = (ClevelandCaps (ClevelandBaseMonad caps)
 -> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> caps -> f caps
forall caps.
HasClevelandCaps caps =>
Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
clevelandCapsL ((ClevelandCaps (ClevelandBaseMonad caps)
  -> f (ClevelandCaps (ClevelandBaseMonad caps)))
 -> caps -> f caps)
-> ((Moneybag -> f Moneybag)
    -> ClevelandCaps (ClevelandBaseMonad caps)
    -> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> (Moneybag -> f Moneybag)
-> caps
-> f caps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Moneybag -> f Moneybag)
-> ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps))
forall (m :: * -> *). Lens' (ClevelandCaps m) Moneybag
ccMoneybagL

getMiscCap :: HasClevelandCaps caps => caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap :: forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap = ClevelandCaps (ClevelandBaseMonad caps)
-> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall (m :: * -> *). ClevelandCaps m -> ClevelandMiscImpl m
ccMiscCap (ClevelandCaps (ClevelandBaseMonad caps)
 -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (caps -> ClevelandCaps (ClevelandBaseMonad caps))
-> caps
-> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (ClevelandCaps (ClevelandBaseMonad caps))
  caps
  (ClevelandCaps (ClevelandBaseMonad caps))
-> caps -> ClevelandCaps (ClevelandBaseMonad caps)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (ClevelandCaps (ClevelandBaseMonad caps))
  caps
  (ClevelandCaps (ClevelandBaseMonad caps))
forall caps.
HasClevelandCaps caps =>
Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
clevelandCapsL

getOpsCap :: HasClevelandCaps caps => caps -> ClevelandOpsImpl (ClevelandBaseMonad caps)
getOpsCap :: forall caps.
HasClevelandCaps caps =>
caps -> ClevelandOpsImpl (ClevelandBaseMonad caps)
getOpsCap caps
r = ClevelandCaps (ClevelandBaseMonad caps)
-> Sender -> ClevelandOpsImpl (ClevelandBaseMonad caps)
forall (m :: * -> *).
ClevelandCaps m -> Sender -> ClevelandOpsImpl m
ccOpsCap (caps
r caps
-> Getting
     (ClevelandCaps (ClevelandBaseMonad caps))
     caps
     (ClevelandCaps (ClevelandBaseMonad caps))
-> ClevelandCaps (ClevelandBaseMonad caps)
forall s a. s -> Getting a s a -> a
^. Getting
  (ClevelandCaps (ClevelandBaseMonad caps))
  caps
  (ClevelandCaps (ClevelandBaseMonad caps))
forall caps.
HasClevelandCaps caps =>
Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
clevelandCapsL) (caps
r caps -> Getting Sender caps Sender -> Sender
forall s a. s -> Getting a s a -> a
^. Getting Sender caps Sender
forall caps. HasClevelandCaps caps => Lens' caps Sender
senderL)

instance Monad m => HasEmulatedCaps (EmulatedCaps m) where
  getEmulatedCap :: EmulatedCaps m
-> EmulatedImpl (ClevelandBaseMonad (EmulatedCaps m))
getEmulatedCap = EmulatedCaps m
-> EmulatedImpl (ClevelandBaseMonad (EmulatedCaps m))
forall (m :: * -> *). EmulatedCaps m -> EmulatedImpl m
ecEmulatedCap

-- | A proof that the given @caps@ record contains
-- the basic cleveland capabilities + the network capabilities.
class HasClevelandCaps caps => HasNetworkCaps caps where
  getNetworkEnvCap :: caps -> NetworkEnv

instance Monad m => HasClevelandCaps (NetworkCaps m) where
  type ClevelandBaseMonad (NetworkCaps m) = m
  clevelandCapsL :: Lens'
  (NetworkCaps m)
  (ClevelandCaps (ClevelandBaseMonad (NetworkCaps m)))
clevelandCapsL = (ClevelandCaps (ClevelandBaseMonad (NetworkCaps m))
 -> f (ClevelandCaps (ClevelandBaseMonad (NetworkCaps m))))
-> NetworkCaps m -> f (NetworkCaps m)
forall (m :: * -> *) (m :: * -> *).
Lens
  (NetworkCaps m) (NetworkCaps m) (ClevelandCaps m) (ClevelandCaps m)
ncClevelandCapsL

instance Monad m => HasNetworkCaps (NetworkCaps m) where
  getNetworkEnvCap :: NetworkCaps m -> NetworkEnv
getNetworkEnvCap = NetworkCaps m -> NetworkEnv
forall (m :: * -> *). NetworkCaps m -> NetworkEnv
ncNetworkEnv

-- | Constraint for a monad in which we can do cleveland actions.
type MonadCleveland caps m =
  ( m ~ ReaderT caps (ClevelandBaseMonad caps)
  , HasClevelandCaps caps
  )

-- | Constraint for a monad in which we can do cleveland actions that can't be
-- run on a real network. It requires the 'EmulatedCaps' capability.
type MonadEmulated caps m =
  ( MonadCleveland caps m
  , HasEmulatedCaps caps
  )

-- | Constraint for a monad in which we can do cleveland actions that can only
-- be run on a real network. It requires the 'NetworkCaps' capability.
type MonadNetwork caps m =
  ( MonadCleveland caps m
  , HasNetworkCaps caps
  )

-- | Monad transformer that adds only the 'ClevelandCaps' capabilities.
type ClevelandT m = ReaderT (ClevelandCaps m) m

-- | Monad transformer that adds both 'ClevelandCaps' and 'EmulatedCaps' capabilities.
type EmulatedT m = ReaderT (EmulatedCaps m) m

-- | Monad transformer that adds both 'ClevelandCaps' and 'NetworkCaps' capabilities.
type NetworkT m = ReaderT (NetworkCaps m) m