{-# OPTIONS_HADDOCK not-home #-}
module Test.Cleveland.Internal.Client
( module Test.Cleveland.Internal.Client
) where
import Control.Lens (_head, each, filtered)
import Data.Aeson.Text qualified as J
import Data.Constraint (withDict, (\\))
import Data.Ratio ((%))
import Data.Set qualified as Set
import Data.Singletons (demote)
import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, secondsToNominalDiffTime)
import Data.Typeable (cast)
import Fmt (Buildable(build), Doc, indentF, pretty, unlinesF, (+|), (|+))
import System.IO (hFlush)
import Time (KnownDivRat, Second, Time, floorRat, sec, threadDelay, toFractional, toUnit)
import Unsafe qualified (fromIntegral)
import Lorentz (NicePackedValue)
import Lorentz qualified as L
import Lorentz.Constraints.Scopes (NiceUnpackedValue)
import Morley.AsRPC (AsRPC, HasRPCRepr(..), TAsRPC, notesAsRPC, rpcSingIEvi)
import Morley.Client
(AliasBehavior(..), MorleyClientEnv, OperationInfo(..), RevealData(..), disableAlphanetWarning,
runMorleyClientM)
import Morley.Client qualified as Client
import Morley.Client.Action (Result)
import Morley.Client.Action.Common (DelegationData(..), runErrorsToClientError)
import Morley.Client.App (failOnTimeout, retryOnceOnTimeout)
import Morley.Client.Full qualified as Client
import Morley.Client.Logging (logInfo, logWarning)
import Morley.Client.RPC.Error qualified as RPC
import Morley.Client.RPC.Types
(AppliedResult(..), BlockConstants(bcHeader), BlockHeaderNoHash(bhnhLevel, bhnhTimestamp),
BlockId(..), EventOperation(..), OperationHash, OriginationScript(..),
ProtocolParameters(ProtocolParameters, ppCostPerByte, ppMinimalBlockDelay, ppOriginationSize),
WithSource(..))
import Morley.Client.RPC.Types qualified as RPC
import Morley.Client.TezosClient.Impl qualified as TezosClient
import Morley.Client.TezosClient.Types (tceMbTezosClientDataDirL)
import Morley.Client.Util qualified as Client
import Morley.Micheline
(Expression, MichelinePrimitive(..), StringEncode(..), TezosInt64, TezosMutez(..),
_ExpressionPrim, _ExpressionSeq, fromExpression, mpaArgsL, mpaPrimL, toExpression)
import Morley.Michelson.Text (unMText)
import Morley.Michelson.Typed (BigMapId, SomeAnnotatedValue(..), SomeContractAndStorage(..), toVal)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core as Tezos
(Mutez, Timestamp(..), addMutez, subMutez, timestampFromUTCTime, unsafeAddMutez, unsafeMulMutez,
unsafeSubMutez)
import Morley.Tezos.Crypto
import Morley.Util.Constrained
import Morley.Util.Named
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Common
import Test.Cleveland.Internal.Exceptions
import Test.Cleveland.Lorentz (toL1Address)
import Test.Cleveland.Util (ceilingUnit)
mkMorleyOnlyRpcEnvNetwork
:: NetworkEnv
-> [SecretKey]
-> Client.MorleyOnlyRpcEnv
mkMorleyOnlyRpcEnvNetwork :: NetworkEnv -> [SecretKey] -> MorleyOnlyRpcEnv
mkMorleyOnlyRpcEnvNetwork NetworkEnv{Bool
Maybe SecretKey
Word
ImplicitAlias
MorleyClientEnv
neMorleyClientEnv :: MorleyClientEnv
neSecretKey :: Maybe SecretKey
neMoneybagAlias :: ImplicitAlias
neExplicitDataDir :: Bool
neVerbosity :: Word
neMorleyClientEnv :: NetworkEnv -> MorleyClientEnv
neSecretKey :: NetworkEnv -> Maybe SecretKey
neMoneybagAlias :: NetworkEnv -> ImplicitAlias
neExplicitDataDir :: NetworkEnv -> Bool
neVerbosity :: NetworkEnv -> Word
..} [SecretKey]
extraSecrets =
Client.MorleyOnlyRpcEnv
{ moreLogAction :: ClientLogAction MorleyOnlyRpcM
moreLogAction = Word -> ClientLogAction MorleyOnlyRpcM
forall (m :: * -> *). MonadIO m => Word -> ClientLogAction m
Client.mkLogAction Word
neVerbosity
, moreClientEnv :: ClientEnv
moreClientEnv = MorleyClientEnv -> ClientEnv
Client.mceClientEnv MorleyClientEnv
neMorleyClientEnv
, moreSecretKeys :: Map ImplicitAddress SecretKey
moreSecretKeys = [Map ImplicitAddress SecretKey] -> Map ImplicitAddress SecretKey
forall a. Monoid a => [a] -> a
mconcat
[ OneItem (Map ImplicitAddress SecretKey)
-> Map ImplicitAddress SecretKey
forall x. One x => OneItem x -> x
one (PublicKey -> ImplicitAddress
mkKeyAddress (SecretKey -> PublicKey
toPublic SecretKey
sk), SecretKey
sk)
| SecretKey
sk <- ([SecretKey] -> [SecretKey])
-> (SecretKey -> [SecretKey] -> [SecretKey])
-> Maybe SecretKey
-> [SecretKey]
-> [SecretKey]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [SecretKey] -> [SecretKey]
forall a. a -> a
id (:) Maybe SecretKey
neSecretKey [SecretKey]
extraSecrets ]
}
data MoneybagConfigurationException
= NoMoneybagAddress ImplicitAlias
| TwoMoneybagKeys ImplicitAlias SecretKey ImplicitAddress
deriving stock ((forall x.
MoneybagConfigurationException
-> Rep MoneybagConfigurationException x)
-> (forall x.
Rep MoneybagConfigurationException x
-> MoneybagConfigurationException)
-> Generic MoneybagConfigurationException
forall x.
Rep MoneybagConfigurationException x
-> MoneybagConfigurationException
forall x.
MoneybagConfigurationException
-> Rep MoneybagConfigurationException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
MoneybagConfigurationException
-> Rep MoneybagConfigurationException x
from :: forall x.
MoneybagConfigurationException
-> Rep MoneybagConfigurationException x
$cto :: forall x.
Rep MoneybagConfigurationException x
-> MoneybagConfigurationException
to :: forall x.
Rep MoneybagConfigurationException x
-> MoneybagConfigurationException
Generic, Int -> MoneybagConfigurationException -> ShowS
[MoneybagConfigurationException] -> ShowS
MoneybagConfigurationException -> String
(Int -> MoneybagConfigurationException -> ShowS)
-> (MoneybagConfigurationException -> String)
-> ([MoneybagConfigurationException] -> ShowS)
-> Show MoneybagConfigurationException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MoneybagConfigurationException -> ShowS
showsPrec :: Int -> MoneybagConfigurationException -> ShowS
$cshow :: MoneybagConfigurationException -> String
show :: MoneybagConfigurationException -> String
$cshowList :: [MoneybagConfigurationException] -> ShowS
showList :: [MoneybagConfigurationException] -> ShowS
Show, MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
(MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool)
-> (MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool)
-> Eq MoneybagConfigurationException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
== :: MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
$c/= :: MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
/= :: MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
Eq)
instance Buildable MoneybagConfigurationException where
build :: MoneybagConfigurationException -> Doc
build = \case
NoMoneybagAddress ImplicitAlias
alias -> forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF @_ @Doc
[ Doc
"Moneybag alias is not registered in the tezos node: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ImplicitAlias -> Doc
forall a. Buildable a => a -> Doc
build ImplicitAlias
alias
, Doc
""
, Doc
"Cleveland's network tests require a special address with plenty of XTZ for"
, Doc
"originating contracts and performing transfers."
, Doc
""
, Doc
"By default, Cleveland expects an account with the alias 'moneybag' to already exist."
, Doc
"If no such alias exists, you can choose to either:"
, Doc
" * Use a different alias, supplied via '--cleveland-moneybag-alias'."
, Doc
" * Import a moneybag account, by supplying its secret key via '--cleveland-moneybag-secret-key'."
]
TwoMoneybagKeys ImplicitAlias
alias SecretKey
envKey ImplicitAddress
existingAddress -> forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF @_ @Doc
[ Doc
"Tried to import the secret key supplied via '--cleveland-moneybag-secret-key' and"
, Doc
"associate it with the alias '" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ImplicitAlias
alias ImplicitAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"', but the alias already exists."
, Doc
""
, Doc
" --cleveland-moneybag-secret-key: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> SecretKey -> Doc
forall a. Buildable a => a -> Doc
build SecretKey
envKey
, Doc
" Existing address : " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ImplicitAddress -> Doc
forall a. Buildable a => a -> Doc
build ImplicitAddress
existingAddress
, Doc
""
, Doc
"Possible fix:"
, Doc
" * If you wish to use the existing address, please remove the '--cleveland-moneybag-secret-key' option."
, Doc
" * Otherwise, please supply a different alias via '--cleveland-moneybag-alias'."
]
instance Exception MoneybagConfigurationException where
displayException :: MoneybagConfigurationException -> String
displayException = MoneybagConfigurationException -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
fromException :: SomeException -> Maybe MoneybagConfigurationException
fromException = SomeException -> Maybe MoneybagConfigurationException
forall e. Exception e => SomeException -> Maybe e
fromPossiblyAnnotatedException
data ClientState = ClientState
{ ClientState -> DefaultAliasCounter
csDefaultAliasCounter :: DefaultAliasCounter
, ClientState -> Set ImplicitAddress
csRefillableAddresses :: Set ImplicitAddress
, ClientState -> Moneybag
csMoneybagAddress :: Moneybag
}
newtype ClientM a = ClientM
{ forall a. ClientM a -> ReaderT (IORef ClientState) IO a
unClientM :: ReaderT (IORef ClientState) IO a
}
deriving newtype ((forall a b. (a -> b) -> ClientM a -> ClientM b)
-> (forall a b. a -> ClientM b -> ClientM a) -> Functor ClientM
forall a b. a -> ClientM b -> ClientM a
forall a b. (a -> b) -> ClientM a -> ClientM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
fmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
$c<$ :: forall a b. a -> ClientM b -> ClientM a
<$ :: forall a b. a -> ClientM b -> ClientM a
Functor, Functor ClientM
Functor ClientM
-> (forall a. a -> ClientM a)
-> (forall a b. ClientM (a -> b) -> ClientM a -> ClientM b)
-> (forall a b c.
(a -> b -> c) -> ClientM a -> ClientM b -> ClientM c)
-> (forall a b. ClientM a -> ClientM b -> ClientM b)
-> (forall a b. ClientM a -> ClientM b -> ClientM a)
-> Applicative ClientM
forall a. a -> ClientM a
forall a b. ClientM a -> ClientM b -> ClientM a
forall a b. ClientM a -> ClientM b -> ClientM b
forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM 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
$cpure :: forall a. a -> ClientM a
pure :: forall a. a -> ClientM a
$c<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
$cliftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
liftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
$c*> :: forall a b. ClientM a -> ClientM b -> ClientM b
*> :: forall a b. ClientM a -> ClientM b -> ClientM b
$c<* :: forall a b. ClientM a -> ClientM b -> ClientM a
<* :: forall a b. ClientM a -> ClientM b -> ClientM a
Applicative, Applicative ClientM
Applicative ClientM
-> (forall a b. ClientM a -> (a -> ClientM b) -> ClientM b)
-> (forall a b. ClientM a -> ClientM b -> ClientM b)
-> (forall a. a -> ClientM a)
-> Monad ClientM
forall a. a -> ClientM a
forall a b. ClientM a -> ClientM b -> ClientM b
forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
$c>> :: forall a b. ClientM a -> ClientM b -> ClientM b
>> :: forall a b. ClientM a -> ClientM b -> ClientM b
$creturn :: forall a. a -> ClientM a
return :: forall a. a -> ClientM a
Monad, Monad ClientM
Monad ClientM -> (forall a. IO a -> ClientM a) -> MonadIO ClientM
forall a. IO a -> ClientM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> ClientM a
liftIO :: forall a. IO a -> ClientM a
MonadIO,
Monad ClientM
Monad ClientM
-> (forall e a. Exception e => e -> ClientM a)
-> MonadThrow ClientM
forall e a. Exception e => e -> ClientM a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
$cthrowM :: forall e a. Exception e => e -> ClientM a
throwM :: forall e a. Exception e => e -> ClientM a
MonadThrow, MonadThrow ClientM
MonadThrow ClientM
-> (forall e a.
Exception e =>
ClientM a -> (e -> ClientM a) -> ClientM a)
-> MonadCatch ClientM
forall e a.
Exception e =>
ClientM a -> (e -> ClientM a) -> ClientM a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
Exception e =>
ClientM a -> (e -> ClientM a) -> ClientM a
catch :: forall e a.
Exception e =>
ClientM a -> (e -> ClientM a) -> ClientM a
MonadCatch, MonadReader (IORef ClientState), Monad ClientM
Monad ClientM
-> (forall a. String -> ClientM a) -> MonadFail ClientM
forall a. String -> ClientM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> ClientM a
fail :: forall a. String -> ClientM a
MonadFail)
data InternalNetworkScenarioError = TooManyRefillIterations Word ImplicitAddress
deriving stock (Int -> InternalNetworkScenarioError -> ShowS
[InternalNetworkScenarioError] -> ShowS
InternalNetworkScenarioError -> String
(Int -> InternalNetworkScenarioError -> ShowS)
-> (InternalNetworkScenarioError -> String)
-> ([InternalNetworkScenarioError] -> ShowS)
-> Show InternalNetworkScenarioError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalNetworkScenarioError -> ShowS
showsPrec :: Int -> InternalNetworkScenarioError -> ShowS
$cshow :: InternalNetworkScenarioError -> String
show :: InternalNetworkScenarioError -> String
$cshowList :: [InternalNetworkScenarioError] -> ShowS
showList :: [InternalNetworkScenarioError] -> ShowS
Show)
instance Buildable InternalNetworkScenarioError where
build :: InternalNetworkScenarioError -> Doc
build (TooManyRefillIterations Word
iter ImplicitAddress
addr) =
Doc
"Too many (" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Word
iter Word -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
") refill iteratons of " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ImplicitAddress
addr ImplicitAddress -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
instance Exception InternalNetworkScenarioError where
displayException :: InternalNetworkScenarioError -> String
displayException = InternalNetworkScenarioError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
fromException :: SomeException -> Maybe InternalNetworkScenarioError
fromException = SomeException -> Maybe InternalNetworkScenarioError
forall e. Exception e => SomeException -> Maybe e
fromPossiblyAnnotatedException
runNetworkT :: NetworkEnv -> NetworkT ClientM a -> IO a
runNetworkT :: forall a. NetworkEnv -> NetworkT ClientM a -> IO a
runNetworkT NetworkEnv
env NetworkT ClientM a
scenario = do
IO ()
disableAlphanetWarning
Moneybag
moneybagAddr <- NetworkEnv -> IO Moneybag
setupMoneybagAddress NetworkEnv
env
let caps :: NetworkCaps ClientM
caps = NetworkCaps
{ ncNetworkEnv :: NetworkEnv
ncNetworkEnv = NetworkEnv
env
, ncClevelandCaps :: ClevelandCaps ClientM
ncClevelandCaps = ClevelandCaps
{ ccSender :: Sender
ccSender = ImplicitAddressWithAlias -> Sender
Sender (ImplicitAddressWithAlias -> Sender)
-> ImplicitAddressWithAlias -> Sender
forall a b. (a -> b) -> a -> b
$ Moneybag -> ImplicitAddressWithAlias
unMoneybag Moneybag
moneybagAddr
, ccMoneybag :: Moneybag
ccMoneybag = Moneybag
moneybagAddr
, ccMiscCap :: ClevelandMiscImpl ClientM
ccMiscCap = NetworkEnv -> ClevelandMiscImpl ClientM
networkMiscImpl NetworkEnv
env
, ccOpsCap :: Sender -> ClevelandOpsImpl ClientM
ccOpsCap = MorleyClientEnv -> Sender -> ClevelandOpsImpl ClientM
networkOpsImpl (NetworkEnv -> MorleyClientEnv
neMorleyClientEnv NetworkEnv
env)
}
}
IORef ClientState
ist <- ClientState -> IO (IORef ClientState)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef ClientState
{ csDefaultAliasCounter :: DefaultAliasCounter
csDefaultAliasCounter = Natural -> DefaultAliasCounter
DefaultAliasCounter Natural
0
, csRefillableAddresses :: Set ImplicitAddress
csRefillableAddresses = Set ImplicitAddress
forall a. Set a
Set.empty
, csMoneybagAddress :: Moneybag
csMoneybagAddress = Moneybag
moneybagAddr
}
let clientM :: ClientM a
clientM = NetworkT ClientM a -> NetworkCaps ClientM -> ClientM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT NetworkT ClientM a
scenario NetworkCaps ClientM
caps
ReaderT (IORef ClientState) IO a -> IORef ClientState -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ClientM a -> ReaderT (IORef ClientState) IO a
forall a. ClientM a -> ReaderT (IORef ClientState) IO a
unClientM ClientM a
clientM) IORef ClientState
ist
setupMoneybagAddress :: NetworkEnv -> IO Moneybag
setupMoneybagAddress :: NetworkEnv -> IO Moneybag
setupMoneybagAddress NetworkEnv{Bool
Maybe SecretKey
Word
ImplicitAlias
MorleyClientEnv
neMorleyClientEnv :: NetworkEnv -> MorleyClientEnv
neSecretKey :: NetworkEnv -> Maybe SecretKey
neMoneybagAlias :: NetworkEnv -> ImplicitAlias
neExplicitDataDir :: NetworkEnv -> Bool
neVerbosity :: NetworkEnv -> Word
neMorleyClientEnv :: MorleyClientEnv
neSecretKey :: Maybe SecretKey
neMoneybagAlias :: ImplicitAlias
neExplicitDataDir :: Bool
neVerbosity :: Word
..} = do
let setupEnv :: MorleyClientEnv
setupEnv = MorleyClientEnv
neMorleyClientEnv MorleyClientEnv
-> (MorleyClientEnv -> MorleyClientEnv) -> MorleyClientEnv
forall a b. a -> (a -> b) -> b
&
if Bool
neExplicitDataDir
then MorleyClientEnv -> MorleyClientEnv
forall a. a -> a
id
else (TezosClientEnv -> Identity TezosClientEnv)
-> MorleyClientEnv -> Identity MorleyClientEnv
Lens' MorleyClientEnv TezosClientEnv
Client.mceTezosClientL ((TezosClientEnv -> Identity TezosClientEnv)
-> MorleyClientEnv -> Identity MorleyClientEnv)
-> ((Maybe String -> Identity (Maybe String))
-> TezosClientEnv -> Identity TezosClientEnv)
-> (Maybe String -> Identity (Maybe String))
-> MorleyClientEnv
-> Identity MorleyClientEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> Identity (Maybe String))
-> TezosClientEnv -> Identity TezosClientEnv
Lens' TezosClientEnv (Maybe String)
tceMbTezosClientDataDirL ((Maybe String -> Identity (Maybe String))
-> MorleyClientEnv -> Identity MorleyClientEnv)
-> Maybe String -> MorleyClientEnv -> MorleyClientEnv
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe String
forall a. Maybe a
Nothing
Maybe ImplicitAddress
storageAddress <- MorleyClientEnv
-> MorleyClientM (Maybe ImplicitAddress)
-> IO (Maybe ImplicitAddress)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
setupEnv (MorleyClientM (Maybe ImplicitAddress)
-> IO (Maybe ImplicitAddress))
-> MorleyClientM (Maybe ImplicitAddress)
-> IO (Maybe ImplicitAddress)
forall a b. (a -> b) -> a -> b
$ ImplicitAlias
-> MorleyClientM (Maybe (ResolvedAddress ImplicitAlias))
forall addressOrAlias (m :: * -> *).
(HasTezosClient m, MonadThrow m, Resolve addressOrAlias) =>
addressOrAlias -> m (Maybe (ResolvedAddress addressOrAlias))
Client.resolveAddressMaybe ImplicitAlias
neMoneybagAlias
ImplicitAddressWithAlias -> Moneybag
Moneybag (ImplicitAddressWithAlias -> Moneybag)
-> IO ImplicitAddressWithAlias -> IO Moneybag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Maybe SecretKey
neSecretKey, Maybe ImplicitAddress
storageAddress) of
(Maybe SecretKey
Nothing, Just ImplicitAddress
addr) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
neExplicitDataDir do
SecretKey
ek <- MorleyClientEnv -> MorleyClientM SecretKey -> IO SecretKey
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
setupEnv (MorleyClientM SecretKey -> IO SecretKey)
-> MorleyClientM SecretKey -> IO SecretKey
forall a b. (a -> b) -> a -> b
$
MorleyClientM SecretKey -> MorleyClientM SecretKey
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (MorleyClientM SecretKey -> MorleyClientM SecretKey)
-> MorleyClientM SecretKey -> MorleyClientM SecretKey
forall a b. (a -> b) -> a -> b
$ ImplicitAlias -> MorleyClientM SecretKey
TezosClient.getSecretKey ImplicitAlias
neMoneybagAlias
IO ImplicitAddressWithAlias -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ImplicitAddressWithAlias -> IO ())
-> IO ImplicitAddressWithAlias -> IO ()
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$
MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
failOnTimeout (MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias
forall a b c. SuperComposition a b c => a -> b -> c
... Bool
-> ImplicitAlias
-> SecretKey
-> MorleyClientM ImplicitAddressWithAlias
TezosClient.importKey Bool
False ImplicitAlias
neMoneybagAlias SecretKey
ek
pure $ ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
Client.AddressWithAlias ImplicitAddress
addr ImplicitAlias
neMoneybagAlias
(Maybe SecretKey
Nothing, Maybe ImplicitAddress
Nothing) -> MoneybagConfigurationException -> IO ImplicitAddressWithAlias
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MoneybagConfigurationException -> IO ImplicitAddressWithAlias)
-> MoneybagConfigurationException -> IO ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ ImplicitAlias -> MoneybagConfigurationException
NoMoneybagAddress ImplicitAlias
neMoneybagAlias
(Just SecretKey
ek, Just ImplicitAddress
sa)
| PublicKey -> ImplicitAddress
mkKeyAddress (SecretKey -> PublicKey
toPublic SecretKey
ek) ImplicitAddress -> ImplicitAddress -> Bool
forall a. Eq a => a -> a -> Bool
== ImplicitAddress
sa -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
neExplicitDataDir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ImplicitAddressWithAlias -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ImplicitAddressWithAlias -> IO ())
-> IO ImplicitAddressWithAlias -> IO ()
forall a b. (a -> b) -> a -> b
$
MorleyClientEnv
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$
MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
failOnTimeout (MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias
forall a b c. SuperComposition a b c => a -> b -> c
... Bool
-> ImplicitAlias
-> SecretKey
-> MorleyClientM ImplicitAddressWithAlias
TezosClient.importKey Bool
False ImplicitAlias
neMoneybagAlias SecretKey
ek
pure $ ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
Client.AddressWithAlias ImplicitAddress
sa ImplicitAlias
neMoneybagAlias
| Bool
otherwise -> MoneybagConfigurationException -> IO ImplicitAddressWithAlias
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MoneybagConfigurationException -> IO ImplicitAddressWithAlias)
-> MoneybagConfigurationException -> IO ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ ImplicitAlias
-> SecretKey -> ImplicitAddress -> MoneybagConfigurationException
TwoMoneybagKeys ImplicitAlias
neMoneybagAlias SecretKey
ek ImplicitAddress
sa
(Just SecretKey
ek, Maybe ImplicitAddress
Nothing) -> do
MorleyClientEnv
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$
MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
failOnTimeout (MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> MorleyClientM ImplicitAddressWithAlias
forall a b c. SuperComposition a b c => a -> b -> c
... Bool
-> ImplicitAlias
-> SecretKey
-> MorleyClientM ImplicitAddressWithAlias
TezosClient.importKey Bool
False ImplicitAlias
neMoneybagAlias SecretKey
ek
return $ ImplicitAddress -> ImplicitAlias -> ImplicitAddressWithAlias
forall (kind :: AddressKind).
KindedAddress kind -> Alias kind -> AddressWithAlias kind
Client.AddressWithAlias (PublicKey -> ImplicitAddress
mkKeyAddress (SecretKey -> PublicKey
toPublic SecretKey
ek)) ImplicitAlias
neMoneybagAlias
networkOpsImpl :: MorleyClientEnv -> Sender -> ClevelandOpsImpl ClientM
networkOpsImpl :: MorleyClientEnv -> Sender -> ClevelandOpsImpl ClientM
networkOpsImpl MorleyClientEnv
env (Sender ImplicitAddressWithAlias
sender) =
(forall a. HasCallStack => ClientM a -> ClientM a)
-> ClevelandOpsImpl ClientM -> ClevelandOpsImpl ClientM
forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandOpsImpl m -> ClevelandOpsImpl m
mapClevelandOpsImplExceptions (ClientM a -> ClientM a
forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
addCallStack (ClientM a -> ClientM a)
-> (ClientM a -> ClientM a) -> ClientM a -> ClientM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> ClientM a -> ClientM a
forall a. MorleyClientEnv -> ClientM a -> ClientM a
exceptionHandler MorleyClientEnv
env)
ClevelandOpsImpl
{ coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput]
-> ClientM [OperationInfo ClevelandResult]
coiRunOperationBatch = MorleyClientEnv
-> ImplicitAddressWithAlias
-> [OperationInfo ClevelandInput]
-> ClientM [OperationInfo ClevelandResult]
runOperationBatch MorleyClientEnv
env ImplicitAddressWithAlias
sender
}
networkMiscImpl :: NetworkEnv -> ClevelandMiscImpl ClientM
networkMiscImpl :: NetworkEnv -> ClevelandMiscImpl ClientM
networkMiscImpl env :: NetworkEnv
env@NetworkEnv{Bool
Maybe SecretKey
Word
ImplicitAlias
MorleyClientEnv
neMorleyClientEnv :: NetworkEnv -> MorleyClientEnv
neSecretKey :: NetworkEnv -> Maybe SecretKey
neMoneybagAlias :: NetworkEnv -> ImplicitAlias
neExplicitDataDir :: NetworkEnv -> Bool
neVerbosity :: NetworkEnv -> Word
neMorleyClientEnv :: MorleyClientEnv
neSecretKey :: Maybe SecretKey
neMoneybagAlias :: ImplicitAlias
neExplicitDataDir :: Bool
neVerbosity :: Word
..} =
(forall a. HasCallStack => ClientM a -> ClientM a)
-> ClevelandMiscImpl ClientM -> ClevelandMiscImpl ClientM
forall (m :: * -> *).
(forall a. HasCallStack => m a -> m a)
-> ClevelandMiscImpl m -> ClevelandMiscImpl m
mapClevelandMiscImplExceptions (ClientM a -> ClientM a
forall (m :: * -> *) a. (MonadCatch m, HasCallStack) => m a -> m a
addCallStack (ClientM a -> ClientM a)
-> (ClientM a -> ClientM a) -> ClientM a -> ClientM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> ClientM a -> ClientM a
forall a. MorleyClientEnv -> ClientM a -> ClientM a
exceptionHandler MorleyClientEnv
neMorleyClientEnv) ClevelandMiscImpl
{ cmiRunIO :: forall res. HasCallStack => IO res -> ClientM res
cmiRunIO = IO res -> ClientM res
forall res. HasCallStack => IO res -> ClientM res
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
, cmiOriginateLargeUntyped :: forall (oty :: OriginationType).
HasCallStack =>
Sender -> OriginateData oty 'IsLarge -> ClientM ContractAddress
cmiOriginateLargeUntyped =
\(Sender ImplicitAddressWithAlias
sender) OriginateData{Maybe KeyHash
Mutez
Alias 'AddressKindContract
ODContractAndStorage oty
odName :: Alias 'AddressKindContract
odBalance :: Mutez
odDelegate :: Maybe KeyHash
odContractAndStorage :: ODContractAndStorage oty
odName :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Alias 'AddressKindContract
odBalance :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Mutez
odDelegate :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Maybe KeyHash
odContractAndStorage :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> ODContractAndStorage oty
..} -> do
let originationScenario :: Client.MorleyClientM (OperationHash, ContractAddress)
originationScenario :: MorleyClientM (OperationHash, ContractAddress)
originationScenario = case ODContractAndStorage oty
odContractAndStorage of
ODContractAndStorageUntyped{Value
Contract
uodStorage :: Value
uodContract :: Contract
uodStorage :: ODContractAndStorage 'OTUntyped -> Value
uodContract :: ODContractAndStorage 'OTUntyped -> Contract
..} ->
AliasBehavior
-> Alias 'AddressKindContract
-> ImplicitAddressWithAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> Maybe KeyHash
-> MorleyClientM (OperationHash, ContractAddress)
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
AliasBehavior
-> Alias 'AddressKindContract
-> ImplicitAddressWithAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> Maybe KeyHash
-> m (OperationHash, ContractAddress)
Client.originateLargeUntypedContract AliasBehavior
OverwriteDuplicateAlias Alias 'AddressKindContract
odName
ImplicitAddressWithAlias
sender Mutez
odBalance Contract
uodContract Value
uodStorage Maybe Mutez
forall a. Maybe a
Nothing Maybe KeyHash
odDelegate
ODContractAndStorageTyped{st
Contract (ToT cp) (ToT st)
todStorage :: st
todContract :: Contract (ToT cp) (ToT st)
todStorage :: forall st vd cp.
ODContractAndStorage ('OTTypedMorley cp st vd) -> st
todContract :: forall st vd cp.
ODContractAndStorage ('OTTypedMorley cp st vd)
-> Contract (ToT cp) (ToT st)
..} | T.Contract{} <- Contract (ToT cp) (ToT st)
todContract ->
AliasBehavior
-> Alias 'AddressKindContract
-> ImplicitAddressWithAlias
-> Mutez
-> Contract (ToT cp) (ToT st)
-> Value (ToT st)
-> Maybe Mutez
-> Maybe KeyHash
-> MorleyClientM (OperationHash, ContractAddress)
forall (m :: * -> *) (cp :: T) (st :: T) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
StorageScope st, ParameterScope cp) =>
AliasBehavior
-> Alias 'AddressKindContract
-> ImplicitAddressWithAlias
-> Mutez
-> Contract cp st
-> Value st
-> Maybe Mutez
-> Maybe KeyHash
-> m (OperationHash, ContractAddress)
Client.originateLargeContract AliasBehavior
OverwriteDuplicateAlias Alias 'AddressKindContract
odName
ImplicitAddressWithAlias
sender Mutez
odBalance Contract (ToT cp) (ToT st)
todContract (st -> Value (ToT st)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal st
todStorage)
Maybe Mutez
forall a. Maybe a
Nothing Maybe KeyHash
odDelegate
ODContractAndStorageLorentz{st
Contract param st vd
odStorage :: st
odContract :: Contract param st vd
odStorage :: forall st param vd.
ODContractAndStorage ('OTTypedLorentz param st vd) -> st
odContract :: forall st param vd.
ODContractAndStorage ('OTTypedLorentz param st vd)
-> Contract param st vd
..} | L.Contract{} <- Contract param st vd
odContract ->
AliasBehavior
-> Alias 'AddressKindContract
-> ImplicitAddressWithAlias
-> Mutez
-> Contract param st vd
-> st
-> Maybe Mutez
-> Maybe KeyHash
-> MorleyClientM (OperationHash, ContractAddress)
forall (m :: * -> *) cp st vd env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
NiceStorage st, NiceParameter cp) =>
AliasBehavior
-> Alias 'AddressKindContract
-> ImplicitAddressWithAlias
-> Mutez
-> Contract cp st vd
-> st
-> Maybe Mutez
-> Maybe KeyHash
-> m (OperationHash, ContractAddress)
Client.lOriginateLargeContract AliasBehavior
OverwriteDuplicateAlias Alias 'AddressKindContract
odName
ImplicitAddressWithAlias
sender Mutez
odBalance Contract param st vd
odContract st
odStorage Maybe Mutez
forall a. Maybe a
Nothing Maybe KeyHash
odDelegate
(OperationHash
_ :: OperationHash, ContractAddress
res) <- IO (OperationHash, ContractAddress)
-> ClientM (OperationHash, ContractAddress)
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (OperationHash, ContractAddress)
-> ClientM (OperationHash, ContractAddress))
-> IO (OperationHash, ContractAddress)
-> ClientM (OperationHash, ContractAddress)
forall a b. (a -> b) -> a -> b
$ do
MorleyClientEnv -> ImplicitAddressWithAlias -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
neMorleyClientEnv ImplicitAddressWithAlias
sender
MorleyClientEnv
-> MorleyClientM (OperationHash, ContractAddress)
-> IO (OperationHash, ContractAddress)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv MorleyClientM (OperationHash, ContractAddress)
originationScenario
Text -> ClientM ()
comment (Text -> ClientM ()) -> Text -> ClientM ()
forall a b. (a -> b) -> a -> b
$ Doc
"Originated large smart contract " Doc -> Doc -> Text
forall b. FromDoc b => Doc -> Doc -> b
+| Alias 'AddressKindContract
odName Alias 'AddressKindContract -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" with address " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Doc
forall a b. (Buildable a, FromDoc b) => a -> b
pretty ContractAddress
res
pure ContractAddress
res
, cmiSignBytes :: HasCallStack =>
ByteString -> ImplicitAddressWithAlias -> ClientM Signature
cmiSignBytes = \ByteString
hash ImplicitAddressWithAlias
signer -> IO Signature -> ClientM Signature
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Signature -> ClientM Signature)
-> IO Signature -> ClientM Signature
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> MorleyClientM Signature -> IO Signature
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM Signature -> IO Signature)
-> MorleyClientM Signature -> IO Signature
forall a b. (a -> b) -> a -> b
$
ImplicitAddressWithAlias
-> Maybe ScrubbedBytes -> ByteString -> MorleyClientM Signature
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAddressWithAlias
-> Maybe ScrubbedBytes -> ByteString -> m Signature
Client.signBytes ImplicitAddressWithAlias
signer Maybe ScrubbedBytes
forall a. Maybe a
Nothing ByteString
hash
, cmiGenKey :: HasCallStack =>
SpecificOrDefaultAlias -> ClientM ImplicitAddressWithAlias
cmiGenKey = \SpecificOrDefaultAlias
sodAlias -> do
ImplicitAlias
alias <- SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias)
-> IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ ImplicitAlias -> MorleyClientM ImplicitAddressWithAlias
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAlias -> m ImplicitAddressWithAlias
Client.genKey ImplicitAlias
alias
, cmiImportKey :: HasCallStack =>
SecretKey
-> SpecificOrDefaultAlias -> ClientM ImplicitAddressWithAlias
cmiImportKey = \SecretKey
key SpecificOrDefaultAlias
sodAlias -> do
ImplicitAlias
alias <- SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias)
-> IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ Bool
-> ImplicitAlias
-> SecretKey
-> MorleyClientM ImplicitAddressWithAlias
TezosClient.importKey Bool
True ImplicitAlias
alias SecretKey
key
, cmiGenFreshKey :: HasCallStack =>
SpecificOrDefaultAlias -> ClientM ImplicitAddressWithAlias
cmiGenFreshKey = \SpecificOrDefaultAlias
sodAlias -> do
ImplicitAlias
alias <- SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias)
-> IO ImplicitAddressWithAlias -> ClientM ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias)
-> MorleyClientM ImplicitAddressWithAlias
-> IO ImplicitAddressWithAlias
forall a b. (a -> b) -> a -> b
$ ImplicitAlias -> MorleyClientM ImplicitAddressWithAlias
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAlias -> m ImplicitAddressWithAlias
Client.genFreshKey ImplicitAlias
alias
, cmiGetBalance :: HasCallStack => L1Address -> ClientM Mutez
cmiGetBalance = (forall (t :: AddressKind).
ConstrainAddressKind
'[ 'AddressKindImplicit, 'AddressKindContract] t =>
KindedAddress t -> ClientM Mutez)
-> L1Address -> ClientM Mutez
forall {k} (c :: k -> Constraint) (f :: k -> *) r.
(forall (t :: k). c t => f t -> r) -> Constrained c f -> r
foldConstrained KindedAddress t -> ClientM Mutez
forall (t :: AddressKind).
ConstrainAddressKind
'[ 'AddressKindImplicit, 'AddressKindContract] t =>
KindedAddress t -> ClientM Mutez
getBalanceHelper
, cmiGetChainId :: HasCallStack => ClientM ChainId
cmiGetChainId = IO ChainId -> ClientM ChainId
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainId -> ClientM ChainId) -> IO ChainId -> ClientM ChainId
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> MorleyClientM ChainId -> IO ChainId
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv MorleyClientM ChainId
forall (m :: * -> *). HasTezosRpc m => m ChainId
Client.getChainId
, cmiAttempt :: forall a e.
(Exception e, HasCallStack) =>
ClientM a -> ClientM (Either e a)
cmiAttempt = ClientM a -> ClientM (Either e a)
forall a e.
(Exception e, HasCallStack) =>
ClientM a -> ClientM (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try
, cmiThrow :: forall a. HasCallStack => SomeException -> ClientM a
cmiThrow = SomeException -> ClientM a
forall a. HasCallStack => SomeException -> ClientM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
, cmiMarkAddressRefillable :: ImplicitAddress -> ClientM ()
cmiMarkAddressRefillable = ImplicitAddress -> ClientM ()
setAddressRefillable
, cmiComment :: HasCallStack => Text -> ClientM ()
cmiComment = HasCallStack => Text -> ClientM ()
Text -> ClientM ()
comment
, cmiUnderlyingImpl :: ClientM (Either (EmulatedImpl ClientM) NetworkEnv)
cmiUnderlyingImpl = Either (EmulatedImpl ClientM) NetworkEnv
-> ClientM (Either (EmulatedImpl ClientM) NetworkEnv)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (EmulatedImpl ClientM) NetworkEnv
-> ClientM (Either (EmulatedImpl ClientM) NetworkEnv))
-> Either (EmulatedImpl ClientM) NetworkEnv
-> ClientM (Either (EmulatedImpl ClientM) NetworkEnv)
forall a b. (a -> b) -> a -> b
$ NetworkEnv -> Either (EmulatedImpl ClientM) NetworkEnv
forall a b. b -> Either a b
Right NetworkEnv
env
, cmiFailure :: forall a. HasCallStack => Doc -> ClientM a
cmiFailure = Doc -> ClientM a
forall a. HasCallStack => Doc -> ClientM a
forall a. Doc -> ClientM a
clientFailure
, ClientM Natural
ClientM (Time Second)
ClientM Timestamp
HasCallStack => ClientM Natural
HasCallStack => ClientM (Time Second)
HasCallStack => ClientM Timestamp
HasCallStack => ContractAddress -> ClientM SomeAnnotatedValue
HasCallStack => L1Address -> ClientM (Maybe KeyHash)
HasCallStack => ImplicitAddressWithAlias -> ClientM PublicKey
HasCallStack => (Natural -> Natural) -> ClientM ()
Time unit -> ClientM ()
ContractAddress -> ClientM [SomeTicket]
ContractAddress -> ClientM SomeAnnotatedValue
L1Address -> ClientM (Maybe KeyHash)
L1Address -> ContractAddress -> Value t -> ClientM Natural
BigMapId k v -> k -> ClientM (Maybe v)
BigMapId k v -> ClientM (Maybe [v])
AddressOrAlias kind -> ClientM (AddressWithAlias kind)
ImplicitAddressWithAlias -> ClientM PublicKey
Sender -> RunCode cp st vd -> ClientM (AsRPC st)
(Natural -> Natural) -> ClientM ()
forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> ClientM (Maybe v)
forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> ClientM (Maybe [v])
forall k v.
(NicePackedValue k, NiceUnpackedValue v) =>
BigMapId k v -> k -> ClientM (Maybe v)
forall {k} v (k :: k).
NiceUnpackedValue v =>
BigMapId k v -> ClientM (Maybe [v])
forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> ClientM (AsRPC st)
forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> ClientM (AsRPC st)
forall {unit :: Rat}.
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> ClientM ()
forall (unit :: Rat).
KnownDivRat unit Second =>
Time unit -> ClientM ()
forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> ClientM (AddressWithAlias kind)
forall (kind :: AddressKind).
AddressOrAlias kind -> ClientM (AddressWithAlias kind)
forall (t :: T).
(ForbidOp t, SingI t) =>
L1Address -> ContractAddress -> Value t -> ClientM Natural
forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> ClientM Natural
cmiTicketBalance :: forall (t :: T).
(ForbidOp t, SingI t) =>
L1Address -> ContractAddress -> Value t -> ClientM Natural
cmiAllTicketBalances :: ContractAddress -> ClientM [SomeTicket]
cmiGetBigMapValueMaybe :: forall k v.
(NicePackedValue k, NiceUnpackedValue v) =>
BigMapId k v -> k -> ClientM (Maybe v)
cmiGetAllBigMapValuesMaybe :: forall {k} v (k :: k).
NiceUnpackedValue v =>
BigMapId k v -> ClientM (Maybe [v])
cmiGetSomeStorage :: ContractAddress -> ClientM SomeAnnotatedValue
cmiResolveAddress :: forall (kind :: AddressKind).
AddressOrAlias kind -> ClientM (AddressWithAlias kind)
cmiGetPublicKey :: ImplicitAddressWithAlias -> ClientM PublicKey
cmiGetDelegate :: L1Address -> ClientM (Maybe KeyHash)
cmiGetNow :: ClientM Timestamp
cmiGetLevel :: ClientM Natural
cmiGetApproximateBlockInterval :: ClientM (Time Second)
cmiAdvanceTime :: forall (unit :: Rat).
KnownDivRat unit Second =>
Time unit -> ClientM ()
cmiAdvanceToLevel :: (Natural -> Natural) -> ClientM ()
cmiRunCode :: forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> ClientM (AsRPC st)
cmiResolveAddress :: forall (kind :: AddressKind).
HasCallStack =>
AddressOrAlias kind -> ClientM (AddressWithAlias kind)
cmiGetSomeStorage :: HasCallStack => ContractAddress -> ClientM SomeAnnotatedValue
cmiGetBigMapValueMaybe :: forall k v.
(HasCallStack, NiceComparable k, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> k -> ClientM (Maybe v)
cmiGetAllBigMapValuesMaybe :: forall k v.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> ClientM (Maybe [v])
cmiGetPublicKey :: HasCallStack => ImplicitAddressWithAlias -> ClientM PublicKey
cmiGetDelegate :: HasCallStack => L1Address -> ClientM (Maybe KeyHash)
cmiAdvanceTime :: forall {unit :: Rat}.
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> ClientM ()
cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> ClientM ()
cmiGetNow :: HasCallStack => ClientM Timestamp
cmiGetLevel :: HasCallStack => ClientM Natural
cmiGetApproximateBlockInterval :: HasCallStack => ClientM (Time Second)
cmiRunCode :: forall cp st vd.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> ClientM (AsRPC st)
cmiTicketBalance :: forall (t :: T).
(ForbidOp t, Comparable t) =>
L1Address -> ContractAddress -> Value t -> ClientM Natural
cmiAllTicketBalances :: ContractAddress -> ClientM [SomeTicket]
..
}
where
cmiTicketBalance
:: forall t. (T.ForbidOp t, T.SingI t)
=> L1Address -> ContractAddress -> T.Value t -> ClientM Natural
cmiTicketBalance :: forall (t :: T).
(ForbidOp t, SingI t) =>
L1Address -> ContractAddress -> Value t -> ClientM Natural
cmiTicketBalance L1Address
owner ContractAddress
ticketer Value t
value = IO Natural -> ClientM Natural
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Natural -> ClientM Natural)
-> (MorleyClientM Natural -> IO Natural)
-> MorleyClientM Natural
-> ClientM Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> MorleyClientM Natural -> IO Natural
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM Natural -> ClientM Natural)
-> MorleyClientM Natural -> ClientM Natural
forall a b. (a -> b) -> a -> b
$
L1Address -> GetTicketBalance -> MorleyClientM Natural
forall (m :: * -> *).
HasTezosRpc m =>
L1Address -> GetTicketBalance -> m Natural
Client.getTicketBalance L1Address
owner Client.GetTicketBalance
{ gtbTicketer :: ContractAddress
Client.gtbTicketer = ContractAddress
ticketer
, gtbContent :: Expression
Client.gtbContent = Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Value -> Expression) -> Value -> Expression
forall a b. (a -> b) -> a -> b
$ Value t -> Value
forall (t :: T). ForbidOp t => Value' Instr t -> Value
T.untypeValueHashable Value t
value
, gtbContentType :: Expression
Client.gtbContentType = Notes t -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Notes t -> Expression) -> Notes t -> Expression
forall a b. (a -> b) -> a -> b
$ forall (t :: T). SingI t => Notes t
T.starNotes @t
}
cmiAllTicketBalances :: ContractAddress -> ClientM [SomeTicket]
cmiAllTicketBalances :: ContractAddress -> ClientM [SomeTicket]
cmiAllTicketBalances ContractAddress
owner = do
[GetAllTicketBalancesResponse]
tickets <- IO [GetAllTicketBalancesResponse]
-> ClientM [GetAllTicketBalancesResponse]
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GetAllTicketBalancesResponse]
-> ClientM [GetAllTicketBalancesResponse])
-> IO [GetAllTicketBalancesResponse]
-> ClientM [GetAllTicketBalancesResponse]
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM [GetAllTicketBalancesResponse]
-> IO [GetAllTicketBalancesResponse]
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM [GetAllTicketBalancesResponse]
-> IO [GetAllTicketBalancesResponse])
-> MorleyClientM [GetAllTicketBalancesResponse]
-> IO [GetAllTicketBalancesResponse]
forall a b. (a -> b) -> a -> b
$ ContractAddress -> MorleyClientM [GetAllTicketBalancesResponse]
forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m [GetAllTicketBalancesResponse]
Client.getAllTicketBalances ContractAddress
owner
[GetAllTicketBalancesResponse]
-> (GetAllTicketBalancesResponse -> ClientM SomeTicket)
-> ClientM [SomeTicket]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [GetAllTicketBalancesResponse]
tickets \Client.GetAllTicketBalancesResponse{ContractAddress
Expression
TezosNat
gatbrTicketer :: ContractAddress
gatbrContentType :: Expression
gatbrContent :: Expression
gatbrAmount :: TezosNat
gatbrAmount :: GetAllTicketBalancesResponse -> TezosNat
gatbrContent :: GetAllTicketBalancesResponse -> Expression
gatbrContentType :: GetAllTicketBalancesResponse -> Expression
gatbrTicketer :: GetAllTicketBalancesResponse -> ContractAddress
..} -> do
Ty
uTy <- Expression -> Either FromExpressionError Ty
forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression Expression
gatbrContentType Either FromExpressionError Ty
-> (Either FromExpressionError Ty -> ClientM Ty) -> ClientM Ty
forall a b. a -> (a -> b) -> b
& \case
Right Ty
ty -> Ty -> ClientM Ty
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty
ty
Left FromExpressionError
err -> Doc -> ClientM Ty
forall a. Doc -> ClientM a
clientFailure (Doc -> ClientM Ty) -> Doc -> ClientM Ty
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Doc
"Failed to decode ticket value:"
, Doc
"Value:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> Doc
forall a. Buildable a => a -> Doc
build (Expression -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToTextBuilder Expression
gatbrContentType)
, Doc
"Decoding error:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FromExpressionError -> Doc
forall a. Buildable a => a -> Doc
build FromExpressionError
err
]
Ty
-> (forall (t :: T). SingI t => Notes t -> ClientM SomeTicket)
-> ClientM SomeTicket
forall r. Ty -> (forall (t :: T). SingI t => Notes t -> r) -> r
T.withUType Ty
uTy \(Notes t
_ :: T.Notes t) -> do
case forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @(T.Value t) Expression
gatbrContent of
Right Value t
val ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure @ClientM (SomeTicket -> ClientM SomeTicket)
-> SomeTicket -> ClientM SomeTicket
forall a b. (a -> b) -> a -> b
$ Ticket (Value t) -> SomeTicket
forall (t :: T). SingI t => Ticket (Value t) -> SomeTicket
SomeTicket T.Ticket
{ tTicketer :: Address
tTicketer = ContractAddress -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ContractAddress
gatbrTicketer
, tData :: Value t
tData = Value t
val
, tAmount :: Natural
tAmount = TezosNat -> Natural
forall a. StringEncode a -> a
unStringEncode TezosNat
gatbrAmount
}
Left FromExpressionError
err -> Doc -> ClientM SomeTicket
forall a. Doc -> ClientM a
clientFailure (Doc -> ClientM SomeTicket) -> Doc -> ClientM SomeTicket
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Doc
"Failed to decode ticket value:"
, Doc
"Value:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> Doc
forall a. Buildable a => a -> Doc
build (Expression -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToTextBuilder Expression
gatbrContentType)
, Doc
"Decoding error:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FromExpressionError -> Doc
forall a. Buildable a => a -> Doc
build FromExpressionError
err
]
cmiGetBigMapValueMaybe :: (NicePackedValue k, NiceUnpackedValue v) => BigMapId k v -> k -> ClientM (Maybe v)
cmiGetBigMapValueMaybe :: forall k v.
(NicePackedValue k, NiceUnpackedValue v) =>
BigMapId k v -> k -> ClientM (Maybe v)
cmiGetBigMapValueMaybe BigMapId k v
bigMapId k
k =
IO (Maybe v) -> ClientM (Maybe v)
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe v) -> ClientM (Maybe v))
-> (MorleyClientM (Maybe v) -> IO (Maybe v))
-> MorleyClientM (Maybe v)
-> ClientM (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> MorleyClientM (Maybe v) -> IO (Maybe v)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM (Maybe v) -> ClientM (Maybe v))
-> MorleyClientM (Maybe v) -> ClientM (Maybe v)
forall a b. (a -> b) -> a -> b
$ BigMapId k v -> k -> MorleyClientM (Maybe v)
forall v k (m :: * -> *).
(NicePackedValue k, NiceUnpackedValue v, HasTezosRpc m) =>
BigMapId k v -> k -> m (Maybe v)
Client.readBigMapValueMaybe BigMapId k v
bigMapId k
k
cmiGetAllBigMapValuesMaybe :: (NiceUnpackedValue v) => BigMapId k v -> ClientM (Maybe [v])
cmiGetAllBigMapValuesMaybe :: forall {k} v (k :: k).
NiceUnpackedValue v =>
BigMapId k v -> ClientM (Maybe [v])
cmiGetAllBigMapValuesMaybe BigMapId k v
bigMapId =
IO (Maybe [v]) -> ClientM (Maybe [v])
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [v]) -> ClientM (Maybe [v]))
-> (MorleyClientM (Maybe [v]) -> IO (Maybe [v]))
-> MorleyClientM (Maybe [v])
-> ClientM (Maybe [v])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> MorleyClientM (Maybe [v]) -> IO (Maybe [v])
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM (Maybe [v]) -> ClientM (Maybe [v]))
-> MorleyClientM (Maybe [v]) -> ClientM (Maybe [v])
forall a b. (a -> b) -> a -> b
$ BigMapId k v -> MorleyClientM (Maybe [v])
forall {k1} v (k2 :: k1) (m :: * -> *).
(NiceUnpackedValue v, HasTezosRpc m) =>
BigMapId k2 v -> m (Maybe [v])
Client.readAllBigMapValuesMaybe BigMapId k v
bigMapId
getStorageType :: Expression -> ClientM U.Ty
getStorageType :: Expression -> ClientM Ty
getStorageType Expression
contractExpr = do
let
storageTypeExprMb :: Maybe Expression
storageTypeExprMb = Expression
contractExpr Expression
-> Getting (First Expression) Expression Expression
-> Maybe Expression
forall s a. s -> Getting (First a) s a -> Maybe a
^?
([Expression] -> Const (First Expression) [Expression])
-> Expression -> Const (First Expression) Expression
Prism' Expression [Expression]
_ExpressionSeq
(([Expression] -> Const (First Expression) [Expression])
-> Expression -> Const (First Expression) Expression)
-> ((Expression -> Const (First Expression) Expression)
-> [Expression] -> Const (First Expression) [Expression])
-> Getting (First Expression) Expression Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression -> Const (First Expression) Expression)
-> [Expression] -> Const (First Expression) [Expression]
forall s t a b. Each s t a b => Traversal s t a b
Traversal [Expression] [Expression] Expression Expression
each
((Expression -> Const (First Expression) Expression)
-> [Expression] -> Const (First Expression) [Expression])
-> Getting (First Expression) Expression Expression
-> (Expression -> Const (First Expression) Expression)
-> [Expression]
-> Const (First Expression) [Expression]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp RegularExp
-> Const (First Expression) (MichelinePrimAp RegularExp))
-> Expression -> Const (First Expression) Expression
Prism' Expression (MichelinePrimAp RegularExp)
_ExpressionPrim
((MichelinePrimAp RegularExp
-> Const (First Expression) (MichelinePrimAp RegularExp))
-> Expression -> Const (First Expression) Expression)
-> ((Expression -> Const (First Expression) Expression)
-> MichelinePrimAp RegularExp
-> Const (First Expression) (MichelinePrimAp RegularExp))
-> Getting (First Expression) Expression Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp RegularExp -> Bool)
-> Optic'
(->)
(Const (First Expression))
(MichelinePrimAp RegularExp)
(MichelinePrimAp RegularExp)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\MichelinePrimAp RegularExp
prim -> MichelinePrimAp RegularExp
prim MichelinePrimAp RegularExp
-> Getting
MichelinePrimitive (MichelinePrimAp RegularExp) MichelinePrimitive
-> MichelinePrimitive
forall s a. s -> Getting a s a -> a
^. Getting
MichelinePrimitive (MichelinePrimAp RegularExp) MichelinePrimitive
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
(MichelinePrimitive -> f MichelinePrimitive)
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaPrimL MichelinePrimitive -> MichelinePrimitive -> Bool
forall a. Eq a => a -> a -> Bool
== MichelinePrimitive
Prim_storage)
Optic'
(->)
(Const (First Expression))
(MichelinePrimAp RegularExp)
(MichelinePrimAp RegularExp)
-> ((Expression -> Const (First Expression) Expression)
-> MichelinePrimAp RegularExp
-> Const (First Expression) (MichelinePrimAp RegularExp))
-> (Expression -> Const (First Expression) Expression)
-> MichelinePrimAp RegularExp
-> Const (First Expression) (MichelinePrimAp RegularExp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Expression] -> Const (First Expression) [Expression])
-> MichelinePrimAp RegularExp
-> Const (First Expression) (MichelinePrimAp RegularExp)
forall (x1 :: ExpExtensionDescriptorKind)
(x2 :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Exp x1] -> f [Exp x2])
-> MichelinePrimAp x1 -> f (MichelinePrimAp x2)
mpaArgsL
(([Expression] -> Const (First Expression) [Expression])
-> MichelinePrimAp RegularExp
-> Const (First Expression) (MichelinePrimAp RegularExp))
-> ((Expression -> Const (First Expression) Expression)
-> [Expression] -> Const (First Expression) [Expression])
-> (Expression -> Const (First Expression) Expression)
-> MichelinePrimAp RegularExp
-> Const (First Expression) (MichelinePrimAp RegularExp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression -> Const (First Expression) Expression)
-> [Expression] -> Const (First Expression) [Expression]
forall s a. Cons s s a a => Traversal' s a
Traversal [Expression] [Expression] Expression Expression
_head
case Maybe Expression
storageTypeExprMb of
Maybe Expression
Nothing -> Doc -> ClientM Ty
forall a. Doc -> ClientM a
clientFailure (Doc -> ClientM Ty) -> Doc -> ClientM Ty
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Doc
"Contract expression did not contain a 'storage' expression."
, Doc
"Contract expression:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> Doc
forall a. Buildable a => a -> Doc
build (Expression -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToTextBuilder Expression
contractExpr)
]
Just Expression
storageTypeExpr ->
case forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @U.Ty Expression
storageTypeExpr of
Left FromExpressionError
err -> Doc -> ClientM Ty
forall a. Doc -> ClientM a
clientFailure (Doc -> ClientM Ty) -> Doc -> ClientM Ty
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Doc
"'storage' expression was not a valid type expression."
, Doc
"Storage expression:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> Doc
forall a. Buildable a => a -> Doc
build (Expression -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToTextBuilder Expression
storageTypeExpr)
, Doc
"Decoding error:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FromExpressionError -> Doc
forall a. Buildable a => a -> Doc
build FromExpressionError
err
]
Right Ty
storageType -> Ty -> ClientM Ty
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty
storageType
cmiGetSomeStorage :: ContractAddress -> ClientM SomeAnnotatedValue
cmiGetSomeStorage :: ContractAddress -> ClientM SomeAnnotatedValue
cmiGetSomeStorage ContractAddress
addr = do
OriginationScript {Expression
osCode :: Expression
osCode :: OriginationScript -> Expression
osCode, Expression
osStorage :: Expression
osStorage :: OriginationScript -> Expression
osStorage} <-
IO OriginationScript -> ClientM OriginationScript
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OriginationScript -> ClientM OriginationScript)
-> (MorleyClientM OriginationScript -> IO OriginationScript)
-> MorleyClientM OriginationScript
-> ClientM OriginationScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv
-> MorleyClientM OriginationScript -> IO OriginationScript
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM OriginationScript -> ClientM OriginationScript)
-> MorleyClientM OriginationScript -> ClientM OriginationScript
forall a b. (a -> b) -> a -> b
$ ContractAddress -> MorleyClientM OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> m OriginationScript
Client.getContractScript ContractAddress
addr
Ty
storageType <- Expression -> ClientM Ty
getStorageType Expression
osCode
Ty
-> (forall (t :: T).
SingI t =>
Notes t -> ClientM SomeAnnotatedValue)
-> ClientM SomeAnnotatedValue
forall r. Ty -> (forall (t :: T). SingI t => Notes t -> r) -> r
T.withUType Ty
storageType \(Notes t
storageNotes :: T.Notes t) -> do
Dict (SingI (TAsRPC t))
-> (SingI (TAsRPC t) => ClientM SomeAnnotatedValue)
-> ClientM SomeAnnotatedValue
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (forall (t :: T). SingI t => Dict (SingI (TAsRPC t))
rpcSingIEvi @t) do
case forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @(T.Value (TAsRPC t)) Expression
osStorage of
Right Value (TAsRPC t)
storageValueRPC ->
SomeAnnotatedValue -> ClientM SomeAnnotatedValue
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeAnnotatedValue -> ClientM SomeAnnotatedValue)
-> SomeAnnotatedValue -> ClientM SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$ Notes (TAsRPC t) -> Value (TAsRPC t) -> SomeAnnotatedValue
forall (t :: T).
SingI t =>
Notes t -> Value t -> SomeAnnotatedValue
SomeAnnotatedValue (Notes t -> Notes (TAsRPC t)
forall (t :: T). Notes t -> Notes (TAsRPC t)
notesAsRPC Notes t
storageNotes) Value (TAsRPC t)
storageValueRPC
Left FromExpressionError
err ->
Doc -> ClientM SomeAnnotatedValue
forall a. Doc -> ClientM a
clientFailure (Doc -> ClientM SomeAnnotatedValue)
-> Doc -> ClientM SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Doc
"Failed to decode storage expression."
, Doc
"Storage expression:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> Doc
forall a. Buildable a => a -> Doc
build (Expression -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToTextBuilder Expression
osStorage)
, Doc
"Decoding error:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FromExpressionError -> Doc
forall a. Buildable a => a -> Doc
build FromExpressionError
err
]
cmiResolveAddress :: AddressOrAlias kind -> ClientM (Client.AddressWithAlias kind)
cmiResolveAddress :: forall (kind :: AddressKind).
AddressOrAlias kind -> ClientM (AddressWithAlias kind)
cmiResolveAddress =
IO (AddressWithAlias kind) -> ClientM (AddressWithAlias kind)
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AddressWithAlias kind) -> ClientM (AddressWithAlias kind))
-> (AddressOrAlias kind -> IO (AddressWithAlias kind))
-> AddressOrAlias kind
-> ClientM (AddressWithAlias kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv
-> MorleyClientM (AddressWithAlias kind)
-> IO (AddressWithAlias kind)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM (AddressWithAlias kind)
-> IO (AddressWithAlias kind))
-> (AddressOrAlias kind -> MorleyClientM (AddressWithAlias kind))
-> AddressOrAlias kind
-> IO (AddressWithAlias kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressOrAlias kind -> MorleyClientM (AddressWithAlias kind)
AddressOrAlias kind
-> MorleyClientM (ResolvedAddressAndAlias (AddressOrAlias kind))
forall addressOrAlias (m :: * -> *).
(HasTezosClient m, MonadThrow m, Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAddressAndAlias addressOrAlias)
Client.resolveAddressWithAlias
cmiGetPublicKey :: Client.ImplicitAddressWithAlias -> ClientM PublicKey
cmiGetPublicKey :: ImplicitAddressWithAlias -> ClientM PublicKey
cmiGetPublicKey =
IO PublicKey -> ClientM PublicKey
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PublicKey -> ClientM PublicKey)
-> (ImplicitAddressWithAlias -> IO PublicKey)
-> ImplicitAddressWithAlias
-> ClientM PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> MorleyClientM PublicKey -> IO PublicKey
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM PublicKey -> IO PublicKey)
-> (ImplicitAddressWithAlias -> MorleyClientM PublicKey)
-> ImplicitAddressWithAlias
-> IO PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientM PublicKey -> MorleyClientM PublicKey
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
retryOnceOnTimeout (MorleyClientM PublicKey -> MorleyClientM PublicKey)
-> (ImplicitAddressWithAlias -> MorleyClientM PublicKey)
-> ImplicitAddressWithAlias
-> MorleyClientM PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddressWithAlias -> MorleyClientM PublicKey
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAddressWithAlias -> m PublicKey
Client.getPublicKey
getBalanceHelper :: L1AddressKind kind => KindedAddress kind -> ClientM Mutez
getBalanceHelper :: forall (t :: AddressKind).
ConstrainAddressKind
'[ 'AddressKindImplicit, 'AddressKindContract] t =>
KindedAddress t -> ClientM Mutez
getBalanceHelper = IO Mutez -> ClientM Mutez
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Mutez -> ClientM Mutez)
-> (KindedAddress kind -> IO Mutez)
-> KindedAddress kind
-> ClientM Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> MorleyClientM Mutez -> IO Mutez
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM Mutez -> IO Mutez)
-> (KindedAddress kind -> MorleyClientM Mutez)
-> KindedAddress kind
-> IO Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> MorleyClientM Mutez
forall (kind :: AddressKind) (m :: * -> *).
(HasTezosRpc m, L1AddressKind kind) =>
KindedAddress kind -> m Mutez
Client.getBalance
cmiGetDelegate :: L1Address -> ClientM (Maybe KeyHash)
cmiGetDelegate :: L1Address -> ClientM (Maybe KeyHash)
cmiGetDelegate =
IO (Maybe KeyHash) -> ClientM (Maybe KeyHash)
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe KeyHash) -> ClientM (Maybe KeyHash))
-> (L1Address -> IO (Maybe KeyHash))
-> L1Address
-> ClientM (Maybe KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv
-> MorleyClientM (Maybe KeyHash) -> IO (Maybe KeyHash)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM (Maybe KeyHash) -> IO (Maybe KeyHash))
-> (L1Address -> MorleyClientM (Maybe KeyHash))
-> L1Address
-> IO (Maybe KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L1Address -> MorleyClientM (Maybe KeyHash)
forall (m :: * -> *).
HasTezosRpc m =>
L1Address -> m (Maybe KeyHash)
Client.getDelegate
cmiGetNow :: ClientM Tezos.Timestamp
cmiGetNow :: ClientM Timestamp
cmiGetNow = UTCTime -> Timestamp
timestampFromUTCTime (UTCTime -> Timestamp) -> ClientM UTCTime -> ClientM Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MorleyClientEnv -> ClientM UTCTime
getLastBlockTimestamp MorleyClientEnv
neMorleyClientEnv
cmiGetLevel :: ClientM Natural
cmiGetLevel :: ClientM Natural
cmiGetLevel = MorleyClientEnv -> ClientM Natural
getLastBlockLevel MorleyClientEnv
neMorleyClientEnv
cmiGetApproximateBlockInterval :: ClientM (Time Second)
cmiGetApproximateBlockInterval :: ClientM (Time Second)
cmiGetApproximateBlockInterval = IO (Time Second) -> ClientM (Time Second)
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Time Second) -> ClientM (Time Second))
-> IO (Time Second) -> ClientM (Time Second)
forall a b. (a -> b) -> a -> b
$ do
ProtocolParameters
pp <- MorleyClientEnv
-> MorleyClientM ProtocolParameters -> IO ProtocolParameters
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ProtocolParameters -> IO ProtocolParameters)
-> MorleyClientM ProtocolParameters -> IO ProtocolParameters
forall a b. (a -> b) -> a -> b
$ MorleyClientM ProtocolParameters
forall (m :: * -> *). HasTezosRpc m => m ProtocolParameters
Client.getProtocolParameters
Time (1 :% 1) -> IO (Time (1 :% 1))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Time (1 :% 1) -> IO (Time (1 :% 1)))
-> (RatioNat -> Time (1 :% 1)) -> RatioNat -> IO (Time (1 :% 1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatioNat -> Time Second
RatioNat -> Time (1 :% 1)
sec (RatioNat -> IO (Time (1 :% 1))) -> RatioNat -> IO (Time (1 :% 1))
forall a b. (a -> b) -> a -> b
$ (TezosNat -> Natural
forall a. StringEncode a -> a
unStringEncode (TezosNat -> Natural) -> TezosNat -> Natural
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> TezosNat
ppMinimalBlockDelay ProtocolParameters
pp) Natural -> Natural -> RatioNat
forall a. Integral a => a -> a -> Ratio a
% Natural
1
cmiAdvanceTime :: (KnownDivRat unit Second) => Time unit -> ClientM ()
cmiAdvanceTime :: forall (unit :: Rat).
KnownDivRat unit Second =>
Time unit -> ClientM ()
cmiAdvanceTime Time unit
delta = do
let
deltaSec :: Time Second
deltaSec :: Time Second
deltaSec = Time Second -> Time Second
forall (unit :: Rat). Time unit -> Time unit
ceilingUnit (Time Second -> Time Second) -> Time Second -> Time Second
forall a b. (a -> b) -> a -> b
$ forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second Time unit
delta
deltaSec' :: NominalDiffTime
deltaSec' :: NominalDiffTime
deltaSec' = Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime) -> Pico -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Time (1 :% 1) -> Pico
forall r (unit :: Rat). Fractional r => Time unit -> r
toFractional Time Second
Time (1 :% 1)
deltaSec
UTCTime
t0 <- MorleyClientEnv -> ClientM UTCTime
getLastBlockTimestamp MorleyClientEnv
neMorleyClientEnv
Time (1 :% 1) -> ClientM ()
forall (unit :: Rat) (m :: * -> *).
(KnownDivRat unit Microsecond, MonadIO m) =>
Time unit -> m ()
threadDelay Time Second
Time (1 :% 1)
deltaSec
let
go :: ClientM ()
go :: ClientM ()
go = do
UTCTime
now <- MorleyClientEnv -> ClientM UTCTime
getLastBlockTimestamp MorleyClientEnv
neMorleyClientEnv
if (UTCTime
now UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
t0) NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
deltaSec'
then ClientM ()
forall (f :: * -> *). Applicative f => f ()
pass
else Time (1 :% 1) -> ClientM ()
forall (unit :: Rat) (m :: * -> *).
(KnownDivRat unit Microsecond, MonadIO m) =>
Time unit -> m ()
threadDelay (RatioNat -> Time Second
sec RatioNat
1) ClientM () -> ClientM () -> ClientM ()
forall a b. ClientM a -> ClientM b -> ClientM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClientM ()
go
ClientM ()
go
cmiAdvanceToLevel :: (Natural -> Natural) -> ClientM ()
cmiAdvanceToLevel :: (Natural -> Natural) -> ClientM ()
cmiAdvanceToLevel Natural -> Natural
targetLevelFn = do
Natural
lastLevel <- MorleyClientEnv -> ClientM Natural
getLastBlockLevel MorleyClientEnv
neMorleyClientEnv
let targetLevel :: Natural
targetLevel = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max (Natural -> Natural
targetLevelFn Natural
lastLevel) Natural
lastLevel
let skippedLevels :: Natural
skippedLevels = Natural
targetLevel Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
lastLevel
Bool -> ClientM () -> ClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
skippedLevels Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0) (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> ClientM () -> ClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
skippedLevels Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
1) (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ do
Time (1 :% 1)
minBlockInterval <- ClientM (Time Second)
ClientM (Time (1 :% 1))
cmiGetApproximateBlockInterval
let waitTime :: Natural
waitTime = (Natural
skippedLevels Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Time (1 :% 1) -> Natural
forall b (unit :: Rat). Integral b => Time unit -> b
floorRat Time (1 :% 1)
minBlockInterval
Time (1 :% 1) -> ClientM ()
forall (unit :: Rat) (m :: * -> *).
(KnownDivRat unit Microsecond, MonadIO m) =>
Time unit -> m ()
threadDelay (Time (1 :% 1) -> ClientM ())
-> (RatioNat -> Time (1 :% 1)) -> RatioNat -> ClientM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatioNat -> Time Second
RatioNat -> Time (1 :% 1)
sec (RatioNat -> ClientM ()) -> RatioNat -> ClientM ()
forall a b. (a -> b) -> a -> b
$ Natural
waitTime Natural -> Natural -> RatioNat
forall a. Integral a => a -> a -> Ratio a
% Natural
1
let go :: ClientM ()
go :: ClientM ()
go = do
Natural
curLevel <- ClientM Natural
cmiGetLevel
Bool -> ClientM () -> ClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
targetLevel Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
curLevel) (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ Time (1 :% 1) -> ClientM ()
forall (unit :: Rat) (m :: * -> *).
(KnownDivRat unit Microsecond, MonadIO m) =>
Time unit -> m ()
threadDelay (RatioNat -> Time Second
sec RatioNat
1) ClientM () -> ClientM () -> ClientM ()
forall a b. ClientM a -> ClientM b -> ClientM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClientM ()
go
ClientM ()
go
cmiRunCode
:: forall cp st vd. (HasRPCRepr st, T.IsoValue (AsRPC st))
=> Sender -> RunCode cp st vd -> ClientM (AsRPC st)
cmiRunCode :: forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> ClientM (AsRPC st)
cmiRunCode (Sender ImplicitAddressWithAlias
sender) (RunCode Contract cp st vd
rcContract Value
rcParameter Value
rcStorage Mutez
rcAmount Maybe Natural
rcLevel Maybe Timestamp
rcNow Mutez
rcBalance Maybe ImplicitAddress
rcSource) = do
IO (AsRPC st) -> ClientM (AsRPC st)
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AsRPC st) -> ClientM (AsRPC st))
-> IO (AsRPC st) -> ClientM (AsRPC st)
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> MorleyClientM (AsRPC st) -> IO (AsRPC st)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv do
L.Contract{} <- Contract cp st vd -> MorleyClientM (Contract cp st vd)
forall a. a -> MorleyClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contract cp st vd
rcContract
Value (ToT (AsRPC st)) -> AsRPC st
forall a. IsoValue a => Value (ToT a) -> a
T.fromVal (Value (ToT (AsRPC st)) -> AsRPC st)
-> MorleyClientM (Value (ToT (AsRPC st)))
-> MorleyClientM (AsRPC st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunContractParameters (ToT cp) (ToT st)
-> MorleyClientM (AsRPC (Value (ToT st)))
forall (cp :: T) (st :: T) (m :: * -> *).
(HasTezosRpc m, StorageScope st) =>
RunContractParameters cp st -> m (AsRPC (Value st))
Client.runContract Client.RunContractParameters
{ rcpContract :: Contract (ToT cp) (ToT st)
rcpContract = Contract cp st vd -> Contract (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
L.toMichelsonContract (Contract cp st vd -> Contract (ToT cp) (ToT st))
-> Contract cp st vd -> Contract (ToT cp) (ToT st)
forall a b. (a -> b) -> a -> b
$ Contract cp st vd
rcContract
, rcpParameter :: Value
rcpParameter = Value
rcParameter
, rcpStorage :: Value
rcpStorage = Value
rcStorage
, rcpAmount :: Mutez
rcpAmount = Mutez
rcAmount
, rcpBalance :: Mutez
rcpBalance = Mutez
rcBalance
, rcpSource :: Maybe ImplicitAddress
rcpSource = Maybe ImplicitAddress
rcSource
, rcpLevel :: Maybe Natural
rcpLevel = Maybe Natural
rcLevel
, rcpNow :: Maybe Timestamp
rcpNow = Maybe Timestamp
rcNow
, rcpSender :: Maybe ImplicitAddress
rcpSender = ImplicitAddress -> Maybe ImplicitAddress
forall a. a -> Maybe a
Just (ImplicitAddress -> Maybe ImplicitAddress)
-> ImplicitAddress -> Maybe ImplicitAddress
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
Client.awaAddress ImplicitAddressWithAlias
sender
}
ClientM (AsRPC st)
-> (RunCodeErrors -> ClientM (AsRPC st)) -> ClientM (AsRPC st)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \case
err :: RunCodeErrors
err@(RPC.RunCodeErrors [RunError]
errs)
| Just ClientRpcError
clientErr <- [RunError] -> Maybe ClientRpcError
runErrorsToClientError [RunError]
errs
-> TransferFailure -> ClientM (AsRPC st)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TransferFailure -> ClientM (AsRPC st))
-> ClientM TransferFailure -> ClientM (AsRPC st)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MorleyClientEnv
-> [OperationResp WithSource]
-> ClientRpcError
-> ClientM TransferFailure
exceptionToTransferFailure MorleyClientEnv
neMorleyClientEnv [] ClientRpcError
clientErr
| Bool
otherwise -> RunCodeErrors -> ClientM (AsRPC st)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM RunCodeErrors
err
clientFailure :: Doc -> ClientM a
clientFailure :: forall a. Doc -> ClientM a
clientFailure = TestError -> ClientM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> ClientM a) -> (Doc -> TestError) -> Doc -> ClientM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError) -> (Doc -> Text) -> Doc -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
comment :: Text -> ClientM ()
Text
msg = IO () -> ClientM ()
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout
getAlias
:: L1AddressKind kind
=> MorleyClientEnv
-> KindedAddress kind
-> ClientM (Alias kind)
getAlias :: forall (kind :: AddressKind).
L1AddressKind kind =>
MorleyClientEnv -> KindedAddress kind -> ClientM (Alias kind)
getAlias MorleyClientEnv
env = IO (Alias kind) -> ClientM (Alias kind)
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Alias kind) -> ClientM (Alias kind))
-> (KindedAddress kind -> IO (Alias kind))
-> KindedAddress kind
-> ClientM (Alias kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> MorleyClientM (Alias kind) -> IO (Alias kind)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM (Alias kind) -> IO (Alias kind))
-> (KindedAddress kind -> MorleyClientM (Alias kind))
-> KindedAddress kind
-> IO (Alias kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> MorleyClientM (Alias kind)
KindedAddress kind
-> MorleyClientM (ResolvedAlias (KindedAddress kind))
forall addressOrAlias (m :: * -> *).
(HasTezosClient m, MonadThrow m, Resolve addressOrAlias) =>
addressOrAlias -> m (ResolvedAlias addressOrAlias)
TezosClient.getAlias
getAliasMaybe
:: L1AddressKind kind
=> MorleyClientEnv
-> KindedAddress kind
-> ClientM (Maybe (Alias kind))
getAliasMaybe :: forall (kind :: AddressKind).
L1AddressKind kind =>
MorleyClientEnv
-> KindedAddress kind -> ClientM (Maybe (Alias kind))
getAliasMaybe MorleyClientEnv
env = IO (Maybe (Alias kind)) -> ClientM (Maybe (Alias kind))
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Alias kind)) -> ClientM (Maybe (Alias kind)))
-> (KindedAddress kind -> IO (Maybe (Alias kind)))
-> KindedAddress kind
-> ClientM (Maybe (Alias kind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv
-> MorleyClientM (Maybe (Alias kind)) -> IO (Maybe (Alias kind))
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM (Maybe (Alias kind)) -> IO (Maybe (Alias kind)))
-> (KindedAddress kind -> MorleyClientM (Maybe (Alias kind)))
-> KindedAddress kind
-> IO (Maybe (Alias kind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> MorleyClientM (Maybe (Alias kind))
KindedAddress kind
-> MorleyClientM (Maybe (ResolvedAlias (KindedAddress kind)))
forall addressOrAlias (m :: * -> *).
(HasTezosClient m, MonadThrow m, Resolve addressOrAlias) =>
addressOrAlias -> m (Maybe (ResolvedAlias addressOrAlias))
Client.getAliasMaybe
getLastBlockTimestamp :: MorleyClientEnv -> ClientM UTCTime
getLastBlockTimestamp :: MorleyClientEnv -> ClientM UTCTime
getLastBlockTimestamp MorleyClientEnv
env = IO UTCTime -> ClientM UTCTime
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> ClientM UTCTime) -> IO UTCTime -> ClientM UTCTime
forall a b. (a -> b) -> a -> b
$
BlockHeaderNoHash -> UTCTime
bhnhTimestamp (BlockHeaderNoHash -> UTCTime)
-> (BlockConstants -> BlockHeaderNoHash)
-> BlockConstants
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConstants -> BlockHeaderNoHash
bcHeader (BlockConstants -> UTCTime) -> IO BlockConstants -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MorleyClientEnv
-> MorleyClientM BlockConstants -> IO BlockConstants
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (BlockId -> MorleyClientM BlockConstants
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockConstants
Client.getBlockConstants BlockId
HeadId)
getLastBlockLevel :: MorleyClientEnv -> ClientM Natural
getLastBlockLevel :: MorleyClientEnv -> ClientM Natural
getLastBlockLevel MorleyClientEnv
env = do
BlockConstants
bc <- IO BlockConstants -> ClientM BlockConstants
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BlockConstants -> ClientM BlockConstants)
-> IO BlockConstants -> ClientM BlockConstants
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM BlockConstants -> IO BlockConstants
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (BlockId -> MorleyClientM BlockConstants
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockConstants
Client.getBlockConstants BlockId
HeadId)
Natural -> ClientM Natural
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> ClientM Natural)
-> (BlockHeaderNoHash -> Natural)
-> BlockHeaderNoHash
-> ClientM Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int64 @Natural (Int64 -> Natural)
-> (BlockHeaderNoHash -> Int64) -> BlockHeaderNoHash -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeaderNoHash -> Int64
bhnhLevel (BlockHeaderNoHash -> ClientM Natural)
-> BlockHeaderNoHash -> ClientM Natural
forall a b. (a -> b) -> a -> b
$ BlockConstants -> BlockHeaderNoHash
bcHeader BlockConstants
bc
runOperationBatch
:: MorleyClientEnv
-> Client.ImplicitAddressWithAlias
-> [OperationInfo ClevelandInput]
-> ClientM [OperationInfo ClevelandResult]
runOperationBatch :: MorleyClientEnv
-> ImplicitAddressWithAlias
-> [OperationInfo ClevelandInput]
-> ClientM [OperationInfo ClevelandResult]
runOperationBatch MorleyClientEnv
env ImplicitAddressWithAlias
sender [OperationInfo ClevelandInput]
ops = do
IORef ClientState
istRef <- ClientM (IORef ClientState)
forall r (m :: * -> *). MonadReader r m => m r
ask
ClientState{csMoneybagAddress :: ClientState -> Moneybag
csMoneybagAddress=Moneybag ImplicitAddressWithAlias
moneybag} <- IORef ClientState -> ClientM ClientState
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef ClientState
istRef
IO () -> ClientM ()
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> ImplicitAddressWithAlias -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
env ImplicitAddressWithAlias
sender
[OperationInfo ClientInput]
ops' <- [OperationInfo ClevelandInput]
-> (OperationInfo ClevelandInput
-> ClientM (OperationInfo ClientInput))
-> ClientM [OperationInfo ClientInput]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [OperationInfo ClevelandInput]
ops \case
OpOriginate (SomeOriginateData OriginateData{Maybe KeyHash
Mutez
Alias 'AddressKindContract
ODContractAndStorage oty
odName :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Alias 'AddressKindContract
odBalance :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Mutez
odDelegate :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Maybe KeyHash
odContractAndStorage :: forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> ODContractAndStorage oty
odName :: Alias 'AddressKindContract
odBalance :: Mutez
odDelegate :: Maybe KeyHash
odContractAndStorage :: ODContractAndStorage oty
..}) -> do
SomeContractAndStorage Contract cp st
odContract Value st
odStorage <- (TcError -> ClientM SomeContractAndStorage)
-> (SomeContractAndStorage -> ClientM SomeContractAndStorage)
-> Either TcError SomeContractAndStorage
-> ClientM SomeContractAndStorage
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TcError -> ClientM SomeContractAndStorage
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeContractAndStorage -> ClientM SomeContractAndStorage
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TcError SomeContractAndStorage
-> ClientM SomeContractAndStorage)
-> Either TcError SomeContractAndStorage
-> ClientM SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$
ODContractAndStorage oty -> Either TcError SomeContractAndStorage
forall (oty :: OriginationType).
ODContractAndStorage oty -> Either TcError SomeContractAndStorage
typeCheckODContractAndStorageIfNeeded ODContractAndStorage oty
odContractAndStorage
OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClientInput -> ClientM (OperationInfo ClientInput))
-> OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a b. (a -> b) -> a -> b
$ OriginationInfo ClientInput -> OperationInfo ClientInput
forall i. OriginationInfo i -> OperationInfo i
OpOriginate Client.OriginationData
{ odAliasBehavior :: AliasBehavior
odAliasBehavior = AliasBehavior
OverwriteDuplicateAlias
, odMbFee :: Maybe Mutez
odMbFee = Maybe Mutez
forall a. Maybe a
Nothing
, Maybe KeyHash
Mutez
Value st
Contract cp st
Alias 'AddressKindContract
odName :: Alias 'AddressKindContract
odBalance :: Mutez
odDelegate :: Maybe KeyHash
odContract :: Contract cp st
odStorage :: Value st
odBalance :: Mutez
odContract :: Contract cp st
odDelegate :: Maybe KeyHash
odName :: Alias 'AddressKindContract
odStorage :: Value st
..
}
OpTransfer TransferData{v
addr
Mutez
EpName
tdTo :: addr
tdAmount :: Mutez
tdEntrypoint :: EpName
tdParameter :: v
tdTo :: ()
tdAmount :: TransferData -> Mutez
tdEntrypoint :: TransferData -> EpName
tdParameter :: ()
..} ->
OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClientInput -> ClientM (OperationInfo ClientInput))
-> OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a b. (a -> b) -> a -> b
$ TransferInfo ClientInput -> OperationInfo ClientInput
forall i. TransferInfo i -> OperationInfo i
OpTransfer (TransferInfo ClientInput -> OperationInfo ClientInput)
-> TransferInfo ClientInput -> OperationInfo ClientInput
forall a b. (a -> b) -> a -> b
$ TD (Value (ToT v)) -> TransactionData
forall (t :: T).
ParameterScope t =>
TD (Value t) -> TransactionData
Client.TransactionData Client.TD
{ tdReceiver :: L1Address
tdReceiver = addr -> L1Address
forall addr. ToL1Address addr => addr -> L1Address
toL1Address addr
tdTo
, tdAmount :: Mutez
tdAmount = Mutez
tdAmount
, tdEpName :: EpName
tdEpName = EpName
tdEntrypoint
, tdParam :: Value (ToT v)
tdParam = v -> Value (ToT v)
forall a. IsoValue a => a -> Value (ToT a)
toVal v
tdParameter
, tdMbFee :: Maybe Mutez
tdMbFee = Maybe Mutez
forall a. Maybe a
Nothing
}
OpTransferTicket TransferTicketData{addr
EpName
Value ('TTicket t)
ttdTo :: addr
ttdEntrypoint :: EpName
ttdParameter :: Value ('TTicket t)
ttdTo :: ()
ttdEntrypoint :: TransferTicketData -> EpName
ttdParameter :: ()
..}
| T.VTicket Address
ttdTicketTicketer Value' Instr arg
ttdTicketContents Natural
ttdTicketAmount <- Value ('TTicket t)
ttdParameter
, Dict (ComparabilityImplies arg)
T.Dict <- Value' Instr arg -> Dict (ComparabilityImplies arg)
forall (t :: T) (proxy :: T -> *).
ForbidNonComparable t =>
proxy t -> Dict (ComparabilityImplies t)
T.comparableImplies Value' Instr arg
ttdTicketContents
-> OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClientInput -> ClientM (OperationInfo ClientInput))
-> OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a b. (a -> b) -> a -> b
$ TransferTicketInfo ClientInput -> OperationInfo ClientInput
forall i. TransferTicketInfo i -> OperationInfo i
OpTransferTicket Client.TransferTicketData
{ ttdDestination :: Address
ttdDestination = L1Address -> Address
forall a. ToAddress a => a -> Address
L.toAddress (L1Address -> Address) -> L1Address -> Address
forall a b. (a -> b) -> a -> b
$ addr -> L1Address
forall addr. ToL1Address addr => addr -> L1Address
toL1Address addr
ttdTo
, ttdMbFee :: Maybe Mutez
ttdMbFee = Maybe Mutez
forall a. Maybe a
Nothing
, Natural
Address
EpName
Value' Instr arg
ttdEntrypoint :: EpName
ttdTicketTicketer :: Address
ttdTicketContents :: Value' Instr arg
ttdTicketAmount :: Natural
ttdEntrypoint :: EpName
ttdTicketAmount :: Natural
ttdTicketContents :: Value' Instr arg
ttdTicketTicketer :: Address
..
}
OpReveal RevealInfo ClevelandInput
key ->
OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClientInput -> ClientM (OperationInfo ClientInput))
-> OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a b. (a -> b) -> a -> b
$ RevealInfo ClientInput -> OperationInfo ClientInput
forall i. RevealInfo i -> OperationInfo i
OpReveal RevealData
{ rdPublicKey :: PublicKey
rdPublicKey = PublicKey
RevealInfo ClevelandInput
key
, rdMbFee :: Maybe Mutez
rdMbFee = Maybe Mutez
forall a. Maybe a
Nothing
}
OpDelegation DelegationInfo ClevelandInput
delegate ->
OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClientInput -> ClientM (OperationInfo ClientInput))
-> OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall a b. (a -> b) -> a -> b
$ DelegationInfo ClientInput -> OperationInfo ClientInput
forall i. DelegationInfo i -> OperationInfo i
OpDelegation DelegationData
{ ddDelegate :: Maybe KeyHash
ddDelegate = Maybe KeyHash
DelegationInfo ClevelandInput
delegate
, ddMbFee :: Maybe Mutez
ddMbFee = Maybe Mutez
forall a. Maybe a
Nothing
}
let refill :: Word -> Client.MorleyClientM Word
refill :: Word -> MorleyClientM Word
refill Word
iter = do
MorleyClientM [(AppliedResult, Mutez)] -> MorleyClientM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MorleyClientM [(AppliedResult, Mutez)] -> MorleyClientM ())
-> MorleyClientM [(AppliedResult, Mutez)] -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias
-> [OperationInfo ClientInput]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations ImplicitAddressWithAlias
sender [OperationInfo ClientInput]
ops'
pure Word
iter
MorleyClientM Word
-> (SomeException -> MorleyClientM Word) -> MorleyClientM Word
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
errs -> do
Bool -> MorleyClientM () -> MorleyClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
iter Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
3) (MorleyClientM () -> MorleyClientM ())
-> MorleyClientM () -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ InternalNetworkScenarioError -> MorleyClientM ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (InternalNetworkScenarioError -> MorleyClientM ())
-> InternalNetworkScenarioError -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ Word -> ImplicitAddress -> InternalNetworkScenarioError
TooManyRefillIterations Word
iter (ImplicitAddress -> InternalNetworkScenarioError)
-> ImplicitAddress -> InternalNetworkScenarioError
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
Client.awaAddress ImplicitAddressWithAlias
sender
Mutez
realBalance <- ImplicitAddress -> MorleyClientM Mutez
forall (kind :: AddressKind) (m :: * -> *).
(HasTezosRpc m, L1AddressKind kind) =>
KindedAddress kind -> m Mutez
Client.getBalance (ImplicitAddress -> MorleyClientM Mutez)
-> ImplicitAddress -> MorleyClientM Mutez
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
Client.awaAddress ImplicitAddressWithAlias
sender
let handleRunErrors :: [RunError] -> MorleyClientM Mutez
handleRunErrors [RunError]
errs'
| Just (Name "balance" -> ("balance" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "balance"
#balance -> Mutez
balance, Name "required" -> ("required" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg Name "required"
#required -> Mutez
required)
<- [RunError] -> Maybe ("balance" :! Mutez, "required" :! Mutez)
findBalanceTooLow [RunError]
errs' = do
Text -> MorleyClientM ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> MorleyClientM ()) -> Text -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias
sender ImplicitAddressWithAlias -> Doc -> Text
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" balance of " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
realBalance Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" \n\
\is too low, need " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
required Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", but got " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
balance Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
let reportedDifference :: Mutez
reportedDifference = HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
unsafeSubMutez Mutez
required Mutez
balance
if Word
iter Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
then Mutez -> MorleyClientM Mutez
approximateRequired Mutez
realBalance
MorleyClientM Mutez
-> (SomeException -> MorleyClientM Mutez) -> MorleyClientM Mutez
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
_ :: SomeException) -> Mutez -> MorleyClientM Mutez
forall a. a -> MorleyClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutez
reportedDifference
else Mutez -> MorleyClientM Mutez
forall a. a -> MorleyClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutez
reportedDifference
| [RunError] -> Bool
findCantPayStorageFee [RunError]
errs' = do
Text -> MorleyClientM ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> MorleyClientM ()) -> Text -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias
sender ImplicitAddressWithAlias -> Doc -> Text
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" balance of " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
realBalance Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n\
\ is too low to pay storage fee"
Mutez -> MorleyClientM Mutez
approximateRequired Mutez
realBalance
MorleyClientM Mutez
-> (SomeException -> MorleyClientM Mutez) -> MorleyClientM Mutez
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
_ :: SomeException) -> Mutez -> MorleyClientM Mutez
forall a. a -> MorleyClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutez
minimalMutez
| Bool
otherwise = SomeException -> MorleyClientM Mutez
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
errs
Mutez
amount <- Mutez -> Mutez -> Mutez
forall a. Ord a => a -> a -> a
max Mutez
minimalMutez (Mutez -> Mutez) -> (Mutez -> Mutez) -> Mutez -> Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutez -> Mutez
addSafetyMutez (Mutez -> Mutez) -> MorleyClientM Mutez -> MorleyClientM Mutez
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if
| Just (Client.UnexpectedRunErrors [RunError]
err) <- SomeException -> Maybe UnexpectedErrors
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
errs -> [RunError] -> MorleyClientM Mutez
handleRunErrors [RunError]
err
| Just (RPC.RunCodeErrors [RunError]
err) <- SomeException -> Maybe RunCodeErrors
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
errs -> [RunError] -> MorleyClientM Mutez
handleRunErrors [RunError]
err
| Bool
otherwise -> SomeException -> MorleyClientM Mutez
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
errs
Text -> MorleyClientM ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> MorleyClientM ()) -> Text -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ Doc
"Will transfer " Doc -> Doc -> Text
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
amount Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" from " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ImplicitAddressWithAlias
moneybag ImplicitAddressWithAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
MorleyClientM (OperationHash, [WithSource EventOperation])
-> MorleyClientM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MorleyClientM (OperationHash, [WithSource EventOperation])
-> MorleyClientM ())
-> MorleyClientM (OperationHash, [WithSource EventOperation])
-> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias
-> ImplicitAddress
-> Mutez
-> EpName
-> ()
-> Maybe Mutez
-> MorleyClientM (OperationHash, [WithSource EventOperation])
forall (m :: * -> *) t env (kind :: AddressKind).
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
NiceParameter t, L1AddressKind kind) =>
ImplicitAddressWithAlias
-> KindedAddress kind
-> Mutez
-> EpName
-> t
-> Maybe Mutez
-> m (OperationHash, [WithSource EventOperation])
Client.lTransfer ImplicitAddressWithAlias
moneybag (ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
Client.awaAddress ImplicitAddressWithAlias
sender) Mutez
amount EpName
U.DefEpName () Maybe Mutez
forall a. Maybe a
Nothing
Word -> MorleyClientM Word
refill (Word
iter Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
addSafetyMutez :: Mutez -> Mutez
addSafetyMutez Mutez
x = Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe Mutez
x (Maybe Mutez -> Mutez) -> Maybe Mutez -> Mutez
forall a b. (a -> b) -> a -> b
$ Mutez -> Mutez -> Maybe Mutez
addMutez Mutez
x Mutez
safetyMutez
minimalMutez :: Mutez
minimalMutez = Mutez
5e5
safetyMutez :: Mutez
safetyMutez = Mutez
100
safetyStorage :: Natural
safetyStorage = Natural
20
approximateRequired :: Mutez -> MorleyClientM Mutez
approximateRequired Mutez
balance = do
([AppliedResult]
appliedResults, [Mutez]
fees) <- [(AppliedResult, Mutez)] -> ([AppliedResult], [Mutez])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(AppliedResult, Mutez)] -> ([AppliedResult], [Mutez]))
-> MorleyClientM [(AppliedResult, Mutez)]
-> MorleyClientM ([AppliedResult], [Mutez])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImplicitAddressWithAlias
-> [OperationInfo ClientInput]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations ImplicitAddressWithAlias
moneybag [OperationInfo ClientInput]
ops'
ProtocolParameters{Int
TezosInt64
TezosNat
TezosMutez
ppCostPerByte :: ProtocolParameters -> TezosMutez
ppMinimalBlockDelay :: ProtocolParameters -> TezosNat
ppOriginationSize :: ProtocolParameters -> Int
ppOriginationSize :: Int
ppHardGasLimitPerOperation :: TezosInt64
ppHardStorageLimitPerOperation :: TezosInt64
ppMinimalBlockDelay :: TezosNat
ppCostPerByte :: TezosMutez
ppHardGasLimitPerBlock :: TezosInt64
ppHardGasLimitPerBlock :: ProtocolParameters -> TezosInt64
ppHardGasLimitPerOperation :: ProtocolParameters -> TezosInt64
ppHardStorageLimitPerOperation :: ProtocolParameters -> TezosInt64
..} <- MorleyClientM ProtocolParameters
forall (m :: * -> *). HasTezosRpc m => m ProtocolParameters
Client.getProtocolParameters
let totalFees :: Mutez
totalFees = [Mutez] -> Mutez
unsafeSumMutez [Mutez]
fees
unsafeSumMutez :: [Mutez] -> Mutez
unsafeSumMutez = (Element [Mutez] -> Mutez -> Mutez) -> Mutez -> [Mutez] -> Mutez
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
forall b. (Element [Mutez] -> b -> b) -> b -> [Mutez] -> b
foldr HasCallStack => Mutez -> Mutez -> Mutez
Element [Mutez] -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
unsafeAddMutez Mutez
zeroMutez
zeroMutez :: Mutez
zeroMutez = Mutez
0
originationSz :: Natural
originationSz = forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Natural Int
ppOriginationSize
(Mutez
opsSum, Natural
originationSize) = ([Mutez] -> Mutez)
-> ([Natural] -> Natural)
-> ([Mutez], [Natural])
-> (Mutez, Natural)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Mutez] -> Mutez
unsafeSumMutez [Natural] -> Natural
[Natural] -> Element [Natural]
forall t. (Container t, Num (Element t)) => t -> Element t
sum (([Mutez], [Natural]) -> (Mutez, Natural))
-> ([(Mutez, Natural)] -> ([Mutez], [Natural]))
-> [(Mutez, Natural)]
-> (Mutez, Natural)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Mutez, Natural)] -> ([Mutez], [Natural])
forall a b. [(a, b)] -> ([a], [b])
unzip
([(Mutez, Natural)] -> (Mutez, Natural))
-> [(Mutez, Natural)] -> (Mutez, Natural)
forall a b. (a -> b) -> a -> b
$ (OperationInfo ClevelandInput -> (Mutez, Natural))
-> [OperationInfo ClevelandInput] -> [(Mutez, Natural)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map OperationInfo ClevelandInput -> (Mutez, Natural)
opcostAndOriginationCount [OperationInfo ClevelandInput]
ops
costPerByte :: Mutez
costPerByte = TezosMutez -> Mutez
unTezosMutez TezosMutez
ppCostPerByte
opcostAndOriginationCount :: OperationInfo ClevelandInput -> (Mutez, Natural)
opcostAndOriginationCount = \case
OpOriginate (SomeOriginateData OriginateData oty 'NotLarge
od) -> (OriginateData oty 'NotLarge -> Mutez
forall (oty :: OriginationType) (large :: LargeOrigination).
OriginateData oty large -> Mutez
odBalance OriginateData oty 'NotLarge
od, Natural
originationSz)
OpTransfer TransferInfo ClevelandInput
td -> (TransferData -> Mutez
tdAmount TransferInfo ClevelandInput
TransferData
td, Natural
0)
OpTransferTicket TransferTicketInfo ClevelandInput
_ -> (Mutez
zeroMutez, Natural
0)
OpReveal RevealInfo ClevelandInput
_ -> (Mutez
zeroMutez, Natural
0)
OpDelegation DelegationInfo ClevelandInput
_ -> (Mutez
zeroMutez, Natural
0)
storageDiff :: AppliedResult -> Natural
storageDiff AppliedResult{[ContractAddress]
TezosInt64
arConsumedMilliGas :: TezosInt64
arStorageSize :: TezosInt64
arPaidStorageDiff :: TezosInt64
arOriginatedContracts :: [ContractAddress]
arAllocatedDestinationContracts :: TezosInt64
arAllocatedDestinationContracts :: AppliedResult -> TezosInt64
arConsumedMilliGas :: AppliedResult -> TezosInt64
arOriginatedContracts :: AppliedResult -> [ContractAddress]
arPaidStorageDiff :: AppliedResult -> TezosInt64
arStorageSize :: AppliedResult -> TezosInt64
..} = Natural
safetyStorage Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @TezosInt64 @Natural TezosInt64
arPaidStorageDiff
storageBurnInBytes :: Natural
storageBurnInBytes = Natural
originationSize Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ [Natural] -> Element [Natural]
forall t. (Container t, Num (Element t)) => t -> Element t
sum ((AppliedResult -> Natural) -> [AppliedResult] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map AppliedResult -> Natural
storageDiff [AppliedResult]
appliedResults)
storageBurnInMutez :: Mutez
storageBurnInMutez = Mutez -> Natural -> Mutez
unsafeMulMutez Mutez
costPerByte Natural
storageBurnInBytes
required :: Mutez
required = Mutez
opsSum HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeAddMutez` Mutez
totalFees HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
`unsafeAddMutez` Mutez
storageBurnInMutez
Text -> MorleyClientM ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logInfo (Text -> MorleyClientM ()) -> Text -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ Doc
"estimated amount needed is " Doc -> Doc -> Text
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
required Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", but got " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
balance Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n\
\Storage size: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Natural
storageBurnInBytes Natural -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"; Operations cost: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
opsSum Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n\
\Fees: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
totalFees Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"; Storage burn cost: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Mutez
storageBurnInMutez Mutez -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
pure $ Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe Mutez
zeroMutez (Maybe Mutez -> Mutez) -> Maybe Mutez -> Mutez
forall a b. (a -> b) -> a -> b
$ Mutez -> Mutez -> Maybe Mutez
subMutez Mutez
required Mutez
balance
Bool
refillable <- ImplicitAddress -> ClientM Bool
isAddressRefillable (ImplicitAddress -> ClientM Bool)
-> ImplicitAddress -> ClientM Bool
forall a b. (a -> b) -> a -> b
$ ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
Client.awaAddress ImplicitAddressWithAlias
sender
[OperationInfo Result]
results <- IO [OperationInfo Result] -> ClientM [OperationInfo Result]
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [OperationInfo Result] -> ClientM [OperationInfo Result])
-> IO [OperationInfo Result] -> ClientM [OperationInfo Result]
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM [OperationInfo Result]
-> IO [OperationInfo Result]
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM [OperationInfo Result] -> IO [OperationInfo Result])
-> MorleyClientM [OperationInfo Result]
-> IO [OperationInfo Result]
forall a b. (a -> b) -> a -> b
$ do
Bool -> MorleyClientM () -> MorleyClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
refillable (MorleyClientM () -> MorleyClientM ())
-> MorleyClientM () -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ do
Word
tookIters <- Word -> MorleyClientM Word
refill Word
0
Bool -> MorleyClientM () -> MorleyClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
tookIters Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
1) (MorleyClientM () -> MorleyClientM ())
-> MorleyClientM () -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ Text -> MorleyClientM ()
forall env (m :: * -> *). WithLog env Message m => Text -> m ()
logWarning (Text -> MorleyClientM ()) -> Text -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$
Doc
"Refill of " Doc -> Doc -> Text
forall b. FromDoc b => Doc -> Doc -> b
+| ImplicitAddressWithAlias
sender ImplicitAddressWithAlias -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" took " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Word
tookIters Word -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" iterations."
(Maybe OperationHash, [OperationInfo Result])
-> [OperationInfo Result]
forall a b. (a, b) -> b
snd ((Maybe OperationHash, [OperationInfo Result])
-> [OperationInfo Result])
-> MorleyClientM (Maybe OperationHash, [OperationInfo Result])
-> MorleyClientM [OperationInfo Result]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImplicitAddressWithAlias
-> [OperationInfo ClientInput]
-> MorleyClientM (Maybe OperationHash, [OperationInfo Result])
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
ImplicitAddressWithAlias
-> [OperationInfo ClientInput]
-> m (Maybe OperationHash, [OperationInfo Result])
Client.runOperations ImplicitAddressWithAlias
sender [OperationInfo ClientInput]
ops'
[OperationInfo Result]
-> (Element [OperationInfo Result] -> ClientM ()) -> ClientM ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ [OperationInfo Result]
results ((Element [OperationInfo Result] -> ClientM ()) -> ClientM ())
-> (Element [OperationInfo Result] -> ClientM ()) -> ClientM ()
forall a b. (a -> b) -> a -> b
$ \case
OpTransfer TransferInfo Result
_ -> ClientM ()
forall (f :: * -> *). Applicative f => f ()
pass
OpTransferTicket TransferTicketInfo Result
_ -> ClientM ()
forall (f :: * -> *). Applicative f => f ()
pass
OpOriginate OriginationInfo Result
addr -> do
Alias 'AddressKindContract
alias <- MorleyClientEnv
-> ContractAddress -> ClientM (Alias 'AddressKindContract)
forall (kind :: AddressKind).
L1AddressKind kind =>
MorleyClientEnv -> KindedAddress kind -> ClientM (Alias kind)
getAlias MorleyClientEnv
env ContractAddress
OriginationInfo Result
addr
Text -> ClientM ()
comment (Text -> ClientM ()) -> Text -> ClientM ()
forall a b. (a -> b) -> a -> b
$ Doc
"Originated smart contract '" Doc -> Doc -> Text
forall b. FromDoc b => Doc -> Doc -> b
+| Alias 'AddressKindContract
alias Alias 'AddressKindContract -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+
Doc
"' with address " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Doc
forall a b. (Buildable a, FromDoc b) => a -> b
pretty ContractAddress
OriginationInfo Result
addr
OpReveal () -> ClientM ()
forall (f :: * -> *). Applicative f => f ()
pass
OpDelegation () -> ClientM ()
forall (f :: * -> *). Applicative f => f ()
pass
(OperationInfo Result -> ClientM (OperationInfo ClevelandResult))
-> [OperationInfo Result]
-> ClientM [OperationInfo ClevelandResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM OperationInfo Result -> ClientM (OperationInfo ClevelandResult)
toClevelandResult [OperationInfo Result]
results
toClevelandResult :: OperationInfo Result -> ClientM (OperationInfo ClevelandResult)
toClevelandResult :: OperationInfo Result -> ClientM (OperationInfo ClevelandResult)
toClevelandResult = \case
OpTransfer TransferInfo Result
ops -> [ContractEvent] -> OperationInfo ClevelandResult
TransferInfo ClevelandResult -> OperationInfo ClevelandResult
forall i. TransferInfo i -> OperationInfo i
OpTransfer ([ContractEvent] -> OperationInfo ClevelandResult)
-> ClientM [ContractEvent]
-> ClientM (OperationInfo ClevelandResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WithSource EventOperation -> ClientM ContractEvent)
-> [WithSource EventOperation] -> ClientM [ContractEvent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM WithSource EventOperation -> ClientM ContractEvent
intOpEventToContractEvent [WithSource EventOperation]
TransferInfo Result
ops
OpTransferTicket TransferTicketInfo Result
ops -> [ContractEvent] -> OperationInfo ClevelandResult
TransferTicketInfo ClevelandResult -> OperationInfo ClevelandResult
forall i. TransferTicketInfo i -> OperationInfo i
OpTransferTicket ([ContractEvent] -> OperationInfo ClevelandResult)
-> ClientM [ContractEvent]
-> ClientM (OperationInfo ClevelandResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WithSource EventOperation -> ClientM ContractEvent)
-> [WithSource EventOperation] -> ClientM [ContractEvent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM WithSource EventOperation -> ClientM ContractEvent
intOpEventToContractEvent [WithSource EventOperation]
TransferTicketInfo Result
ops
OpOriginate OriginationInfo Result
ops -> OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult))
-> OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult)
forall a b. (a -> b) -> a -> b
$ OriginationInfo ClevelandResult -> OperationInfo ClevelandResult
forall i. OriginationInfo i -> OperationInfo i
OpOriginate OriginationInfo Result
OriginationInfo ClevelandResult
ops
OpReveal RevealInfo Result
ops -> OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult))
-> OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult)
forall a b. (a -> b) -> a -> b
$ RevealInfo ClevelandResult -> OperationInfo ClevelandResult
forall i. RevealInfo i -> OperationInfo i
OpReveal RevealInfo Result
RevealInfo ClevelandResult
ops
OpDelegation DelegationInfo Result
ops -> OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult))
-> OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult)
forall a b. (a -> b) -> a -> b
$ DelegationInfo ClevelandResult -> OperationInfo ClevelandResult
forall i. DelegationInfo i -> OperationInfo i
OpDelegation DelegationInfo Result
DelegationInfo ClevelandResult
ops
intOpEventToContractEvent :: WithSource EventOperation -> ClientM ContractEvent
intOpEventToContractEvent :: WithSource EventOperation -> ClientM ContractEvent
intOpEventToContractEvent WithSource{wsOtherData :: forall a. WithSource a -> a
wsOtherData = EventOperation{Maybe MText
Maybe Expression
Expression
eoType :: Expression
eoTag :: Maybe MText
eoPayload :: Maybe Expression
eoPayload :: EventOperation -> Maybe Expression
eoTag :: EventOperation -> Maybe MText
eoType :: EventOperation -> Expression
..}, Address
wsSource :: Address
wsSource :: forall a. WithSource a -> Address
..} = do
T.AsUType (Notes t
ceType :: T.Notes t) <- (FromExpressionError -> ClientM Ty)
-> (T -> ClientM Ty) -> Either FromExpressionError T -> ClientM Ty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FromExpressionError -> ClientM Ty
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Ty -> ClientM Ty
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty -> ClientM Ty) -> (T -> Ty) -> T -> ClientM Ty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Ty
toTy) (Either FromExpressionError T -> ClientM Ty)
-> Either FromExpressionError T -> ClientM Ty
forall a b. (a -> b) -> a -> b
$ forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @U.T Expression
eoType
Maybe SomeAnnotatedValue
cePayload <- case Maybe Expression
eoPayload of
Maybe Expression
Nothing -> Maybe SomeAnnotatedValue -> ClientM (Maybe SomeAnnotatedValue)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SomeAnnotatedValue
forall a. Maybe a
Nothing
Just Expression
payload -> case forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @(T.Value t) (Expression -> Either FromExpressionError (Value t))
-> (Expression -> Expression)
-> Expression
-> Either FromExpressionError (Value t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Expression -> Either FromExpressionError (Value t))
-> Expression -> Either FromExpressionError (Value t)
forall a b. (a -> b) -> a -> b
$ Expression
payload of
Right Value t
value -> Maybe SomeAnnotatedValue -> ClientM (Maybe SomeAnnotatedValue)
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SomeAnnotatedValue -> ClientM (Maybe SomeAnnotatedValue))
-> (SomeAnnotatedValue -> Maybe SomeAnnotatedValue)
-> SomeAnnotatedValue
-> ClientM (Maybe SomeAnnotatedValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeAnnotatedValue -> Maybe SomeAnnotatedValue
forall a. a -> Maybe a
Just (SomeAnnotatedValue -> ClientM (Maybe SomeAnnotatedValue))
-> SomeAnnotatedValue -> ClientM (Maybe SomeAnnotatedValue)
forall a b. (a -> b) -> a -> b
$ Notes t -> Value t -> SomeAnnotatedValue
forall (t :: T).
SingI t =>
Notes t -> Value t -> SomeAnnotatedValue
SomeAnnotatedValue Notes t
ceType Value t
value
Left FromExpressionError
err ->
Doc -> ClientM (Maybe SomeAnnotatedValue)
forall a. Doc -> ClientM a
clientFailure (Doc -> ClientM (Maybe SomeAnnotatedValue))
-> Doc -> ClientM (Maybe SomeAnnotatedValue)
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Doc
"Failed to decode event payload expression."
, Doc
"Payload expression:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Builder -> Doc
forall a. Buildable a => a -> Doc
build (Expression -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToTextBuilder (Expression -> Builder) -> Expression -> Builder
forall a b. (a -> b) -> a -> b
$ Expression -> Expression
forall a. ToExpression a => a -> Expression
toExpression Expression
payload)
, Doc
"Decoding error:"
, Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FromExpressionError -> Doc
forall a. Buildable a => a -> Doc
build FromExpressionError
err
]
ContractAddress
ceSource :: ContractAddress <- case Address
wsSource of
Constrained ceSource :: KindedAddress a
ceSource@ContractAddress{} -> ContractAddress -> ClientM ContractAddress
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KindedAddress a
ContractAddress
ceSource
Constrained (KindedAddress a
addr :: KindedAddress kind) ->
TestError -> ClientM ContractAddress
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> ClientM ContractAddress)
-> TestError -> ClientM ContractAddress
forall a b. (a -> b) -> a -> b
$ Text -> TestError
CustomTestError (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected event source kind: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddressKind -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: AddressKind).
(SingKind AddressKind, SingI a) =>
Demote AddressKind
demote @kind)
(SingI a => Text) -> Dict (SingI a) -> Text
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress a -> Dict (SingI a)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress a
addr
pure $ ContractEvent
{ ceTag :: Text
ceTag = Text -> (MText -> Text) -> Maybe MText -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MText -> Text
unMText Maybe MText
eoTag
, Maybe SomeAnnotatedValue
ContractAddress
cePayload :: Maybe SomeAnnotatedValue
ceSource :: ContractAddress
ceSource :: ContractAddress
cePayload :: Maybe SomeAnnotatedValue
..
}
where
toTy :: U.T -> U.Ty
toTy :: T -> Ty
toTy T
t = T -> TypeAnn -> Ty
U.Ty T
t TypeAnn
forall {k} (a :: k). Annotation a
U.noAnn
dryRunOperations :: Client.ImplicitAddressWithAlias
-> [OperationInfo Client.ClientInput]
-> Client.MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations :: ImplicitAddressWithAlias
-> [OperationInfo ClientInput]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations ImplicitAddressWithAlias
s = \case
[] -> [(AppliedResult, Mutez)] -> MorleyClientM [(AppliedResult, Mutez)]
forall a. a -> MorleyClientM a
forall (m :: * -> *) a. Monad m => a -> m a
return []
(OperationInfo ClientInput
x:[OperationInfo ClientInput]
xs) -> NonEmpty (AppliedResult, Mutez) -> [(AppliedResult, Mutez)]
NonEmpty (AppliedResult, Mutez)
-> [Element (NonEmpty (AppliedResult, Mutez))]
forall t. Container t => t -> [Element t]
toList (NonEmpty (AppliedResult, Mutez) -> [(AppliedResult, Mutez)])
-> (NonEmpty (AppliedResult, TezosMutez)
-> NonEmpty (AppliedResult, Mutez))
-> NonEmpty (AppliedResult, TezosMutez)
-> [(AppliedResult, Mutez)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AppliedResult, TezosMutez) -> (AppliedResult, Mutez))
-> NonEmpty (AppliedResult, TezosMutez)
-> NonEmpty (AppliedResult, Mutez)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((TezosMutez -> Mutez)
-> (AppliedResult, TezosMutez) -> (AppliedResult, Mutez)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second TezosMutez -> Mutez
unTezosMutez) (NonEmpty (AppliedResult, TezosMutez) -> [(AppliedResult, Mutez)])
-> MorleyClientM (NonEmpty (AppliedResult, TezosMutez))
-> MorleyClientM [(AppliedResult, Mutez)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImplicitAddressWithAlias
-> NonEmpty (OperationInfo ClientInput)
-> MorleyClientM (NonEmpty (AppliedResult, TezosMutez))
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
ImplicitAddressWithAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (NonEmpty (AppliedResult, TezosMutez))
Client.dryRunOperationsNonEmpty ImplicitAddressWithAlias
s (OperationInfo ClientInput
x OperationInfo ClientInput
-> [OperationInfo ClientInput]
-> NonEmpty (OperationInfo ClientInput)
forall a. a -> [a] -> NonEmpty a
:| [OperationInfo ClientInput]
xs)
findBalanceTooLow :: [Client.RunError] -> Maybe ("balance" :! Mutez, "required" :! Mutez)
findBalanceTooLow :: [RunError] -> Maybe ("balance" :! Mutez, "required" :! Mutez)
findBalanceTooLow
(Client.BalanceTooLow "balance" :! Mutez
balance "required" :! Mutez
required:[RunError]
_)
= ("balance" :! Mutez, "required" :! Mutez)
-> Maybe ("balance" :! Mutez, "required" :! Mutez)
forall a. a -> Maybe a
Just ("balance" :! Mutez
balance, "required" :! Mutez
required)
findBalanceTooLow (RunError
_:[RunError]
xs) = [RunError] -> Maybe ("balance" :! Mutez, "required" :! Mutez)
findBalanceTooLow [RunError]
xs
findBalanceTooLow [] = Maybe ("balance" :! Mutez, "required" :! Mutez)
forall a. Maybe a
Nothing
findCantPayStorageFee :: [Client.RunError] -> Bool
findCantPayStorageFee :: [RunError] -> Bool
findCantPayStorageFee
(RunError
Client.CantPayStorageFee:[RunError]
_)
= Bool
True
findCantPayStorageFee (RunError
_:[RunError]
xs) = [RunError] -> Bool
findCantPayStorageFee [RunError]
xs
findCantPayStorageFee [] = Bool
False
resolveAddressAndAlias :: MorleyClientEnv -> KindedAddress kind -> ClientM AddressAndAlias
resolveAddressAndAlias :: forall (kind :: AddressKind).
MorleyClientEnv -> KindedAddress kind -> ClientM AddressAndAlias
resolveAddressAndAlias MorleyClientEnv
env KindedAddress kind
addr =
case KindedAddress kind
addr of
ImplicitAddress{} -> KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
AddressAndAlias KindedAddress kind
addr (Maybe (Alias kind) -> AddressAndAlias)
-> ClientM (Maybe (Alias kind)) -> ClientM AddressAndAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MorleyClientEnv
-> KindedAddress kind -> ClientM (Maybe (Alias kind))
forall (kind :: AddressKind).
L1AddressKind kind =>
MorleyClientEnv
-> KindedAddress kind -> ClientM (Maybe (Alias kind))
getAliasMaybe MorleyClientEnv
env KindedAddress kind
addr
ContractAddress{} -> KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
AddressAndAlias KindedAddress kind
addr (Maybe (Alias kind) -> AddressAndAlias)
-> ClientM (Maybe (Alias kind)) -> ClientM AddressAndAlias
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MorleyClientEnv
-> KindedAddress kind -> ClientM (Maybe (Alias kind))
forall (kind :: AddressKind).
L1AddressKind kind =>
MorleyClientEnv
-> KindedAddress kind -> ClientM (Maybe (Alias kind))
getAliasMaybe MorleyClientEnv
env KindedAddress kind
addr
SmartRollupAddress{} -> AddressAndAlias -> ClientM AddressAndAlias
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
forall (kind :: AddressKind).
KindedAddress kind -> Maybe (Alias kind) -> AddressAndAlias
AddressAndAlias KindedAddress kind
addr Maybe (Alias kind)
forall a. Maybe a
Nothing)
exceptionToTransferFailure
:: MorleyClientEnv
-> [RPC.OperationResp RPC.WithSource]
-> RPC.ClientRpcError
-> ClientM TransferFailure
exceptionToTransferFailure :: MorleyClientEnv
-> [OperationResp WithSource]
-> ClientRpcError
-> ClientM TransferFailure
exceptionToTransferFailure MorleyClientEnv
env [OperationResp WithSource]
stack = \case
RPC.ContractFailed ContractAddress
addr Expression
expr -> ContractAddress -> TransferFailureReason -> ClientM TransferFailure
forall (kind :: AddressKind).
KindedAddress kind
-> TransferFailureReason -> ClientM TransferFailure
mkTransferFailure ContractAddress
addr (TransferFailureReason -> ClientM TransferFailure)
-> TransferFailureReason -> ClientM TransferFailure
forall a b. (a -> b) -> a -> b
$ ExpressionOrTypedValue
-> Maybe ErrorSrcPos -> TransferFailureReason
FailedWith (Expression -> ExpressionOrTypedValue
EOTVExpression Expression
expr) Maybe ErrorSrcPos
forall a. Maybe a
Nothing
RPC.BadParameter (MkAddress KindedAddress kind
addr) Expression
_ -> KindedAddress kind
-> TransferFailureReason -> ClientM TransferFailure
forall (kind :: AddressKind).
KindedAddress kind
-> TransferFailureReason -> ClientM TransferFailure
mkTransferFailure KindedAddress kind
addr TransferFailureReason
BadParameter
RPC.EmptyTransaction ImplicitAddress
addr -> ImplicitAddress -> TransferFailureReason -> ClientM TransferFailure
forall (kind :: AddressKind).
KindedAddress kind
-> TransferFailureReason -> ClientM TransferFailure
mkTransferFailure ImplicitAddress
addr TransferFailureReason
EmptyTransaction
RPC.ShiftOverflow ContractAddress
addr -> ContractAddress -> TransferFailureReason -> ClientM TransferFailure
forall (kind :: AddressKind).
KindedAddress kind
-> TransferFailureReason -> ClientM TransferFailure
mkTransferFailure ContractAddress
addr TransferFailureReason
ShiftOverflow
RPC.GasExhaustion ContractAddress
addr -> ContractAddress -> TransferFailureReason -> ClientM TransferFailure
forall (kind :: AddressKind).
KindedAddress kind
-> TransferFailureReason -> ClientM TransferFailure
mkTransferFailure ContractAddress
addr TransferFailureReason
GasExhaustion
ClientRpcError
internalError -> ClientRpcError -> ClientM TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientRpcError
internalError
where
mkTransferFailure :: KindedAddress kind -> TransferFailureReason -> ClientM TransferFailure
mkTransferFailure :: forall (kind :: AddressKind).
KindedAddress kind
-> TransferFailureReason -> ClientM TransferFailure
mkTransferFailure KindedAddress kind
addr TransferFailureReason
e = do
AddressAndAlias
addr' <- MorleyClientEnv -> KindedAddress kind -> ClientM AddressAndAlias
forall (kind :: AddressKind).
MorleyClientEnv -> KindedAddress kind -> ClientM AddressAndAlias
resolveAddressAndAlias MorleyClientEnv
env KindedAddress kind
addr
pure $ AddressAndAlias
-> CallSequence -> TransferFailureReason -> TransferFailure
TransferFailure AddressAndAlias
addr' ([OperationResp WithSource] -> CallSequence
rpcToCallSeq [OperationResp WithSource]
stack) TransferFailureReason
e
rpcToCallSeq :: [RPC.OperationResp RPC.WithSource] -> CallSequence
rpcToCallSeq :: [OperationResp WithSource] -> CallSequence
rpcToCallSeq = (OperationResp WithSource
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp)))
-> [OperationResp WithSource] -> CallSequence
forall k a.
Eq k =>
(a -> ToCallSeqM k (Maybe (k, CallSequenceOp)))
-> [a] -> CallSequence
toCallSeq \case
RPC.TransactionOpResp RPC.WithSource{wsOtherData :: forall a. WithSource a -> a
wsOtherData=to :: TransactionOperation
to@RPC.TransactionOperation{Address
TezosMutez
ParametersInternal
toAmount :: TezosMutez
toDestination :: Address
toParameters :: ParametersInternal
toAmount :: TransactionOperation -> TezosMutez
toDestination :: TransactionOperation -> Address
toParameters :: TransactionOperation -> ParametersInternal
..},Address
wsSource :: forall a. WithSource a -> Address
wsSource :: Address
..} ->
(Address, CallSequenceOp) -> Maybe (Address, CallSequenceOp)
forall a. a -> Maybe a
Just ((Address, CallSequenceOp) -> Maybe (Address, CallSequenceOp))
-> ([CallSequenceOp] -> (Address, CallSequenceOp))
-> [CallSequenceOp]
-> Maybe (Address, CallSequenceOp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address
wsSource,) (CallSequenceOp -> (Address, CallSequenceOp))
-> ([CallSequenceOp] -> CallSequenceOp)
-> [CallSequenceOp]
-> (Address, CallSequenceOp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionOperation -> CallSequence -> CallSequenceOp
forall a.
(Buildable a, Show a) =>
a -> CallSequence -> CallSequenceOp
CallSequenceOp TransactionOperation
to (CallSequence -> CallSequenceOp)
-> ([CallSequenceOp] -> CallSequence)
-> [CallSequenceOp]
-> CallSequenceOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CallSequenceOp] -> CallSequence
CallSequence ([CallSequenceOp] -> Maybe (Address, CallSequenceOp))
-> StateT [(Address, [CallSequenceOp])] Identity [CallSequenceOp]
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address
-> StateT [(Address, [CallSequenceOp])] Identity [CallSequenceOp]
forall k. Eq k => k -> ToCallSeqM k [CallSequenceOp]
popToCallSeq Address
toDestination
RPC.TransferTicketOpResp RPC.WithSource{wsOtherData :: forall a. WithSource a -> a
wsOtherData=to :: TransferTicketOperation
to@RPC.TransferTicketOperation{Text
Address
Expression
TezosNat
ttoTicketContents :: Expression
ttoTicketTy :: Expression
ttoTicketTicketer :: Address
ttoTicketAmount :: TezosNat
ttoDestination :: Address
ttoEntrypoint :: Text
ttoDestination :: TransferTicketOperation -> Address
ttoEntrypoint :: TransferTicketOperation -> Text
ttoTicketAmount :: TransferTicketOperation -> TezosNat
ttoTicketContents :: TransferTicketOperation -> Expression
ttoTicketTicketer :: TransferTicketOperation -> Address
ttoTicketTy :: TransferTicketOperation -> Expression
..},Address
wsSource :: forall a. WithSource a -> Address
wsSource :: Address
..} ->
(Address, CallSequenceOp) -> Maybe (Address, CallSequenceOp)
forall a. a -> Maybe a
Just ((Address, CallSequenceOp) -> Maybe (Address, CallSequenceOp))
-> ([CallSequenceOp] -> (Address, CallSequenceOp))
-> [CallSequenceOp]
-> Maybe (Address, CallSequenceOp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address
wsSource,) (CallSequenceOp -> (Address, CallSequenceOp))
-> ([CallSequenceOp] -> CallSequenceOp)
-> [CallSequenceOp]
-> (Address, CallSequenceOp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransferTicketOperation -> CallSequence -> CallSequenceOp
forall a.
(Buildable a, Show a) =>
a -> CallSequence -> CallSequenceOp
CallSequenceOp TransferTicketOperation
to (CallSequence -> CallSequenceOp)
-> ([CallSequenceOp] -> CallSequence)
-> [CallSequenceOp]
-> CallSequenceOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CallSequenceOp] -> CallSequence
CallSequence ([CallSequenceOp] -> Maybe (Address, CallSequenceOp))
-> StateT [(Address, [CallSequenceOp])] Identity [CallSequenceOp]
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address
-> StateT [(Address, [CallSequenceOp])] Identity [CallSequenceOp]
forall k. Eq k => k -> ToCallSeqM k [CallSequenceOp]
popToCallSeq Address
ttoDestination
RPC.OriginationOpResp RPC.WithSource{Address
OriginationOperation
wsOtherData :: forall a. WithSource a -> a
wsSource :: forall a. WithSource a -> Address
wsSource :: Address
wsOtherData :: OriginationOperation
..} ->
Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a. a -> StateT [(Address, [CallSequenceOp])] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp)))
-> Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a b. (a -> b) -> a -> b
$ (Address, CallSequenceOp) -> Maybe (Address, CallSequenceOp)
forall a. a -> Maybe a
Just (Address
wsSource, OriginationOperation -> CallSequence -> CallSequenceOp
forall a.
(Buildable a, Show a) =>
a -> CallSequence -> CallSequenceOp
CallSequenceOp OriginationOperation
wsOtherData CallSequence
forall a. Monoid a => a
mempty)
RPC.DelegationOpResp RPC.WithSource{Address
DelegationOperation
wsOtherData :: forall a. WithSource a -> a
wsSource :: forall a. WithSource a -> Address
wsSource :: Address
wsOtherData :: DelegationOperation
..} ->
Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a. a -> StateT [(Address, [CallSequenceOp])] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp)))
-> Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a b. (a -> b) -> a -> b
$ (Address, CallSequenceOp) -> Maybe (Address, CallSequenceOp)
forall a. a -> Maybe a
Just (Address
wsSource, DelegationOperation -> CallSequence -> CallSequenceOp
forall a.
(Buildable a, Show a) =>
a -> CallSequence -> CallSequenceOp
CallSequenceOp DelegationOperation
wsOtherData CallSequence
forall a. Monoid a => a
mempty)
RPC.RevealOpResp RPC.WithSource{Address
RevealOperation
wsOtherData :: forall a. WithSource a -> a
wsSource :: forall a. WithSource a -> Address
wsSource :: Address
wsOtherData :: RevealOperation
..} ->
Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a. a -> StateT [(Address, [CallSequenceOp])] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp)))
-> Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a b. (a -> b) -> a -> b
$ (Address, CallSequenceOp) -> Maybe (Address, CallSequenceOp)
forall a. a -> Maybe a
Just (Address
wsSource, RevealOperation -> CallSequence -> CallSequenceOp
forall a.
(Buildable a, Show a) =>
a -> CallSequence -> CallSequenceOp
CallSequenceOp RevealOperation
wsOtherData CallSequence
forall a. Monoid a => a
mempty)
RPC.EventOpResp RPC.WithSource{Address
EventOperation
wsOtherData :: forall a. WithSource a -> a
wsSource :: forall a. WithSource a -> Address
wsSource :: Address
wsOtherData :: EventOperation
..} ->
Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a. a -> StateT [(Address, [CallSequenceOp])] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp)))
-> Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a b. (a -> b) -> a -> b
$ (Address, CallSequenceOp) -> Maybe (Address, CallSequenceOp)
forall a. a -> Maybe a
Just (Address
wsSource, EventOperation -> CallSequence -> CallSequenceOp
forall a.
(Buildable a, Show a) =>
a -> CallSequence -> CallSequenceOp
CallSequenceOp EventOperation
wsOtherData CallSequence
forall a. Monoid a => a
mempty)
RPC.OtherOpResp Text
_ ->
Maybe (Address, CallSequenceOp)
-> ToCallSeqM Address (Maybe (Address, CallSequenceOp))
forall a. a -> StateT [(Address, [CallSequenceOp])] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Address, CallSequenceOp)
forall a. Maybe a
Nothing
exceptionHandler :: MorleyClientEnv -> ClientM a -> ClientM a
exceptionHandler :: forall a. MorleyClientEnv -> ClientM a -> ClientM a
exceptionHandler MorleyClientEnv
env ClientM a
action = ClientM a
action ClientM a -> (SomeException -> ClientM a) -> ClientM a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \case
se :: SomeException
se@(SomeException e
e)
| Just ClientRpcError
err <- e -> Maybe ClientRpcError
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e -> TransferFailure -> ClientM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TransferFailure -> ClientM a)
-> ClientM TransferFailure -> ClientM a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MorleyClientEnv
-> [OperationResp WithSource]
-> ClientRpcError
-> ClientM TransferFailure
exceptionToTransferFailure MorleyClientEnv
env [] ClientRpcError
err
| Just RPC.ClientRpcErrorWithStack{NonEmpty (OperationResp WithSource)
ClientRpcError
crewsStack :: NonEmpty (OperationResp WithSource)
crewsError :: ClientRpcError
crewsError :: forall a. ClientRpcErrorWithStack a -> a
crewsStack :: forall a.
ClientRpcErrorWithStack a -> NonEmpty (OperationResp WithSource)
..} <- e -> Maybe (ClientRpcErrorWithStack ClientRpcError)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
-> TransferFailure -> ClientM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TransferFailure -> ClientM a)
-> ClientM TransferFailure -> ClientM a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MorleyClientEnv
-> [OperationResp WithSource]
-> ClientRpcError
-> ClientM TransferFailure
exceptionToTransferFailure MorleyClientEnv
env (NonEmpty (OperationResp WithSource)
-> [Element (NonEmpty (OperationResp WithSource))]
forall t. Container t => t -> [Element t]
toList NonEmpty (OperationResp WithSource)
crewsStack) ClientRpcError
crewsError
| Bool
otherwise -> SomeException -> ClientM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
se
resolveSpecificOrDefaultAlias :: SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias :: SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias (SpecificAlias ImplicitAlias
alias) = ImplicitAlias -> ClientM ImplicitAlias
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImplicitAlias
alias
resolveSpecificOrDefaultAlias (SpecificOrDefaultAlias
DefaultAlias) = do
IORef ClientState
stateRef <- ClientM (IORef ClientState)
forall r (m :: * -> *). MonadReader r m => m r
ask
ist :: ClientState
ist@ClientState{csDefaultAliasCounter :: ClientState -> DefaultAliasCounter
csDefaultAliasCounter=DefaultAliasCounter Natural
counter} <- IORef ClientState -> ClientM ClientState
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef ClientState
stateRef
IORef ClientState -> ClientState -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef ClientState
stateRef ClientState
ist{ csDefaultAliasCounter :: DefaultAliasCounter
csDefaultAliasCounter = Natural -> DefaultAliasCounter
DefaultAliasCounter (Natural -> DefaultAliasCounter) -> Natural -> DefaultAliasCounter
forall a b. (a -> b) -> a -> b
$ Natural
counter Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1 }
pure $ Natural -> ImplicitAlias
mkDefaultAlias Natural
counter
setAddressRefillable :: ImplicitAddress -> ClientM ()
setAddressRefillable :: ImplicitAddress -> ClientM ()
setAddressRefillable ImplicitAddress
addr = do
IORef ClientState
stRef <- ClientM (IORef ClientState)
forall r (m :: * -> *). MonadReader r m => m r
ask
IORef ClientState -> (ClientState -> ClientState) -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef ClientState
stRef ((ClientState -> ClientState) -> ClientM ())
-> (ClientState -> ClientState) -> ClientM ()
forall a b. (a -> b) -> a -> b
$ \st :: ClientState
st@ClientState{Set ImplicitAddress
DefaultAliasCounter
Moneybag
csDefaultAliasCounter :: ClientState -> DefaultAliasCounter
csRefillableAddresses :: ClientState -> Set ImplicitAddress
csMoneybagAddress :: ClientState -> Moneybag
csDefaultAliasCounter :: DefaultAliasCounter
csRefillableAddresses :: Set ImplicitAddress
csMoneybagAddress :: Moneybag
..} ->
ClientState
st{csRefillableAddresses :: Set ImplicitAddress
csRefillableAddresses=ImplicitAddress -> Set ImplicitAddress -> Set ImplicitAddress
forall a. Ord a => a -> Set a -> Set a
Set.insert ImplicitAddress
addr Set ImplicitAddress
csRefillableAddresses}
isAddressRefillable :: ImplicitAddress -> ClientM Bool
isAddressRefillable :: ImplicitAddress -> ClientM Bool
isAddressRefillable ImplicitAddress
addr = do
IORef ClientState
stRef <- ClientM (IORef ClientState)
forall r (m :: * -> *). MonadReader r m => m r
ask
ImplicitAddress -> Set ImplicitAddress -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ImplicitAddress
addr (Set ImplicitAddress -> Bool)
-> (ClientState -> Set ImplicitAddress) -> ClientState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> Set ImplicitAddress
csRefillableAddresses (ClientState -> Bool) -> ClientM ClientState -> ClientM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef ClientState -> ClientM ClientState
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef ClientState
stRef
revealKeyUnlessRevealed :: MorleyClientEnv -> Client.ImplicitAddressWithAlias -> IO ()
revealKeyUnlessRevealed :: MorleyClientEnv -> ImplicitAddressWithAlias -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
env ImplicitAddressWithAlias
addr = MorleyClientEnv -> MorleyClientM () -> IO ()
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM () -> IO ()) -> MorleyClientM () -> IO ()
forall a b. (a -> b) -> a -> b
$
ImplicitAddressWithAlias -> MorleyClientM ()
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
ImplicitAddressWithAlias -> m ()
Client.revealKeyUnlessRevealed ImplicitAddressWithAlias
addr
newtype TestError
= CustomTestError Text
deriving stock Int -> TestError -> ShowS
[TestError] -> ShowS
TestError -> String
(Int -> TestError -> ShowS)
-> (TestError -> String)
-> ([TestError] -> ShowS)
-> Show TestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestError -> ShowS
showsPrec :: Int -> TestError -> ShowS
$cshow :: TestError -> String
show :: TestError -> String
$cshowList :: [TestError] -> ShowS
showList :: [TestError] -> ShowS
Show
instance Exception TestError where
displayException :: TestError -> String
displayException = TestError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty
fromException :: SomeException -> Maybe TestError
fromException = SomeException -> Maybe TestError
forall e. Exception e => SomeException -> Maybe e
fromPossiblyAnnotatedException
instance Buildable TestError where
build :: TestError -> Doc
build (CustomTestError Text
msg) = Text -> Doc
forall a. Buildable a => a -> Doc
build Text
msg