{-# OPTIONS_HADDOCK not-home #-}
module Test.Cleveland.Internal.Abstract
( module Test.Cleveland.Internal.Abstract
) where
import Control.Lens (Each, each, filtered, makeLenses, makeLensesFor, makeLensesWith)
import Data.Constraint (Bottom(..), (\\))
import Data.Default (Default(..))
import Data.Type.Equality (pattern Refl)
import Fmt (Buildable(..), Doc, blockListF, pretty, unlinesF, (+|), (|+))
import Prelude hiding (Each)
import Time (KnownDivRat, Second, Time)
import Lorentz (Contract(..))
import Lorentz.Constraints
import Lorentz.Entrypoints.Core (EntrypointRef(..), NiceEntrypointName, eprName)
import Morley.AsRPC (HasRPCRepr(AsRPC))
import Morley.Client (MorleyClientEnv, Result)
import Morley.Client.Types
import Morley.Micheline (Expression, fromExpression)
import Morley.Michelson.ErrorPos (ErrorSrcPos)
import Morley.Michelson.Interpret (MorleyLogs(..))
import Morley.Michelson.Runtime (VotingPowers)
import Morley.Michelson.Typed (BigMapId)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.AnnotatedValue (SomeAnnotatedValue)
import Morley.Michelson.Typed.Entrypoints
import Morley.Michelson.Typed.Scope (ConstantScope)
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core (ChainId, Mutez, Timestamp)
import Morley.Tezos.Crypto
import Morley.Tezos.Crypto qualified as Crypto
import Morley.Util.Batching
import Morley.Util.Lens (postfixLFields)
import Morley.Util.Sing (eqI)
import Morley.Util.TypeLits
import Test.Cleveland.Internal.Exceptions
import Test.Cleveland.Lorentz.Types
data LargeOrigination = IsLarge | NotLarge
data OriginationType where
OTTypedLorentz :: Type -> Type -> Type -> OriginationType
OTTypedMorley :: Type -> Type -> Type -> OriginationType
OTUntyped :: OriginationType
type OriginateData :: OriginationType -> LargeOrigination -> Type
data OriginateData oty large = OriginateData
{ forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> ContractAlias
odName :: ContractAlias
, forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Mutez
odBalance :: Mutez
, forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Maybe KeyHash
odDelegate :: Maybe KeyHash
, forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> ODContractAndStorage oty
odContractAndStorage :: ODContractAndStorage oty
}
type ODContractAndStorage :: OriginationType -> Type
data ODContractAndStorage oty where
ODContractAndStorageLorentz ::
{ forall st vd cp.
ODContractAndStorage ('OTTypedLorentz vd st cp) -> st
odStorage :: st
, forall st vd cp.
ODContractAndStorage ('OTTypedLorentz vd st cp)
-> Contract vd st cp
odContract :: Contract param st vd
} -> ODContractAndStorage ('OTTypedLorentz param st vd)
ODContractAndStorageUntyped ::
{ ODContractAndStorage 'OTUntyped -> Value
uodStorage :: U.Value
, ODContractAndStorage 'OTUntyped -> Contract
uodContract :: U.Contract
} -> ODContractAndStorage 'OTUntyped
ODContractAndStorageTyped :: (NiceStorage st, NiceViewsDescriptor vd, NiceParameter cp) =>
{ forall st vd cp.
ODContractAndStorage ('OTTypedMorley cp st vd) -> st
todStorage :: st
, forall st vd cp.
ODContractAndStorage ('OTTypedMorley cp st vd)
-> Contract (ToT cp) (ToT st)
todContract :: T.Contract (T.ToT cp) (T.ToT st)
} -> ODContractAndStorage ('OTTypedMorley cp st vd)
data TransferData =
forall v addr. (NiceParameter v, ToL1Address addr) => TransferData
{ ()
tdTo :: addr
, TransferData -> Mutez
tdAmount :: Mutez
, TransferData -> EpName
tdEntrypoint :: EpName
, ()
tdParameter :: v
}
data TransferTicketData =
forall t addr. (T.WellTyped t, ToL1Address addr) => TransferTicketData
{ ()
ttdTo :: addr
, TransferTicketData -> EpName
ttdEntrypoint :: EpName
, ()
ttdParameter :: T.Value ('T.TTicket t)
}
type TypedContract :: Type -> Type -> Type -> Type
newtype TypedContract cp st vd = TypedContract (T.Contract (T.ToT cp) (T.ToT st))
data SomeOriginateData large where
SomeOriginateData :: OriginateData oty large -> SomeOriginateData large
data ClevelandInput
instance OperationInfoDescriptor ClevelandInput where
type TransferInfo ClevelandInput = TransferData
type TransferTicketInfo ClevelandInput = TransferTicketData
type OriginationInfo ClevelandInput = SomeOriginateData 'NotLarge
type RevealInfo ClevelandInput = PublicKey
type DelegationInfo ClevelandInput = Maybe KeyHash
data ContractEvent = ContractEvent
{ ContractEvent -> ContractAddress
ceSource :: ContractAddress
, ContractEvent -> Text
ceTag :: Text
, ContractEvent -> Maybe SomeAnnotatedValue
cePayload :: Maybe SomeAnnotatedValue
}
data ClevelandResult
instance OperationInfoDescriptor ClevelandResult where
type TransferInfo ClevelandResult = [ContractEvent]
type TransferTicketInfo ClevelandResult = [ContractEvent]
type OriginationInfo ClevelandResult = OriginationInfo Result
type RevealInfo ClevelandResult = RevealInfo Result
type DelegationInfo ClevelandResult = DelegationInfo Result
data BatchResultMismatch
= BatchResultMismatch Text
instance Buildable BatchResultMismatch where
build :: BatchResultMismatch -> Doc
build = \case
BatchResultMismatch Text
expected ->
Doc
"For " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
expected Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" operation received inappropriate result"
newtype Sender = Sender { Sender -> ImplicitAddressWithAlias
unSender :: ImplicitAddressWithAlias }
newtype Moneybag = Moneybag { Moneybag -> ImplicitAddressWithAlias
unMoneybag :: ImplicitAddressWithAlias }
data SpecificOrDefaultAlias
= SpecificAlias ImplicitAlias
| DefaultAlias
deriving stock (Int -> SpecificOrDefaultAlias -> ShowS
[SpecificOrDefaultAlias] -> ShowS
SpecificOrDefaultAlias -> String
(Int -> SpecificOrDefaultAlias -> ShowS)
-> (SpecificOrDefaultAlias -> String)
-> ([SpecificOrDefaultAlias] -> ShowS)
-> Show SpecificOrDefaultAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecificOrDefaultAlias] -> ShowS
$cshowList :: [SpecificOrDefaultAlias] -> ShowS
show :: SpecificOrDefaultAlias -> String
$cshow :: SpecificOrDefaultAlias -> String
showsPrec :: Int -> SpecificOrDefaultAlias -> ShowS
$cshowsPrec :: Int -> SpecificOrDefaultAlias -> ShowS
Show)
instance IsString SpecificOrDefaultAlias where
fromString :: String -> SpecificOrDefaultAlias
fromString = ImplicitAlias -> SpecificOrDefaultAlias
SpecificAlias (ImplicitAlias -> SpecificOrDefaultAlias)
-> (String -> ImplicitAlias) -> String -> SpecificOrDefaultAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ImplicitAlias
ImplicitAlias (Text -> ImplicitAlias)
-> (String -> Text) -> String -> ImplicitAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
instance Default SpecificOrDefaultAlias where
def :: SpecificOrDefaultAlias
def = SpecificOrDefaultAlias
DefaultAlias
mkDefaultAlias :: Natural -> ImplicitAlias
mkDefaultAlias :: Natural -> ImplicitAlias
mkDefaultAlias Natural
counter =
Text -> ImplicitAlias
ImplicitAlias (Text -> ImplicitAlias)
-> (String -> Text) -> String -> ImplicitAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString (String -> ImplicitAlias) -> String -> ImplicitAlias
forall a b. (a -> b) -> a -> b
$ (String
"default_cleveland_alias" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Natural
counter)
auto :: SpecificOrDefaultAlias
auto :: SpecificOrDefaultAlias
auto = SpecificOrDefaultAlias
forall a. Default a => a
def
newtype DefaultAliasCounter = DefaultAliasCounter {DefaultAliasCounter -> Natural
unDefaultAliasCounter :: Natural}
deriving stock (DefaultAliasCounter -> DefaultAliasCounter -> Bool
(DefaultAliasCounter -> DefaultAliasCounter -> Bool)
-> (DefaultAliasCounter -> DefaultAliasCounter -> Bool)
-> Eq DefaultAliasCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultAliasCounter -> DefaultAliasCounter -> Bool
$c/= :: DefaultAliasCounter -> DefaultAliasCounter -> Bool
== :: DefaultAliasCounter -> DefaultAliasCounter -> Bool
$c== :: DefaultAliasCounter -> DefaultAliasCounter -> Bool
Eq, Int -> DefaultAliasCounter -> ShowS
[DefaultAliasCounter] -> ShowS
DefaultAliasCounter -> String
(Int -> DefaultAliasCounter -> ShowS)
-> (DefaultAliasCounter -> String)
-> ([DefaultAliasCounter] -> ShowS)
-> Show DefaultAliasCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultAliasCounter] -> ShowS
$cshowList :: [DefaultAliasCounter] -> ShowS
show :: DefaultAliasCounter -> String
$cshow :: DefaultAliasCounter -> String
showsPrec :: Int -> DefaultAliasCounter -> ShowS
$cshowsPrec :: Int -> DefaultAliasCounter -> ShowS
Show)
data ClevelandOpsImpl m = ClevelandOpsImpl
{ forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch
:: HasCallStack => [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
}
data ClevelandMiscImpl m = ClevelandMiscImpl
{ forall (m :: * -> *).
ClevelandMiscImpl m -> forall res. HasCallStack => IO res -> m res
cmiRunIO :: forall res. HasCallStack => IO res -> m res
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
cmiResolveAddress :: forall kind. HasCallStack => AddressOrAlias kind -> m (AddressWithAlias kind)
, forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey :: HasCallStack => SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
, forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey :: HasCallStack => SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
, forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenFreshKey :: HasCallStack => SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
, forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
cmiSignBytes :: HasCallStack => ByteString -> ImplicitAddressWithAlias -> m Crypto.Signature
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiOriginateLargeUntyped
:: forall oty. HasCallStack
=> Sender
-> OriginateData oty 'IsLarge
-> m ContractAddress
, :: HasCallStack => Text -> m ()
, forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => L1Address -> m Mutez
cmiGetBalance :: HasCallStack => L1Address -> m Mutez
, forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetSomeStorage :: HasCallStack => ContractAddress -> m SomeAnnotatedValue
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
cmiGetBigMapValueMaybe
:: forall k v. (HasCallStack, NiceComparable k, NicePackedValue k, NiceUnpackedValue v)
=> BigMapId k v -> k -> m (Maybe v)
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
cmiGetAllBigMapValuesMaybe
:: forall k v. (HasCallStack, NiceComparable k, NiceUnpackedValue v)
=> BigMapId k v -> m (Maybe [v])
, forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetPublicKey :: HasCallStack => ImplicitAddressWithAlias -> m Crypto.PublicKey
, forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetDelegate :: HasCallStack => L1Address -> m (Maybe Crypto.KeyHash)
, forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m ChainId
cmiGetChainId :: HasCallStack => m ChainId
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
cmiAdvanceTime :: forall unit. (HasCallStack, KnownDivRat unit Second) => Time unit -> m ()
, forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> m ()
, forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Timestamp
cmiGetNow :: HasCallStack => m Timestamp
, forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Natural
cmiGetLevel :: HasCallStack => m Natural
, forall (m :: * -> *).
ClevelandMiscImpl m -> forall a. HasCallStack => Doc -> m a
cmiFailure :: forall a. HasCallStack => Doc -> m a
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a. HasCallStack => SomeException -> m a
cmiThrow :: forall a. HasCallStack => SomeException -> m a
, forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m (Time Second)
cmiGetApproximateBlockInterval :: HasCallStack => m (Time Second)
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiAttempt :: forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
, forall (m :: * -> *).
ClevelandMiscImpl m -> ImplicitAddress -> m ()
cmiMarkAddressRefillable :: ImplicitAddress -> m ()
, forall (m :: * -> *).
ClevelandMiscImpl m -> m (Either (EmulatedImpl m) NetworkEnv)
cmiUnderlyingImpl :: m (Either (EmulatedImpl m) NetworkEnv)
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
cmiRunCode
:: forall cp st vd. (HasCallStack, HasRPCRepr st, T.IsoValue (AsRPC st))
=> Sender -> RunCode cp st vd -> m (AsRPC st)
, forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
cmiTicketBalance
:: forall t. (T.ForbidOp t, T.Comparable t)
=> L1Address -> ContractAddress -> T.Value t -> m Natural
, forall (m :: * -> *).
ClevelandMiscImpl m -> ContractAddress -> m [SomeTicket]
cmiAllTicketBalances :: ContractAddress -> m [SomeTicket]
}
data SomeTicket where
SomeTicket :: T.SingI t => T.Ticket (T.Value t) -> SomeTicket
instance Buildable SomeTicket where
build :: SomeTicket -> Doc
build (SomeTicket T.Ticket{Natural
Address
Value t
tTicketer :: forall arg. Ticket arg -> Address
tData :: forall arg. Ticket arg -> arg
tAmount :: forall arg. Ticket arg -> Natural
tAmount :: Natural
tData :: Value t
tTicketer :: Address
..}) =
Doc
"Ticket with ticketer " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Address
tTicketer
Address -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", value " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Value t
tData
Value t -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", amount " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Natural
tAmount
Natural -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
instance Eq SomeTicket where
(SomeTicket (Ticket (Value t)
val1 :: T.Ticket (T.Value t1))) == :: SomeTicket -> SomeTicket -> Bool
== (SomeTicket (Ticket (Value t)
val2 :: T.Ticket (T.Value t2)))
| Just t :~: t
Refl <- forall {k} (a :: k) (b :: k).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
forall (a :: T) (b :: T).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
eqI @t1 @t2 = Ticket (Value t)
val1 Ticket (Value t) -> Ticket (Value t) -> Bool
forall a. Eq a => a -> a -> Bool
== Ticket (Value t)
Ticket (Value t)
val2
| Bool
otherwise = Bool
False
data RunCode cp st vd = RunCode
{ forall cp st vd. RunCode cp st vd -> Contract cp st vd
rcContract :: Contract cp st vd
, forall cp st vd. RunCode cp st vd -> Value
rcParameter :: U.Value
, forall cp st vd. RunCode cp st vd -> Value
rcStorage :: U.Value
, forall cp st vd. RunCode cp st vd -> Mutez
rcAmount :: Mutez
, forall cp st vd. RunCode cp st vd -> Maybe Natural
rcLevel :: Maybe Natural
, forall cp st vd. RunCode cp st vd -> Maybe Timestamp
rcNow :: Maybe Timestamp
, forall cp st vd. RunCode cp st vd -> Mutez
rcBalance :: Mutez
, forall cp st vd. RunCode cp st vd -> Maybe ImplicitAddress
rcSource :: Maybe ImplicitAddress
}
data EmulatedImpl m = EmulatedImpl
{ forall (m :: * -> *). EmulatedImpl m -> [(Text, m ())] -> m ()
eiBranchout :: [(Text, m ())] -> m ()
, forall (m :: * -> *).
EmulatedImpl m
-> forall st addr.
(HasCallStack, ToStorageType st addr) =>
addr -> m st
eiGetStorage
:: forall st addr. (HasCallStack, ToStorageType st addr)
=> addr -> m st
, forall (m :: * -> *).
EmulatedImpl m -> forall a. m a -> m (LogsInfo, a)
eiGetMorleyLogs :: forall a. m a -> m (LogsInfo, a)
, forall (m :: * -> *). EmulatedImpl m -> VotingPowers -> m ()
eiSetVotingPowers :: VotingPowers -> m ()
}
data NetworkEnv = NetworkEnv
{ NetworkEnv -> MorleyClientEnv
neMorleyClientEnv :: MorleyClientEnv
, NetworkEnv -> Maybe SecretKey
neSecretKey :: Maybe Crypto.SecretKey
, NetworkEnv -> ImplicitAlias
neMoneybagAlias :: ImplicitAlias
, NetworkEnv -> Bool
neExplicitDataDir :: Bool
, NetworkEnv -> Word
neVerbosity :: Word
}
data ScenarioLogs = ScenarioLogs
{ ScenarioLogs -> Address
_slAddr :: Address
, ScenarioLogs -> MorleyLogs
_slLog :: MorleyLogs
} deriving stock (ScenarioLogs -> ScenarioLogs -> Bool
(ScenarioLogs -> ScenarioLogs -> Bool)
-> (ScenarioLogs -> ScenarioLogs -> Bool) -> Eq ScenarioLogs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScenarioLogs -> ScenarioLogs -> Bool
$c/= :: ScenarioLogs -> ScenarioLogs -> Bool
== :: ScenarioLogs -> ScenarioLogs -> Bool
$c== :: ScenarioLogs -> ScenarioLogs -> Bool
Eq, Int -> ScenarioLogs -> ShowS
LogsInfo -> ShowS
ScenarioLogs -> String
(Int -> ScenarioLogs -> ShowS)
-> (ScenarioLogs -> String)
-> (LogsInfo -> ShowS)
-> Show ScenarioLogs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: LogsInfo -> ShowS
$cshowList :: LogsInfo -> ShowS
show :: ScenarioLogs -> String
$cshow :: ScenarioLogs -> String
showsPrec :: Int -> ScenarioLogs -> ShowS
$cshowsPrec :: Int -> ScenarioLogs -> ShowS
Show)
type LogsInfo = [ScenarioLogs]
makeLenses ''ScenarioLogs
makeLensesWith postfixLFields ''NetworkEnv
logsL :: Lens' ScenarioLogs MorleyLogs
logsL :: Lens' ScenarioLogs MorleyLogs
logsL = (MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs
Lens' ScenarioLogs MorleyLogs
slLog
filterLogsByAddrL
:: (ToAddress addr, Applicative f)
=> addr
-> (MorleyLogs -> f MorleyLogs)
-> ScenarioLogs
-> f ScenarioLogs
filterLogsByAddrL :: forall addr (f :: * -> *).
(ToAddress addr, Applicative f) =>
addr
-> (MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs
filterLogsByAddrL (addr -> Address
forall a. ToAddress a => a -> Address
toAddress -> Address
addr) = (ScenarioLogs -> Bool) -> Optic' (->) f ScenarioLogs ScenarioLogs
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\(ScenarioLogs Address
a MorleyLogs
_) -> Address
a Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr) Optic' (->) f ScenarioLogs ScenarioLogs
-> ((MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs)
-> (MorleyLogs -> f MorleyLogs)
-> ScenarioLogs
-> f ScenarioLogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs
Lens' ScenarioLogs MorleyLogs
logsL
logsForAddress
:: ( Each s s ScenarioLogs ScenarioLogs
, ToAddress addr
)
=> addr
-> s
-> [MorleyLogs]
logsForAddress :: forall s addr.
(Each s s ScenarioLogs ScenarioLogs, ToAddress addr) =>
addr -> s -> [MorleyLogs]
logsForAddress addr
addr = (s -> Getting (Endo [MorleyLogs]) s MorleyLogs -> [MorleyLogs]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (ScenarioLogs -> Const (Endo [MorleyLogs]) ScenarioLogs)
-> s -> Const (Endo [MorleyLogs]) s
forall s t a b. Each s t a b => Traversal s t a b
each ((ScenarioLogs -> Const (Endo [MorleyLogs]) ScenarioLogs)
-> s -> Const (Endo [MorleyLogs]) s)
-> ((MorleyLogs -> Const (Endo [MorleyLogs]) MorleyLogs)
-> ScenarioLogs -> Const (Endo [MorleyLogs]) ScenarioLogs)
-> Getting (Endo [MorleyLogs]) s MorleyLogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. addr
-> (MorleyLogs -> Const (Endo [MorleyLogs]) MorleyLogs)
-> ScenarioLogs
-> Const (Endo [MorleyLogs]) ScenarioLogs
forall addr (f :: * -> *).
(ToAddress addr, Applicative f) =>
addr
-> (MorleyLogs -> f MorleyLogs) -> ScenarioLogs -> f ScenarioLogs
filterLogsByAddrL addr
addr)
collectLogs :: LogsInfo -> MorleyLogs
collectLogs :: LogsInfo -> MorleyLogs
collectLogs = (Element LogsInfo -> MorleyLogs) -> LogsInfo -> MorleyLogs
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element LogsInfo -> MorleyLogs
ScenarioLogs -> MorleyLogs
_slLog
newtype ClevelandOpsBatch a = ClevelandOpsBatch
{ forall a.
ClevelandOpsBatch a
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
a
unClevelandOpsBatch
:: BatchingM (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) Void a
} deriving newtype ((forall a b.
(a -> b) -> ClevelandOpsBatch a -> ClevelandOpsBatch b)
-> (forall a b. a -> ClevelandOpsBatch b -> ClevelandOpsBatch a)
-> Functor ClevelandOpsBatch
forall a b. a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
forall a b. (a -> b) -> ClevelandOpsBatch a -> ClevelandOpsBatch b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
$c<$ :: forall a b. a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
fmap :: forall a b. (a -> b) -> ClevelandOpsBatch a -> ClevelandOpsBatch b
$cfmap :: forall a b. (a -> b) -> ClevelandOpsBatch a -> ClevelandOpsBatch b
Functor, Functor ClevelandOpsBatch
Functor ClevelandOpsBatch
-> (forall a. a -> ClevelandOpsBatch a)
-> (forall a b.
ClevelandOpsBatch (a -> b)
-> ClevelandOpsBatch a -> ClevelandOpsBatch b)
-> (forall a b c.
(a -> b -> c)
-> ClevelandOpsBatch a
-> ClevelandOpsBatch b
-> ClevelandOpsBatch c)
-> (forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch b)
-> (forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch a)
-> Applicative ClevelandOpsBatch
forall a. a -> ClevelandOpsBatch a
forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch b
forall a b.
ClevelandOpsBatch (a -> b)
-> ClevelandOpsBatch a -> ClevelandOpsBatch b
forall a b c.
(a -> b -> c)
-> ClevelandOpsBatch a
-> ClevelandOpsBatch b
-> ClevelandOpsBatch c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
$c<* :: forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch a
*> :: forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch b
$c*> :: forall a b.
ClevelandOpsBatch a -> ClevelandOpsBatch b -> ClevelandOpsBatch b
liftA2 :: forall a b c.
(a -> b -> c)
-> ClevelandOpsBatch a
-> ClevelandOpsBatch b
-> ClevelandOpsBatch c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ClevelandOpsBatch a
-> ClevelandOpsBatch b
-> ClevelandOpsBatch c
<*> :: forall a b.
ClevelandOpsBatch (a -> b)
-> ClevelandOpsBatch a -> ClevelandOpsBatch b
$c<*> :: forall a b.
ClevelandOpsBatch (a -> b)
-> ClevelandOpsBatch a -> ClevelandOpsBatch b
pure :: forall a. a -> ClevelandOpsBatch a
$cpure :: forall a. a -> ClevelandOpsBatch a
Applicative)
instance
( Bottom
, TypeError
( 'Text "Attempt to use monad capabilities within a batch" ':$$:
'Text "In case you are using a do-block, make sure that" ':$$:
'Text "• `ApplicativeDo` extension is enabled" ':$$:
'Text "• there is a return statement in the end" ':$$:
'Text "• returned value picks variables in the order in which they are defined"
)
) => Monad ClevelandOpsBatch where
>>= :: forall a b.
ClevelandOpsBatch a
-> (a -> ClevelandOpsBatch b) -> ClevelandOpsBatch b
(>>=) = forall a. Bottom => a
ClevelandOpsBatch a
-> (a -> ClevelandOpsBatch b) -> ClevelandOpsBatch b
no
runBatched
:: (HasCallStack, Functor m)
=> ClevelandOpsImpl m
-> ClevelandOpsBatch a
-> m a
runBatched :: forall (m :: * -> *) a.
(HasCallStack, Functor m) =>
ClevelandOpsImpl m -> ClevelandOpsBatch a -> m a
runBatched ClevelandOpsImpl m
impl =
Proxy Void
-> ClevelandOpsImpl m
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
a
-> m a
forall e (m :: * -> *) a.
(HasCallStack, Buildable e, Functor m) =>
Proxy e
-> ClevelandOpsImpl m
-> BatchingM
(OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
runOperationBatchM (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Void) ClevelandOpsImpl m
impl (BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
a
-> m a)
-> (ClevelandOpsBatch a
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
a)
-> ClevelandOpsBatch a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClevelandOpsBatch a
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
a
forall a.
ClevelandOpsBatch a
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
a
unClevelandOpsBatch
batchedOpsImpl :: ClevelandOpsImpl ClevelandOpsBatch
batchedOpsImpl :: ClevelandOpsImpl ClevelandOpsBatch
batchedOpsImpl = ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
[OperationInfo ClevelandInput]
-> m [OperationInfo ClevelandResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
{ coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput]
-> ClevelandOpsBatch [OperationInfo ClevelandResult]
coiRunOperationBatch = BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
[OperationInfo ClevelandResult]
-> ClevelandOpsBatch [OperationInfo ClevelandResult]
forall a.
BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
a
-> ClevelandOpsBatch a
ClevelandOpsBatch (BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
[OperationInfo ClevelandResult]
-> ClevelandOpsBatch [OperationInfo ClevelandResult])
-> ([OperationInfo ClevelandInput]
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
[OperationInfo ClevelandResult])
-> [OperationInfo ClevelandInput]
-> ClevelandOpsBatch [OperationInfo ClevelandResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OperationInfo ClevelandInput
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
(OperationInfo ClevelandResult))
-> [OperationInfo ClevelandInput]
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
[OperationInfo ClevelandResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OperationInfo ClevelandInput
-> (OperationInfo ClevelandResult
-> Either Void (OperationInfo ClevelandResult))
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
Void
(OperationInfo ClevelandResult)
forall i o e a. i -> (o -> Either e a) -> BatchingM i o e a
`submitThenParse` OperationInfo ClevelandResult
-> Either Void (OperationInfo ClevelandResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
}
runOperationBatchM
:: (HasCallStack, Buildable e, Functor m)
=> Proxy e
-> ClevelandOpsImpl m
-> BatchingM (OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
runOperationBatchM :: forall e (m :: * -> *) a.
(HasCallStack, Buildable e, Functor m) =>
Proxy e
-> ClevelandOpsImpl m
-> BatchingM
(OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
runOperationBatchM Proxy e
_ ClevelandOpsImpl m
impl =
(((), a) -> a) -> m ((), a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), a) -> a
forall a b. (a, b) -> b
snd (m ((), a) -> m a)
-> (BatchingM
(OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m ((), a))
-> BatchingM
(OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([OperationInfo ClevelandInput]
-> m ((), [OperationInfo ClevelandResult]))
-> BatchingM
(OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m ((), a)
forall (m :: * -> *) e i r o a.
(Functor m, Buildable e) =>
([i] -> m (r, [o])) -> BatchingM i o e a -> m (r, a)
unsafeRunBatching (([OperationInfo ClevelandResult]
-> ((), [OperationInfo ClevelandResult]))
-> m [OperationInfo ClevelandResult]
-> m ((), [OperationInfo ClevelandResult])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), ) (m [OperationInfo ClevelandResult]
-> m ((), [OperationInfo ClevelandResult]))
-> ([OperationInfo ClevelandInput]
-> m [OperationInfo ClevelandResult])
-> [OperationInfo ClevelandInput]
-> m ((), [OperationInfo ClevelandResult])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClevelandOpsImpl m
-> HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch ClevelandOpsImpl m
impl)
runSingleOperation
:: (HasCallStack, Functor m)
=> ClevelandOpsImpl m
-> Text
-> OperationInfo ClevelandInput
-> (OperationInfo ClevelandResult -> Maybe a)
-> m a
runSingleOperation :: forall (m :: * -> *) a.
(HasCallStack, Functor m) =>
ClevelandOpsImpl m
-> Text
-> OperationInfo ClevelandInput
-> (OperationInfo ClevelandResult -> Maybe a)
-> m a
runSingleOperation ClevelandOpsImpl m
impl Text
desc OperationInfo ClevelandInput
opData OperationInfo ClevelandResult -> Maybe a
parseRes =
Proxy BatchResultMismatch
-> ClevelandOpsImpl m
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
BatchResultMismatch
a
-> m a
forall e (m :: * -> *) a.
(HasCallStack, Buildable e, Functor m) =>
Proxy e
-> ClevelandOpsImpl m
-> BatchingM
(OperationInfo ClevelandInput) (OperationInfo ClevelandResult) e a
-> m a
runOperationBatchM (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BatchResultMismatch) ClevelandOpsImpl m
impl (BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
BatchResultMismatch
a
-> m a)
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
BatchResultMismatch
a
-> m a
forall a b. (a -> b) -> a -> b
$
OperationInfo ClevelandInput
opData OperationInfo ClevelandInput
-> (OperationInfo ClevelandResult -> Either BatchResultMismatch a)
-> BatchingM
(OperationInfo ClevelandInput)
(OperationInfo ClevelandResult)
BatchResultMismatch
a
forall i o e a. i -> (o -> Either e a) -> BatchingM i o e a
`submitThenParse` BatchResultMismatch -> Maybe a -> Either BatchResultMismatch a
forall l r. l -> Maybe r -> Either l r
maybeToRight (Text -> BatchResultMismatch
BatchResultMismatch Text
desc) (Maybe a -> Either BatchResultMismatch a)
-> (OperationInfo ClevelandResult -> Maybe a)
-> OperationInfo ClevelandResult
-> Either BatchResultMismatch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationInfo ClevelandResult -> Maybe a
parseRes
data ExpressionOrTypedValue where
EOTVExpression :: Expression -> ExpressionOrTypedValue
EOTVTypedValue :: (T.SingI t, ConstantScope t) => T.Value t -> ExpressionOrTypedValue
deriving stock instance Show ExpressionOrTypedValue
instance Eq ExpressionOrTypedValue where
== :: ExpressionOrTypedValue -> ExpressionOrTypedValue -> Bool
(==) (EOTVExpression Expression
x) (EOTVExpression Expression
y) = Expression
x Expression -> Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Expression
y
(==) (EOTVTypedValue (Value t
x :: T.Value t)) (EOTVTypedValue (Value t
y :: T.Value u))
= case forall {k} (a :: k) (b :: k).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
forall (a :: T) (b :: T).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
eqI @t @u of
Just t :~: t
Refl -> Value t
x Value t -> Value t -> Bool
forall a. Eq a => a -> a -> Bool
== Value t
Value t
y
Maybe (t :~: t)
Nothing -> Bool
False
(==) ExpressionOrTypedValue
_ ExpressionOrTypedValue
_ = Bool
False
instance Buildable ExpressionOrTypedValue where
build :: ExpressionOrTypedValue -> Doc
build = \case
EOTVExpression Expression
e -> (FromExpressionError -> Doc)
-> (Value -> Doc) -> Either FromExpressionError Value -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Doc -> FromExpressionError -> Doc
forall a b. a -> b -> a
const (Doc -> FromExpressionError -> Doc)
-> Doc -> FromExpressionError -> Doc
forall a b. (a -> b) -> a -> b
$ Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
e) Value -> Doc
forall a. Buildable a => a -> Doc
build (Either FromExpressionError Value -> Doc)
-> Either FromExpressionError Value -> Doc
forall a b. (a -> b) -> a -> b
$ forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @U.Value Expression
e
EOTVTypedValue Value t
v -> Value t -> Doc
forall a. Buildable a => a -> Doc
build Value t
v
data AddressAndAlias = forall kind. AddressAndAlias (KindedAddress kind) (Maybe (Alias kind))
deriving stock instance Show AddressAndAlias
instance Eq AddressAndAlias where
(AddressAndAlias (KindedAddress kind
addr1 :: KindedAddress kind1) Maybe (Alias kind)
_) == :: AddressAndAlias -> AddressAndAlias -> Bool
==
(AddressAndAlias (KindedAddress kind
addr2 :: KindedAddress kind2) Maybe (Alias kind)
_) =
Bool -> ((kind :~: kind) -> Bool) -> Maybe (kind :~: kind) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\kind :~: kind
Refl -> KindedAddress kind
addr1 KindedAddress kind -> KindedAddress kind -> Bool
forall a. Eq a => a -> a -> Bool
== KindedAddress kind
KindedAddress kind
addr2) (Maybe (kind :~: kind) -> Bool) -> Maybe (kind :~: kind) -> Bool
forall a b. (a -> b) -> a -> b
$
forall {k} (a :: k) (b :: k).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
forall (a :: AddressKind) (b :: AddressKind).
(SingI a, SingI b, TestEquality Sing) =>
Maybe (a :~: b)
eqI @kind1 @kind2 (SingI kind => Maybe (kind :~: kind))
-> Dict (SingI kind) -> Maybe (kind :~: kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress kind -> Dict (SingI kind)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress kind
addr1 (SingI kind => Maybe (kind :~: kind))
-> Dict (SingI kind) -> Maybe (kind :~: kind)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress kind -> Dict (SingI kind)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress kind
addr2
instance ToAddress AddressAndAlias where
toAddress :: AddressAndAlias -> Address
toAddress (AddressAndAlias KindedAddress kind
a Maybe (Alias kind)
_) = KindedAddress kind -> Address
forall a. ToAddress a => a -> Address
toAddress KindedAddress kind
a
instance Buildable AddressAndAlias where
build :: AddressAndAlias -> Doc
build (AddressAndAlias KindedAddress kind
addr Maybe (Alias kind)
mbAlias) =
KindedAddress kind -> Doc
forall a. Buildable a => a -> Doc
build KindedAddress kind
addr Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Doc -> (Alias kind -> Doc) -> Maybe (Alias kind) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"" (\Alias kind
alias -> Doc
" (" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Alias kind
alias Alias kind -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
")") Maybe (Alias kind)
mbAlias
data TransferFailure = TransferFailure
{ TransferFailure -> AddressAndAlias
tfAddressAndAlias :: AddressAndAlias
, TransferFailure -> CallSequence
tfCallSeqence :: CallSequence
, TransferFailure -> TransferFailureReason
tfReason :: TransferFailureReason
}
deriving stock instance Show TransferFailure
newtype CallSequence = CallSequence [CallSequenceOp]
deriving stock Int -> CallSequence -> ShowS
[CallSequence] -> ShowS
CallSequence -> String
(Int -> CallSequence -> ShowS)
-> (CallSequence -> String)
-> ([CallSequence] -> ShowS)
-> Show CallSequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallSequence] -> ShowS
$cshowList :: [CallSequence] -> ShowS
show :: CallSequence -> String
$cshow :: CallSequence -> String
showsPrec :: Int -> CallSequence -> ShowS
$cshowsPrec :: Int -> CallSequence -> ShowS
Show
deriving newtype (Eq (Element CallSequence) =>
Element CallSequence -> CallSequence -> Bool
Ord (Element CallSequence) =>
CallSequence -> Maybe (Element CallSequence)
Monoid (Element CallSequence) =>
CallSequence -> Element CallSequence
(Element CallSequence ~ Bool) => CallSequence -> Bool
CallSequence -> Bool
CallSequence -> Int
CallSequence -> [Element CallSequence]
CallSequence -> Maybe (Element CallSequence)
(Element CallSequence -> Bool) -> CallSequence -> Bool
(Element CallSequence -> Bool)
-> CallSequence -> Maybe (Element CallSequence)
(Element CallSequence
-> Element CallSequence -> Element CallSequence)
-> CallSequence -> Maybe (Element CallSequence)
(CallSequence -> [Element CallSequence])
-> (CallSequence -> Bool)
-> (forall b.
(Element CallSequence -> b -> b) -> b -> CallSequence -> b)
-> (forall b.
(b -> Element CallSequence -> b) -> b -> CallSequence -> b)
-> (forall b.
(b -> Element CallSequence -> b) -> b -> CallSequence -> b)
-> (CallSequence -> Int)
-> (Eq (Element CallSequence) =>
Element CallSequence -> CallSequence -> Bool)
-> (forall m.
Monoid m =>
(Element CallSequence -> m) -> CallSequence -> m)
-> (Monoid (Element CallSequence) =>
CallSequence -> Element CallSequence)
-> (forall b.
(Element CallSequence -> b -> b) -> b -> CallSequence -> b)
-> (Eq (Element CallSequence) =>
Element CallSequence -> CallSequence -> Bool)
-> ((Element CallSequence -> Bool) -> CallSequence -> Bool)
-> ((Element CallSequence -> Bool) -> CallSequence -> Bool)
-> ((Element CallSequence ~ Bool) => CallSequence -> Bool)
-> ((Element CallSequence ~ Bool) => CallSequence -> Bool)
-> ((Element CallSequence -> Bool)
-> CallSequence -> Maybe (Element CallSequence))
-> (CallSequence -> Maybe (Element CallSequence))
-> (Ord (Element CallSequence) =>
CallSequence -> Maybe (Element CallSequence))
-> (Ord (Element CallSequence) =>
CallSequence -> Maybe (Element CallSequence))
-> ((Element CallSequence
-> Element CallSequence -> Element CallSequence)
-> CallSequence -> Maybe (Element CallSequence))
-> ((Element CallSequence
-> Element CallSequence -> Element CallSequence)
-> CallSequence -> Maybe (Element CallSequence))
-> Container CallSequence
forall m.
Monoid m =>
(Element CallSequence -> m) -> CallSequence -> m
forall t.
(t -> [Element t])
-> (t -> Bool)
-> (forall b. (Element t -> b -> b) -> b -> t -> b)
-> (forall b. (b -> Element t -> b) -> b -> t -> b)
-> (forall b. (b -> Element t -> b) -> b -> t -> b)
-> (t -> Int)
-> (Eq (Element t) => Element t -> t -> Bool)
-> (forall m. Monoid m => (Element t -> m) -> t -> m)
-> (Monoid (Element t) => t -> Element t)
-> (forall b. (Element t -> b -> b) -> b -> t -> b)
-> (Eq (Element t) => Element t -> t -> Bool)
-> ((Element t -> Bool) -> t -> Bool)
-> ((Element t -> Bool) -> t -> Bool)
-> ((Element t ~ Bool) => t -> Bool)
-> ((Element t ~ Bool) => t -> Bool)
-> ((Element t -> Bool) -> t -> Maybe (Element t))
-> (t -> Maybe (Element t))
-> (Ord (Element t) => t -> Maybe (Element t))
-> (Ord (Element t) => t -> Maybe (Element t))
-> ((Element t -> Element t -> Element t)
-> t -> Maybe (Element t))
-> ((Element t -> Element t -> Element t)
-> t -> Maybe (Element t))
-> Container t
forall b.
(b -> Element CallSequence -> b) -> b -> CallSequence -> b
forall b.
(Element CallSequence -> b -> b) -> b -> CallSequence -> b
safeFoldl1 :: (Element CallSequence
-> Element CallSequence -> Element CallSequence)
-> CallSequence -> Maybe (Element CallSequence)
$csafeFoldl1 :: (Element CallSequence
-> Element CallSequence -> Element CallSequence)
-> CallSequence -> Maybe (Element CallSequence)
safeFoldr1 :: (Element CallSequence
-> Element CallSequence -> Element CallSequence)
-> CallSequence -> Maybe (Element CallSequence)
$csafeFoldr1 :: (Element CallSequence
-> Element CallSequence -> Element CallSequence)
-> CallSequence -> Maybe (Element CallSequence)
safeMinimum :: Ord (Element CallSequence) =>
CallSequence -> Maybe (Element CallSequence)
$csafeMinimum :: Ord (Element CallSequence) =>
CallSequence -> Maybe (Element CallSequence)
safeMaximum :: Ord (Element CallSequence) =>
CallSequence -> Maybe (Element CallSequence)
$csafeMaximum :: Ord (Element CallSequence) =>
CallSequence -> Maybe (Element CallSequence)
safeHead :: CallSequence -> Maybe (Element CallSequence)
$csafeHead :: CallSequence -> Maybe (Element CallSequence)
find :: (Element CallSequence -> Bool)
-> CallSequence -> Maybe (Element CallSequence)
$cfind :: (Element CallSequence -> Bool)
-> CallSequence -> Maybe (Element CallSequence)
or :: (Element CallSequence ~ Bool) => CallSequence -> Bool
$cor :: (Element CallSequence ~ Bool) => CallSequence -> Bool
and :: (Element CallSequence ~ Bool) => CallSequence -> Bool
$cand :: (Element CallSequence ~ Bool) => CallSequence -> Bool
any :: (Element CallSequence -> Bool) -> CallSequence -> Bool
$cany :: (Element CallSequence -> Bool) -> CallSequence -> Bool
all :: (Element CallSequence -> Bool) -> CallSequence -> Bool
$call :: (Element CallSequence -> Bool) -> CallSequence -> Bool
notElem :: Eq (Element CallSequence) =>
Element CallSequence -> CallSequence -> Bool
$cnotElem :: Eq (Element CallSequence) =>
Element CallSequence -> CallSequence -> Bool
foldr' :: forall b.
(Element CallSequence -> b -> b) -> b -> CallSequence -> b
$cfoldr' :: forall b.
(Element CallSequence -> b -> b) -> b -> CallSequence -> b
fold :: Monoid (Element CallSequence) =>
CallSequence -> Element CallSequence
$cfold :: Monoid (Element CallSequence) =>
CallSequence -> Element CallSequence
foldMap :: forall m.
Monoid m =>
(Element CallSequence -> m) -> CallSequence -> m
$cfoldMap :: forall m.
Monoid m =>
(Element CallSequence -> m) -> CallSequence -> m
elem :: Eq (Element CallSequence) =>
Element CallSequence -> CallSequence -> Bool
$celem :: Eq (Element CallSequence) =>
Element CallSequence -> CallSequence -> Bool
length :: CallSequence -> Int
$clength :: CallSequence -> Int
foldl' :: forall b.
(b -> Element CallSequence -> b) -> b -> CallSequence -> b
$cfoldl' :: forall b.
(b -> Element CallSequence -> b) -> b -> CallSequence -> b
foldl :: forall b.
(b -> Element CallSequence -> b) -> b -> CallSequence -> b
$cfoldl :: forall b.
(b -> Element CallSequence -> b) -> b -> CallSequence -> b
foldr :: forall b.
(Element CallSequence -> b -> b) -> b -> CallSequence -> b
$cfoldr :: forall b.
(Element CallSequence -> b -> b) -> b -> CallSequence -> b
null :: CallSequence -> Bool
$cnull :: CallSequence -> Bool
toList :: CallSequence -> [Element CallSequence]
$ctoList :: CallSequence -> [Element CallSequence]
Container, NonEmpty CallSequence -> CallSequence
CallSequence -> CallSequence -> CallSequence
(CallSequence -> CallSequence -> CallSequence)
-> (NonEmpty CallSequence -> CallSequence)
-> (forall b. Integral b => b -> CallSequence -> CallSequence)
-> Semigroup CallSequence
forall b. Integral b => b -> CallSequence -> CallSequence
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> CallSequence -> CallSequence
$cstimes :: forall b. Integral b => b -> CallSequence -> CallSequence
sconcat :: NonEmpty CallSequence -> CallSequence
$csconcat :: NonEmpty CallSequence -> CallSequence
<> :: CallSequence -> CallSequence -> CallSequence
$c<> :: CallSequence -> CallSequence -> CallSequence
Semigroup, Semigroup CallSequence
CallSequence
Semigroup CallSequence
-> CallSequence
-> (CallSequence -> CallSequence -> CallSequence)
-> ([CallSequence] -> CallSequence)
-> Monoid CallSequence
[CallSequence] -> CallSequence
CallSequence -> CallSequence -> CallSequence
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CallSequence] -> CallSequence
$cmconcat :: [CallSequence] -> CallSequence
mappend :: CallSequence -> CallSequence -> CallSequence
$cmappend :: CallSequence -> CallSequence -> CallSequence
mempty :: CallSequence
$cmempty :: CallSequence
Monoid)
instance Buildable CallSequence where
build :: CallSequence -> Doc
build (CallSequence [CallSequenceOp]
xs)
| [CallSequenceOp] -> Bool
forall t. Container t => t -> Bool
null [CallSequenceOp]
xs = Doc
forall a. Monoid a => a
mempty
| Bool
otherwise = [CallSequenceOp] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF [CallSequenceOp]
xs
buildLastBranchLinear :: CallSequence -> Doc
buildLastBranchLinear :: CallSequence -> Doc
buildLastBranchLinear = [Doc] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF ([Doc] -> Doc) -> (CallSequence -> [Doc]) -> CallSequence -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallSequence -> [Doc]
go
where
go :: CallSequence -> [Doc]
go (CallSequence [CallSequenceOp]
xs) = [CallSequenceOp] -> Maybe (NonEmpty CallSequenceOp)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [CallSequenceOp]
xs Maybe (NonEmpty CallSequenceOp)
-> (Maybe (NonEmpty CallSequenceOp) -> [Doc]) -> [Doc]
forall a b. a -> (a -> b) -> b
&
[Doc]
-> (NonEmpty CallSequenceOp -> [Doc])
-> Maybe (NonEmpty CallSequenceOp)
-> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Doc]
forall a. Monoid a => a
mempty
\(NonEmpty CallSequenceOp -> CallSequenceOp
forall a. NonEmpty a -> a
last -> CallSequenceOp{a
CallSequence
csoSubCalls :: CallSequenceOp -> CallSequence
csoData :: ()
csoSubCalls :: CallSequence
csoData :: a
..}) -> a -> Doc
forall a. Buildable a => a -> Doc
build a
csoData Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: CallSequence -> [Doc]
go CallSequence
csoSubCalls
data CallSequenceOp =
forall a. (Buildable a, Show a) => CallSequenceOp
{ ()
csoData :: a
, CallSequenceOp -> CallSequence
csoSubCalls :: CallSequence
}
deriving stock instance Show CallSequenceOp
instance Buildable CallSequenceOp where
build :: CallSequenceOp -> Doc
build CallSequenceOp{a
CallSequence
csoSubCalls :: CallSequence
csoData :: a
csoSubCalls :: CallSequenceOp -> CallSequence
csoData :: ()
..}
| CallSequence -> Bool
forall t. Container t => t -> Bool
null CallSequence
csoSubCalls = a -> Doc
forall a. Buildable a => a -> Doc
build a
csoData
| Bool
otherwise = [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ a -> Doc
forall a. Buildable a => a -> Doc
build a
csoData
, CallSequence -> Doc
forall a. Buildable a => a -> Doc
build CallSequence
csoSubCalls
]
type ToCallSeqM k = State [(k, [CallSequenceOp])]
toCallSeq :: Eq k => (a -> ToCallSeqM k (Maybe (k, CallSequenceOp))) -> [a] -> CallSequence
toCallSeq :: forall k a.
Eq k =>
(a -> ToCallSeqM k (Maybe (k, CallSequenceOp)))
-> [a] -> CallSequence
toCallSeq a -> ToCallSeqM k (Maybe (k, CallSequenceOp))
toCallOp = [CallSequenceOp] -> CallSequence
CallSequence ([CallSequenceOp] -> CallSequence)
-> ([a] -> [CallSequenceOp]) -> [a] -> CallSequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, [CallSequenceOp]) -> [CallSequenceOp])
-> [(k, [CallSequenceOp])] -> [CallSequenceOp]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (k, [CallSequenceOp]) -> [CallSequenceOp]
forall a b. (a, b) -> b
snd ([(k, [CallSequenceOp])] -> [CallSequenceOp])
-> ([a] -> [(k, [CallSequenceOp])]) -> [a] -> [CallSequenceOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, [CallSequenceOp])]
-> State [(k, [CallSequenceOp])] () -> [(k, [CallSequenceOp])]
forall s a. s -> State s a -> s
executingState [(k, [CallSequenceOp])]
forall a. Monoid a => a
mempty (State [(k, [CallSequenceOp])] () -> [(k, [CallSequenceOp])])
-> ([a] -> State [(k, [CallSequenceOp])] ())
-> [a]
-> [(k, [CallSequenceOp])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> State [(k, [CallSequenceOp])] ()
go ([a] -> State [(k, [CallSequenceOp])] ())
-> ([a] -> [a]) -> [a] -> State [(k, [CallSequenceOp])] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
where
go :: [a] -> State [(k, [CallSequenceOp])] ()
go = \case
[] -> State [(k, [CallSequenceOp])] ()
forall (f :: * -> *). Applicative f => f ()
pass
(a
y : [a]
ys) -> a -> ToCallSeqM k (Maybe (k, CallSequenceOp))
toCallOp a
y ToCallSeqM k (Maybe (k, CallSequenceOp))
-> (Maybe (k, CallSequenceOp) -> State [(k, [CallSequenceOp])] ())
-> State [(k, [CallSequenceOp])] ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State [(k, [CallSequenceOp])] ()
-> ((k, CallSequenceOp) -> State [(k, [CallSequenceOp])] ())
-> Maybe (k, CallSequenceOp)
-> State [(k, [CallSequenceOp])] ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe State [(k, [CallSequenceOp])] ()
forall (f :: * -> *). Applicative f => f ()
pass ((k -> CallSequenceOp -> State [(k, [CallSequenceOp])] ())
-> (k, CallSequenceOp) -> State [(k, [CallSequenceOp])] ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> CallSequenceOp -> State [(k, [CallSequenceOp])] ()
forall {a} {a} {m :: * -> *}.
(MonadState [(a, [a])] m, Eq a) =>
a -> a -> m ()
push) State [(k, [CallSequenceOp])] ()
-> State [(k, [CallSequenceOp])] ()
-> State [(k, [CallSequenceOp])] ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> State [(k, [CallSequenceOp])] ()
go [a]
ys
push :: a -> a -> m ()
push a
src a
op = ([(a, [a])] -> [(a, [a])]) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify \case
(a
src', [a]
ops) : [(a, [a])]
xs | a
src a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
src' -> (a
src', a
opa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ops) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a, [a])]
xs
[(a, [a])]
xs -> (a
src, [a
op]) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a, [a])]
xs
popToCallSeq :: Eq k => k -> ToCallSeqM k [CallSequenceOp]
popToCallSeq :: forall k. Eq k => k -> ToCallSeqM k [CallSequenceOp]
popToCallSeq k
src = StateT [(k, [CallSequenceOp])] Identity [(k, [CallSequenceOp])]
forall s (m :: * -> *). MonadState s m => m s
get StateT [(k, [CallSequenceOp])] Identity [(k, [CallSequenceOp])]
-> ([(k, [CallSequenceOp])]
-> StateT [(k, [CallSequenceOp])] Identity [CallSequenceOp])
-> StateT [(k, [CallSequenceOp])] Identity [CallSequenceOp]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(k
src', [CallSequenceOp]
ops) : [(k, [CallSequenceOp])]
xs | k
src k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
src' -> [(k, [CallSequenceOp])]
-> StateT [(k, [CallSequenceOp])] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [(k, [CallSequenceOp])]
xs StateT [(k, [CallSequenceOp])] Identity ()
-> StateT [(k, [CallSequenceOp])] Identity [CallSequenceOp]
-> StateT [(k, [CallSequenceOp])] Identity [CallSequenceOp]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [CallSequenceOp]
-> StateT [(k, [CallSequenceOp])] Identity [CallSequenceOp]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CallSequenceOp]
ops
[(k, [CallSequenceOp])]
_ -> [CallSequenceOp]
-> StateT [(k, [CallSequenceOp])] Identity [CallSequenceOp]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CallSequenceOp]
forall a. Monoid a => a
mempty
instance Eq TransferFailure where
TransferFailure
tf1 == :: TransferFailure -> TransferFailure -> Bool
== TransferFailure
tf2 = TransferFailure -> AddressAndAlias
tfAddressAndAlias TransferFailure
tf1 AddressAndAlias -> AddressAndAlias -> Bool
forall a. Eq a => a -> a -> Bool
== TransferFailure -> AddressAndAlias
tfAddressAndAlias TransferFailure
tf2
Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& TransferFailure -> TransferFailureReason
tfReason TransferFailure
tf1 TransferFailureReason -> TransferFailureReason -> Bool
forall a. Eq a => a -> a -> Bool
== TransferFailure -> TransferFailureReason
tfReason TransferFailure
tf2
data TransferFailureReason
= FailedWith ExpressionOrTypedValue (Maybe ErrorSrcPos)
| EmptyTransaction
| BadParameter
| MutezArithError T.MutezArithErrorType
| ShiftOverflow
| GasExhaustion
deriving stock (Int -> TransferFailureReason -> ShowS
[TransferFailureReason] -> ShowS
TransferFailureReason -> String
(Int -> TransferFailureReason -> ShowS)
-> (TransferFailureReason -> String)
-> ([TransferFailureReason] -> ShowS)
-> Show TransferFailureReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferFailureReason] -> ShowS
$cshowList :: [TransferFailureReason] -> ShowS
show :: TransferFailureReason -> String
$cshow :: TransferFailureReason -> String
showsPrec :: Int -> TransferFailureReason -> ShowS
$cshowsPrec :: Int -> TransferFailureReason -> ShowS
Show, TransferFailureReason -> TransferFailureReason -> Bool
(TransferFailureReason -> TransferFailureReason -> Bool)
-> (TransferFailureReason -> TransferFailureReason -> Bool)
-> Eq TransferFailureReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransferFailureReason -> TransferFailureReason -> Bool
$c/= :: TransferFailureReason -> TransferFailureReason -> Bool
== :: TransferFailureReason -> TransferFailureReason -> Bool
$c== :: TransferFailureReason -> TransferFailureReason -> Bool
Eq)
instance Buildable TransferFailure where
build :: TransferFailure -> Doc
build (TransferFailure AddressAndAlias
addr CallSequence
stack TransferFailureReason
reason) = [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF [Doc
message, Doc
rest]
where
message :: Doc
message = case TransferFailureReason
reason of
TransferFailureReason
EmptyTransaction -> TransferFailureReason
reason TransferFailureReason -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
": " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| AddressAndAlias
addr AddressAndAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
TransferFailureReason
BadParameter -> Doc
"Attempted to call contract " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| AddressAndAlias
addr AddressAndAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" with a " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| TransferFailureReason
reason TransferFailureReason -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
FailedWith{} -> Doc
"Contract: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| AddressAndAlias
addr AddressAndAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| TransferFailureReason
reason TransferFailureReason -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
TransferFailureReason
_ -> Doc
"Contract: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| AddressAndAlias
addr AddressAndAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" failed due to a " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| TransferFailureReason
reason TransferFailureReason -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
rest :: Doc
rest | CallSequence -> Bool
forall t. Container t => t -> Bool
null CallSequence
stack = Doc
forall a. Monoid a => a
mempty
| Bool
otherwise = Doc
"Call chain:\n" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CallSequence -> Doc
buildLastBranchLinear CallSequence
stack
instance Buildable TransferFailureReason where
build :: TransferFailureReason -> Doc
build = \case
FailedWith ExpressionOrTypedValue
expr Maybe ErrorSrcPos
loc -> Doc
"failed with: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ExpressionOrTypedValue
expr ExpressionOrTypedValue -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc -> (ErrorSrcPos -> Doc) -> Maybe ErrorSrcPos -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"" ((Doc
" at " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|) (Doc -> Doc) -> (ErrorSrcPos -> Doc) -> ErrorSrcPos -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorSrcPos -> Doc
forall a. Buildable a => a -> Doc
build) Maybe ErrorSrcPos
loc
TransferFailureReason
EmptyTransaction -> Doc
"Attempted to transfer 0tz to a simple address"
TransferFailureReason
BadParameter -> Doc
"parameter of the wrong type"
MutezArithError MutezArithErrorType
typ -> Doc
"mutez " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| MutezArithErrorType
typ MutezArithErrorType -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
TransferFailureReason
ShiftOverflow -> Doc
"overflow error"
TransferFailureReason
GasExhaustion -> Doc
"gas exhaustion"
data GenericTestError
= UnexpectedSuccess
deriving stock Int -> GenericTestError -> ShowS
[GenericTestError] -> ShowS
GenericTestError -> String
(Int -> GenericTestError -> ShowS)
-> (GenericTestError -> String)
-> ([GenericTestError] -> ShowS)
-> Show GenericTestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericTestError] -> ShowS
$cshowList :: [GenericTestError] -> ShowS
show :: GenericTestError -> String
$cshow :: GenericTestError -> String
showsPrec :: Int -> GenericTestError -> ShowS
$cshowsPrec :: Int -> GenericTestError -> ShowS
Show
instance Buildable GenericTestError where
build :: GenericTestError -> Doc
build = \case
GenericTestError
UnexpectedSuccess ->
Doc
"Expected an exception to be thrown, but it wasn't"
instance Exception TransferFailure where
displayException :: TransferFailure -> String
displayException = TransferFailure -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
fromException :: SomeException -> Maybe TransferFailure
fromException = SomeException -> Maybe TransferFailure
forall e. Exception e => SomeException -> Maybe e
fromPossiblyAnnotatedException
instance Exception GenericTestError where
displayException :: GenericTestError -> String
displayException = GenericTestError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
fromException :: SomeException -> Maybe GenericTestError
fromException = SomeException -> Maybe GenericTestError
forall e. Exception e => SomeException -> Maybe e
fromPossiblyAnnotatedException
class NiceEntrypointName epName => EntrypointNameConstructor (epName :: Symbol) a where
ep :: a
instance (NiceEntrypointName epName, mname ~ 'Just epName)
=> EntrypointNameConstructor epName (EntrypointRef mname) where
ep :: EntrypointRef mname
ep = EntrypointRef mname
forall (name :: Symbol).
NiceEntrypointName name =>
EntrypointRef ('Just name)
Call
instance NiceEntrypointName epName => EntrypointNameConstructor epName EpName where
ep :: EpName
ep = EntrypointRef ('Just epName) -> EpName
forall (mname :: Maybe Symbol). EntrypointRef mname -> EpName
eprName (EntrypointRef ('Just epName) -> EpName)
-> EntrypointRef ('Just epName) -> EpName
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol).
NiceEntrypointName name =>
EntrypointRef ('Just name)
Call @epName
instance (any ~ "", t ~ Text) => EntrypointNameConstructor any (t -> EpName) where
ep :: t -> EpName
ep = Either String EpName -> EpName
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either String EpName -> EpName)
-> (Text -> Either String EpName) -> Text -> EpName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String EpName
U.buildEpName
mapClevelandOpsImplExceptions
:: (forall a. HasCallStack => m a -> m a)
-> ClevelandOpsImpl m -> ClevelandOpsImpl m
mapClevelandOpsImplExceptions :: forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandOpsImpl m -> ClevelandOpsImpl m
mapClevelandOpsImplExceptions forall a. HasCallStack => m a -> m a
f ClevelandOpsImpl{HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch :: forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
..} = ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
[OperationInfo ClevelandInput]
-> m [OperationInfo ClevelandResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
{ coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch = \[OperationInfo ClevelandInput]
op -> m [OperationInfo ClevelandResult]
-> m [OperationInfo ClevelandResult]
forall a. HasCallStack => m a -> m a
f (m [OperationInfo ClevelandResult]
-> m [OperationInfo ClevelandResult])
-> m [OperationInfo ClevelandResult]
-> m [OperationInfo ClevelandResult]
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
[OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch [OperationInfo ClevelandInput]
op
}
mapClevelandMiscImplExceptions
:: (forall a. HasCallStack => m a -> m a)
-> ClevelandMiscImpl m -> ClevelandMiscImpl m
mapClevelandMiscImplExceptions :: forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandMiscImpl m -> ClevelandMiscImpl m
mapClevelandMiscImplExceptions forall a. HasCallStack => m a -> m a
f ClevelandMiscImpl{m (Either (EmulatedImpl m) NetworkEnv)
HasCallStack => m Natural
HasCallStack => m (Time Second)
HasCallStack => m ChainId
HasCallStack => m Timestamp
HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
HasCallStack => Text -> m ()
HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
HasCallStack => ContractAddress -> m SomeAnnotatedValue
HasCallStack => L1Address -> m (Maybe KeyHash)
HasCallStack => L1Address -> m Mutez
HasCallStack => ImplicitAddressWithAlias -> m PublicKey
HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
HasCallStack => (Natural -> Natural) -> m ()
ImplicitAddress -> m ()
ContractAddress -> m [SomeTicket]
forall res. HasCallStack => IO res -> m res
forall a. HasCallStack => SomeException -> m a
forall a. HasCallStack => Doc -> m a
forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiAllTicketBalances :: ContractAddress -> m [SomeTicket]
cmiTicketBalance :: forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
cmiRunCode :: forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
cmiUnderlyingImpl :: m (Either (EmulatedImpl m) NetworkEnv)
cmiMarkAddressRefillable :: ImplicitAddress -> m ()
cmiAttempt :: forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiGetApproximateBlockInterval :: HasCallStack => m (Time Second)
cmiThrow :: forall a. HasCallStack => SomeException -> m a
cmiFailure :: forall a. HasCallStack => Doc -> m a
cmiGetLevel :: HasCallStack => m Natural
cmiGetNow :: HasCallStack => m Timestamp
cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceTime :: forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
cmiGetChainId :: HasCallStack => m ChainId
cmiGetDelegate :: HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetPublicKey :: HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetAllBigMapValuesMaybe :: forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
cmiGetBigMapValueMaybe :: forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
cmiGetSomeStorage :: HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetBalance :: HasCallStack => L1Address -> m Mutez
cmiComment :: HasCallStack => Text -> m ()
cmiOriginateLargeUntyped :: forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiSignBytes :: HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
cmiGenFreshKey :: HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey :: HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey :: HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiResolveAddress :: forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
cmiRunIO :: forall res. HasCallStack => IO res -> m res
cmiAllTicketBalances :: forall (m :: * -> *).
ClevelandMiscImpl m -> ContractAddress -> m [SomeTicket]
cmiTicketBalance :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
cmiRunCode :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
cmiUnderlyingImpl :: forall (m :: * -> *).
ClevelandMiscImpl m -> m (Either (EmulatedImpl m) NetworkEnv)
cmiMarkAddressRefillable :: forall (m :: * -> *).
ClevelandMiscImpl m -> ImplicitAddress -> m ()
cmiAttempt :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiGetApproximateBlockInterval :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m (Time Second)
cmiThrow :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a. HasCallStack => SomeException -> m a
cmiFailure :: forall (m :: * -> *).
ClevelandMiscImpl m -> forall a. HasCallStack => Doc -> m a
cmiGetLevel :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Natural
cmiGetNow :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m Timestamp
cmiAdvanceToLevel :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceTime :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
cmiGetChainId :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => m ChainId
cmiGetDelegate :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetPublicKey :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetAllBigMapValuesMaybe :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
cmiGetBigMapValueMaybe :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
cmiGetSomeStorage :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetBalance :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => L1Address -> m Mutez
cmiComment :: forall (m :: * -> *).
ClevelandMiscImpl m -> HasCallStack => Text -> m ()
cmiOriginateLargeUntyped :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiSignBytes :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
cmiGenFreshKey :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey :: forall (m :: * -> *).
ClevelandMiscImpl m
-> HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiResolveAddress :: forall (m :: * -> *).
ClevelandMiscImpl m
-> forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
cmiRunIO :: forall (m :: * -> *).
ClevelandMiscImpl m -> forall res. HasCallStack => IO res -> m res
..} = ClevelandMiscImpl :: forall (m :: * -> *).
(forall res. HasCallStack => IO res -> m res)
-> (forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind))
-> (HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias)
-> (HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias)
-> (HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias)
-> (HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature)
-> (forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress)
-> (HasCallStack => Text -> m ())
-> (HasCallStack => L1Address -> m Mutez)
-> (HasCallStack => ContractAddress -> m SomeAnnotatedValue)
-> (forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v))
-> (forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v]))
-> (HasCallStack => ImplicitAddressWithAlias -> m PublicKey)
-> (HasCallStack => L1Address -> m (Maybe KeyHash))
-> (HasCallStack => m ChainId)
-> (forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ())
-> (HasCallStack => (Natural -> Natural) -> m ())
-> (HasCallStack => m Timestamp)
-> (HasCallStack => m Natural)
-> (forall a. HasCallStack => Doc -> m a)
-> (forall a. HasCallStack => SomeException -> m a)
-> (HasCallStack => m (Time Second))
-> (forall a e.
(Exception e, HasCallStack) =>
m a -> m (Either e a))
-> (ImplicitAddress -> m ())
-> m (Either (EmulatedImpl m) NetworkEnv)
-> (forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st))
-> (forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural)
-> (ContractAddress -> m [SomeTicket])
-> ClevelandMiscImpl m
ClevelandMiscImpl
{ cmiRunIO :: forall res. HasCallStack => IO res -> m res
cmiRunIO = \IO res
action -> m res -> m res
forall a. HasCallStack => m a -> m a
f (m res -> m res) -> m res -> m res
forall a b. (a -> b) -> a -> b
$ IO res -> m res
forall res. HasCallStack => IO res -> m res
cmiRunIO IO res
action
, cmiResolveAddress :: forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
cmiResolveAddress = \AddressOrAlias kind
address -> m (AddressWithAlias kind) -> m (AddressWithAlias kind)
forall a. HasCallStack => m a -> m a
f (m (AddressWithAlias kind) -> m (AddressWithAlias kind))
-> m (AddressWithAlias kind) -> m (AddressWithAlias kind)
forall a b. (a -> b) -> a -> b
$ AddressOrAlias kind -> m (AddressWithAlias kind)
forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> m (AddressWithAlias kind)
cmiResolveAddress AddressOrAlias kind
address
, cmiSignBytes :: HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
cmiSignBytes = \ByteString
bs ImplicitAddressWithAlias
alias -> m Signature -> m Signature
forall a. HasCallStack => m a -> m a
f (m Signature -> m Signature) -> m Signature -> m Signature
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> m Signature
ByteString -> ImplicitAddressWithAlias -> m Signature
cmiSignBytes ByteString
bs ImplicitAddressWithAlias
alias
, cmiGenKey :: HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey = \SpecificOrDefaultAlias
alias -> m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a. HasCallStack => m a -> m a
f (m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias)
-> m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenKey SpecificOrDefaultAlias
alias
, cmiImportKey :: HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey = m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a. HasCallStack => m a -> m a
f (m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias)
-> (SecretKey
-> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias)
-> SecretKey
-> SpecificOrDefaultAlias
-> m ImplicitAddressWithAlias
forall a b c. SuperComposition a b c => a -> b -> c
... HasCallStack =>
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
SecretKey -> SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiImportKey
, cmiGenFreshKey :: HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenFreshKey = \SpecificOrDefaultAlias
alias -> m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a. HasCallStack => m a -> m a
f (m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias)
-> m ImplicitAddressWithAlias -> m ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
SpecificOrDefaultAlias -> m ImplicitAddressWithAlias
cmiGenFreshKey SpecificOrDefaultAlias
alias
, cmiOriginateLargeUntyped :: forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiOriginateLargeUntyped = \Sender
sender OriginateData oty 'IsLarge
uodata -> m ContractAddress -> m ContractAddress
forall a. HasCallStack => m a -> m a
f (m ContractAddress -> m ContractAddress)
-> m ContractAddress -> m ContractAddress
forall a b. (a -> b) -> a -> b
$ Sender -> OriginateData oty 'IsLarge -> m ContractAddress
forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> m ContractAddress
cmiOriginateLargeUntyped Sender
sender OriginateData oty 'IsLarge
uodata
, cmiComment :: HasCallStack => Text -> m ()
cmiComment = \Text
t -> m () -> m ()
forall a. HasCallStack => m a -> m a
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> m ()
Text -> m ()
cmiComment Text
t
, cmiGetBalance :: HasCallStack => L1Address -> m Mutez
cmiGetBalance = \L1Address
addr -> m Mutez -> m Mutez
forall a. HasCallStack => m a -> m a
f (m Mutez -> m Mutez) -> m Mutez -> m Mutez
forall a b. (a -> b) -> a -> b
$ HasCallStack => L1Address -> m Mutez
L1Address -> m Mutez
cmiGetBalance L1Address
addr
, cmiGetSomeStorage :: HasCallStack => ContractAddress -> m SomeAnnotatedValue
cmiGetSomeStorage = \ContractAddress
addr -> m SomeAnnotatedValue -> m SomeAnnotatedValue
forall a. HasCallStack => m a -> m a
f (m SomeAnnotatedValue -> m SomeAnnotatedValue)
-> m SomeAnnotatedValue -> m SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$ HasCallStack => ContractAddress -> m SomeAnnotatedValue
ContractAddress -> m SomeAnnotatedValue
cmiGetSomeStorage ContractAddress
addr
, cmiGetBigMapValueMaybe :: forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
cmiGetBigMapValueMaybe = \BigMapId k v
bmId k
k -> m (Maybe v) -> m (Maybe v)
forall a. HasCallStack => m a -> m a
f (m (Maybe v) -> m (Maybe v)) -> m (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ BigMapId k v -> k -> m (Maybe v)
forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> m (Maybe v)
cmiGetBigMapValueMaybe BigMapId k v
bmId k
k
, cmiGetAllBigMapValuesMaybe :: forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
cmiGetAllBigMapValuesMaybe = \BigMapId k v
bmId -> m (Maybe [v]) -> m (Maybe [v])
forall a. HasCallStack => m a -> m a
f (m (Maybe [v]) -> m (Maybe [v])) -> m (Maybe [v]) -> m (Maybe [v])
forall a b. (a -> b) -> a -> b
$ BigMapId k v -> m (Maybe [v])
forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v])
cmiGetAllBigMapValuesMaybe BigMapId k v
bmId
, cmiGetPublicKey :: HasCallStack => ImplicitAddressWithAlias -> m PublicKey
cmiGetPublicKey = \ImplicitAddressWithAlias
addr -> m PublicKey -> m PublicKey
forall a. HasCallStack => m a -> m a
f (m PublicKey -> m PublicKey) -> m PublicKey -> m PublicKey
forall a b. (a -> b) -> a -> b
$ HasCallStack => ImplicitAddressWithAlias -> m PublicKey
ImplicitAddressWithAlias -> m PublicKey
cmiGetPublicKey ImplicitAddressWithAlias
addr
, cmiGetDelegate :: HasCallStack => L1Address -> m (Maybe KeyHash)
cmiGetDelegate = m (Maybe KeyHash) -> m (Maybe KeyHash)
forall a. HasCallStack => m a -> m a
f (m (Maybe KeyHash) -> m (Maybe KeyHash))
-> (L1Address -> m (Maybe KeyHash))
-> L1Address
-> m (Maybe KeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => L1Address -> m (Maybe KeyHash)
L1Address -> m (Maybe KeyHash)
cmiGetDelegate
, cmiGetChainId :: HasCallStack => m ChainId
cmiGetChainId = m ChainId -> m ChainId
forall a. HasCallStack => m a -> m a
f (m ChainId -> m ChainId) -> m ChainId -> m ChainId
forall a b. (a -> b) -> a -> b
$ m ChainId
HasCallStack => m ChainId
cmiGetChainId
, cmiAdvanceTime :: forall (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
cmiAdvanceTime = \Time unit
time -> m () -> m ()
forall a. HasCallStack => m a -> m a
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Time unit -> m ()
forall {unit :: Rat}.
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> m ()
cmiAdvanceTime Time unit
time
, cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> m ()
cmiAdvanceToLevel = \Natural -> Natural
level -> m () -> m ()
forall a. HasCallStack => m a -> m a
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => (Natural -> Natural) -> m ()
(Natural -> Natural) -> m ()
cmiAdvanceToLevel Natural -> Natural
level
, cmiGetNow :: HasCallStack => m Timestamp
cmiGetNow = m Timestamp -> m Timestamp
forall a. HasCallStack => m a -> m a
f (m Timestamp -> m Timestamp) -> m Timestamp -> m Timestamp
forall a b. (a -> b) -> a -> b
$ m Timestamp
HasCallStack => m Timestamp
cmiGetNow
, cmiGetLevel :: HasCallStack => m Natural
cmiGetLevel = m Natural -> m Natural
forall a. HasCallStack => m a -> m a
f (m Natural -> m Natural) -> m Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ m Natural
HasCallStack => m Natural
cmiGetLevel
, cmiFailure :: forall a. HasCallStack => Doc -> m a
cmiFailure = \Doc
builder -> m a -> m a
forall a. HasCallStack => m a -> m a
f (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Doc -> m a
forall a. HasCallStack => Doc -> m a
cmiFailure Doc
builder
, cmiGetApproximateBlockInterval :: HasCallStack => m (Time Second)
cmiGetApproximateBlockInterval = m (Time (1 :% 1)) -> m (Time (1 :% 1))
forall a. HasCallStack => m a -> m a
f (m (Time (1 :% 1)) -> m (Time (1 :% 1)))
-> m (Time (1 :% 1)) -> m (Time (1 :% 1))
forall a b. (a -> b) -> a -> b
$ m (Time (1 :% 1))
HasCallStack => m (Time Second)
cmiGetApproximateBlockInterval
, cmiAttempt :: forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiAttempt = \m a
action -> m a -> m (Either e a)
forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiAttempt m a
action
, cmiMarkAddressRefillable :: ImplicitAddress -> m ()
cmiMarkAddressRefillable = m () -> m ()
forall a. HasCallStack => m a -> m a
f (m () -> m ())
-> (ImplicitAddress -> m ()) -> ImplicitAddress -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddress -> m ()
cmiMarkAddressRefillable
, cmiThrow :: forall a. HasCallStack => SomeException -> m a
cmiThrow = forall a. HasCallStack => SomeException -> m a
cmiThrow
, cmiUnderlyingImpl :: m (Either (EmulatedImpl m) NetworkEnv)
cmiUnderlyingImpl = m (Either (EmulatedImpl m) NetworkEnv)
-> m (Either (EmulatedImpl m) NetworkEnv)
forall a. HasCallStack => m a -> m a
f (m (Either (EmulatedImpl m) NetworkEnv)
-> m (Either (EmulatedImpl m) NetworkEnv))
-> m (Either (EmulatedImpl m) NetworkEnv)
-> m (Either (EmulatedImpl m) NetworkEnv)
forall a b. (a -> b) -> a -> b
$ m (Either (EmulatedImpl m) NetworkEnv)
cmiUnderlyingImpl
, cmiRunCode :: forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
cmiRunCode = m (AsRPC st) -> m (AsRPC st)
forall a. HasCallStack => m a -> m a
f (m (AsRPC st) -> m (AsRPC st))
-> (Sender -> RunCode cp st vd -> m (AsRPC st))
-> Sender
-> RunCode cp st vd
-> m (AsRPC st)
forall a b c. SuperComposition a b c => a -> b -> c
... Sender -> RunCode cp st vd -> m (AsRPC st)
forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> m (AsRPC st)
cmiRunCode
, cmiTicketBalance :: forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
cmiTicketBalance = m Natural -> m Natural
forall a. HasCallStack => m a -> m a
f (m Natural -> m Natural)
-> (L1Address -> ContractAddress -> Value t -> m Natural)
-> L1Address
-> ContractAddress
-> Value t
-> m Natural
forall a b c. SuperComposition a b c => a -> b -> c
... L1Address -> ContractAddress -> Value t -> m Natural
forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> m Natural
cmiTicketBalance
, cmiAllTicketBalances :: ContractAddress -> m [SomeTicket]
cmiAllTicketBalances = m [SomeTicket] -> m [SomeTicket]
forall a. HasCallStack => m a -> m a
f (m [SomeTicket] -> m [SomeTicket])
-> (ContractAddress -> m [SomeTicket])
-> ContractAddress
-> m [SomeTicket]
forall a b c. SuperComposition a b c => a -> b -> c
... ContractAddress -> m [SomeTicket]
cmiAllTicketBalances
}
data ClevelandCaps m = ClevelandCaps
{ forall (m :: * -> *). ClevelandCaps m -> Sender
ccSender :: Sender
, forall (m :: * -> *). ClevelandCaps m -> Moneybag
ccMoneybag :: Moneybag
, forall (m :: * -> *). ClevelandCaps m -> ClevelandMiscImpl m
ccMiscCap :: ClevelandMiscImpl m
, forall (m :: * -> *).
ClevelandCaps m -> Sender -> ClevelandOpsImpl m
ccOpsCap :: Sender -> ClevelandOpsImpl m
}
data EmulatedCaps m = EmulatedCaps
{ forall (m :: * -> *). EmulatedCaps m -> EmulatedImpl m
ecEmulatedCap :: EmulatedImpl m
, forall (m :: * -> *). EmulatedCaps m -> ClevelandCaps m
ecClevelandCaps :: ClevelandCaps m
}
data NetworkCaps m = NetworkCaps
{ forall (m :: * -> *). NetworkCaps m -> NetworkEnv
ncNetworkEnv :: NetworkEnv
, forall (m :: * -> *). NetworkCaps m -> ClevelandCaps m
ncClevelandCaps :: ClevelandCaps m
}
makeLensesFor [("ccSender", "ccSenderL"), ("ccMoneybag", "ccMoneybagL")] ''ClevelandCaps
makeLensesFor [("ecClevelandCaps", "ecClevelandCapsL")] ''EmulatedCaps
makeLensesFor [("ncClevelandCaps", "ncClevelandCapsL")] ''NetworkCaps
class Monad (ClevelandBaseMonad caps) => HasClevelandCaps caps where
type ClevelandBaseMonad caps :: Type -> Type
clevelandCapsL :: Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
class HasClevelandCaps caps => HasEmulatedCaps caps where
getEmulatedCap :: caps -> EmulatedImpl (ClevelandBaseMonad caps)
instance Monad m => HasClevelandCaps (ClevelandCaps m) where
type ClevelandBaseMonad (ClevelandCaps m) = m
clevelandCapsL :: Lens'
(ClevelandCaps m)
(ClevelandCaps (ClevelandBaseMonad (ClevelandCaps m)))
clevelandCapsL = (ClevelandCaps (ClevelandBaseMonad (ClevelandCaps m))
-> f (ClevelandCaps (ClevelandBaseMonad (ClevelandCaps m))))
-> ClevelandCaps m -> f (ClevelandCaps m)
forall a. a -> a
id
instance Monad m => HasClevelandCaps (EmulatedCaps m) where
type ClevelandBaseMonad (EmulatedCaps m) = m
clevelandCapsL :: Lens'
(EmulatedCaps m)
(ClevelandCaps (ClevelandBaseMonad (EmulatedCaps m)))
clevelandCapsL = (ClevelandCaps (ClevelandBaseMonad (EmulatedCaps m))
-> f (ClevelandCaps (ClevelandBaseMonad (EmulatedCaps m))))
-> EmulatedCaps m -> f (EmulatedCaps m)
forall (m :: * -> *). Lens' (EmulatedCaps m) (ClevelandCaps m)
ecClevelandCapsL
senderL :: HasClevelandCaps caps => Lens' caps Sender
senderL :: forall caps. HasClevelandCaps caps => Lens' caps Sender
senderL = (ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> caps -> f caps
forall caps.
HasClevelandCaps caps =>
Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
clevelandCapsL ((ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> caps -> f caps)
-> ((Sender -> f Sender)
-> ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> (Sender -> f Sender)
-> caps
-> f caps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sender -> f Sender)
-> ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps))
forall (m :: * -> *). Lens' (ClevelandCaps m) Sender
ccSenderL
moneybagL :: HasClevelandCaps caps => Lens' caps Moneybag
moneybagL :: forall caps. HasClevelandCaps caps => Lens' caps Moneybag
moneybagL = (ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> caps -> f caps
forall caps.
HasClevelandCaps caps =>
Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
clevelandCapsL ((ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> caps -> f caps)
-> ((Moneybag -> f Moneybag)
-> ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps)))
-> (Moneybag -> f Moneybag)
-> caps
-> f caps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Moneybag -> f Moneybag)
-> ClevelandCaps (ClevelandBaseMonad caps)
-> f (ClevelandCaps (ClevelandBaseMonad caps))
forall (m :: * -> *). Lens' (ClevelandCaps m) Moneybag
ccMoneybagL
getMiscCap :: HasClevelandCaps caps => caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap :: forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap = ClevelandCaps (ClevelandBaseMonad caps)
-> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall (m :: * -> *). ClevelandCaps m -> ClevelandMiscImpl m
ccMiscCap (ClevelandCaps (ClevelandBaseMonad caps)
-> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (caps -> ClevelandCaps (ClevelandBaseMonad caps))
-> caps
-> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
(ClevelandCaps (ClevelandBaseMonad caps))
caps
(ClevelandCaps (ClevelandBaseMonad caps))
-> caps -> ClevelandCaps (ClevelandBaseMonad caps)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(ClevelandCaps (ClevelandBaseMonad caps))
caps
(ClevelandCaps (ClevelandBaseMonad caps))
forall caps.
HasClevelandCaps caps =>
Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
clevelandCapsL
getOpsCap :: HasClevelandCaps caps => caps -> ClevelandOpsImpl (ClevelandBaseMonad caps)
getOpsCap :: forall caps.
HasClevelandCaps caps =>
caps -> ClevelandOpsImpl (ClevelandBaseMonad caps)
getOpsCap caps
r = ClevelandCaps (ClevelandBaseMonad caps)
-> Sender -> ClevelandOpsImpl (ClevelandBaseMonad caps)
forall (m :: * -> *).
ClevelandCaps m -> Sender -> ClevelandOpsImpl m
ccOpsCap (caps
r caps
-> Getting
(ClevelandCaps (ClevelandBaseMonad caps))
caps
(ClevelandCaps (ClevelandBaseMonad caps))
-> ClevelandCaps (ClevelandBaseMonad caps)
forall s a. s -> Getting a s a -> a
^. Getting
(ClevelandCaps (ClevelandBaseMonad caps))
caps
(ClevelandCaps (ClevelandBaseMonad caps))
forall caps.
HasClevelandCaps caps =>
Lens' caps (ClevelandCaps (ClevelandBaseMonad caps))
clevelandCapsL) (caps
r caps -> Getting Sender caps Sender -> Sender
forall s a. s -> Getting a s a -> a
^. Getting Sender caps Sender
forall caps. HasClevelandCaps caps => Lens' caps Sender
senderL)
instance Monad m => HasEmulatedCaps (EmulatedCaps m) where
getEmulatedCap :: EmulatedCaps m
-> EmulatedImpl (ClevelandBaseMonad (EmulatedCaps m))
getEmulatedCap = EmulatedCaps m
-> EmulatedImpl (ClevelandBaseMonad (EmulatedCaps m))
forall (m :: * -> *). EmulatedCaps m -> EmulatedImpl m
ecEmulatedCap
class HasClevelandCaps caps => HasNetworkCaps caps where
getNetworkEnvCap :: caps -> NetworkEnv
instance Monad m => HasClevelandCaps (NetworkCaps m) where
type ClevelandBaseMonad (NetworkCaps m) = m
clevelandCapsL :: Lens'
(NetworkCaps m)
(ClevelandCaps (ClevelandBaseMonad (NetworkCaps m)))
clevelandCapsL = (ClevelandCaps (ClevelandBaseMonad (NetworkCaps m))
-> f (ClevelandCaps (ClevelandBaseMonad (NetworkCaps m))))
-> NetworkCaps m -> f (NetworkCaps m)
forall (m :: * -> *) (m :: * -> *).
Lens
(NetworkCaps m) (NetworkCaps m) (ClevelandCaps m) (ClevelandCaps m)
ncClevelandCapsL
instance Monad m => HasNetworkCaps (NetworkCaps m) where
getNetworkEnvCap :: NetworkCaps m -> NetworkEnv
getNetworkEnvCap = NetworkCaps m -> NetworkEnv
forall (m :: * -> *). NetworkCaps m -> NetworkEnv
ncNetworkEnv
type MonadCleveland caps m =
( m ~ ReaderT caps (ClevelandBaseMonad caps)
, HasClevelandCaps caps
)
type MonadEmulated caps m =
( MonadCleveland caps m
, HasEmulatedCaps caps
)
type MonadNetwork caps m =
( MonadCleveland caps m
, HasNetworkCaps caps
)
type ClevelandT m = ReaderT (ClevelandCaps m) m
type EmulatedT m = ReaderT (EmulatedCaps m) m
type NetworkT m = ReaderT (NetworkCaps m) m