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

{-# OPTIONS_HADDOCK not-home #-}

-- | The bulk of Cleveland actions.
module Test.Cleveland.Internal.Actions.Misc
  ( module Test.Cleveland.Internal.Actions.Misc
  ) where

import Data.Singletons (demote)
import Fmt (Buildable, Builder, build, indentF, unlinesF, (+|), (|+))
import Time (KnownDivRat, Second, Time, toNum)
import Unsafe qualified (fromIntegral)

import Lorentz (BigMapId, Contract(..), DemoteViewsDescriptor, IsoValue)
import Lorentz.Bytes
import Lorentz.Constraints
import Morley.AsRPC (HasRPCRepr(..))
import Morley.Client
  (MorleyClientEnv, MorleyOnlyRpcEnv, OperationInfo(..), RunError(..), UnexpectedErrors(..))
import Morley.Client.Types (ImplicitAddressWithAlias, awaAddress)
import Morley.Michelson.Runtime (ExecutorError'(..), VotingPowers)
import Morley.Michelson.Runtime.GState (GStateUpdateError(..))
import Morley.Michelson.Runtime.Import qualified as Runtime
import Morley.Michelson.Typed (SomeAnnotatedValue)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.AnnotatedValue (castTo, getT, value)
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 (KeyHash, PublicKey, SecretKey, Signature)
import Morley.Util.SizedList qualified as SL
import Morley.Util.SizedList.Types
import Test.Cleveland.Instances ()
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Actions.Assertions
import Test.Cleveland.Internal.Actions.Helpers
import Test.Cleveland.Internal.Actions.MonadOpsInternal
import Test.Cleveland.Internal.Actions.Transfer
import Test.Cleveland.Internal.Client (mkMorleyOnlyRpcEnvNetwork)
import Test.Cleveland.Internal.Exceptions (fromPossiblyAnnotatedException)
import Test.Cleveland.Lorentz.Import qualified as LorentzImport
import Test.Cleveland.Lorentz.Types

{-# ANN module ("HLint: ignore Avoid lambda using `infix`" :: Text) #-}

-- $setup
-- >>> :m +Morley.Util.SizedList.Types
-- >>> :{
-- isEquivalentTo :: Show a => a -> a -> Bool
-- isEquivalentTo a b = Debug.show a == Debug.show b
-- infix 0 `isEquivalentTo`
-- :}

-- | Update the current sender on whose behalf transfers and originations are
-- invoked.
withSender :: (MonadCleveland caps m) => ImplicitAddressWithAlias -> m a -> m a
withSender :: forall caps (m :: * -> *) a.
MonadCleveland caps m =>
ImplicitAddressWithAlias -> m a -> m a
withSender ImplicitAddressWithAlias
addr =
  (caps -> caps) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (ASetter caps caps Sender Sender -> Sender -> caps -> caps
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter caps caps Sender Sender
forall caps. HasClevelandCaps caps => Lens' caps Sender
senderL (ImplicitAddressWithAlias -> Sender
Sender ImplicitAddressWithAlias
addr))

-- | Update the current moneybag that transfers money on the newly created
-- addresses. For the rare occasions when this is necessary.
withMoneybag :: (MonadCleveland caps m) => ImplicitAddressWithAlias -> m a -> m a
withMoneybag :: forall caps (m :: * -> *) a.
MonadCleveland caps m =>
ImplicitAddressWithAlias -> m a -> m a
withMoneybag ImplicitAddressWithAlias
addr =
  (caps -> caps) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (ASetter caps caps Moneybag Moneybag -> Moneybag -> caps -> caps
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter caps caps Moneybag Moneybag
forall caps. HasClevelandCaps caps => Lens' caps Moneybag
moneybagL (ImplicitAddressWithAlias -> Moneybag
Moneybag ImplicitAddressWithAlias
addr))

-- | Runs an 'IO' action.
runIO :: (HasCallStack, MonadCleveland caps m) => IO res -> m res
runIO :: forall caps (m :: * -> *) res.
(HasCallStack, MonadCleveland caps m) =>
IO res -> m res
runIO IO res
io = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps res)
-> ReaderT caps (ClevelandBaseMonad caps) res
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall res.
   HasCallStack =>
   IO res -> ClevelandBaseMonad caps res
forall (m :: * -> *).
ClevelandMiscImpl m -> forall res. HasCallStack => IO res -> m res
cmiRunIO ClevelandMiscImpl (ClevelandBaseMonad caps)
cap IO res
io

-- | Get the address of the implicit account / contract associated with the given alias.
resolveAddress
  :: (HasCallStack, MonadCleveland caps m)
  => Alias kind -> m (KindedAddress kind)
resolveAddress :: forall caps (m :: * -> *) (kind :: AddressKind).
(HasCallStack, MonadCleveland caps m) =>
Alias kind -> m (KindedAddress kind)
resolveAddress Alias kind
alias = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps (KindedAddress kind))
-> ReaderT caps (ClevelandBaseMonad caps) (KindedAddress kind)
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> AddressWithAlias kind -> KindedAddress kind
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress (AddressWithAlias kind -> KindedAddress kind)
-> ClevelandBaseMonad caps (AddressWithAlias kind)
-> ClevelandBaseMonad caps (KindedAddress kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall (kind :: AddressKind).
   HasCallStack =>
   AddressOrAlias kind
   -> ClevelandBaseMonad caps (AddressWithAlias kind)
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (kind :: AddressKind).
   HasCallStack =>
   AddressOrAlias kind -> m (AddressWithAlias kind)
cmiResolveAddress ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (Alias kind -> AddressOrAlias kind
forall (kind :: AddressKind). Alias kind -> AddressOrAlias kind
AddressAlias Alias kind
alias)

-- | Simple combinator that marks address as "refillable".
--
-- If a refillable address lacks funds for the next operation,
-- some funds will automatically be transferred to it.
refillable :: (ToImplicitAddress addr, MonadCleveland caps m) => m addr -> m addr
refillable :: forall addr caps (m :: * -> *).
(ToImplicitAddress addr, MonadCleveland caps m) =>
m addr -> m addr
refillable = (Identity addr -> addr) -> m (Identity addr) -> m addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity addr -> addr
forall a. Identity a -> a
runIdentity (m (Identity addr) -> m addr)
-> (m addr -> m (Identity addr)) -> m addr -> m addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Identity addr) -> m (Identity addr)
forall addr (f :: * -> *) caps (m :: * -> *).
(ToImplicitAddress addr, Traversable f, MonadCleveland caps m) =>
m (f addr) -> m (f addr)
refillables (m (Identity addr) -> m (Identity addr))
-> (m addr -> m (Identity addr)) -> m addr -> m (Identity addr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (addr -> Identity addr) -> m addr -> m (Identity addr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap addr -> Identity addr
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Mark multiple addresses as 'refillable', useful with 'newAddresses' &c.
refillables
  :: (ToImplicitAddress addr, Traversable f, MonadCleveland caps m)
  => m (f addr) -> m (f addr)
refillables :: forall addr (f :: * -> *) caps (m :: * -> *).
(ToImplicitAddress addr, Traversable f, MonadCleveland caps m) =>
m (f addr) -> m (f addr)
refillables m (f addr)
mkAddrs = do
  f addr
addrs <- m (f addr)
mkAddrs
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps (f ()))
-> ReaderT caps (ClevelandBaseMonad caps) (f ())
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> (addr -> ClevelandBaseMonad caps ())
-> f addr -> ClevelandBaseMonad caps (f ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ClevelandMiscImpl (ClevelandBaseMonad caps)
-> ImplicitAddress -> ClevelandBaseMonad caps ()
forall (m :: * -> *).
ClevelandMiscImpl m -> ImplicitAddress -> m ()
cmiMarkAddressRefillable ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (ImplicitAddress -> ClevelandBaseMonad caps ())
-> (addr -> ImplicitAddress) -> addr -> ClevelandBaseMonad caps ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. addr -> ImplicitAddress
forall addr. ToImplicitAddress addr => addr -> ImplicitAddress
toImplicitAddress) f addr
addrs
  pure f addr
addrs

-- | If the given alias is already associated with an existing address,
-- that address will be reused and returned.
-- Otherwise, generate a new secret key and record it with given alias.
--
-- If the account has too low of a balance, a small amount of XTZ will
-- be transferred to it.
--
-- Notes:
--
-- * By default, the XTZ is transferred from the account associated with the @moneybag@ alias.
--   This can be overridden with the @--cleveland-moneybag-alias@ command line option, the
--   @TASTY_CLEVELAND_MONEYBAG_ALIAS@ env var, or 'withMoneybag'.
newAddress :: (HasCallStack, MonadCleveland caps m) => SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
newAddress :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
newAddress SpecificOrDefaultAlias
alias = do
  SizedList' ('S 'Z) ImplicitAddressWithAlias
addrs <- SizedList 1 SpecificOrDefaultAlias
-> m (SizedList 1 ImplicitAddressWithAlias)
forall (n :: Nat) (n' :: Peano) caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, IsoNatPeano n n') =>
SizedList n SpecificOrDefaultAlias
-> m (SizedList n ImplicitAddressWithAlias)
newAddresses (SizedList 1 SpecificOrDefaultAlias
 -> m (SizedList 1 ImplicitAddressWithAlias))
-> SizedList 1 SpecificOrDefaultAlias
-> m (SizedList 1 ImplicitAddressWithAlias)
forall a b. (a -> b) -> a -> b
$ SpecificOrDefaultAlias
alias SpecificOrDefaultAlias
-> SizedList' 'Z SpecificOrDefaultAlias
-> SizedList' ('S 'Z) SpecificOrDefaultAlias
forall a (n1 :: Peano).
a -> SizedList' n1 a -> SizedList' ('S n1) a
:< SizedList' 'Z SpecificOrDefaultAlias
forall a. SizedList' 'Z a
Nil
  case SizedList' ('S 'Z) ImplicitAddressWithAlias
addrs of
    ImplicitAddressWithAlias
addr :< SizedList' n1 ImplicitAddressWithAlias
Nil -> ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImplicitAddressWithAlias
addr

-- | Batched version of `newAddress`
newAddresses
  :: forall n n' caps m.
    (HasCallStack, MonadCleveland caps m, IsoNatPeano n n')
  => SizedList n SpecificOrDefaultAlias
  -> m (SizedList n ImplicitAddressWithAlias)
newAddresses :: forall (n :: Nat) (n' :: Peano) caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, IsoNatPeano n n') =>
SizedList n SpecificOrDefaultAlias
-> m (SizedList n ImplicitAddressWithAlias)
newAddresses SizedList n SpecificOrDefaultAlias
aliases = do
  SizedList' n' ImplicitAddressWithAlias
addrs <- (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad
         caps (SizedList' n' ImplicitAddressWithAlias))
-> ReaderT
     caps
     (ClevelandBaseMonad caps)
     (SizedList' n' ImplicitAddressWithAlias)
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> (SpecificOrDefaultAlias
 -> ClevelandBaseMonad caps ImplicitAddressWithAlias)
-> SizedList' n' SpecificOrDefaultAlias
-> ClevelandBaseMonad caps (SizedList' n' ImplicitAddressWithAlias)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   SpecificOrDefaultAlias
   -> ClevelandBaseMonad caps ImplicitAddressWithAlias
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey ClevelandMiscImpl (ClevelandBaseMonad caps)
cap) SizedList' n' SpecificOrDefaultAlias
SizedList n SpecificOrDefaultAlias
aliases
  Moneybag ImplicitAddressWithAlias
moneybag <- Getting Moneybag caps Moneybag -> m Moneybag
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Moneybag caps Moneybag
forall caps. HasClevelandCaps caps => Lens' caps Moneybag
moneybagL

  -- Addresses may exist from previous scenarios runs and have sufficient
  -- balance for the sake of testing; if so, we can save some time
  SizedList' n' Mutez
balances <- (ImplicitAddressWithAlias -> m Mutez)
-> SizedList' n' ImplicitAddressWithAlias
-> m (SizedList' n' Mutez)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ImplicitAddressWithAlias -> m Mutez
forall caps (m :: * -> *) addr.
(HasCallStack, MonadCleveland caps m, ToL1Address addr) =>
addr -> m Mutez
getBalance SizedList' n' ImplicitAddressWithAlias
addrs
  ImplicitAddressWithAlias -> m () -> m ()
forall caps (m :: * -> *) a.
MonadCleveland caps m =>
ImplicitAddressWithAlias -> m a -> m a
withSender ImplicitAddressWithAlias
moneybag do
    ClevelandOpsBatch () -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
ClevelandOpsBatch a -> m a
inBatch do
      SizedList' (MinPeano n' n') (ClevelandOpsBatch ())
-> ClevelandOpsBatch ()
forall t (f :: * -> *) a.
(Container t, Applicative f, Element t ~ f a) =>
t -> f ()
sequenceA_ (SizedList' (MinPeano n' n') (ClevelandOpsBatch ())
 -> ClevelandOpsBatch ())
-> SizedList' (MinPeano n' n') (ClevelandOpsBatch ())
-> ClevelandOpsBatch ()
forall a b. (a -> b) -> a -> b
$
        (ImplicitAddressWithAlias -> Mutez -> ClevelandOpsBatch ())
-> SizedList' n' ImplicitAddressWithAlias
-> SizedList' n' Mutez
-> SizedList' (MinPeano n' n') (ClevelandOpsBatch ())
forall a b c (n :: Peano) (m :: Peano).
(a -> b -> c)
-> SizedList' n a -> SizedList' m b -> SizedList' (MinPeano n m) c
SL.zipWith ImplicitAddressWithAlias -> Mutez -> ClevelandOpsBatch ()
forall {f :: * -> *} {a} {addr}.
(Applicative f, Ord a, Num a,
 TransferFunc
   ('Incomplete (InitialTransferMode addr))
   'TransferIgnoreResult
   'HasAmount
   (f ()),
 ToL1Address addr) =>
addr -> a -> f ()
refillIfLowBalance SizedList' n' ImplicitAddressWithAlias
addrs SizedList' n' Mutez
balances

  pure SizedList' n' ImplicitAddressWithAlias
addrs
  where
    refillIfLowBalance :: addr -> a -> f ()
refillIfLowBalance addr
addr a
balance =
      Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
balance a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.5_e6) do  -- < 0.5 XTZ
        addr -> Mutez -> f ()
forall addr r.
(HasCallStack,
 TransferFunc
   ('Incomplete (InitialTransferMode addr))
   'TransferIgnoreResult
   'HasNoAmount
   r,
 ToL1Address addr) =>
addr -> r
transfer addr
addr (Mutez
0.9_e6 :: Mutez) -- 0.9 XTZ

-- | Generate a new secret key and record it with given alias. If the
-- alias is already known, the key will be overwritten. The address is
-- guaranteed to be fresh, i. e. no operations on it have been made.
newFreshAddress
  :: (HasCallStack, MonadCleveland caps m)
  => SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
newFreshAddress :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
newFreshAddress SpecificOrDefaultAlias
alias = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps ImplicitAddressWithAlias)
-> ReaderT caps (ClevelandBaseMonad caps) ImplicitAddressWithAlias
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   SpecificOrDefaultAlias
   -> ClevelandBaseMonad caps ImplicitAddressWithAlias
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenFreshKey ClevelandMiscImpl (ClevelandBaseMonad caps)
cap SpecificOrDefaultAlias
alias

-- | Get the signature of the preapplied operation.
signBytes
  :: (HasCallStack, MonadCleveland caps m)
  => ByteString -> ImplicitAddressWithAlias -> m Signature
signBytes :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
ByteString -> ImplicitAddressWithAlias -> m Signature
signBytes ByteString
bytes ImplicitAddressWithAlias
signer = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps Signature)
-> ReaderT caps (ClevelandBaseMonad caps) Signature
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   ByteString
   -> ImplicitAddressWithAlias -> ClevelandBaseMonad caps Signature
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   ByteString -> ImplicitAddressWithAlias -> m Signature
cmiSignBytes ClevelandMiscImpl (ClevelandBaseMonad caps)
cap ByteString
bytes ImplicitAddressWithAlias
signer

-- | Create a list of similarly named 'SpecificAlias'es.
--
-- For example,
--
-- >>> enumAliases @2 "operator" `isEquivalentTo` "operator-0" :< "operator-1" :< Nil
-- True
enumAliases
  :: forall n n'.
     (SingIPeano n, IsoNatPeano n n')
  => ImplicitAlias -> SizedList n SpecificOrDefaultAlias
enumAliases :: forall (n :: Nat) (n' :: Peano).
(SingIPeano n, IsoNatPeano n n') =>
ImplicitAlias -> SizedList n SpecificOrDefaultAlias
enumAliases (ImplicitAlias Text
pfx) =
  ImplicitAlias -> SpecificOrDefaultAlias
SpecificAlias (ImplicitAlias -> SpecificOrDefaultAlias)
-> SizedList' n' ImplicitAlias
-> SizedList' n' SpecificOrDefaultAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (n :: Nat) (n' :: Peano) a.
(SingIPeano n, IsoNatPeano n n') =>
(Natural -> a) -> SizedList n a
SL.generate @n (\Natural
n -> Text -> ImplicitAlias
ImplicitAlias (Text -> ImplicitAlias) -> Text -> ImplicitAlias
forall a b. (a -> b) -> a -> b
$ Text
pfx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Natural -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Natural
n)

-- | Type-safer version of 'signBytes'.
signBinary
  :: (HasCallStack, BytesLike bs, MonadCleveland caps m)
  => bs -> ImplicitAddressWithAlias -> m (TSignature bs)
signBinary :: forall bs caps (m :: * -> *).
(HasCallStack, BytesLike bs, MonadCleveland caps m) =>
bs -> ImplicitAddressWithAlias -> m (TSignature bs)
signBinary bs
bs ImplicitAddressWithAlias
addr = Signature -> TSignature bs
forall a. Signature -> TSignature a
TSignature (Signature -> TSignature bs) -> m Signature -> m (TSignature bs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ImplicitAddressWithAlias -> m Signature
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
ByteString -> ImplicitAddressWithAlias -> m Signature
signBytes (bs -> ByteString
forall bs. BytesLike bs => bs -> ByteString
toBytes bs
bs) ImplicitAddressWithAlias
addr

-- | Import an untyped contract from file.
importUntypedContract :: (HasCallStack, MonadCleveland caps m) => FilePath -> m U.Contract
importUntypedContract :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
FilePath -> m Contract
importUntypedContract = IO Contract -> m Contract
forall caps (m :: * -> *) res.
(HasCallStack, MonadCleveland caps m) =>
IO res -> m res
runIO (IO Contract -> m Contract)
-> (FilePath -> IO Contract) -> FilePath -> m Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Contract
Runtime.importUntypedContract

-- | Import a contract from file.
--
-- The compiler must be able to infer the types of parameter, storage and views.
-- In case there are no views or you don't care, you can use 'Lorentz.noViews'.
importContract
  :: ( HasCallStack, NiceParameter param, NiceStorage st
     , NiceViewsDescriptor vd, DemoteViewsDescriptor vd
     , MonadCleveland caps m
     )
  => FilePath -> m (Contract param st vd)
importContract :: forall param st vd caps (m :: * -> *).
(HasCallStack, NiceParameter param, NiceStorage st,
 NiceViewsDescriptor vd, DemoteViewsDescriptor vd,
 MonadCleveland caps m) =>
FilePath -> m (Contract param st vd)
importContract = IO (Contract param st vd) -> m (Contract param st vd)
forall caps (m :: * -> *) res.
(HasCallStack, MonadCleveland caps m) =>
IO res -> m res
runIO (IO (Contract param st vd) -> m (Contract param st vd))
-> (FilePath -> IO (Contract param st vd))
-> FilePath
-> m (Contract param st vd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Contract param st vd)
forall cp st vd.
(NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd,
 DemoteViewsDescriptor vd) =>
FilePath -> IO (Contract cp st vd)
LorentzImport.importContract

{- | Run operations in a batch.
Best used with the @ApplicativeDo@ GHC extension.

Example:

@
{-# LANGUAGE ApplicativeDo #-}

contract <- inBatch $ do
  contract <- originate ...
  for_ [1..3] \i ->
    transfer ...
  return contract
@

Batched operations should be applied to chain faster, but note that batches have
their own limits. For instance, at the moment of writing, the gas limit on a
batch is 10x of gas limit applied to a single operation.

A context of a batch is only 'Applicative', not 'Monad'. This means that:

* Return values of one function cannot be passed to another function in the same
  batch, it can only be returned;
* Sometimes the compiler does not recognize that only 'Applicative' context is
  required, in case of any issues with that - follow the error messages.

-}
inBatch :: (HasCallStack, MonadCleveland caps m) => ClevelandOpsBatch a -> m a
inBatch :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
ClevelandOpsBatch a -> m a
inBatch ClevelandOpsBatch a
batch = do
  (caps -> ClevelandOpsImpl (ClevelandBaseMonad caps))
-> (ClevelandOpsImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps a)
-> ReaderT caps (ClevelandBaseMonad caps) a
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandOpsImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandOpsImpl (ClevelandBaseMonad caps)
getOpsCap \ClevelandOpsImpl (ClevelandBaseMonad caps)
cap -> ClevelandOpsImpl (ClevelandBaseMonad caps)
-> ClevelandOpsBatch a -> ClevelandBaseMonad caps a
forall (m :: * -> *) a.
(HasCallStack, Functor m) =>
ClevelandOpsImpl m -> ClevelandOpsBatch a -> m a
runBatched ClevelandOpsImpl (ClevelandBaseMonad caps)
cap ClevelandOpsBatch a
batch

-- | Print the given string verbatim as a comment.
-- At the moment, this is a no-op in emulator tests.
comment :: (HasCallStack, MonadCleveland caps m) => Text -> m ()
comment :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Text -> m ()
comment Text
cmt = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps ())
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack => Text -> ClevelandBaseMonad caps ()
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Text -> m ()
cmiComment ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Text
cmt

-- | Get the balance of the given address.
getBalance
  :: (HasCallStack, MonadCleveland caps m, ToL1Address addr)
  => addr -> m Mutez
getBalance :: forall caps (m :: * -> *) addr.
(HasCallStack, MonadCleveland caps m, ToL1Address addr) =>
addr -> m Mutez
getBalance addr
addr = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps Mutez)
-> ReaderT caps (ClevelandBaseMonad caps) Mutez
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack => L1Address -> ClevelandBaseMonad caps Mutez
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => L1Address -> m Mutez
cmiGetBalance ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> L1Address
forall addr. ToL1Address addr => addr -> L1Address
toL1Address addr
addr)

-- | Get the delegate for the given contract/implicit address.
getDelegate
  :: (HasCallStack, MonadCleveland caps m, ToL1Address addr)
  => addr -> m (Maybe KeyHash)
getDelegate :: forall caps (m :: * -> *) addr.
(HasCallStack, MonadCleveland caps m, ToL1Address addr) =>
addr -> m (Maybe KeyHash)
getDelegate addr
addr = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps (Maybe KeyHash))
-> ReaderT caps (ClevelandBaseMonad caps) (Maybe KeyHash)
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   L1Address -> ClevelandBaseMonad caps (Maybe KeyHash)
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetDelegate ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> L1Address
forall addr. ToL1Address addr => addr -> L1Address
toL1Address addr
addr)

-- | Register the given implicit address as a delegate.
registerDelegate
  :: (HasCallStack, MonadCleveland caps m)
  => ImplicitAddressWithAlias -> m ()
registerDelegate :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
ImplicitAddressWithAlias -> m ()
registerDelegate ImplicitAddressWithAlias
addr = do
  caps
caps <- m caps
forall r (m :: * -> *). MonadReader r m => m r
ask
  Either SomeException ()
r <- ClevelandBaseMonad caps (Either SomeException ())
-> ReaderT caps (ClevelandBaseMonad caps) (Either SomeException ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClevelandBaseMonad caps (Either SomeException ())
 -> ReaderT
      caps (ClevelandBaseMonad caps) (Either SomeException ()))
-> ClevelandBaseMonad caps (Either SomeException ())
-> ReaderT caps (ClevelandBaseMonad caps) (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall a e.
   (Exception e, HasCallStack) =>
   ClevelandBaseMonad caps a -> ClevelandBaseMonad caps (Either e a)
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiAttempt (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap caps
caps) (ClevelandBaseMonad caps ()
 -> ClevelandBaseMonad caps (Either SomeException ()))
-> ClevelandBaseMonad caps ()
-> ClevelandBaseMonad caps (Either SomeException ())
forall a b. (a -> b) -> a -> b
$
    ReaderT caps (ClevelandBaseMonad caps) ()
-> caps -> ClevelandBaseMonad caps ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ImplicitAddressWithAlias
-> Maybe KeyHash -> ReaderT caps (ClevelandBaseMonad caps) ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
ImplicitAddressWithAlias -> Maybe KeyHash -> m ()
setDelegate ImplicitAddressWithAlias
addr (Maybe KeyHash -> ReaderT caps (ClevelandBaseMonad caps) ())
-> Maybe KeyHash -> ReaderT caps (ClevelandBaseMonad caps) ()
forall a b. (a -> b) -> a -> b
$ KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just (KeyHash -> Maybe KeyHash) -> KeyHash -> Maybe KeyHash
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> KeyHash
unImplicitAddress (ImplicitAddress -> KeyHash) -> ImplicitAddress -> KeyHash
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress ImplicitAddressWithAlias
addr) caps
caps
  -- NB: we do some exception wrangling such that registerDelegate doesn't error
  -- out if an address is already a delegate. The primary reason for this is the
  -- disconnect between network, which remembers delegation state between
  -- scenarios, and the emulator, which does not. Hence we want registerDelegate
  -- to be idempotent.
  case Either SomeException ()
r of
    Right () -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
    Left SomeException
e
      | Just (UnexpectedRunErrors [RunError
DelegateAlreadyActive]) <- SomeException -> Maybe UnexpectedErrors
forall e. Exception e => SomeException -> Maybe e
fromPossiblyAnnotatedException SomeException
e -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
      | Just (EEFailedToApplyUpdates GStateAlreadySetDelegate{} :: ExecutorError' AddressAndAlias)
        <- SomeException -> Maybe (ExecutorError' AddressAndAlias)
forall e. Exception e => SomeException -> Maybe e
fromPossiblyAnnotatedException SomeException
e
      -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
      | Bool
otherwise -> ClevelandBaseMonad caps ()
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClevelandBaseMonad caps ()
 -> ReaderT caps (ClevelandBaseMonad caps) ())
-> ClevelandBaseMonad caps ()
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall a b. (a -> b) -> a -> b
$ ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall a.
   HasCallStack =>
   SomeException -> ClevelandBaseMonad caps a
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a. HasCallStack => SomeException -> m a
cmiThrow (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap caps
caps) SomeException
e

-- | Set/unset delegate
setDelegate
  :: (HasCallStack, MonadCleveland caps m)
  => ImplicitAddressWithAlias -> Maybe KeyHash -> m ()
setDelegate :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
ImplicitAddressWithAlias -> Maybe KeyHash -> m ()
setDelegate ImplicitAddressWithAlias
addr Maybe KeyHash
kh = m [OperationInfo ClevelandResult] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [OperationInfo ClevelandResult] -> m ())
-> m [OperationInfo ClevelandResult] -> m ()
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias
-> m [OperationInfo ClevelandResult]
-> m [OperationInfo ClevelandResult]
forall caps (m :: * -> *) a.
MonadCleveland caps m =>
ImplicitAddressWithAlias -> m a -> m a
withSender ImplicitAddressWithAlias
addr (m [OperationInfo ClevelandResult]
 -> m [OperationInfo ClevelandResult])
-> m [OperationInfo ClevelandResult]
-> m [OperationInfo ClevelandResult]
forall a b. (a -> b) -> a -> b
$
  (ClevelandOpsImpl m -> m [OperationInfo ClevelandResult])
-> m [OperationInfo ClevelandResult]
forall (m :: * -> *) a.
MonadOpsInternal m =>
(ClevelandOpsImpl m -> m a) -> m a
withOpsCap \ClevelandOpsImpl m
cap -> ClevelandOpsImpl m
-> HasCallStack =>
   [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
   [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch ClevelandOpsImpl m
cap [DelegationInfo ClevelandInput -> OperationInfo ClevelandInput
forall i. DelegationInfo i -> OperationInfo i
OpDelegation Maybe KeyHash
DelegationInfo ClevelandInput
kh]

-- | Retrieve a contract's storage in its "RPC representation"
-- (i.e., all its big_maps will be replaced by big_map IDs).
--
-- If the storage is of a user-defined type, then 'Test.Cleveland.deriveRPC' /
-- 'Test.Cleveland.deriveManyRPC' should be used to create an RPC representation of the storage
-- type.
--
-- > data MyStorage = MyStorage { field1 :: Natural, field2 :: BigMap Integer MText }
-- > deriveRPC "MyStorage"
getStorage
  :: forall st addr caps m.
    (HasCallStack, MonadCleveland caps m, ToStorageType st addr, IsoValue (AsRPC st))
  => addr
  -> m (AsRPC st)
getStorage :: forall st addr caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, ToStorageType st addr,
 IsoValue (AsRPC st)) =>
addr -> m (AsRPC st)
getStorage addr
contract = do
  SomeAnnotatedValue
someSt <- addr -> m SomeAnnotatedValue
forall addr caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, ToContractAddress addr) =>
addr -> m SomeAnnotatedValue
getSomeStorage addr
contract
  case SomeAnnotatedValue
someSt SomeAnnotatedValue
-> Getting (First (AsRPC st)) SomeAnnotatedValue (AsRPC st)
-> Maybe (AsRPC st)
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall v1 v2.
(IsoValue v1, IsoValue v2) =>
Prism
  SomeAnnotatedValue
  SomeAnnotatedValue
  (AnnotatedValue v1)
  (AnnotatedValue v2)
castTo @(AsRPC st) ((AnnotatedValue (AsRPC st)
  -> Const (First (AsRPC st)) (AnnotatedValue (AsRPC st)))
 -> SomeAnnotatedValue
 -> Const (First (AsRPC st)) SomeAnnotatedValue)
-> ((AsRPC st -> Const (First (AsRPC st)) (AsRPC st))
    -> AnnotatedValue (AsRPC st)
    -> Const (First (AsRPC st)) (AnnotatedValue (AsRPC st)))
-> Getting (First (AsRPC st)) SomeAnnotatedValue (AsRPC st)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AsRPC st -> Const (First (AsRPC st)) (AsRPC st))
-> AnnotatedValue (AsRPC st)
-> Const (First (AsRPC st)) (AnnotatedValue (AsRPC st))
forall v. IsoValue v => Lens' (AnnotatedValue v) v
value of
    Just AsRPC st
st -> AsRPC st -> m (AsRPC st)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AsRPC st
st
    Maybe (AsRPC st)
Nothing -> Builder -> m (AsRPC st)
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure (Builder -> m (AsRPC st)) -> Builder -> m (AsRPC st)
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
      [ Builder
"Expected storage to be of type:"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ T -> Builder
forall p. Buildable p => p -> Builder
build (T -> Builder) -> T -> Builder
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @(T.ToT (AsRPC st))
      , Builder
"But its type was:"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ T -> Builder
forall p. Buildable p => p -> Builder
build (T -> Builder) -> T -> Builder
forall a b. (a -> b) -> a -> b
$ SomeAnnotatedValue -> T
getT SomeAnnotatedValue
someSt
      ]

-- | Retrieve a contract's full storage, including the contents of its big_maps.
--
-- This function can only be used in emulator-only tests.
getFullStorage
  :: forall st addr caps m.
    (HasCallStack, MonadEmulated caps m, ToStorageType st addr)
  => addr
  -> m st
getFullStorage :: forall st addr caps (m :: * -> *).
(HasCallStack, MonadEmulated caps m, ToStorageType st addr) =>
addr -> m st
getFullStorage addr
contract = do
  (caps -> EmulatedImpl (ClevelandBaseMonad caps))
-> (EmulatedImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps st)
-> ReaderT caps (ClevelandBaseMonad caps) st
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> EmulatedImpl (ClevelandBaseMonad caps)
forall caps.
HasEmulatedCaps caps =>
caps -> EmulatedImpl (ClevelandBaseMonad caps)
getEmulatedCap \EmulatedImpl (ClevelandBaseMonad caps)
cap -> EmulatedImpl (ClevelandBaseMonad caps)
-> forall st addr.
   (HasCallStack, ToStorageType st addr) =>
   addr -> ClevelandBaseMonad caps st
forall (m :: * -> *).
EmulatedImpl m
-> forall st addr.
   (HasCallStack, ToStorageType st addr) =>
   addr -> m st
eiGetStorage EmulatedImpl (ClevelandBaseMonad caps)
cap addr
contract

-- | Similar to 'getStorage', but doesn't require knowing
-- the storage type in advance.
--
-- Use the optics in 'Morley.Michelson.Typed.AnnotatedValue' to
-- read data from the storage.
getSomeStorage
  :: forall addr caps m.
    (HasCallStack, MonadCleveland caps m, ToContractAddress addr)
  => addr
  -> m SomeAnnotatedValue
getSomeStorage :: forall addr caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, ToContractAddress addr) =>
addr -> m SomeAnnotatedValue
getSomeStorage addr
contract = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps SomeAnnotatedValue)
-> ReaderT caps (ClevelandBaseMonad caps) SomeAnnotatedValue
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   ContractAddress -> ClevelandBaseMonad caps SomeAnnotatedValue
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetSomeStorage ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> ContractAddress
forall addr. ToContractAddress addr => addr -> ContractAddress
toContractAddress addr
contract)

-- | 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.
getBigMapValueMaybe
  :: forall k v caps m.
   ( HasCallStack, MonadCleveland caps m
   , NiceComparable k, NicePackedValue k, NiceUnpackedValue v
   )
  => BigMapId k v -> k -> m (Maybe v)
getBigMapValueMaybe :: forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NicePackedValue k, NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
getBigMapValueMaybe BigMapId k v
bmId k
key = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps (Maybe v))
-> ReaderT caps (ClevelandBaseMonad caps) (Maybe v)
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall k v.
   (HasCallStack, NiceComparable k, NicePackedValue k,
    NiceUnpackedValue v) =>
   BigMapId k v -> k -> ClevelandBaseMonad caps (Maybe v)
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
   (HasCallStack, NiceComparable k, NicePackedValue k,
    NiceUnpackedValue v) =>
   BigMapId k v -> k -> m (Maybe v)
cmiGetBigMapValueMaybe ClevelandMiscImpl (ClevelandBaseMonad caps)
cap BigMapId k v
bmId k
key

-- | Like 'getBigMapValueMaybe', but fails the tests instead of returning 'Nothing'.
getBigMapValue
  :: forall k v caps m.
   ( HasCallStack, MonadCleveland caps m
   , NiceComparable k, NicePackedValue k, NiceUnpackedValue v
   , Buildable k
   )
  => BigMapId k v -> k -> m v
getBigMapValue :: forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NicePackedValue k, NiceUnpackedValue v, Buildable k) =>
BigMapId k v -> k -> m v
getBigMapValue BigMapId k v
bmId k
k =
  BigMapId k v -> k -> m (Maybe v)
forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NicePackedValue k, NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
getBigMapValueMaybe BigMapId k v
bmId k
k m (Maybe v) -> (Maybe v -> m v) -> m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just v
v -> v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v
    Maybe v
Nothing -> Builder -> m v
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure (Builder -> m v) -> Builder -> m v
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF @_ @Builder
      [ Builder
"Either:"
      , Builder
"  1. A big_map with ID '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| BigMapId k v
bmId BigMapId k v -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"' does not exist, or"
      , Builder
"  2. It exists, but does not contain the key '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| k
k k -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"'."
      ]

-- | Retrieve all big_map values, given a big_map ID.
-- Returns 'Nothing' when the big_map ID does not exist.
getAllBigMapValuesMaybe
  :: forall k v caps m.
  ( HasCallStack, MonadCleveland caps m
  , NiceComparable k, NiceUnpackedValue v
  )
  => BigMapId k v -> m (Maybe [v])
getAllBigMapValuesMaybe :: forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
getAllBigMapValuesMaybe BigMapId k v
bmId = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps (Maybe [v]))
-> ReaderT caps (ClevelandBaseMonad caps) (Maybe [v])
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall k v.
   (HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
   BigMapId k v -> ClevelandBaseMonad caps (Maybe [v])
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
   (HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
   BigMapId k v -> m (Maybe [v])
cmiGetAllBigMapValuesMaybe ClevelandMiscImpl (ClevelandBaseMonad caps)
cap BigMapId k v
bmId

-- | Like 'getAllBigMapValuesMaybe', but fails the tests instead of returning 'Nothing'.
getAllBigMapValues
  :: forall k v caps m.
  ( HasCallStack, MonadCleveland caps m
  , NiceComparable k, NiceUnpackedValue v
  )
  => BigMapId k v -> m [v]
getAllBigMapValues :: forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NiceUnpackedValue v) =>
BigMapId k v -> m [v]
getAllBigMapValues BigMapId k v
bmId =
  BigMapId k v -> m (Maybe [v])
forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
getAllBigMapValuesMaybe BigMapId k v
bmId m (Maybe [v]) -> (Maybe [v] -> m [v]) -> m [v]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just [v]
vs -> [v] -> m [v]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v]
vs
    Maybe [v]
Nothing -> Builder -> m [v]
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure (Builder -> m [v]) -> Builder -> m [v]
forall a b. (a -> b) -> a -> b
$ Builder
"A big map with ID '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| BigMapId k v
bmId BigMapId k v -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"' does not exist"

-- | Retrieve a big_map size, given a big_map ID.
-- Returns 'Nothing' when the big_map ID does not exist.
--
-- /O(n)/, because it's implemented with 'Morley.Client.RPC.Getters.getBigMapValues'.
getBigMapSizeMaybe
  :: forall k v caps m.
  ( HasCallStack, MonadCleveland caps m
  , NiceComparable k, NiceUnpackedValue v
  )
  => BigMapId k v -> m (Maybe Natural)
getBigMapSizeMaybe :: forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe Natural)
getBigMapSizeMaybe BigMapId k v
bmId =
    (Maybe [v] -> Maybe Natural) -> m (Maybe [v]) -> m (Maybe Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([v] -> Natural) -> Maybe [v] -> Maybe Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Natural (Int -> Natural) -> ([v] -> Int) -> [v] -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Int
forall t. Container t => t -> Int
length)) (BigMapId k v -> m (Maybe [v])
forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
getAllBigMapValuesMaybe BigMapId k v
bmId)

-- | Like 'getBigMapSizeMaybe', but fails the tests instead of returning 'Nothing'.
getBigMapSize
  :: forall k v caps m.
  ( HasCallStack, MonadCleveland caps m
  , NiceComparable k, NiceUnpackedValue v
  )
  => BigMapId k v -> m Natural
getBigMapSize :: forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NiceUnpackedValue v) =>
BigMapId k v -> m Natural
getBigMapSize BigMapId k v
bmId =
  forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Natural (Int -> Natural) -> ([v] -> Int) -> [v] -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Int
forall t. Container t => t -> Int
length ([v] -> Natural) -> m [v] -> m Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BigMapId k v -> m [v]
forall k v caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceComparable k,
 NiceUnpackedValue v) =>
BigMapId k v -> m [v]
getAllBigMapValues BigMapId k v
bmId

-- | Get the public key associated with given address.
-- Fail if given address is not an implicit account.
getPublicKey :: (HasCallStack, MonadCleveland caps m) => ImplicitAddressWithAlias -> m PublicKey
getPublicKey :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
ImplicitAddressWithAlias -> m PublicKey
getPublicKey ImplicitAddressWithAlias
addr = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps PublicKey)
-> ReaderT caps (ClevelandBaseMonad caps) PublicKey
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   ImplicitAddressWithAlias -> ClevelandBaseMonad caps PublicKey
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetPublicKey ClevelandMiscImpl (ClevelandBaseMonad caps)
cap ImplicitAddressWithAlias
addr

-- | Get the chain's @ChainId@.
getChainId :: (HasCallStack, MonadCleveland caps m) => m ChainId
getChainId :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
m ChainId
getChainId = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps ChainId)
-> ReaderT caps (ClevelandBaseMonad caps) ChainId
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack => ClevelandBaseMonad caps ChainId
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m ChainId
cmiGetChainId ClevelandMiscImpl (ClevelandBaseMonad caps)
cap

-- | 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.
advanceTime
  :: forall unit caps m
  . (HasCallStack, MonadCleveland caps m, KnownDivRat unit Second)
  => Time unit -> m ()
advanceTime :: forall (unit :: Rat) caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, KnownDivRat unit Second) =>
Time unit -> m ()
advanceTime Time unit
time = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps ())
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall (unit :: Rat).
   (HasCallStack, KnownDivRat unit Second) =>
   Time unit -> ClevelandBaseMonad caps ()
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (unit :: Rat).
   (HasCallStack, KnownDivRat unit Second) =>
   Time unit -> m ()
cmiAdvanceTime ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Time unit
time

-- | Wait till the provided number of levels is past.
advanceLevel
  :: forall caps m
  . (HasCallStack, MonadCleveland caps m)
  => Natural -> m ()
advanceLevel :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Natural -> m ()
advanceLevel Natural
l = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps ())
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   (Natural -> Natural) -> ClevelandBaseMonad caps ()
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceToLevel ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
l)

-- | Wait till the provided level is reached.
advanceToLevel
  :: forall caps m
  . (HasCallStack, MonadCleveland caps m)
  => Natural -> m ()
advanceToLevel :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Natural -> m ()
advanceToLevel Natural
target = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps ())
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   (Natural -> Natural) -> ClevelandBaseMonad caps ()
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceToLevel ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (Natural -> Natural -> Natural
forall a b. a -> b -> a
const Natural
target)

-- | Get the timestamp observed by the last block to be baked.
getNow :: (HasCallStack, MonadCleveland caps m) => m Timestamp
getNow :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
m Timestamp
getNow = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps Timestamp)
-> ReaderT caps (ClevelandBaseMonad caps) Timestamp
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack => ClevelandBaseMonad caps Timestamp
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Timestamp
cmiGetNow ClevelandMiscImpl (ClevelandBaseMonad caps)
cap

-- | Get the current level observed by the last block to be baked.
getLevel :: (HasCallStack, MonadCleveland caps m) => m Natural
getLevel :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
m Natural
getLevel = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps Natural)
-> ReaderT caps (ClevelandBaseMonad caps) Natural
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack => ClevelandBaseMonad caps Natural
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Natural
cmiGetLevel ClevelandMiscImpl (ClevelandBaseMonad caps)
cap

-- | Get approximate block interval in seconds. Note, that this value
-- is minimal bound and real intervals can be larger, see
-- http://tezos.gitlab.io/active/consensus.html#minimal-block-delay-function
-- for more information about block delays.
getApproximateBlockInterval :: (HasCallStack, MonadCleveland caps m) => m (Time Second)
getApproximateBlockInterval :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
m (Time Second)
getApproximateBlockInterval = do
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps (Time (1 :% 1)))
-> ReaderT caps (ClevelandBaseMonad caps) (Time (1 :% 1))
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack => ClevelandBaseMonad caps (Time Second)
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m (Time Second)
cmiGetApproximateBlockInterval ClevelandMiscImpl (ClevelandBaseMonad caps)
cap

-- | Get minimal block delay in seconds. This is essentially the same as
-- 'getApproximateBlockInterval', but returns a 'Natural' instead of @Time
-- Second@.
--
-- Can be useful when testing code using @MIN_BLOCK_TIME@ instruction.
getMinBlockTime :: (HasCallStack, MonadCleveland caps m) => m Natural
getMinBlockTime :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
m Natural
getMinBlockTime = forall (unitTo :: Rat) n (unit :: Rat).
(KnownDivRat unit unitTo, Num n) =>
Time unit -> n
toNum @Second (Time (1 :% 1) -> Natural) -> m (Time (1 :% 1)) -> m Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Time (1 :% 1))
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
m (Time Second)
getApproximateBlockInterval

-- | Execute a contract's code without originating it.
-- The chain's state will not be modified.
--
-- Notes:
--
-- * If the contract's code emits operations, they will not be executed.
-- * The sender's account won't be debited.
-- * When running an _originated_ contract, the @BALANCE@ instruction returns the
--   sum of the contract's balance before the transfer operation + the amount of tz being transferred.
--   In other words, this invariant holds: @BALANCE >= AMOUNT@.
--   However, since `runCode` allows overriding the @BALANCE@ instruction,
--   then this invariant no longer holds. It's possible that @BALANCE < AMOUNT@.
runCode
  :: (HasCallStack, MonadCleveland caps m, HasRPCRepr st, IsoValue (AsRPC st))
  => RunCode cp st vd -> m (AsRPC st)
runCode :: forall caps (m :: * -> *) st cp vd.
(HasCallStack, MonadCleveland caps m, HasRPCRepr st,
 IsoValue (AsRPC st)) =>
RunCode cp st vd -> m (AsRPC st)
runCode RunCode cp st vd
rc = do
  Sender
sender <- Getting Sender caps Sender -> m Sender
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Sender caps Sender
forall caps. HasClevelandCaps caps => Lens' caps Sender
senderL
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps (AsRPC st))
-> ReaderT caps (ClevelandBaseMonad caps) (AsRPC st)
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall cp st vd.
   (HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
   Sender -> RunCode cp st vd -> ClevelandBaseMonad caps (AsRPC st)
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall cp st vd.
   (HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
   Sender -> RunCode cp st vd -> m (AsRPC st)
cmiRunCode ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Sender
sender RunCode cp st vd
rc

-- | Execute multiple testing scenarios independently.
--
-- * Actions performed before 'branchout' will be observed by all branches.
-- * Actions performed in branches will _not_ be observed by any actions performed after 'branchout'.
-- * 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.
branchout :: forall caps m. (MonadEmulated caps m) => [(Text, m ())] -> m ()
branchout :: forall caps (m :: * -> *).
MonadEmulated caps m =>
[(Text, m ())] -> m ()
branchout [(Text, m ())]
branches = do
  caps
caps <- m caps
forall r (m :: * -> *). MonadReader r m => m r
ask
  let [(Text, ClevelandBaseMonad caps ())]
branches' :: [(Text, ClevelandBaseMonad caps ())] = (ReaderT caps (ClevelandBaseMonad caps) ()
 -> ClevelandBaseMonad caps ())
-> (Text, ReaderT caps (ClevelandBaseMonad caps) ())
-> (Text, ClevelandBaseMonad caps ())
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((ReaderT caps (ClevelandBaseMonad caps) ()
 -> caps -> ClevelandBaseMonad caps ())
-> caps
-> ReaderT caps (ClevelandBaseMonad caps) ()
-> ClevelandBaseMonad caps ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT caps (ClevelandBaseMonad caps) ()
-> caps -> ClevelandBaseMonad caps ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT caps
caps) ((Text, ReaderT caps (ClevelandBaseMonad caps) ())
 -> (Text, ClevelandBaseMonad caps ()))
-> [(Text, ReaderT caps (ClevelandBaseMonad caps) ())]
-> [(Text, ClevelandBaseMonad caps ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, m ())]
[(Text, ReaderT caps (ClevelandBaseMonad caps) ())]
branches
  ClevelandBaseMonad caps ()
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClevelandBaseMonad caps ()
 -> ReaderT caps (ClevelandBaseMonad caps) ())
-> ClevelandBaseMonad caps ()
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall a b. (a -> b) -> a -> b
$ EmulatedImpl (ClevelandBaseMonad caps)
-> [(Text, ClevelandBaseMonad caps ())]
-> ClevelandBaseMonad caps ()
forall (m :: * -> *). EmulatedImpl m -> [(Text, m ())] -> m ()
eiBranchout (caps -> EmulatedImpl (ClevelandBaseMonad caps)
forall caps.
HasEmulatedCaps caps =>
caps -> EmulatedImpl (ClevelandBaseMonad caps)
getEmulatedCap caps
caps) [(Text, ClevelandBaseMonad caps ())]
branches'

-- | Execute one or more actions and roll them back afterwards.
-- Actions performed in 'offshoot' will _not_ be observed by any
-- actions performed after 'offshoot'.
--
-- Similar to 'branchout', but accepts one single branch.
offshoot :: forall caps m. MonadEmulated caps m => Text -> m () -> m ()
offshoot :: forall caps (m :: * -> *).
MonadEmulated caps m =>
Text -> m () -> m ()
offshoot Text
branchName m ()
branch = [(Text, m ())] -> m ()
forall caps (m :: * -> *).
MonadEmulated caps m =>
[(Text, m ())] -> m ()
branchout [(Text
branchName, m ()
branch)]

{- | Returns the result of the action with the logs it produced. Logs are messages
printed by the Lorentz instruction 'Lorentz.printComment'.

This function can be combined either with lens-based accessors or helper functions to get
more specific information about logs.

Examples:

@
(logsInfo, _) <- getMorleyLogs scenario
logsInfo ^.. each . logsL @== [MorleyLogs ["log"], MorleyLogs ["log2"]]
logsInfo ^.. each . filterLogsByAddrL addr @== [MorleyLogs ["log"]]
@

@
(logsInfo, _) <- getMorleyLogs scenario
collectLogs logsInfo @== MorleyLogs ["log", "log2"]
logsForAddress logsInfo @== [MorleyLogs ["log"]]
@

-}
getMorleyLogs :: forall a caps m. MonadEmulated caps m => m a -> m (LogsInfo, a)
getMorleyLogs :: forall a caps (m :: * -> *).
MonadEmulated caps m =>
m a -> m (LogsInfo, a)
getMorleyLogs m a
action = do
  caps
caps <- m caps
forall r (m :: * -> *). MonadReader r m => m r
ask
  let ClevelandBaseMonad caps a
action' :: ClevelandBaseMonad caps a = ReaderT caps (ClevelandBaseMonad caps) a
-> caps -> ClevelandBaseMonad caps a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT m a
ReaderT caps (ClevelandBaseMonad caps) a
action caps
caps
  ClevelandBaseMonad caps (LogsInfo, a)
-> ReaderT caps (ClevelandBaseMonad caps) (LogsInfo, a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClevelandBaseMonad caps (LogsInfo, a)
 -> ReaderT caps (ClevelandBaseMonad caps) (LogsInfo, a))
-> ClevelandBaseMonad caps (LogsInfo, a)
-> ReaderT caps (ClevelandBaseMonad caps) (LogsInfo, a)
forall a b. (a -> b) -> a -> b
$ EmulatedImpl (ClevelandBaseMonad caps)
-> forall a.
   ClevelandBaseMonad caps a -> ClevelandBaseMonad caps (LogsInfo, a)
forall (m :: * -> *).
EmulatedImpl m -> forall a. m a -> m (LogsInfo, a)
eiGetMorleyLogs (caps -> EmulatedImpl (ClevelandBaseMonad caps)
forall caps.
HasEmulatedCaps caps =>
caps -> EmulatedImpl (ClevelandBaseMonad caps)
getEmulatedCap caps
caps) ClevelandBaseMonad caps a
action'

-- | Version of `getMorleyLogs` for actions that don't return a result.
getMorleyLogs_ :: MonadEmulated caps m => m () -> m LogsInfo
getMorleyLogs_ :: forall caps (m :: * -> *).
MonadEmulated caps m =>
m () -> m LogsInfo
getMorleyLogs_ m ()
action = (LogsInfo, ()) -> LogsInfo
forall a b. (a, b) -> a
fst ((LogsInfo, ()) -> LogsInfo) -> m (LogsInfo, ()) -> m LogsInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m () -> m (LogsInfo, ())
forall a caps (m :: * -> *).
MonadEmulated caps m =>
m a -> m (LogsInfo, a)
getMorleyLogs m ()
action

-- | Updates voting power accessible via @VOTING_POWER@ and similar
-- instructions.
setVotingPowers :: MonadEmulated caps m => VotingPowers -> m ()
setVotingPowers :: forall caps (m :: * -> *).
MonadEmulated caps m =>
VotingPowers -> m ()
setVotingPowers VotingPowers
vp = do
  (caps -> EmulatedImpl (ClevelandBaseMonad caps))
-> (EmulatedImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps ())
-> ReaderT caps (ClevelandBaseMonad caps) ()
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> EmulatedImpl (ClevelandBaseMonad caps)
forall caps.
HasEmulatedCaps caps =>
caps -> EmulatedImpl (ClevelandBaseMonad caps)
getEmulatedCap \EmulatedImpl (ClevelandBaseMonad caps)
cap -> EmulatedImpl (ClevelandBaseMonad caps)
-> VotingPowers -> ClevelandBaseMonad caps ()
forall (m :: * -> *). EmulatedImpl m -> VotingPowers -> m ()
eiSetVotingPowers EmulatedImpl (ClevelandBaseMonad caps)
cap VotingPowers
vp

-- | A helper constraint synonym to make signatures below a bit shorter
type EqBaseMonad a b = ClevelandBaseMonad a ~ ClevelandBaseMonad b

-- | Perform an action if we are currently in emulation mode.
-- See also 'ifEmulation' note on constraints.
whenEmulation
  :: MonadCleveland caps m
  => (forall caps1 m1. (EqBaseMonad caps caps1, MonadEmulated caps1 m1) => m1 ())
  -> m ()
whenEmulation :: forall caps (m :: * -> *).
MonadCleveland caps m =>
(forall caps1 (m1 :: * -> *).
 (EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
 m1 ())
-> m ()
whenEmulation forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
m1 ()
action = (forall caps1 (m1 :: * -> *).
 (EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
 m1 ())
-> (forall caps1 (m1 :: * -> *).
    (EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
    m1 ())
-> m ()
forall a caps (m :: * -> *).
MonadCleveland caps m =>
(forall caps1 (m1 :: * -> *).
 (EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
 m1 a)
-> (forall caps1 (m1 :: * -> *).
    (EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
    m1 a)
-> m a
ifEmulation forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
m1 ()
action forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
m1 ()
forall (f :: * -> *). Applicative f => f ()
pass

-- | Perform an action if we are currently in network mode.
-- See also 'ifEmulation' note on constraints.
whenNetwork
  :: MonadCleveland caps m
  => (forall caps1 m1. (EqBaseMonad caps caps1, MonadNetwork caps1 m1) => m1 ())
  -> m ()
whenNetwork :: forall caps (m :: * -> *).
MonadCleveland caps m =>
(forall caps1 (m1 :: * -> *).
 (EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
 m1 ())
-> m ()
whenNetwork forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
m1 ()
action = (forall caps1 (m1 :: * -> *).
 (EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
 m1 ())
-> (forall caps1 (m1 :: * -> *).
    (EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
    m1 ())
-> m ()
forall a caps (m :: * -> *).
MonadCleveland caps m =>
(forall caps1 (m1 :: * -> *).
 (EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
 m1 a)
-> (forall caps1 (m1 :: * -> *).
    (EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
    m1 a)
-> m a
ifEmulation forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
m1 ()
forall (f :: * -> *). Applicative f => f ()
pass forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
m1 ()
action

{- | Perform one action if we are currently in emulation mode, another otherwise

Functions passed as the first two arguments are universally quantified over
the outer monad, so if additional constraints are required beyond
'MonadEmulated' or 'MonadCleveland', those constraints have to go on the base
monad, e.g.

@
someFunction :: (MonadCleveland caps m, MonadFail (ClevelandBaseMonad caps)) => m ()
someFunction = whenEmulation do
  Just x <- pure (Just 1 :: Maybe Int) -- this would error without MonadFail
  runIO $ print x
@
-}
ifEmulation
  :: forall a caps m
   . MonadCleveland caps m
  => (forall caps1 m1. (EqBaseMonad caps caps1, MonadEmulated caps1 m1) => m1 a)
  -> (forall caps1 m1. (EqBaseMonad caps caps1, MonadNetwork caps1 m1) => m1 a)
  -> m a
ifEmulation :: forall a caps (m :: * -> *).
MonadCleveland caps m =>
(forall caps1 (m1 :: * -> *).
 (EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
 m1 a)
-> (forall caps1 (m1 :: * -> *).
    (EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
    m1 a)
-> m a
ifEmulation forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
m1 a
onEmu forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
m1 a
onNet = (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad
         caps (Either (EmulatedImpl (ClevelandBaseMonad caps)) NetworkEnv))
-> ReaderT
     caps
     (ClevelandBaseMonad caps)
     (Either (EmulatedImpl (ClevelandBaseMonad caps)) NetworkEnv)
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap ClevelandMiscImpl (ClevelandBaseMonad caps)
-> ClevelandBaseMonad
     caps (Either (EmulatedImpl (ClevelandBaseMonad caps)) NetworkEnv)
forall (m :: * -> *).
ClevelandMiscImpl m -> m (Either (EmulatedImpl m) NetworkEnv)
cmiUnderlyingImpl ReaderT
  caps
  (ClevelandBaseMonad caps)
  (Either (EmulatedImpl (ClevelandBaseMonad caps)) NetworkEnv)
-> (Either (EmulatedImpl (ClevelandBaseMonad caps)) NetworkEnv
    -> ReaderT caps (ClevelandBaseMonad caps) a)
-> ReaderT caps (ClevelandBaseMonad caps) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right NetworkEnv
impl -> (caps -> ClevelandCaps (ClevelandBaseMonad caps))
-> (ClevelandCaps (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps a)
-> ReaderT caps (ClevelandBaseMonad caps) a
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap (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) (ReaderT
  (NetworkCaps (ClevelandBaseMonad caps)) (ClevelandBaseMonad caps) a
-> NetworkCaps (ClevelandBaseMonad caps)
-> ClevelandBaseMonad caps a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  (NetworkCaps (ClevelandBaseMonad caps)) (ClevelandBaseMonad caps) a
forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadNetwork caps1 m1) =>
m1 a
onNet (NetworkCaps (ClevelandBaseMonad caps)
 -> ClevelandBaseMonad caps a)
-> (ClevelandCaps (ClevelandBaseMonad caps)
    -> NetworkCaps (ClevelandBaseMonad caps))
-> ClevelandCaps (ClevelandBaseMonad caps)
-> ClevelandBaseMonad caps a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkEnv
-> ClevelandCaps (ClevelandBaseMonad caps)
-> NetworkCaps (ClevelandBaseMonad caps)
forall (m :: * -> *).
NetworkEnv -> ClevelandCaps m -> NetworkCaps m
NetworkCaps NetworkEnv
impl)
  Left EmulatedImpl (ClevelandBaseMonad caps)
impl -> (caps -> ClevelandCaps (ClevelandBaseMonad caps))
-> (ClevelandCaps (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps a)
-> ReaderT caps (ClevelandBaseMonad caps) a
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap (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) (ReaderT
  (EmulatedCaps (ClevelandBaseMonad caps))
  (ClevelandBaseMonad caps)
  a
-> EmulatedCaps (ClevelandBaseMonad caps)
-> ClevelandBaseMonad caps a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  (EmulatedCaps (ClevelandBaseMonad caps))
  (ClevelandBaseMonad caps)
  a
forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
m1 a
onEmu (EmulatedCaps (ClevelandBaseMonad caps)
 -> ClevelandBaseMonad caps a)
-> (ClevelandCaps (ClevelandBaseMonad caps)
    -> EmulatedCaps (ClevelandBaseMonad caps))
-> ClevelandCaps (ClevelandBaseMonad caps)
-> ClevelandBaseMonad caps a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmulatedImpl (ClevelandBaseMonad caps)
-> ClevelandCaps (ClevelandBaseMonad caps)
-> EmulatedCaps (ClevelandBaseMonad caps)
forall (m :: * -> *).
EmulatedImpl m -> ClevelandCaps m -> EmulatedCaps m
EmulatedCaps EmulatedImpl (ClevelandBaseMonad caps)
impl)

-- | Get a 'MorleyClientEnv' when running a test on network. Useful to run
-- f.ex. @octez-client@ inside a network test.
--
-- This is considered a pretty low-level function, so it's better to avoid it in
-- most cases.
getMorleyClientEnv :: MonadNetwork caps m => m MorleyClientEnv
getMorleyClientEnv :: forall caps (m :: * -> *). MonadNetwork caps m => m MorleyClientEnv
getMorleyClientEnv = (caps -> MorleyClientEnv) -> m MorleyClientEnv
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((caps -> MorleyClientEnv) -> m MorleyClientEnv)
-> (caps -> MorleyClientEnv) -> m MorleyClientEnv
forall a b. (a -> b) -> a -> b
$ NetworkEnv -> MorleyClientEnv
neMorleyClientEnv (NetworkEnv -> MorleyClientEnv)
-> (caps -> NetworkEnv) -> caps -> MorleyClientEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. caps -> NetworkEnv
forall caps. HasNetworkCaps caps => caps -> NetworkEnv
getNetworkEnvCap

-- | Get a 'MorleyOnlyRpcEnv' when running a test on network. Useful to run raw
-- network actions inside a network test.
--
-- This is considered a pretty low-level function, so it's better to avoid it in
-- most cases.
getOnlyRpcEnv :: MonadNetwork caps m => [SecretKey] -> m MorleyOnlyRpcEnv
getOnlyRpcEnv :: forall caps (m :: * -> *).
MonadNetwork caps m =>
[SecretKey] -> m MorleyOnlyRpcEnv
getOnlyRpcEnv [SecretKey]
sks = (caps -> MorleyOnlyRpcEnv) -> m MorleyOnlyRpcEnv
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((caps -> MorleyOnlyRpcEnv) -> m MorleyOnlyRpcEnv)
-> (caps -> MorleyOnlyRpcEnv) -> m MorleyOnlyRpcEnv
forall a b. (a -> b) -> a -> b
$ (NetworkEnv -> [SecretKey] -> MorleyOnlyRpcEnv)
-> [SecretKey] -> NetworkEnv -> MorleyOnlyRpcEnv
forall a b c. (a -> b -> c) -> b -> a -> c
flip NetworkEnv -> [SecretKey] -> MorleyOnlyRpcEnv
mkMorleyOnlyRpcEnvNetwork [SecretKey]
sks (NetworkEnv -> MorleyOnlyRpcEnv)
-> (caps -> NetworkEnv) -> caps -> MorleyOnlyRpcEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. caps -> NetworkEnv
forall caps. HasNetworkCaps caps => caps -> NetworkEnv
getNetworkEnvCap

-- | Import an (unencrypted) secret key as an alias. Can be used to get an
-- implicit address/alias with a specific key or key type. If you don't care
-- about the key or key type, consider using 'newAddress' or 'newAddresses'
-- instead.
importSecretKey
  :: MonadCleveland caps m
  => SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
importSecretKey :: forall caps (m :: * -> *).
MonadCleveland caps m =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
importSecretKey SecretKey
sk SpecificOrDefaultAlias
alias = (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps ImplicitAddressWithAlias)
-> ReaderT caps (ClevelandBaseMonad caps) ImplicitAddressWithAlias
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> HasCallStack =>
   SecretKey
   -> SpecificOrDefaultAlias
   -> ClevelandBaseMonad caps ImplicitAddressWithAlias
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
   SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey ClevelandMiscImpl (ClevelandBaseMonad caps)
cap SecretKey
sk SpecificOrDefaultAlias
alias

-- | Get balance for a particular ticket.
getTicketBalance
  :: ( MonadCleveland caps m, T.HasNoOpToT a, NiceComparable a
     , ToL1Address addr, ToContractAddress contractAddr
     )
  => addr -> contractAddr -> a -> m Natural
getTicketBalance :: forall caps (m :: * -> *) a addr contractAddr.
(MonadCleveland caps m, HasNoOpToT a, NiceComparable a,
 ToL1Address addr, ToContractAddress contractAddr) =>
addr -> contractAddr -> a -> m Natural
getTicketBalance addr
addr contractAddr
tcktr a
val =
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps Natural)
-> ReaderT caps (ClevelandBaseMonad caps) Natural
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap ->
    ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall (t :: T).
   (HasNoOp t, Comparable t) =>
   L1Address
   -> ContractAddress -> Value t -> ClevelandBaseMonad caps Natural
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (t :: T).
   (HasNoOp t, Comparable t) =>
   L1Address -> ContractAddress -> Value t -> m Natural
cmiTicketBalance ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> L1Address
forall addr. ToL1Address addr => addr -> L1Address
toL1Address addr
addr) (contractAddr -> ContractAddress
forall addr. ToContractAddress addr => addr -> ContractAddress
toContractAddress contractAddr
tcktr) (a -> Value (ToT a)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal a
val)

-- | Get balance for all contract's tickets.
getAllTicketBalances :: (MonadCleveland caps m, ToContractAddress addr) => addr -> m [SomeTicket]
getAllTicketBalances :: forall caps (m :: * -> *) addr.
(MonadCleveland caps m, ToContractAddress addr) =>
addr -> m [SomeTicket]
getAllTicketBalances addr
addr =
  (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
    -> ClevelandBaseMonad caps [SomeTicket])
-> ReaderT caps (ClevelandBaseMonad caps) [SomeTicket]
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> ContractAddress -> ClevelandBaseMonad caps [SomeTicket]
forall (m :: * -> *).
ClevelandMiscImpl m -> ContractAddress -> m [SomeTicket]
cmiAllTicketBalances ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> ContractAddress
forall addr. ToContractAddress addr => addr -> ContractAddress
toContractAddress addr
addr)