module Test.Cleveland.Internal.Actions
( MonadOps(..)
, withSender
, withMoneybag
, runIO
, resolveAddress
, refillable
, newAddress
, newFreshAddress
, enumAliasHints
, signBytes
, signBinary
, originate
, originateSimple
, originateUntyped
, originateUntypedSimple
, originateTypedSimple
, originateLarge
, originateLargeSimple
, originateLargeUntyped
, originateLargeUntypedSimple
, transfer
, transferMoney
, call
, inBatch
, importUntypedContract
, importContract
, noViews
, comment
, getBalance
, getStorage
, getFullStorage
, getSomeStorage
, getAllBigMapValues
, getAllBigMapValuesMaybe
, getBigMapSize
, getBigMapSizeMaybe
, getBigMapValueMaybe
, getBigMapValue
, getMorleyLogs
, getMorleyLogs_
, getPublicKey
, getChainId
, advanceTime
, advanceLevel
, advanceToLevel
, getNow
, getLevel
, getApproximateBlockInterval
, runCode
, branchout
, offshoot
, getDelegate
, registerDelegate
, setVotingPowers
, whenEmulation
, whenNetwork
, ifEmulation
, failure
, assert
, (@==)
, (@/=)
, (@@==)
, (@@/=)
, checkCompares
, checkComparesWith
, evalJust
, evalRight
, attempt
, catchTransferFailure
, checkTransferFailure
, expectTransferFailure
, expectFailedWith
, expectError
, expectCustomError
, expectCustomError_
, expectCustomErrorNoArg
, expectNumericError
, clarifyErrors
, TransferFailurePredicate(..)
, shiftOverflow
, emptyTransaction
, badParameter
, gasExhaustion
, failedWith
, addressIs
, constant
, lerror
, customError
, customError_
, customErrorNoArg
, numericError
, withCap
) where
import Data.Constraint (Dict(Dict), (\\))
import Data.Either.Validation (Validation(..))
import Data.List.NonEmpty qualified as NE
import Data.Singletons (demote)
import Fmt (Buildable, Builder, build, indentF, nameF, pretty, unlinesF, (+|), (|+))
import Time (KnownDivRat, Second, Time)
import Unsafe qualified (fromIntegral)
import Lorentz
(BigMapId, Contract(..), CustomError(..), DemoteViewsDescriptor, ErrorTagMap,
HasEntrypointArg(useHasEntrypointArg), IsError, IsoValue, Label, MText, MustHaveErrorArg,
ToTAddress, errorTagToMText, errorToVal, errorToValNumeric, noViews, pattern DefEpName,
toMichelsonContract, toTAddress, toVal, zeroMutez)
import Lorentz.Bytes
import Lorentz.Constraints
import Morley.AsRPC (HasRPCRepr(..))
import Morley.Client (OperationInfo(..))
import Morley.Micheline (Expression, FromExpression(..), toExpression)
import Morley.Michelson.Printer.Util (buildRenderDoc)
import Morley.Michelson.Runtime (VotingPowers)
import Morley.Michelson.Runtime.Import qualified as Runtime
import Morley.Michelson.Typed
(SomeAnnotatedValue, SomeConstant, SomeConstrainedValue(..), convertContract, untypeValue)
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 (Address)
import Morley.Tezos.Core (ChainId, Mutez, Timestamp)
import Morley.Tezos.Crypto (KeyHash, PublicKey, Signature)
import Morley.Util.SizedList qualified as SL
import Morley.Util.SizedList.Types
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Client qualified as Client (TestError(..))
import Test.Cleveland.Internal.Exceptions (WithCallStack(..))
import Test.Cleveland.Internal.Pure as Pure (TestError(..))
import Test.Cleveland.Lorentz.Import qualified as LorentzImport
import Test.Cleveland.Lorentz.Types
{-# ANN module ("HLint: ignore Avoid lambda using `infix`" :: Text) #-}
class Functor m => MonadOps m where
withOpsCap :: (ClevelandOpsImpl m -> m a) -> m a
instance MonadOps ClevelandOpsBatch where
withOpsCap :: (ClevelandOpsImpl ClevelandOpsBatch -> ClevelandOpsBatch a)
-> ClevelandOpsBatch a
withOpsCap ClevelandOpsImpl ClevelandOpsBatch -> ClevelandOpsBatch a
mkAction = ClevelandOpsImpl ClevelandOpsBatch -> ClevelandOpsBatch a
mkAction ClevelandOpsImpl ClevelandOpsBatch
batchedOpsImpl
instance (HasClevelandCaps caps, ClevelandBaseMonad caps ~ m) => MonadOps (ReaderT caps m) where
withOpsCap :: (ClevelandOpsImpl (ReaderT caps m) -> ReaderT caps m a)
-> ReaderT caps m a
withOpsCap ClevelandOpsImpl (ReaderT caps m) -> ReaderT caps m a
mkAction = do
ClevelandOpsImpl m
opsCap :: ClevelandOpsImpl m <- (caps -> ClevelandOpsImpl m) -> ReaderT caps m (ClevelandOpsImpl m)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks caps -> ClevelandOpsImpl m
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandOpsImpl (ClevelandBaseMonad caps)
getOpsCap
let ClevelandOpsImpl (ReaderT caps m)
opsCap' :: ClevelandOpsImpl (ReaderT caps m) =
ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo Result])
-> ClevelandOpsImpl m
ClevelandOpsImpl
{ coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput]
-> ReaderT caps m [OperationInfo Result]
coiRunOperationBatch = m [OperationInfo Result] -> ReaderT caps m [OperationInfo Result]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [OperationInfo Result] -> ReaderT caps m [OperationInfo Result])
-> ([OperationInfo ClevelandInput] -> m [OperationInfo Result])
-> [OperationInfo ClevelandInput]
-> ReaderT caps m [OperationInfo Result]
forall a b c. SuperComposition a b c => a -> b -> c
... ClevelandOpsImpl m
-> HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo Result]
forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo Result]
coiRunOperationBatch ClevelandOpsImpl m
opsCap
}
ClevelandOpsImpl (ReaderT caps m) -> ReaderT caps m a
mkAction ClevelandOpsImpl (ReaderT caps m)
opsCap'
withSender :: MonadCleveland caps m => Address -> m a -> m a
withSender :: Address -> m a -> m a
withSender Address
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 (Address -> Sender
Sender Address
addr))
withMoneybag :: MonadCleveland caps m => Address -> m a -> m a
withMoneybag :: Address -> m a -> m a
withMoneybag Address
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 (Address -> Moneybag
Moneybag Address
addr))
runIO :: (HasCallStack, MonadCleveland caps m) => IO res -> m res
runIO :: 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)
-> IO res -> ClevelandBaseMonad caps res
forall (m :: * -> *).
ClevelandMiscImpl m -> forall res. HasCallStack => IO res -> m res
cmiRunIO ClevelandMiscImpl (ClevelandBaseMonad caps)
cap IO res
io
resolveAddress
:: (HasCallStack, MonadCleveland caps m)
=> AliasHint -> m Address
resolveAddress :: AliasHint -> m Address
resolveAddress AliasHint
alias = do
(caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
-> ClevelandBaseMonad caps Address)
-> ReaderT caps (ClevelandBaseMonad caps) Address
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)
-> AliasHint -> ClevelandBaseMonad caps Address
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => AliasHint -> m Address
cmiResolveAddress ClevelandMiscImpl (ClevelandBaseMonad caps)
cap AliasHint
alias
refillable :: MonadCleveland caps m => m Address -> m Address
refillable :: m Address -> m Address
refillable m Address
action = do
Address
addr <- m Address
action
(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)
-> Address -> ClevelandBaseMonad caps ()
forall (m :: * -> *). ClevelandMiscImpl m -> Address -> m ()
cmiMarkAddressRefillable ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Address
addr
pure Address
addr
newAddress :: (HasCallStack, MonadCleveland caps m) => SpecificOrDefaultAliasHint -> m Address
newAddress :: SpecificOrDefaultAliasHint -> m Address
newAddress SpecificOrDefaultAliasHint
alias = do
Address
addr <- (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
-> ClevelandBaseMonad caps Address)
-> ReaderT caps (ClevelandBaseMonad caps) Address
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)
-> SpecificOrDefaultAliasHint -> ClevelandBaseMonad caps Address
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => SpecificOrDefaultAliasHint -> m Address
cmiGenKey ClevelandMiscImpl (ClevelandBaseMonad caps)
cap SpecificOrDefaultAliasHint
alias
Moneybag Address
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
Mutez
balance <- Address -> m Mutez
forall caps (m :: * -> *) addr.
(HasCallStack, MonadCleveland caps m, ToAddress addr) =>
addr -> m Mutez
getBalance Address
addr
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Mutez
balance Mutez -> Mutez -> Bool
forall a. Ord a => a -> a -> Bool
< Mutez
0.5_e6) do
Address -> m () -> m ()
forall caps (m :: * -> *) a.
MonadCleveland caps m =>
Address -> m a -> m a
withSender Address
moneybag do
Address -> Mutez -> m ()
forall (m :: * -> *) addr.
(HasCallStack, MonadOps m, ToAddress addr) =>
addr -> Mutez -> m ()
transferMoney Address
addr Mutez
0.9_e6
pure Address
addr
newFreshAddress :: (HasCallStack, MonadCleveland caps m) => SpecificOrDefaultAliasHint -> m Address
newFreshAddress :: SpecificOrDefaultAliasHint -> m Address
newFreshAddress SpecificOrDefaultAliasHint
aliasHint = do
(caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
-> ClevelandBaseMonad caps Address)
-> ReaderT caps (ClevelandBaseMonad caps) Address
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)
-> SpecificOrDefaultAliasHint -> ClevelandBaseMonad caps Address
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => SpecificOrDefaultAliasHint -> m Address
cmiGenFreshKey ClevelandMiscImpl (ClevelandBaseMonad caps)
cap SpecificOrDefaultAliasHint
aliasHint
signBytes :: (HasCallStack, MonadCleveland caps m) => ByteString -> Address -> m Signature
signBytes :: ByteString -> Address -> m Signature
signBytes ByteString
bytes Address
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)
-> ByteString -> Address -> ClevelandBaseMonad caps Signature
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ByteString -> Address -> m Signature
cmiSignBytes ClevelandMiscImpl (ClevelandBaseMonad caps)
cap ByteString
bytes Address
signer
enumAliasHints
:: forall n n'.
(SingIPeano n, IsoNatPeano n n')
=> AliasHint -> SizedList n SpecificOrDefaultAliasHint
enumAliasHints :: AliasHint -> SizedList n SpecificOrDefaultAliasHint
enumAliasHints AliasHint
pfx = AliasHint -> SpecificOrDefaultAliasHint
SpecificAliasHint (AliasHint -> SpecificOrDefaultAliasHint)
-> SizedList' n' AliasHint
-> SizedList' n' SpecificOrDefaultAliasHint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural -> AliasHint) -> SizedList n AliasHint
forall (n :: Nat) (n' :: Peano) a.
(SingIPeano n, IsoNatPeano n n') =>
(Natural -> a) -> SizedList n a
SL.generate @n (\Natural
n -> AliasHint
pfx AliasHint -> AliasHint -> AliasHint
forall a. Semigroup a => a -> a -> a
<> AliasHint
"-" AliasHint -> AliasHint -> AliasHint
forall a. Semigroup a => a -> a -> a
<> Natural -> AliasHint
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Natural
n)
signBinary :: (HasCallStack, BytesLike bs, MonadCleveland caps m) => bs -> Address -> m (TSignature bs)
signBinary :: bs -> Address -> m (TSignature bs)
signBinary bs
bs Address
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 -> Address -> m Signature
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
ByteString -> Address -> m Signature
signBytes (bs -> ByteString
forall bs. BytesLike bs => bs -> ByteString
toBytes bs
bs) Address
addr
originateUntyped :: (HasCallStack, MonadOps m) => UntypedOriginateData -> m Address
originateUntyped :: UntypedOriginateData -> m Address
originateUntyped UntypedOriginateData
uod = (ClevelandOpsImpl m -> m Address) -> m Address
forall (m :: * -> *) a.
MonadOps m =>
(ClevelandOpsImpl m -> m a) -> m a
withOpsCap \ClevelandOpsImpl m
opsCap ->
ClevelandOpsImpl m
-> Text
-> OperationInfo ClevelandInput
-> (OperationInfo Result -> Maybe Address)
-> m Address
forall (m :: * -> *) a.
(HasCallStack, Functor m) =>
ClevelandOpsImpl m
-> Text
-> OperationInfo ClevelandInput
-> (OperationInfo Result -> Maybe a)
-> m a
runSingleOperation ClevelandOpsImpl m
opsCap Text
"origination" (OriginationInfo ClevelandInput -> OperationInfo ClevelandInput
forall i. OriginationInfo i -> OperationInfo i
OpOriginate OriginationInfo ClevelandInput
UntypedOriginateData
uod) \case
OpOriginate OriginationInfo Result
addr -> Address -> Maybe Address
forall a. a -> Maybe a
Just Address
OriginationInfo Result
addr
OperationInfo Result
_ -> Maybe Address
forall a. Maybe a
Nothing
originateUntypedSimple
:: (HasCallStack, MonadOps m) => AliasHint -> U.Value -> U.Contract -> m Address
originateUntypedSimple :: AliasHint -> Value -> Contract -> m Address
originateUntypedSimple AliasHint
uodName Value
uodStorage Contract
uodContract = do
let uodBalance :: Mutez
uodBalance = Mutez
zeroMutez
UntypedOriginateData -> m Address
forall (m :: * -> *).
(HasCallStack, MonadOps m) =>
UntypedOriginateData -> m Address
originateUntyped UntypedOriginateData :: AliasHint -> Mutez -> Value -> Contract -> UntypedOriginateData
UntypedOriginateData{Mutez
Value
Contract
AliasHint
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: AliasHint
uodBalance :: Mutez
uodContract :: Contract
uodStorage :: Value
uodName :: AliasHint
..}
originate
:: forall cp st vd m.
(HasCallStack, MonadOps m)
=> OriginateData cp st vd -> m (ContractHandle cp st vd)
originate :: OriginateData cp st vd -> m (ContractHandle cp st vd)
originate dat :: OriginateData cp st vd
dat@OriginateData{ odContract :: forall param st vd.
OriginateData param st vd -> Contract param st vd
odContract = Contract{}, st
Mutez
AliasHint
odStorage :: forall param st vd. OriginateData param st vd -> st
odBalance :: forall param st vd. OriginateData param st vd -> Mutez
odName :: forall param st vd. OriginateData param st vd -> AliasHint
odStorage :: st
odBalance :: Mutez
odName :: AliasHint
.. } = do
Address
addr <- UntypedOriginateData -> m Address
forall (m :: * -> *).
(HasCallStack, MonadOps m) =>
UntypedOriginateData -> m Address
originateUntyped (OriginateData cp st vd -> UntypedOriginateData
forall param st vd.
OriginateData param st vd -> UntypedOriginateData
originateDataToUntyped OriginateData cp st vd
dat)
pure $ Text -> Address -> ContractHandle cp st vd
forall cp st vd.
(NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd) =>
Text -> Address -> ContractHandle cp st vd
ContractHandle (AliasHint -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AliasHint
odName) Address
addr
originateSimple
:: forall cp st vd m.
( HasCallStack
, MonadOps m
)
=> AliasHint
-> st
-> Contract cp st vd
-> m (ContractHandle cp st vd)
originateSimple :: AliasHint -> st -> Contract cp st vd -> m (ContractHandle cp st vd)
originateSimple AliasHint
odName st
odStorage Contract cp st vd
odContract = do
let odBalance :: Mutez
odBalance = Mutez
zeroMutez
OriginateData cp st vd -> m (ContractHandle cp st vd)
forall cp st vd (m :: * -> *).
(HasCallStack, MonadOps m) =>
OriginateData cp st vd -> m (ContractHandle cp st vd)
originate OriginateData :: forall param st vd.
AliasHint
-> Mutez -> st -> Contract param st vd -> OriginateData param st vd
OriginateData{st
Mutez
Contract cp st vd
AliasHint
odBalance :: Mutez
odContract :: Contract cp st vd
odStorage :: st
odName :: AliasHint
odStorage :: st
odBalance :: Mutez
odName :: AliasHint
odContract :: Contract cp st vd
..}
originateTypedSimple
:: forall cp st vd m.
( HasCallStack
, MonadOps m
, NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd
)
=> AliasHint -> st -> T.Contract (T.ToT cp) (T.ToT st) -> m (ContractHandle cp st vd)
originateTypedSimple :: AliasHint
-> st -> Contract (ToT cp) (ToT st) -> m (ContractHandle cp st vd)
originateTypedSimple AliasHint
name st
storage contract :: Contract (ToT cp) (ToT st)
contract@T.Contract{} = do
Address
addr <- AliasHint -> Value -> Contract -> m Address
forall (m :: * -> *).
(HasCallStack, MonadOps m) =>
AliasHint -> Value -> Contract -> m Address
originateUntypedSimple AliasHint
name (st -> Value
forall st. NiceStorage st => st -> Value
untypeHelper st
storage) (Contract (ToT cp) (ToT st) -> Contract
forall (param :: T) (store :: T). Contract param store -> Contract
convertContract Contract (ToT cp) (ToT st)
contract)
pure $ Text -> Address -> ContractHandle cp st vd
forall cp st vd.
(NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd) =>
Text -> Address -> ContractHandle cp st vd
ContractHandle (AliasHint -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AliasHint
name) Address
addr
originateLargeUntyped
:: (HasCallStack, MonadCleveland caps m) => UntypedOriginateData -> m Address
originateLargeUntyped :: UntypedOriginateData -> m Address
originateLargeUntyped UntypedOriginateData
uod = 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 Address)
-> ReaderT caps (ClevelandBaseMonad caps) Address
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)
-> Sender
-> UntypedOriginateData
-> ClevelandBaseMonad caps Address
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => Sender -> UntypedOriginateData -> m Address
cmiOriginateLargeUntyped ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Sender
sender UntypedOriginateData
uod
originateLargeUntypedSimple
:: (HasCallStack, MonadCleveland caps m)
=> AliasHint -> U.Value -> U.Contract -> m Address
originateLargeUntypedSimple :: AliasHint -> Value -> Contract -> m Address
originateLargeUntypedSimple AliasHint
uodName Value
uodStorage Contract
uodContract = do
let uodBalance :: Mutez
uodBalance = Mutez
zeroMutez
UntypedOriginateData -> m Address
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
UntypedOriginateData -> m Address
originateLargeUntyped UntypedOriginateData :: AliasHint -> Mutez -> Value -> Contract -> UntypedOriginateData
UntypedOriginateData{Mutez
Value
Contract
AliasHint
uodBalance :: Mutez
uodContract :: Contract
uodStorage :: Value
uodName :: AliasHint
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: AliasHint
..}
originateLarge
:: forall param st vd m caps.
(HasCallStack, MonadCleveland caps m)
=> OriginateData param st vd -> m (ContractHandle param st vd)
originateLarge :: OriginateData param st vd -> m (ContractHandle param st vd)
originateLarge dat :: OriginateData param st vd
dat@OriginateData{ odContract :: forall param st vd.
OriginateData param st vd -> Contract param st vd
odContract = Contract{}, st
Mutez
AliasHint
odStorage :: st
odBalance :: Mutez
odName :: AliasHint
odStorage :: forall param st vd. OriginateData param st vd -> st
odBalance :: forall param st vd. OriginateData param st vd -> Mutez
odName :: forall param st vd. OriginateData param st vd -> AliasHint
.. } = do
Address
addr <- UntypedOriginateData -> m Address
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
UntypedOriginateData -> m Address
originateLargeUntyped (OriginateData param st vd -> UntypedOriginateData
forall param st vd.
OriginateData param st vd -> UntypedOriginateData
originateDataToUntyped OriginateData param st vd
dat)
pure $ Text -> Address -> ContractHandle param st vd
forall cp st vd.
(NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd) =>
Text -> Address -> ContractHandle cp st vd
ContractHandle (AliasHint -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty AliasHint
odName) Address
addr
originateLargeSimple
:: forall param st vd m caps.
( HasCallStack
, MonadCleveland caps m
)
=> AliasHint
-> st
-> Contract param st vd
-> m (ContractHandle param st vd)
originateLargeSimple :: AliasHint
-> st -> Contract param st vd -> m (ContractHandle param st vd)
originateLargeSimple AliasHint
odName st
odStorage Contract param st vd
odContract = do
let odBalance :: Mutez
odBalance = Mutez
zeroMutez
OriginateData param st vd -> m (ContractHandle param st vd)
forall param st vd (m :: * -> *) caps.
(HasCallStack, MonadCleveland caps m) =>
OriginateData param st vd -> m (ContractHandle param st vd)
originateLarge OriginateData :: forall param st vd.
AliasHint
-> Mutez -> st -> Contract param st vd -> OriginateData param st vd
OriginateData{st
Mutez
Contract param st vd
AliasHint
odBalance :: Mutez
odContract :: Contract param st vd
odStorage :: st
odName :: AliasHint
odStorage :: st
odBalance :: Mutez
odName :: AliasHint
odContract :: Contract param st vd
..}
transfer :: (HasCallStack, MonadOps m) => TransferData -> m ()
transfer :: TransferData -> m ()
transfer TransferData
td = (ClevelandOpsImpl m -> m ()) -> m ()
forall (m :: * -> *) a.
MonadOps m =>
(ClevelandOpsImpl m -> m a) -> m a
withOpsCap \ClevelandOpsImpl m
opsCap ->
ClevelandOpsImpl m
-> Text
-> OperationInfo ClevelandInput
-> (OperationInfo Result -> Maybe ())
-> m ()
forall (m :: * -> *) a.
(HasCallStack, Functor m) =>
ClevelandOpsImpl m
-> Text
-> OperationInfo ClevelandInput
-> (OperationInfo Result -> Maybe a)
-> m a
runSingleOperation ClevelandOpsImpl m
opsCap Text
"transfer" (TransferInfo ClevelandInput -> OperationInfo ClevelandInput
forall i. TransferInfo i -> OperationInfo i
OpTransfer TransferInfo ClevelandInput
TransferData
td) \case
OpTransfer () -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
OperationInfo Result
_ -> Maybe ()
forall a. Maybe a
Nothing
transferMoney :: (HasCallStack, MonadOps m, ToAddress addr) => addr -> Mutez -> m ()
transferMoney :: addr -> Mutez -> m ()
transferMoney addr
to Mutez
amount = TransferData -> m ()
forall (m :: * -> *).
(HasCallStack, MonadOps m) =>
TransferData -> m ()
transfer TransferData :: forall v addr.
(NiceParameter v, ToAddress addr) =>
addr -> Mutez -> EpName -> v -> TransferData
TransferData
{ tdTo :: addr
tdTo = addr
to
, tdAmount :: Mutez
tdAmount = Mutez
amount
, tdEntrypoint :: EpName
tdEntrypoint = EpName
DefEpName
, tdParameter :: ()
tdParameter = ()
}
call
:: forall param vd addr m epRef epArg.
(HasCallStack, MonadOps m, ToTAddress param vd addr, HasEntrypointArg param epRef epArg
, IsoValue epArg, Typeable epArg)
=> addr
-> epRef
-> epArg
-> m ()
call :: addr -> epRef -> epArg -> m ()
call addr
to epRef
epRef epArg
param =
case epRef -> (Dict (ParameterScope (ToT epArg)), EpName)
forall k (cp :: k) name arg.
HasEntrypointArg cp name arg =>
name -> (Dict (ParameterScope (ToT arg)), EpName)
useHasEntrypointArg @param @epRef @epArg epRef
epRef of
(Dict (ParameterScope (ToT epArg))
Dict, EpName
epName) ->
TransferData -> m ()
forall (m :: * -> *).
(HasCallStack, MonadOps m) =>
TransferData -> m ()
transfer TransferData :: forall v addr.
(NiceParameter v, ToAddress addr) =>
addr -> Mutez -> EpName -> v -> TransferData
TransferData
{ tdTo :: Address
tdTo = TAddress param vd -> Address
forall a. ToAddress a => a -> Address
toAddress (TAddress param vd -> Address) -> TAddress param vd -> Address
forall a b. (a -> b) -> a -> b
$ addr -> TAddress param vd
forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
toTAddress @param @vd @addr addr
to
, tdAmount :: Mutez
tdAmount = Mutez
zeroMutez
, tdEntrypoint :: EpName
tdEntrypoint = EpName
epName
, tdParameter :: epArg
tdParameter = epArg
param
}
importUntypedContract :: (HasCallStack, MonadCleveland caps m) => FilePath -> m U.Contract
importUntypedContract :: 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
importContract
:: ( HasCallStack, NiceParameter param, NiceStorage st
, NiceViewsDescriptor vd, DemoteViewsDescriptor vd
, MonadCleveland caps m
)
=> FilePath -> m (Contract param st vd)
importContract :: 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
inBatch :: (HasCallStack, MonadCleveland caps m) => ClevelandOpsBatch a -> m a
inBatch :: 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
comment :: (HasCallStack, MonadCleveland caps m) => Text -> m ()
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)
-> Text -> ClevelandBaseMonad caps ()
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Text -> m ()
cmiComment ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Text
cmt
getBalance :: (HasCallStack, MonadCleveland caps m, ToAddress addr) => addr -> m Mutez
getBalance :: 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)
-> Address -> ClevelandBaseMonad caps Mutez
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Address -> m Mutez
cmiGetBalance ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> Address
forall a. ToAddress a => a -> Address
toAddress addr
addr)
getDelegate :: (HasCallStack, MonadCleveland caps m, ToAddress addr) => addr -> m (Maybe KeyHash)
getDelegate :: 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)
-> Address -> ClevelandBaseMonad caps (Maybe KeyHash)
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Address -> m (Maybe KeyHash)
cmiGetDelegate ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> Address
forall a. ToAddress a => a -> Address
toAddress addr
addr)
registerDelegate :: (HasCallStack, MonadCleveland caps m, ToAddress addr) => addr -> m ()
registerDelegate :: addr -> m ()
registerDelegate addr
addr = 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)
-> Address -> ClevelandBaseMonad caps ()
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Address -> m ()
cmiRegisterDelegate ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> Address
forall a. ToAddress a => a -> Address
toAddress addr
addr)
getStorage
:: forall st addr caps m.
(HasCallStack, MonadCleveland caps m, ToStorageType st addr, IsoValue (AsRPC st))
=> addr
-> m (AsRPC st)
getStorage :: addr -> m (AsRPC st)
getStorage addr
contract = do
SomeAnnotatedValue
someSt <- addr -> m SomeAnnotatedValue
forall addr caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, ToAddress 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 v2.
(IsoValue (AsRPC st), IsoValue v2) =>
Prism
SomeAnnotatedValue
SomeAnnotatedValue
(AnnotatedValue (AsRPC st))
(AnnotatedValue v2)
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
$ (SingKind T, SingI (ToT (AsRPC st))) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
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
]
getFullStorage
:: forall st addr caps m.
(HasCallStack, MonadEmulated caps m, ToStorageType st addr)
=> addr
-> m st
getFullStorage :: 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)
-> 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
getSomeStorage
:: forall addr caps m.
(HasCallStack, MonadCleveland caps m, ToAddress addr)
=> addr
-> m SomeAnnotatedValue
getSomeStorage :: 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)
-> Address -> ClevelandBaseMonad caps SomeAnnotatedValue
forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => Address -> m SomeAnnotatedValue
cmiGetSomeStorage ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (addr -> Address
forall a. ToAddress a => a -> Address
toAddress addr
contract)
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 -> 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)
-> 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
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 -> 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
$ [Builder] -> Builder
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
"'."
]
getAllBigMapValuesMaybe
:: forall k v caps m.
( HasCallStack, MonadCleveland caps m
, NiceComparable k, NiceUnpackedValue v
)
=> BigMapId k v -> m (Maybe [v])
getAllBigMapValuesMaybe :: 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)
-> 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
getAllBigMapValues
:: forall k v caps m.
( HasCallStack, MonadCleveland caps m
, NiceComparable k, NiceUnpackedValue v
)
=> BigMapId k v -> m [v]
getAllBigMapValues :: 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"
getBigMapSizeMaybe
:: forall k v caps m.
( HasCallStack, MonadCleveland caps m
, NiceComparable k, NiceUnpackedValue v
)
=> BigMapId k v -> m (Maybe Natural)
getBigMapSizeMaybe :: 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 ((HasCallStack, Integral Int, Integral Natural) => Int -> Natural
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)
getBigMapSize
:: forall k v caps m.
( HasCallStack, MonadCleveland caps m
, NiceComparable k, NiceUnpackedValue v
)
=> BigMapId k v -> m Natural
getBigMapSize :: BigMapId k v -> m Natural
getBigMapSize BigMapId k v
bmId =
(HasCallStack, Integral Int, Integral Natural) => Int -> Natural
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
getPublicKey :: (HasCallStack, MonadCleveland caps m) => Address -> m PublicKey
getPublicKey :: Address -> m PublicKey
getPublicKey Address
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)
-> Address -> ClevelandBaseMonad caps PublicKey
forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Address -> m PublicKey
cmiGetPublicKey ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Address
addr
getChainId :: (HasCallStack, MonadCleveland caps m) => m ChainId
getChainId :: 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
advanceTime
:: forall unit caps m
. (HasCallStack, MonadCleveland caps m, KnownDivRat unit Second)
=> Time unit -> m ()
advanceTime :: 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)
-> 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
advanceLevel
:: forall caps m
. (HasCallStack, MonadCleveland caps m)
=> Natural -> m ()
advanceLevel :: 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)
-> (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)
advanceToLevel
:: forall caps m
. (HasCallStack, MonadCleveland caps m)
=> Natural -> m ()
advanceToLevel :: 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)
-> (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)
getNow :: (HasCallStack, MonadCleveland caps m) => m Timestamp
getNow :: 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
getLevel :: (HasCallStack, MonadCleveland caps m) => m Natural
getLevel :: 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
getApproximateBlockInterval :: (HasCallStack, MonadCleveland caps m) => m (Time Second)
getApproximateBlockInterval :: 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
runCode
:: (HasCallStack, MonadCleveland caps m, HasRPCRepr st, IsoValue (AsRPC st))
=> RunCode cp st vd -> m (AsRPC st)
runCode :: 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)
-> 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
branchout :: forall caps m. (MonadEmulated caps m) => [(Text, m ())] -> m ()
branchout :: [(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'
offshoot :: forall caps m. MonadEmulated caps m => Text -> m () -> m ()
offshoot :: 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)]
getMorleyLogs :: forall a caps m. MonadEmulated caps m => m a -> m (LogsInfo, a)
getMorleyLogs :: 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)
-> 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'
getMorleyLogs_ :: MonadEmulated caps m => m () -> m LogsInfo
getMorleyLogs_ :: 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
setVotingPowers :: MonadEmulated caps m => VotingPowers -> m ()
setVotingPowers :: 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
type EqBaseMonad a b = ClevelandBaseMonad a ~ ClevelandBaseMonad b
whenEmulation
:: 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 ())
-> 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, MonadCleveland 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, MonadCleveland caps1 m1) =>
m1 a)
-> m a
ifEmulation forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
m1 ()
action forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadCleveland caps1 m1) =>
m1 ()
forall (f :: * -> *). Applicative f => f ()
pass
whenNetwork
:: MonadCleveland caps m
=> (forall caps1 m1. (EqBaseMonad caps caps1, MonadCleveland caps1 m1) => m1 ())
-> m ()
whenNetwork :: (forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadCleveland caps1 m1) =>
m1 ())
-> m ()
whenNetwork forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadCleveland caps1 m1) =>
m1 ()
action = (forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
m1 ())
-> (forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadCleveland 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, MonadCleveland 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, MonadCleveland caps1 m1) =>
m1 ()
action
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, MonadCleveland caps1 m1) => m1 a)
-> m a
ifEmulation :: (forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadEmulated caps1 m1) =>
m1 a)
-> (forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadCleveland 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, MonadCleveland caps1 m1) =>
m1 a
onNet = (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
-> ClevelandBaseMonad
caps (Maybe (EmulatedImpl (ClevelandBaseMonad caps))))
-> ReaderT
caps
(ClevelandBaseMonad caps)
(Maybe (EmulatedImpl (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)
-> ClevelandBaseMonad
caps (Maybe (EmulatedImpl (ClevelandBaseMonad caps)))
forall (m :: * -> *).
ClevelandMiscImpl m -> m (Maybe (EmulatedImpl m))
cmiEmulatedImpl ReaderT
caps
(ClevelandBaseMonad caps)
(Maybe (EmulatedImpl (ClevelandBaseMonad caps)))
-> (Maybe (EmulatedImpl (ClevelandBaseMonad caps))
-> ReaderT caps (ClevelandBaseMonad caps) a)
-> ReaderT caps (ClevelandBaseMonad caps) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (EmulatedImpl (ClevelandBaseMonad caps))
Nothing -> ReaderT caps (ClevelandBaseMonad caps) a
forall caps1 (m1 :: * -> *).
(EqBaseMonad caps caps1, MonadCleveland caps1 m1) =>
m1 a
onNet
Just 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)
failure :: forall a caps m. (HasCallStack, MonadCleveland caps m) => Builder -> m a
failure :: Builder -> m a
failure Builder
msg = do
(caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (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 -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> Builder -> ClevelandBaseMonad caps a
forall (m :: * -> *).
ClevelandMiscImpl m -> forall a. HasCallStack => Builder -> m a
cmiFailure ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Builder
msg
assert :: (HasCallStack, MonadCleveland caps m) => Bool -> Builder -> m ()
assert :: Bool -> Builder -> m ()
assert Bool
b Builder
errMsg =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Builder -> m ()
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure Builder
errMsg
(@==)
:: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
=> a
-> a
-> m ()
a
actual @== :: a -> a -> m ()
@== a
expected =
Bool -> Builder -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Builder -> m ()
assert (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected) (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$
[Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Failed comparison"
, Builder
"━━ Expected (rhs) ━━"
, a -> Builder
forall p. Buildable p => p -> Builder
build a
expected
, Builder
"━━ Got (lhs) ━━"
, a -> Builder
forall p. Buildable p => p -> Builder
build a
actual
]
infix 1 @==
(@/=)
:: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
=> a -> a -> m ()
a
a @/= :: a -> a -> m ()
@/= a
b =
Bool -> Builder -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Builder -> m ()
assert (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
b) (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$
[Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"The two values are equal:"
, a -> Builder
forall p. Buildable p => p -> Builder
build a
a
]
infix 1 @/=
(@@==)
:: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
=> m a
-> a
-> m ()
m a
getActual @@== :: m a -> a -> m ()
@@== a
expected = do
a
actual <- m a
getActual
a
actual a -> a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Eq a, Buildable a) =>
a -> a -> m ()
@== a
expected
infix 1 @@==
(@@/=)
:: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
=> m a -> a -> m ()
m a
getA @@/= :: m a -> a -> m ()
@@/= a
b = do
a
a <- m a
getA
a
a a -> a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Eq a, Buildable a) =>
a -> a -> m ()
@/= a
b
infix 1 @@/=
checkCompares
:: forall a b caps m
. (HasCallStack, MonadCleveland caps m, Buildable a, Buildable b)
=> a
-> (a -> b -> Bool)
-> b
-> m ()
checkCompares :: a -> (a -> b -> Bool) -> b -> m ()
checkCompares a
a a -> b -> Bool
f b
b = (a -> Text) -> a -> (a -> b -> Bool) -> (b -> Text) -> b -> m ()
forall a b caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
(a -> Text) -> a -> (a -> b -> Bool) -> (b -> Text) -> b -> m ()
checkComparesWith a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty a
a a -> b -> Bool
f b -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty b
b
checkComparesWith
:: forall a b caps m
. (HasCallStack, MonadCleveland caps m)
=> (a -> Text)
-> a
-> (a -> b -> Bool)
-> (b -> Text)
-> b
-> m ()
checkComparesWith :: (a -> Text) -> a -> (a -> b -> Bool) -> (b -> Text) -> b -> m ()
checkComparesWith a -> Text
showA a
a a -> b -> Bool
f b -> Text
showB b
b =
Bool -> Builder -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Builder -> m ()
assert (a -> b -> Bool
f a
a b
b) (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Text
"Failed"
, Text
"━━ lhs ━━"
, a -> Text
showA a
a
, Text
"━━ rhs ━━"
, b -> Text
showB b
b
]
evalJust :: (HasCallStack, MonadCleveland caps m) => Builder -> Maybe a -> m a
evalJust :: Builder -> Maybe a -> m a
evalJust Builder
err = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Builder -> m a
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure Builder
err) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
evalRight :: (HasCallStack, MonadCleveland caps m) => (a -> Builder) -> Either a b -> m b
evalRight :: (a -> Builder) -> Either a b -> m b
evalRight a -> Builder
mkErr = (a -> m b) -> (b -> m b) -> Either a b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Builder -> m b
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure (Builder -> m b) -> (a -> Builder) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
mkErr) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
attempt
:: forall e caps m a. (HasCallStack, MonadCleveland caps m, Exception e)
=> m a -> m (Either e a)
attempt :: m a -> m (Either e a)
attempt 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 (Either e a)
-> ReaderT caps (ClevelandBaseMonad caps) (Either e a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClevelandBaseMonad caps (Either e a)
-> ReaderT caps (ClevelandBaseMonad caps) (Either e a))
-> ClevelandBaseMonad caps (Either e a)
-> ReaderT caps (ClevelandBaseMonad caps) (Either e a)
forall a b. (a -> b) -> a -> b
$ ClevelandMiscImpl (ClevelandBaseMonad caps)
-> 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 a
action'
catchTransferFailure :: (HasCallStack, MonadCleveland caps m) => m a -> m TransferFailure
catchTransferFailure :: m a -> m TransferFailure
catchTransferFailure m a
action =
m a -> m (Either TransferFailure a)
forall e caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Exception e) =>
m a -> m (Either e a)
attempt m a
action m (Either TransferFailure a)
-> (Either TransferFailure a -> m TransferFailure)
-> m TransferFailure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left TransferFailure
err -> TransferFailure -> m TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return TransferFailure
err
Right a
_ -> IO TransferFailure -> m TransferFailure
forall caps (m :: * -> *) res.
(HasCallStack, MonadCleveland caps m) =>
IO res -> m res
runIO (IO TransferFailure -> m TransferFailure)
-> IO TransferFailure -> m TransferFailure
forall a b. (a -> b) -> a -> b
$ GenericTestError -> IO TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM GenericTestError
UnexpectedSuccess
expectTransferFailure :: (HasCallStack, MonadCleveland caps m) => TransferFailurePredicate -> m a -> m ()
expectTransferFailure :: TransferFailurePredicate -> m a -> m ()
expectTransferFailure TransferFailurePredicate
predicate m a
act = do
TransferFailure
err <- m a -> m TransferFailure
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
m a -> m TransferFailure
catchTransferFailure m a
act
TransferFailure -> TransferFailurePredicate -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
TransferFailure -> TransferFailurePredicate -> m ()
checkTransferFailure TransferFailure
err TransferFailurePredicate
predicate
checkTransferFailure :: (HasCallStack, MonadCleveland caps m) => TransferFailure -> TransferFailurePredicate -> m ()
checkTransferFailure :: TransferFailure -> TransferFailurePredicate -> m ()
checkTransferFailure TransferFailure
err TransferFailurePredicate
predicate =
case TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go TransferFailurePredicate
predicate of
Success () -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
Failure NonEmpty Builder
expectedOutcome -> Builder -> m ()
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Expected transfer to fail with an error such that:"
, Builder
""
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ NonEmpty Builder -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF NonEmpty Builder
expectedOutcome
, Builder
""
, Builder
"But these conditions were not met."
, Builder
"Actual transfer error:"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ TransferFailure -> Builder
forall p. Buildable p => p -> Builder
build TransferFailure
err
]
where
go :: TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go :: TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go = \case
AndPredicate NonEmpty TransferFailurePredicate
ps ->
(NonEmpty Builder -> NonEmpty Builder)
-> Validation (NonEmpty Builder) ()
-> Validation (NonEmpty Builder) ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Builder -> NonEmpty Builder -> NonEmpty Builder
fmtExpectedOutcomes Builder
"AND") ((Element (NonEmpty TransferFailurePredicate)
-> Validation (NonEmpty Builder) ())
-> NonEmpty TransferFailurePredicate
-> Validation (NonEmpty Builder) ()
forall t (f :: * -> *) b.
(Container t, Applicative f) =>
(Element t -> f b) -> t -> f ()
traverse_ Element (NonEmpty TransferFailurePredicate)
-> Validation (NonEmpty Builder) ()
TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go NonEmpty TransferFailurePredicate
ps)
OrPredicate NonEmpty TransferFailurePredicate
ps ->
case (Element (NonEmpty TransferFailurePredicate)
-> Validation (NonEmpty Builder) ())
-> NonEmpty TransferFailurePredicate
-> Validation (NonEmpty Builder) ()
forall t (f :: * -> *) b.
(Container t, Applicative f) =>
(Element t -> f b) -> t -> f ()
traverse_ Element (NonEmpty TransferFailurePredicate)
-> Validation (NonEmpty Builder) ()
TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go NonEmpty TransferFailurePredicate
ps of
Success () -> () -> Validation (NonEmpty Builder) ()
forall e a. a -> Validation e a
Success ()
Failure NonEmpty Builder
expectedOutcomes ->
if NonEmpty Builder -> Int
forall t. Container t => t -> Int
length NonEmpty Builder
expectedOutcomes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty TransferFailurePredicate -> Int
forall t. Container t => t -> Int
length NonEmpty TransferFailurePredicate
ps
then NonEmpty Builder -> Validation (NonEmpty Builder) ()
forall e a. e -> Validation e a
Failure (NonEmpty Builder -> Validation (NonEmpty Builder) ())
-> NonEmpty Builder -> Validation (NonEmpty Builder) ()
forall a b. (a -> b) -> a -> b
$ Builder -> NonEmpty Builder -> NonEmpty Builder
fmtExpectedOutcomes Builder
"OR" NonEmpty Builder
expectedOutcomes
else () -> Validation (NonEmpty Builder) ()
forall e a. a -> Validation e a
Success ()
TransferFailurePredicate TransferFailure -> Validation Builder ()
p -> (Builder -> NonEmpty Builder)
-> Validation Builder () -> Validation (NonEmpty Builder) ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Builder -> NonEmpty Builder
forall x. One x => OneItem x -> x
one (Validation Builder () -> Validation (NonEmpty Builder) ())
-> Validation Builder () -> Validation (NonEmpty Builder) ()
forall a b. (a -> b) -> a -> b
$ TransferFailure -> Validation Builder ()
p TransferFailure
err
fmtExpectedOutcomes :: Builder -> NonEmpty Builder -> NonEmpty Builder
fmtExpectedOutcomes :: Builder -> NonEmpty Builder -> NonEmpty Builder
fmtExpectedOutcomes Builder
delimiter = \case
Builder
expectedOutcome :| [] -> OneItem (NonEmpty Builder) -> NonEmpty Builder
forall x. One x => OneItem x -> x
one Builder
OneItem (NonEmpty Builder)
expectedOutcome
NonEmpty Builder
expectedOutcomes ->
OneItem (NonEmpty Builder) -> NonEmpty Builder
forall x. One x => OneItem x -> x
one (OneItem (NonEmpty Builder) -> NonEmpty Builder)
-> OneItem (NonEmpty Builder) -> NonEmpty Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"("
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ NonEmpty Builder -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF (NonEmpty Builder -> Builder) -> NonEmpty Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> NonEmpty Builder -> NonEmpty Builder
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse Builder
delimiter NonEmpty Builder
expectedOutcomes
, Builder
")"
]
expectFailedWith
:: forall err a caps m
. (HasCallStack, MonadCleveland caps m, NiceConstant err)
=> err -> m a -> m ()
expectFailedWith :: err -> m a -> m ()
expectFailedWith err
err = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (err -> SomeConstant
forall err. NiceConstant err => err -> SomeConstant
constant err
err)
expectError
:: forall err a caps m
. (HasCallStack, MonadCleveland caps m, IsError err)
=> err -> m a -> m ()
expectError :: err -> m a -> m ()
expectError err
err = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (err -> SomeConstant
forall err. IsError err => err -> SomeConstant
lerror err
err)
expectCustomError
:: forall arg a tag caps m
. ( HasCallStack, MonadCleveland caps m
, IsError (CustomError tag)
, MustHaveErrorArg tag (MText, arg)
)
=> Label tag -> arg -> m a -> m ()
expectCustomError :: Label tag -> arg -> m a -> m ()
expectCustomError Label tag
tag arg
arg = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (Label tag -> arg -> SomeConstant
forall arg (tag :: Symbol).
(IsError (CustomError tag), MustHaveErrorArg tag (MText, arg)) =>
Label tag -> arg -> SomeConstant
customError Label tag
tag arg
arg)
expectCustomError_
:: ( HasCallStack, MonadCleveland caps m
, IsError (CustomError tag)
, MustHaveErrorArg tag (MText, ())
)
=> Label tag -> m a -> m ()
expectCustomError_ :: Label tag -> m a -> m ()
expectCustomError_ Label tag
tag = Label tag -> () -> m a -> m ()
forall arg a (tag :: Symbol) caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, IsError (CustomError tag),
MustHaveErrorArg tag (MText, arg)) =>
Label tag -> arg -> m a -> m ()
expectCustomError Label tag
tag ()
expectCustomErrorNoArg
:: ( HasCallStack, MonadCleveland caps m
, IsError (CustomError tag)
, MustHaveErrorArg tag MText
)
=> Label tag -> m a -> m ()
expectCustomErrorNoArg :: Label tag -> m a -> m ()
expectCustomErrorNoArg Label tag
tag = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (Label tag -> SomeConstant
forall (tag :: Symbol).
(IsError (CustomError tag), MustHaveErrorArg tag MText) =>
Label tag -> SomeConstant
customErrorNoArg Label tag
tag)
expectNumericError
:: forall err a caps m
. (HasCallStack, MonadCleveland caps m, IsError err)
=> ErrorTagMap -> err -> m a -> m ()
expectNumericError :: ErrorTagMap -> err -> m a -> m ()
expectNumericError ErrorTagMap
tagMap err
err = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (ErrorTagMap -> err -> SomeConstant
forall err. IsError err => ErrorTagMap -> err -> SomeConstant
numericError ErrorTagMap
tagMap err
err)
clarifyErrors :: forall caps m a. (MonadCleveland caps m)
=> Builder -> m a -> m a
clarifyErrors :: Builder -> m a -> m a
clarifyErrors Builder
message m a
action = do
m a -> m (Either SomeException a)
forall e caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Exception e) =>
m a -> m (Either e a)
attempt m a
action m (Either SomeException a)
-> (Either SomeException a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (SomeException
e :: SomeException) -> (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (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 -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> SomeException -> ClevelandBaseMonad caps a
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a. HasCallStack => SomeException -> m a
cmiThrow ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (SomeException -> SomeException
handle SomeException
e)
Right a
val -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
where
handle :: SomeException -> SomeException
handle :: SomeException -> SomeException
handle SomeException
e = SomeException -> Maybe SomeException -> SomeException
forall a. a -> Maybe a -> a
fromMaybe SomeException
e (Maybe SomeException -> SomeException)
-> Maybe SomeException -> SomeException
forall a b. (a -> b) -> a -> b
$
(TestError -> TestError) -> SomeException -> Maybe SomeException
forall e a.
(Exception e, Exception a) =>
(a -> e) -> SomeException -> Maybe SomeException
wrap TestError -> TestError
testClientErrorHandler SomeException
e
Maybe SomeException -> Maybe SomeException -> Maybe SomeException
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TestError -> TestError) -> SomeException -> Maybe SomeException
forall e a.
(Exception e, Exception a) =>
(a -> e) -> SomeException -> Maybe SomeException
wrap TestError -> TestError
testPureErrorHandler SomeException
e
Maybe SomeException -> Maybe SomeException -> Maybe SomeException
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (WithCallStack -> WithCallStack)
-> SomeException -> Maybe SomeException
forall e a.
(Exception e, Exception a) =>
(a -> e) -> SomeException -> Maybe SomeException
wrap WithCallStack -> WithCallStack
withCallStackErrorHandler SomeException
e
wrap :: (a -> e) -> SomeException -> Maybe SomeException
wrap a -> e
f = (a -> SomeException) -> Maybe a -> Maybe SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (e -> SomeException
forall e. Exception e => e -> SomeException
toException (e -> SomeException) -> (a -> e) -> a -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
f) (Maybe a -> Maybe SomeException)
-> (SomeException -> Maybe a)
-> SomeException
-> Maybe SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Maybe a
forall e. Exception e => SomeException -> Maybe e
fromException
addPrefix :: Text -> Text
addPrefix = Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> (Text -> Builder) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder -> Builder
nameF Builder
message (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
forall p. Buildable p => p -> Builder
build
testClientErrorHandler :: Client.TestError -> Client.TestError
testClientErrorHandler :: TestError -> TestError
testClientErrorHandler = \case
Client.CustomTestError Text
msg -> Text -> TestError
Client.CustomTestError (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ Text -> Text
addPrefix Text
msg
testPureErrorHandler :: Pure.TestError -> Pure.TestError
testPureErrorHandler :: TestError -> TestError
testPureErrorHandler = \case
Pure.CustomTestError Text
msg -> Text -> TestError
Pure.CustomTestError (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ Text -> Text
addPrefix Text
msg
TestError
err -> TestError
err
withCallStackErrorHandler :: WithCallStack -> WithCallStack
withCallStackErrorHandler :: WithCallStack -> WithCallStack
withCallStackErrorHandler (WithCallStack CallStack
cst SomeException
e) = CallStack -> SomeException -> WithCallStack
WithCallStack CallStack
cst (SomeException -> WithCallStack) -> SomeException -> WithCallStack
forall a b. (a -> b) -> a -> b
$ SomeException -> SomeException
handle SomeException
e
data TransferFailurePredicate
= TransferFailurePredicate
(TransferFailure -> Validation Builder ())
| AndPredicate (NonEmpty TransferFailurePredicate)
| OrPredicate (NonEmpty TransferFailurePredicate)
instance Boolean TransferFailurePredicate where
AndPredicate NonEmpty TransferFailurePredicate
l && :: TransferFailurePredicate
-> TransferFailurePredicate -> TransferFailurePredicate
&& AndPredicate NonEmpty TransferFailurePredicate
r = NonEmpty TransferFailurePredicate -> TransferFailurePredicate
AndPredicate (NonEmpty TransferFailurePredicate -> TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate -> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$ NonEmpty TransferFailurePredicate
l NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
forall a. Semigroup a => a -> a -> a
<> NonEmpty TransferFailurePredicate
r
AndPredicate NonEmpty TransferFailurePredicate
l && TransferFailurePredicate
r = NonEmpty TransferFailurePredicate -> TransferFailurePredicate
AndPredicate (NonEmpty TransferFailurePredicate -> TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate -> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$ NonEmpty TransferFailurePredicate
l NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
forall a. Semigroup a => a -> a -> a
<> OneItem (NonEmpty TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate
forall x. One x => OneItem x -> x
one OneItem (NonEmpty TransferFailurePredicate)
TransferFailurePredicate
r
TransferFailurePredicate
l && AndPredicate NonEmpty TransferFailurePredicate
r = NonEmpty TransferFailurePredicate -> TransferFailurePredicate
AndPredicate (NonEmpty TransferFailurePredicate -> TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate -> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate
forall x. One x => OneItem x -> x
one OneItem (NonEmpty TransferFailurePredicate)
TransferFailurePredicate
l NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
forall a. Semigroup a => a -> a -> a
<> NonEmpty TransferFailurePredicate
r
TransferFailurePredicate
l && TransferFailurePredicate
r = NonEmpty TransferFailurePredicate -> TransferFailurePredicate
AndPredicate (NonEmpty TransferFailurePredicate -> TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate -> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate
forall x. One x => OneItem x -> x
one OneItem (NonEmpty TransferFailurePredicate)
TransferFailurePredicate
l NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
forall a. Semigroup a => a -> a -> a
<> OneItem (NonEmpty TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate
forall x. One x => OneItem x -> x
one OneItem (NonEmpty TransferFailurePredicate)
TransferFailurePredicate
r
OrPredicate NonEmpty TransferFailurePredicate
l || :: TransferFailurePredicate
-> TransferFailurePredicate -> TransferFailurePredicate
|| OrPredicate NonEmpty TransferFailurePredicate
r = NonEmpty TransferFailurePredicate -> TransferFailurePredicate
OrPredicate (NonEmpty TransferFailurePredicate -> TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate -> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$ NonEmpty TransferFailurePredicate
l NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
forall a. Semigroup a => a -> a -> a
<> NonEmpty TransferFailurePredicate
r
OrPredicate NonEmpty TransferFailurePredicate
l || TransferFailurePredicate
r = NonEmpty TransferFailurePredicate -> TransferFailurePredicate
OrPredicate (NonEmpty TransferFailurePredicate -> TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate -> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$ NonEmpty TransferFailurePredicate
l NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
forall a. Semigroup a => a -> a -> a
<> OneItem (NonEmpty TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate
forall x. One x => OneItem x -> x
one OneItem (NonEmpty TransferFailurePredicate)
TransferFailurePredicate
r
TransferFailurePredicate
l || OrPredicate NonEmpty TransferFailurePredicate
r = NonEmpty TransferFailurePredicate -> TransferFailurePredicate
OrPredicate (NonEmpty TransferFailurePredicate -> TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate -> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate
forall x. One x => OneItem x -> x
one OneItem (NonEmpty TransferFailurePredicate)
TransferFailurePredicate
l NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
forall a. Semigroup a => a -> a -> a
<> NonEmpty TransferFailurePredicate
r
TransferFailurePredicate
l || TransferFailurePredicate
r = NonEmpty TransferFailurePredicate -> TransferFailurePredicate
OrPredicate (NonEmpty TransferFailurePredicate -> TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate -> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate
forall x. One x => OneItem x -> x
one OneItem (NonEmpty TransferFailurePredicate)
TransferFailurePredicate
l NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
-> NonEmpty TransferFailurePredicate
forall a. Semigroup a => a -> a -> a
<> OneItem (NonEmpty TransferFailurePredicate)
-> NonEmpty TransferFailurePredicate
forall x. One x => OneItem x -> x
one OneItem (NonEmpty TransferFailurePredicate)
TransferFailurePredicate
r
transferFailureReasonPredicate
:: (TransferFailureReason -> Validation Builder ())
-> TransferFailurePredicate
transferFailureReasonPredicate :: (TransferFailureReason -> Validation Builder ())
-> TransferFailurePredicate
transferFailureReasonPredicate TransferFailureReason -> Validation Builder ()
p = (TransferFailure -> Validation Builder ())
-> TransferFailurePredicate
TransferFailurePredicate ((TransferFailure -> Validation Builder ())
-> TransferFailurePredicate)
-> (TransferFailure -> Validation Builder ())
-> TransferFailurePredicate
forall a b. (a -> b) -> a -> b
$
\(TransferFailure Address
_ TransferFailureReason
reason) -> TransferFailureReason -> Validation Builder ()
p TransferFailureReason
reason
shiftOverflow :: TransferFailurePredicate
shiftOverflow :: TransferFailurePredicate
shiftOverflow = (TransferFailureReason -> Validation Builder ())
-> TransferFailurePredicate
transferFailureReasonPredicate \case
TransferFailureReason
ShiftOverflow -> Validation Builder ()
forall (f :: * -> *). Applicative f => f ()
pass
TransferFailureReason
_ -> Builder -> Validation Builder ()
forall e a. e -> Validation e a
Failure Builder
"Contract failed due to an overflow error"
emptyTransaction :: TransferFailurePredicate
emptyTransaction :: TransferFailurePredicate
emptyTransaction = (TransferFailureReason -> Validation Builder ())
-> TransferFailurePredicate
transferFailureReasonPredicate \case
TransferFailureReason
EmptyTransaction -> Validation Builder ()
forall (f :: * -> *). Applicative f => f ()
pass
TransferFailureReason
_ -> Builder -> Validation Builder ()
forall e a. e -> Validation e a
Failure Builder
"Attempted to transfer 0tz to a simple address"
badParameter :: TransferFailurePredicate
badParameter :: TransferFailurePredicate
badParameter = (TransferFailureReason -> Validation Builder ())
-> TransferFailurePredicate
transferFailureReasonPredicate \case
TransferFailureReason
BadParameter -> Validation Builder ()
forall (f :: * -> *). Applicative f => f ()
pass
TransferFailureReason
_ -> Builder -> Validation Builder ()
forall e a. e -> Validation e a
Failure Builder
"Attempted to call a contract with a parameter of the wrong type"
gasExhaustion :: TransferFailurePredicate
gasExhaustion :: TransferFailurePredicate
gasExhaustion = (TransferFailureReason -> Validation Builder ())
-> TransferFailurePredicate
transferFailureReasonPredicate \case
TransferFailureReason
GasExhaustion -> Validation Builder ()
forall (f :: * -> *). Applicative f => f ()
pass
TransferFailureReason
_ -> Builder -> Validation Builder ()
forall e a. e -> Validation e a
Failure Builder
"Execution failed due to gas exhaustion"
failedWith :: SomeConstant -> TransferFailurePredicate
failedWith :: SomeConstant -> TransferFailurePredicate
failedWith SomeConstant
expectedFailWithVal = (TransferFailureReason -> Validation Builder ())
-> TransferFailurePredicate
transferFailureReasonPredicate \case
FailedWith (EOTVExpression Expression
actualFailWithExpr) Maybe InstrCallStack
_
| Expression
actualFailWithExpr Expression -> SomeConstant -> Bool
`isEq` SomeConstant
expectedFailWithVal -> Validation Builder ()
forall (f :: * -> *). Applicative f => f ()
pass
FailedWith (EOTVTypedValue Value t
actualFailWithVal) Maybe InstrCallStack
_
| Value t -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value t
actualFailWithVal Expression -> SomeConstant -> Bool
`isEq` SomeConstant
expectedFailWithVal -> Validation Builder ()
forall (f :: * -> *). Applicative f => f ()
pass
TransferFailureReason
_ -> Builder -> Validation Builder ()
forall e a. e -> Validation e a
Failure (Builder -> Validation Builder ())
-> Builder -> Validation Builder ()
forall a b. (a -> b) -> a -> b
$ Builder
"Contract failed with: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SomeConstant -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc SomeConstant
expectedFailWithVal
where
isEq :: Expression -> SomeConstant -> Bool
isEq :: Expression -> SomeConstant -> Bool
isEq Expression
expr (SomeConstant (Value t
v :: T.Value t)) =
(FromExpressionError -> Bool)
-> (Value t -> Bool)
-> Either FromExpressionError (Value t)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> FromExpressionError -> Bool
forall a b. a -> b -> a
const Bool
False) (Value t -> Value t -> Bool
forall a. Eq a => a -> a -> Bool
== Value t
v) (Expression -> Either FromExpressionError (Value t)
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @(T.Value t) Expression
expr)
addressIs
:: ToAddress addr
=> addr
-> TransferFailurePredicate
addressIs :: addr -> TransferFailurePredicate
addressIs (addr -> Address
forall a. ToAddress a => a -> Address
toAddress -> Address
expectedAddr) = (TransferFailure -> Validation Builder ())
-> TransferFailurePredicate
TransferFailurePredicate \TransferFailure
err -> do
let TransferFailure Address
actualAddr TransferFailureReason
_ = TransferFailure
err
Bool -> Validation Builder () -> Validation Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Address
actualAddr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
/= Address
expectedAddr) (Validation Builder () -> Validation Builder ())
-> Validation Builder () -> Validation Builder ()
forall a b. (a -> b) -> a -> b
$
Builder -> Validation Builder ()
forall e a. e -> Validation e a
Failure (Builder -> Validation Builder ())
-> Builder -> Validation Builder ()
forall a b. (a -> b) -> a -> b
$ Builder
"Failure occurred in contract with address: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
expectedAddr
constant :: forall err. NiceConstant err => err -> SomeConstant
constant :: err -> SomeConstant
constant err
err =
(((SingI (ToT err), WellTyped (ToT err),
FailOnOperationFound (ContainsOp (ToT err)),
FailOnBigMapFound (ContainsBigMap (ToT err)),
FailOnContractFound (ContainsContract (ToT err)),
FailOnTicketFound (ContainsTicket (ToT err)),
FailOnSaplingStateFound (ContainsSaplingState (ToT err))),
KnownValue err)
:- ConstantScope (ToT err))
-> (ConstantScope (ToT err) => SomeConstant) -> SomeConstant
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (((SingI (ToT err), WellTyped (ToT err),
FailOnOperationFound (ContainsOp (ToT err)),
FailOnBigMapFound (ContainsBigMap (ToT err)),
FailOnContractFound (ContainsContract (ToT err)),
FailOnTicketFound (ContainsTicket (ToT err)),
FailOnSaplingStateFound (ContainsSaplingState (ToT err))),
KnownValue err)
:- ConstantScope (ToT err)
forall a. NiceConstant a :- ConstantScope (ToT a)
niceConstantEvi @err) ((ConstantScope (ToT err) => SomeConstant) -> SomeConstant)
-> (ConstantScope (ToT err) => SomeConstant) -> SomeConstant
forall a b. (a -> b) -> a -> b
$
Value (ToT err) -> SomeConstant
forall (t :: T). ConstantScope t => Value t -> SomeConstant
SomeConstant (Value (ToT err) -> SomeConstant)
-> Value (ToT err) -> SomeConstant
forall a b. (a -> b) -> a -> b
$ err -> Value (ToT err)
forall a. IsoValue a => a -> Value (ToT a)
toVal err
err
lerror :: forall err. IsError err => err -> SomeConstant
lerror :: err -> SomeConstant
lerror err
err = err
-> (forall (t :: T). ConstantScope t => Value t -> SomeConstant)
-> SomeConstant
forall e r.
IsError e =>
e -> (forall (t :: T). ErrorScope t => Value t -> r) -> r
errorToVal err
err forall (t :: T). ConstantScope t => Value t -> SomeConstant
SomeConstant
customError
:: forall arg tag. (IsError (CustomError tag), MustHaveErrorArg tag (MText, arg))
=> Label tag -> arg -> SomeConstant
customError :: Label tag -> arg -> SomeConstant
customError Label tag
tag arg
arg =
CustomError tag -> SomeConstant
forall err. IsError err => err -> SomeConstant
lerror (CustomError tag -> SomeConstant)
-> CustomError tag -> SomeConstant
forall a b. (a -> b) -> a -> b
$ Label tag -> CustomErrorRep tag -> CustomError tag
forall (tag :: Symbol).
Label tag -> CustomErrorRep tag -> CustomError tag
CustomError Label tag
tag (Label tag -> MText
forall (tag :: Symbol). Label tag -> MText
errorTagToMText Label tag
tag, arg
arg)
customError_
:: (IsError (CustomError tag), MustHaveErrorArg tag (MText, ()))
=> Label tag -> SomeConstant
customError_ :: Label tag -> SomeConstant
customError_ Label tag
tag = Label tag -> () -> SomeConstant
forall arg (tag :: Symbol).
(IsError (CustomError tag), MustHaveErrorArg tag (MText, arg)) =>
Label tag -> arg -> SomeConstant
customError Label tag
tag ()
customErrorNoArg
:: (IsError (CustomError tag), MustHaveErrorArg tag MText)
=> Label tag -> SomeConstant
customErrorNoArg :: Label tag -> SomeConstant
customErrorNoArg Label tag
tag =
CustomError tag -> SomeConstant
forall err. IsError err => err -> SomeConstant
lerror (CustomError tag -> SomeConstant)
-> CustomError tag -> SomeConstant
forall a b. (a -> b) -> a -> b
$ Label tag -> CustomErrorRep tag -> CustomError tag
forall (tag :: Symbol).
Label tag -> CustomErrorRep tag -> CustomError tag
CustomError Label tag
tag (Label tag -> MText
forall (tag :: Symbol). Label tag -> MText
errorTagToMText Label tag
tag)
numericError :: forall err. IsError err => ErrorTagMap -> err -> SomeConstant
numericError :: ErrorTagMap -> err -> SomeConstant
numericError ErrorTagMap
tagMap err
err = ErrorTagMap
-> err
-> (forall (t :: T). ConstantScope t => Value t -> SomeConstant)
-> SomeConstant
forall e r.
IsError e =>
ErrorTagMap
-> e -> (forall (t :: T). ConstantScope t => Value t -> r) -> r
errorToValNumeric ErrorTagMap
tagMap err
err forall (t :: T). ConstantScope t => Value t -> SomeConstant
SomeConstant
withCap :: Monad m => (caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap :: (caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> cap
getCap cap -> m a
useCap = do
cap
cap <- (caps -> cap) -> ReaderT caps m cap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks caps -> cap
getCap
m a -> ReaderT caps m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT caps m a) -> m a -> ReaderT caps m a
forall a b. (a -> b) -> a -> b
$ cap -> m a
useCap cap
cap
originateDataToUntyped :: OriginateData param st vd -> UntypedOriginateData
originateDataToUntyped :: OriginateData param st vd -> UntypedOriginateData
originateDataToUntyped OriginateData{ odContract :: forall param st vd.
OriginateData param st vd -> Contract param st vd
odContract = contract :: Contract param st vd
contract@Contract{}, st
Mutez
AliasHint
odStorage :: st
odBalance :: Mutez
odName :: AliasHint
odStorage :: forall param st vd. OriginateData param st vd -> st
odBalance :: forall param st vd. OriginateData param st vd -> Mutez
odName :: forall param st vd. OriginateData param st vd -> AliasHint
.. } =
UntypedOriginateData :: AliasHint -> Mutez -> Value -> Contract -> UntypedOriginateData
UntypedOriginateData
{ uodName :: AliasHint
uodName = AliasHint
odName
, uodBalance :: Mutez
uodBalance = Mutez
odBalance
, uodStorage :: Value
uodStorage = st -> Value
forall st. NiceStorage st => st -> Value
untypeHelper st
odStorage
, uodContract :: Contract
uodContract = Contract (ToT param) (ToT st) -> Contract
forall (param :: T) (store :: T). Contract param store -> Contract
convertContract (Contract (ToT param) (ToT st) -> Contract)
-> Contract (ToT param) (ToT st) -> Contract
forall a b. (a -> b) -> a -> b
$ Contract param st vd -> Contract (ToT param) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract Contract param st vd
contract
}
untypeHelper :: forall st. NiceStorage st => st -> U.Value
untypeHelper :: st -> Value
untypeHelper = Value' Instr (ToT st) -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
untypeValue (Value' Instr (ToT st) -> Value)
-> (st -> Value' Instr (ToT st)) -> st -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> Value' Instr (ToT st)
forall a. IsoValue a => a -> Value (ToT a)
toVal (StorageScope (ToT st) => st -> Value)
-> (((SingI (ToT st), WellTyped (ToT st),
FailOnOperationFound (ContainsOp (ToT st)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
FailOnContractFound (ContainsContract (ToT st))),
KnownValue st)
:- StorageScope (ToT st))
-> st
-> Value
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT st), WellTyped (ToT st),
FailOnOperationFound (ContainsOp (ToT st)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
FailOnContractFound (ContainsContract (ToT st))),
KnownValue st)
:- StorageScope (ToT st)
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st