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

-- | Implementation that works with real Tezos network, it
-- talks to a Tezos node and uses @tezos-client@.

module Test.Cleveland.Internal.Client
  ( ClientM (..)
  , runNetworkT

  -- * Capability implementations
  , networkOpsImpl
  , networkMiscImpl

  -- * Internals
  , revealKeyUnlessRevealed
  , setupMoneybagAddress
  , ClientState(..)
  , TestError(..)
  , MoneybagConfigurationException (..)

  -- * Environment
  , mkMorleyOnlyRpcEnvNetwork

  -- * Lens for 'NetworkEnv'
  , neMorleyClientEnvL
  , neSecretKeyL
  , neMoneybagAliasL
  , neExplicitDataDirL

  -- * Error types
  , InternalNetworkScenarioError(..)
  ) where

import Control.Lens (_head, each, filtered)
import Data.Aeson.Text qualified as J
import Data.Constraint (withDict, (\\))
import Data.Default (def)
import Data.Ratio ((%))
import Data.Set qualified as Set
import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, secondsToNominalDiffTime)
import Fmt (Buildable(build), Builder, indentF, pretty, unlinesF, (+|), (|+))
import System.IO (hFlush)
import Time (KnownDivRat, Second, Time, sec, threadDelay, toNum, toUnit)
import Unsafe qualified (fromIntegral)

import Lorentz (NicePackedValue)
import Lorentz qualified as L
import Lorentz.Constraints.Scopes (NiceUnpackedValue, niceParameterEvi)
import Morley.AsRPC (AsRPC, HasRPCRepr(..), TAsRPC, notesAsRPC, rpcSingIEvi)
import Morley.Client (MorleyClientEnv, OperationInfo(..), disableAlphanetWarning, runMorleyClientM)
import Morley.Client qualified as Client
import Morley.Client.Action (Result)
import Morley.Client.Action.Reveal qualified as RevealRPC
import Morley.Client.App (failOnTimeout, retryOnceOnTimeout)
import Morley.Client.Init qualified as Client
import Morley.Client.Logging (logInfo, logWarning)
import Morley.Client.RPC.Error qualified as RPC (ClientRpcError(..), RunCodeErrors(..))
import Morley.Client.RPC.Types
  (AppliedResult(..), BlockConstants(bcHeader), BlockHeaderNoHash(bhnhLevel, bhnhTimestamp),
  BlockId(..), IntOpEvent(..), OriginationScript(..),
  ProtocolParameters(ProtocolParameters, ppCostPerByte, ppMinimalBlockDelay, ppOriginationSize))
import Morley.Client.TezosClient.Impl as TezosClient (getPublicKey, getSecretKey, importKey)
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.TypeCheck (typeCheckContractAndStorage, typeCheckingWith)
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.Exception
import Morley.Util.Named
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Exceptions (addCallStack)
import Test.Cleveland.Lorentz (toL1Address)
import Test.Cleveland.Util (ceilingUnit)

-- | Construct 'Client.MorleyOnlyRpcEnv' from 'NetworkEnv'.
mkMorleyOnlyRpcEnvNetwork
  :: NetworkEnv
  -> [SecretKey]  -- ^ Extra secrets that should be known
  -> Client.MorleyOnlyRpcEnv
mkMorleyOnlyRpcEnvNetwork :: NetworkEnv -> [SecretKey] -> MorleyOnlyRpcEnv
mkMorleyOnlyRpcEnvNetwork NetworkEnv{Bool
Maybe SecretKey
ImplicitAlias
MorleyClientEnv
neExplicitDataDir :: NetworkEnv -> Bool
neMoneybagAlias :: NetworkEnv -> ImplicitAlias
neSecretKey :: NetworkEnv -> Maybe SecretKey
neMorleyClientEnv :: NetworkEnv -> MorleyClientEnv
neExplicitDataDir :: Bool
neMoneybagAlias :: ImplicitAlias
neSecretKey :: Maybe SecretKey
neMorleyClientEnv :: MorleyClientEnv
..} [SecretKey]
extraSecrets =
  MorleyOnlyRpcEnv :: ClientLogAction MorleyOnlyRpcM
-> ClientEnv -> Map ImplicitAddress SecretKey -> MorleyOnlyRpcEnv
Client.MorleyOnlyRpcEnv
  { moreLogAction :: ClientLogAction MorleyOnlyRpcM
moreLogAction = Word -> ClientLogAction MorleyOnlyRpcM
forall (m :: * -> *). MonadIO m => Word -> ClientLogAction m
Client.mkLogAction Word
0
  , moreClientEnv :: ClientEnv
moreClientEnv = MorleyClientEnv -> ClientEnv
forall (m :: * -> *). MorleyClientEnv' m -> 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 ]
  }

-- | This error designates that necessary preparations for running tests
-- are not made.
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
$cto :: forall x.
Rep MoneybagConfigurationException x
-> MoneybagConfigurationException
$cfrom :: forall x.
MoneybagConfigurationException
-> Rep MoneybagConfigurationException x
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
showList :: [MoneybagConfigurationException] -> ShowS
$cshowList :: [MoneybagConfigurationException] -> ShowS
show :: MoneybagConfigurationException -> String
$cshow :: MoneybagConfigurationException -> String
showsPrec :: Int -> MoneybagConfigurationException -> ShowS
$cshowsPrec :: Int -> MoneybagConfigurationException -> ShowS
Show, MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
(MoneybagConfigurationException
 -> MoneybagConfigurationException -> Bool)
-> (MoneybagConfigurationException
    -> MoneybagConfigurationException -> Bool)
-> Eq MoneybagConfigurationException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
$c/= :: MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
== :: MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
$c== :: MoneybagConfigurationException
-> MoneybagConfigurationException -> Bool
Eq)

instance Buildable MoneybagConfigurationException where
  build :: MoneybagConfigurationException -> Builder
build = \case
    NoMoneybagAddress ImplicitAlias
alias -> forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF @_ @Builder
      [ Builder
"Moneybag alias is not registered in the tezos node: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ImplicitAlias -> Builder
forall p. Buildable p => p -> Builder
build ImplicitAlias
alias
      , Builder
""
      , Builder
"Cleveland's network tests require a special address with plenty of XTZ for"
      , Builder
"originating contracts and performing transfers."
      , Builder
""
      , Builder
"By default, Cleveland expects an account with the alias 'moneybag' to already exist."
      , Builder
"If no such alias exists, you can choose to either:"
      , Builder
"  * Use a different alias, supplied via '--cleveland-moneybag-alias'."
      , Builder
"  * 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 -> Builder
unlinesF @_ @Builder
      [ Builder
"Tried to import the secret key supplied via '--cleveland-moneybag-secret-key' and"
      , Builder
"associate it with the alias '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAlias
alias ImplicitAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"', but the alias already exists."
      , Builder
""
      , Builder
"  --cleveland-moneybag-secret-key: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SecretKey -> Builder
forall p. Buildable p => p -> Builder
build SecretKey
envKey
      , Builder
"  Existing address             : " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ImplicitAddress -> Builder
forall p. Buildable p => p -> Builder
build ImplicitAddress
existingAddress
      , Builder
""
      , Builder
"Possible fix:"
      , Builder
"  * If you wish to use the existing address, please remove the '--cleveland-moneybag-secret-key' option."
      , Builder
"  * 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, FromBuilder b) => a -> b
pretty

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
<$ :: forall a b. a -> ClientM b -> ClientM a
$c<$ :: forall a b. a -> ClientM b -> ClientM a
fmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
$cfmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
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
<* :: forall a b. ClientM a -> ClientM b -> ClientM a
$c<* :: forall a b. ClientM a -> ClientM b -> ClientM a
*> :: forall a b. ClientM a -> ClientM b -> ClientM b
$c*> :: forall a b. ClientM a -> ClientM b -> ClientM b
liftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
$cliftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
$c<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
pure :: forall a. a -> ClientM a
$cpure :: forall a. a -> 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
return :: forall a. a -> ClientM a
$creturn :: forall a. a -> ClientM a
>> :: forall a b. ClientM a -> ClientM b -> ClientM b
$c>> :: forall a b. ClientM a -> ClientM b -> ClientM b
>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
$c>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
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
liftIO :: forall a. IO a -> ClientM a
$cliftIO :: 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
throwM :: forall e a. Exception e => e -> ClientM a
$cthrowM :: 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
catch :: forall e a.
Exception e =>
ClientM a -> (e -> ClientM a) -> ClientM a
$ccatch :: 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
fail :: forall a. String -> ClientM a
$cfail :: 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
showList :: [InternalNetworkScenarioError] -> ShowS
$cshowList :: [InternalNetworkScenarioError] -> ShowS
show :: InternalNetworkScenarioError -> String
$cshow :: InternalNetworkScenarioError -> String
showsPrec :: Int -> InternalNetworkScenarioError -> ShowS
$cshowsPrec :: Int -> InternalNetworkScenarioError -> ShowS
Show)

instance Buildable InternalNetworkScenarioError where
  build :: InternalNetworkScenarioError -> Builder
build (TooManyRefillIterations Word
iter ImplicitAddress
addr) =
    Builder
"Too many (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Word
iter Word -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
") refill iteratons of " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
addr ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

instance Exception InternalNetworkScenarioError where
  displayException :: InternalNetworkScenarioError -> String
displayException = InternalNetworkScenarioError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

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 :: forall (m :: * -> *).
NetworkEnv -> ClevelandCaps m -> NetworkCaps m
NetworkCaps
        { ncNetworkEnv :: NetworkEnv
ncNetworkEnv = NetworkEnv
env
        , ncClevelandCaps :: ClevelandCaps ClientM
ncClevelandCaps = ClevelandCaps :: forall (m :: * -> *).
Sender
-> Moneybag
-> ClevelandMiscImpl m
-> (Sender -> ClevelandOpsImpl m)
-> ClevelandCaps m
ClevelandCaps
            { ccSender :: Sender
ccSender = ImplicitAddress -> Sender
Sender (ImplicitAddress -> Sender) -> ImplicitAddress -> Sender
forall a b. (a -> b) -> a -> b
$ Moneybag -> ImplicitAddress
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 :: DefaultAliasCounter
-> Set ImplicitAddress -> Moneybag -> ClientState
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

-- | Initialize @moneybag@ address by given 'NetworkEnv'
setupMoneybagAddress :: NetworkEnv -> IO Moneybag
setupMoneybagAddress :: NetworkEnv -> IO Moneybag
setupMoneybagAddress NetworkEnv{Bool
Maybe SecretKey
ImplicitAlias
MorleyClientEnv
neExplicitDataDir :: Bool
neMoneybagAlias :: ImplicitAlias
neSecretKey :: Maybe SecretKey
neMorleyClientEnv :: MorleyClientEnv
neExplicitDataDir :: NetworkEnv -> Bool
neMoneybagAlias :: NetworkEnv -> ImplicitAlias
neSecretKey :: NetworkEnv -> Maybe SecretKey
neMorleyClientEnv :: NetworkEnv -> MorleyClientEnv
..} = 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
forall (m :: * -> *). Lens' (MorleyClientEnv' m) 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
$
    ImplicitAddressOrAlias -> MorleyClientM (Maybe ImplicitAddress)
forall (m :: * -> *) (kind :: AddressKind).
HasTezosClient m =>
AddressOrAlias kind -> m (Maybe (KindedAddress kind))
Client.resolveAddressMaybe (ImplicitAlias -> ImplicitAddressOrAlias
forall (kind :: AddressKind). Alias kind -> AddressOrAlias kind
AddressAlias ImplicitAlias
neMoneybagAlias)
  ImplicitAddress -> Moneybag
Moneybag (ImplicitAddress -> Moneybag) -> IO ImplicitAddress -> 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)
-> (ImplicitAddressOrAlias -> MorleyClientM SecretKey)
-> ImplicitAddressOrAlias
-> MorleyClientM SecretKey
forall a b c. SuperComposition a b c => a -> b -> c
... ImplicitAddressOrAlias -> MorleyClientM SecretKey
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
ImplicitAddressOrAlias -> m SecretKey
TezosClient.getSecretKey)
          (ImplicitAlias -> ImplicitAddressOrAlias
forall (kind :: AddressKind). Alias kind -> AddressOrAlias kind
AddressAlias ImplicitAlias
neMoneybagAlias)
        IO ImplicitAlias -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ImplicitAlias -> IO ()) -> IO ImplicitAlias -> IO ()
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> MorleyClientM ImplicitAlias -> IO ImplicitAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAlias -> IO ImplicitAlias)
-> MorleyClientM ImplicitAlias -> IO ImplicitAlias
forall a b. (a -> b) -> a -> b
$
          MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
failOnTimeout (MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias)
-> MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias
forall a b c. SuperComposition a b c => a -> b -> c
... Bool -> ImplicitAlias -> SecretKey -> MorleyClientM ImplicitAlias
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
Bool -> ImplicitAlias -> SecretKey -> m ImplicitAlias
TezosClient.importKey Bool
False ImplicitAlias
neMoneybagAlias SecretKey
ek
      pure ImplicitAddress
addr
    (Maybe SecretKey
Nothing, Maybe ImplicitAddress
Nothing) -> MoneybagConfigurationException -> IO ImplicitAddress
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MoneybagConfigurationException -> IO ImplicitAddress)
-> MoneybagConfigurationException -> IO ImplicitAddress
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 ImplicitAlias -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ImplicitAlias -> IO ()) -> IO ImplicitAlias -> IO ()
forall a b. (a -> b) -> a -> b
$
            MorleyClientEnv -> MorleyClientM ImplicitAlias -> IO ImplicitAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAlias -> IO ImplicitAlias)
-> MorleyClientM ImplicitAlias -> IO ImplicitAlias
forall a b. (a -> b) -> a -> b
$
              MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
failOnTimeout (MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias)
-> MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias
forall a b c. SuperComposition a b c => a -> b -> c
... Bool -> ImplicitAlias -> SecretKey -> MorleyClientM ImplicitAlias
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
Bool -> ImplicitAlias -> SecretKey -> m ImplicitAlias
TezosClient.importKey Bool
False ImplicitAlias
neMoneybagAlias SecretKey
ek
          pure ImplicitAddress
sa
      | Bool
otherwise -> MoneybagConfigurationException -> IO ImplicitAddress
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MoneybagConfigurationException -> IO ImplicitAddress)
-> MoneybagConfigurationException -> IO ImplicitAddress
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 ImplicitAlias -> IO ImplicitAlias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAlias -> IO ImplicitAlias)
-> MorleyClientM ImplicitAlias -> IO ImplicitAlias
forall a b. (a -> b) -> a -> b
$
        MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadThrow m) =>
m a -> m a
failOnTimeout (MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias)
-> MorleyClientM ImplicitAlias -> MorleyClientM ImplicitAlias
forall a b c. SuperComposition a b c => a -> b -> c
... Bool -> ImplicitAlias -> SecretKey -> MorleyClientM ImplicitAlias
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
Bool -> ImplicitAlias -> SecretKey -> m ImplicitAlias
TezosClient.importKey Bool
False ImplicitAlias
neMoneybagAlias SecretKey
ek
      return $ PublicKey -> ImplicitAddress
mkKeyAddress (SecretKey -> PublicKey
toPublic SecretKey
ek)

-- | Implementation that works with real network and uses @tezos-node@
-- RPC and @tezos-client@.
networkOpsImpl :: MorleyClientEnv -> Sender -> ClevelandOpsImpl ClientM
networkOpsImpl :: MorleyClientEnv -> Sender -> ClevelandOpsImpl ClientM
networkOpsImpl MorleyClientEnv
env (Sender ImplicitAddress
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. (HasCallStack, MonadCatch m) => 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
. ClientM a -> ClientM a
forall a. ClientM a -> ClientM a
exceptionHandler)
    ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
 [OperationInfo ClevelandInput]
 -> m [OperationInfo ClevelandResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
    { coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput]
-> ClientM [OperationInfo ClevelandResult]
coiRunOperationBatch = MorleyClientEnv
-> ImplicitAddress
-> [OperationInfo ClevelandInput]
-> ClientM [OperationInfo ClevelandResult]
runOperationBatch MorleyClientEnv
env ImplicitAddress
sender
    }

networkMiscImpl :: NetworkEnv -> ClevelandMiscImpl ClientM
networkMiscImpl :: NetworkEnv -> ClevelandMiscImpl ClientM
networkMiscImpl env :: NetworkEnv
env@NetworkEnv{Bool
Maybe SecretKey
ImplicitAlias
MorleyClientEnv
neExplicitDataDir :: Bool
neMoneybagAlias :: ImplicitAlias
neSecretKey :: Maybe SecretKey
neMorleyClientEnv :: MorleyClientEnv
neExplicitDataDir :: NetworkEnv -> Bool
neMoneybagAlias :: NetworkEnv -> ImplicitAlias
neSecretKey :: NetworkEnv -> Maybe SecretKey
neMorleyClientEnv :: NetworkEnv -> MorleyClientEnv
..} =
  (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. (HasCallStack, MonadCatch m) => 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
. ClientM a -> ClientM a
forall a. ClientM a -> ClientM a
exceptionHandler) ClevelandMiscImpl :: forall (m :: * -> *).
(forall res. HasCallStack => IO res -> m res)
-> (forall (kind :: AddressKind).
    HasCallStack =>
    Alias kind -> m (KindedAddress kind))
-> (HasCallStack => SpecificOrDefaultAlias -> m ImplicitAddress)
-> (HasCallStack => SpecificOrDefaultAlias -> m ImplicitAddress)
-> (HasCallStack => ByteString -> ImplicitAddress -> m Signature)
-> (HasCallStack =>
    Sender -> UntypedOriginateData 'IsLarge -> m ContractAddress)
-> (HasCallStack => Text -> m ())
-> (HasCallStack => L1Address -> m Mutez)
-> (HasCallStack => ContractAddress -> m SomeAnnotatedValue)
-> (forall k v.
    (HasCallStack, NiceComparable k, NicePackedValue k,
     NiceUnpackedValue v) =>
    BigMapId k v -> k -> m (Maybe v))
-> (forall k v.
    (HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
    BigMapId k v -> m (Maybe [v]))
-> (HasCallStack => ImplicitAddress -> m PublicKey)
-> (HasCallStack => ContractAddress -> m (Maybe KeyHash))
-> (HasCallStack => ImplicitAddress -> m ())
-> (HasCallStack => m ChainId)
-> (forall (unit :: Rat).
    (HasCallStack, KnownDivRat unit Second) =>
    Time unit -> m ())
-> (HasCallStack => (Natural -> Natural) -> m ())
-> (HasCallStack => m Timestamp)
-> (HasCallStack => m Natural)
-> (forall a. HasCallStack => Builder -> m a)
-> (forall a. HasCallStack => SomeException -> m a)
-> (HasCallStack => m (Time Second))
-> (forall a e.
    (Exception e, HasCallStack) =>
    m a -> m (Either e a))
-> (ImplicitAddress -> m ())
-> m (Either (EmulatedImpl m) NetworkEnv)
-> (forall cp st vd.
    (HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
    Sender -> RunCode cp st vd -> m (AsRPC st))
-> ClevelandMiscImpl m
ClevelandMiscImpl
    { cmiRunIO :: forall res. HasCallStack => IO res -> ClientM res
cmiRunIO = forall res. HasCallStack => IO res -> ClientM res
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

    , cmiOriginateLargeUntyped :: HasCallStack =>
Sender -> UntypedOriginateData 'IsLarge -> ClientM ContractAddress
cmiOriginateLargeUntyped = \(Sender ImplicitAddress
sender) UntypedOriginateData{Mutez
Contract
Value
Alias 'AddressKindContract
uodContract :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Contract
uodStorage :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Value
uodBalance :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Mutez
uodName :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Alias 'AddressKindContract
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: Alias 'AddressKindContract
..} -> do
        let originationScenario :: MorleyClientM (OperationHash, ContractAddress)
originationScenario =
              Bool
-> Alias 'AddressKindContract
-> ImplicitAddressOrAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> MorleyClientM (OperationHash, ContractAddress)
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
Bool
-> Alias 'AddressKindContract
-> ImplicitAddressOrAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> m (OperationHash, ContractAddress)
Client.originateLargeUntypedContract Bool
True Alias 'AddressKindContract
uodName (ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
KindedAddress kind -> AddressOrAlias kind
AddressResolved ImplicitAddress
sender)
                Mutez
uodBalance Contract
uodContract Value
uodStorage Maybe Mutez
forall a. Maybe a
Nothing
        -- Note that tezos key reveal operation cost an additional fee
        -- so that's why we reveal keys in origination and transaction
        -- rather than doing it before scenario execution
        (OperationHash
_, ContractAddress
res) <- IO (OperationHash, ContractAddress)
-> ClientM (OperationHash, ContractAddress)
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 -> ImplicitAddress -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
neMorleyClientEnv ImplicitAddress
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
$ Builder
"Originated large smart contract " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias 'AddressKindContract
uodName Alias 'AddressKindContract -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" with address " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ContractAddress
res
        pure ContractAddress
res

    , cmiSignBytes :: HasCallStack => ByteString -> ImplicitAddress -> ClientM Signature
cmiSignBytes = \ByteString
hash ImplicitAddress
signer -> IO Signature -> ClientM Signature
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
$
        -- We don't use password protected accounts in cleveland tests
        ImplicitAddressOrAlias
-> Maybe ScrubbedBytes -> ByteString -> MorleyClientM Signature
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAddressOrAlias
-> Maybe ScrubbedBytes -> ByteString -> m Signature
Client.signBytes (ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
KindedAddress kind -> AddressOrAlias kind
AddressResolved ImplicitAddress
signer) Maybe ScrubbedBytes
forall a. Maybe a
Nothing ByteString
hash

    , cmiGenKey :: HasCallStack => SpecificOrDefaultAlias -> ClientM ImplicitAddress
cmiGenKey = \SpecificOrDefaultAlias
sodAlias -> do
        ImplicitAlias
alias <- SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
        IO ImplicitAddress -> ClientM ImplicitAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImplicitAddress -> ClientM ImplicitAddress)
-> IO ImplicitAddress -> ClientM ImplicitAddress
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM ImplicitAddress -> IO ImplicitAddress
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAddress -> IO ImplicitAddress)
-> MorleyClientM ImplicitAddress -> IO ImplicitAddress
forall a b. (a -> b) -> a -> b
$ ImplicitAlias -> MorleyClientM ImplicitAddress
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAlias -> m ImplicitAddress
Client.genKey ImplicitAlias
alias

    , cmiGenFreshKey :: HasCallStack => SpecificOrDefaultAlias -> ClientM ImplicitAddress
cmiGenFreshKey = \SpecificOrDefaultAlias
sodAlias -> do
        ImplicitAlias
alias <- SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias SpecificOrDefaultAlias
sodAlias
        IO ImplicitAddress -> ClientM ImplicitAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImplicitAddress -> ClientM ImplicitAddress)
-> IO ImplicitAddress -> ClientM ImplicitAddress
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM ImplicitAddress -> IO ImplicitAddress
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM ImplicitAddress -> IO ImplicitAddress)
-> MorleyClientM ImplicitAddress -> IO ImplicitAddress
forall a b. (a -> b) -> a -> b
$ ImplicitAlias -> MorleyClientM ImplicitAddress
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAlias -> m ImplicitAddress
Client.genFreshKey ImplicitAlias
alias

    , cmiGetBalance :: HasCallStack => L1Address -> ClientM Mutez
cmiGetBalance = \(MkConstrainedAddress KindedAddress kind
a) -> KindedAddress kind -> ClientM Mutez
forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> ClientM Mutez
getBalanceHelper KindedAddress kind
a
    , cmiGetChainId :: HasCallStack => ClientM ChainId
cmiGetChainId = IO ChainId -> ClientM ChainId
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 = 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 = 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
    , cmiRegisterDelegate :: HasCallStack => ImplicitAddress -> ClientM ()
cmiRegisterDelegate = \ImplicitAddress
addr -> IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> MorleyClientM () -> IO ()
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM () -> IO ()) -> MorleyClientM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        ImplicitAlias
alias <- ImplicitAddressOrAlias -> MorleyClientM ImplicitAlias
forall (m :: * -> *) (kind :: AddressKind).
(HasTezosClient m, L1AddressKind kind) =>
AddressOrAlias kind -> m (Alias kind)
Client.getAlias (ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
KindedAddress kind -> AddressOrAlias kind
AddressResolved ImplicitAddress
addr)
        ImplicitAlias -> Maybe ScrubbedBytes -> MorleyClientM ()
forall (m :: * -> *).
HasTezosClient m =>
ImplicitAlias -> Maybe ScrubbedBytes -> m ()
Client.registerDelegate ImplicitAlias
alias Maybe ScrubbedBytes
forall a. Maybe a
Nothing
    , 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 (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 => Builder -> ClientM a
cmiFailure = forall a. HasCallStack => Builder -> ClientM a
forall a. Builder -> ClientM a
clientFailure
    , ClientM Natural
ClientM (Time Second)
ClientM Timestamp
HasCallStack => ClientM Natural
HasCallStack => ClientM (Time Second)
HasCallStack => ClientM Timestamp
HasCallStack => ImplicitAddress -> ClientM PublicKey
HasCallStack => ContractAddress -> ClientM (Maybe KeyHash)
HasCallStack => ContractAddress -> ClientM SomeAnnotatedValue
HasCallStack => (Natural -> Natural) -> ClientM ()
ImplicitAddress -> ClientM PublicKey
ContractAddress -> ClientM (Maybe KeyHash)
ContractAddress -> ClientM SomeAnnotatedValue
(Natural -> Natural) -> ClientM ()
forall {k} {v}.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> ClientM (Maybe [v])
forall {k} {v}.
(HasCallStack, NiceComparable k, NicePackedValue k,
 NiceUnpackedValue v) =>
BigMapId k v -> k -> 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 =>
Alias kind -> ClientM (KindedAddress kind)
forall (kind :: AddressKind).
Alias kind -> ClientM (KindedAddress kind)
cmiRunCode :: forall {cp} {st} {vd}.
(HasCallStack, HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> ClientM (AsRPC st)
cmiGetApproximateBlockInterval :: HasCallStack => ClientM (Time Second)
cmiGetLevel :: HasCallStack => ClientM Natural
cmiGetNow :: HasCallStack => ClientM Timestamp
cmiAdvanceToLevel :: HasCallStack => (Natural -> Natural) -> ClientM ()
cmiAdvanceTime :: forall {unit :: Rat}.
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> ClientM ()
cmiGetDelegate :: HasCallStack => ContractAddress -> ClientM (Maybe KeyHash)
cmiGetPublicKey :: HasCallStack => ImplicitAddress -> ClientM PublicKey
cmiGetAllBigMapValuesMaybe :: forall {k} {v}.
(HasCallStack, NiceComparable k, NiceUnpackedValue v) =>
BigMapId k v -> ClientM (Maybe [v])
cmiGetBigMapValueMaybe :: forall {k} {v}.
(HasCallStack, NiceComparable k, NicePackedValue k,
 NiceUnpackedValue v) =>
BigMapId k v -> k -> ClientM (Maybe v)
cmiGetSomeStorage :: HasCallStack => ContractAddress -> ClientM SomeAnnotatedValue
cmiResolveAddress :: forall {kind :: AddressKind}.
HasCallStack =>
Alias kind -> ClientM (KindedAddress kind)
cmiRunCode :: forall cp st vd.
(HasRPCRepr st, IsoValue (AsRPC st)) =>
Sender -> RunCode cp st vd -> ClientM (AsRPC st)
cmiAdvanceToLevel :: (Natural -> Natural) -> ClientM ()
cmiAdvanceTime :: forall (unit :: Rat).
KnownDivRat unit Second =>
Time unit -> ClientM ()
cmiGetApproximateBlockInterval :: ClientM (Time Second)
cmiGetLevel :: ClientM Natural
cmiGetNow :: ClientM Timestamp
cmiGetDelegate :: ContractAddress -> ClientM (Maybe KeyHash)
cmiGetPublicKey :: ImplicitAddress -> ClientM PublicKey
cmiResolveAddress :: forall (kind :: AddressKind).
Alias kind -> ClientM (KindedAddress kind)
cmiGetSomeStorage :: ContractAddress -> ClientM SomeAnnotatedValue
cmiGetAllBigMapValuesMaybe :: forall {k} v (k :: k).
NiceUnpackedValue v =>
BigMapId k v -> ClientM (Maybe [v])
cmiGetBigMapValueMaybe :: forall k v.
(NicePackedValue k, NiceUnpackedValue v) =>
BigMapId k v -> k -> ClientM (Maybe v)
..
    }
  where
    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 (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 (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
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).
Lens' (MichelinePrimAp x) MichelinePrimitive
mpaPrimL MichelinePrimitive -> MichelinePrimitive -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> MichelinePrimitive
MichelinePrimitive Text
"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).
Lens (MichelinePrimAp x1) (MichelinePrimAp x2) [Exp x1] [Exp 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
_head

      case Maybe Expression
storageTypeExprMb of
        Maybe Expression
Nothing -> Builder -> ClientM Ty
forall a. Builder -> ClientM a
clientFailure (Builder -> ClientM Ty) -> Builder -> ClientM Ty
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
          [ Builder
"Contract expression did not contain a 'storage' expression."
          , Builder
"Contract expression:"
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
forall p. Buildable p => p -> Builder
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 -> Builder -> ClientM Ty
forall a. Builder -> ClientM a
clientFailure (Builder -> ClientM Ty) -> Builder -> ClientM Ty
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
              [ Builder
"'storage' expression was not a valid type expression."
              , Builder
"Storage expression:"
              , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
forall p. Buildable p => p -> Builder
build (Expression -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToTextBuilder Expression
storageTypeExpr)
              , Builder
"Decoding error:"
              , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ FromExpressionError -> Builder
forall p. Buildable p => p -> Builder
build FromExpressionError
err
              ]
            Right Ty
storageType -> Ty -> ClientM Ty
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 :: OriginationScript -> Expression
osCode :: Expression
osCode, Expression
osStorage :: OriginationScript -> Expression
osStorage :: Expression
osStorage} <-
        IO OriginationScript -> ClientM OriginationScript
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
        (SingI t :- 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 :- 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 (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 ->
              Builder -> ClientM SomeAnnotatedValue
forall a. Builder -> ClientM a
clientFailure (Builder -> ClientM SomeAnnotatedValue)
-> Builder -> ClientM SomeAnnotatedValue
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
                [ Builder
"Failed to decode storage expression."
                , Builder
"Storage expression:"
                , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
forall p. Buildable p => p -> Builder
build (Expression -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToTextBuilder Expression
osStorage)
                , Builder
"Decoding error:"
                , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ FromExpressionError -> Builder
forall p. Buildable p => p -> Builder
build FromExpressionError
err
                ]

    cmiResolveAddress :: Alias kind -> ClientM (KindedAddress kind)
    cmiResolveAddress :: forall (kind :: AddressKind).
Alias kind -> ClientM (KindedAddress kind)
cmiResolveAddress =
      IO (KindedAddress kind) -> ClientM (KindedAddress kind)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (KindedAddress kind) -> ClientM (KindedAddress kind))
-> (Alias kind -> IO (KindedAddress kind))
-> Alias kind
-> ClientM (KindedAddress kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv
-> MorleyClientM (KindedAddress kind) -> IO (KindedAddress kind)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
neMorleyClientEnv (MorleyClientM (KindedAddress kind) -> IO (KindedAddress kind))
-> (Alias kind -> MorleyClientM (KindedAddress kind))
-> Alias kind
-> IO (KindedAddress kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressOrAlias kind -> MorleyClientM (KindedAddress kind)
forall (m :: * -> *) (kind :: AddressKind).
(MonadThrow m, HasTezosClient m) =>
AddressOrAlias kind -> m (KindedAddress kind)
Client.resolveAddress (AddressOrAlias kind -> MorleyClientM (KindedAddress kind))
-> (Alias kind -> AddressOrAlias kind)
-> Alias kind
-> MorleyClientM (KindedAddress kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias kind -> AddressOrAlias kind
forall (kind :: AddressKind). Alias kind -> AddressOrAlias kind
AddressAlias

    cmiGetPublicKey :: ImplicitAddress -> ClientM PublicKey
    cmiGetPublicKey :: ImplicitAddress -> ClientM PublicKey
cmiGetPublicKey = IO PublicKey -> ClientM PublicKey
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PublicKey -> ClientM PublicKey)
-> (ImplicitAddress -> IO PublicKey)
-> ImplicitAddress
-> 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)
-> (ImplicitAddress -> MorleyClientM PublicKey)
-> ImplicitAddress
-> 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)
-> (ImplicitAddressOrAlias -> MorleyClientM PublicKey)
-> ImplicitAddressOrAlias
-> MorleyClientM PublicKey
forall a b c. SuperComposition a b c => a -> b -> c
... ImplicitAddressOrAlias -> MorleyClientM PublicKey
forall env (m :: * -> *).
(WithClientLog env m, HasTezosClientEnv env, MonadIO m,
 MonadCatch m) =>
ImplicitAddressOrAlias -> m PublicKey
TezosClient.getPublicKey) (ImplicitAddressOrAlias -> MorleyClientM PublicKey)
-> (ImplicitAddress -> ImplicitAddressOrAlias)
-> ImplicitAddress
-> MorleyClientM PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
KindedAddress kind -> AddressOrAlias kind
AddressResolved

    getBalanceHelper :: L1AddressKind kind => KindedAddress kind -> ClientM Mutez
    getBalanceHelper :: forall (kind :: AddressKind).
L1AddressKind kind =>
KindedAddress kind -> ClientM Mutez
getBalanceHelper = IO Mutez -> ClientM Mutez
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 :: ContractAddress -> ClientM (Maybe KeyHash)
    cmiGetDelegate :: ContractAddress -> ClientM (Maybe KeyHash)
cmiGetDelegate =
      IO (Maybe KeyHash) -> ClientM (Maybe KeyHash)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe KeyHash) -> ClientM (Maybe KeyHash))
-> (ContractAddress -> IO (Maybe KeyHash))
-> ContractAddress
-> 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))
-> (ContractAddress -> MorleyClientM (Maybe KeyHash))
-> ContractAddress
-> IO (Maybe KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractAddress -> MorleyClientM (Maybe KeyHash)
forall (m :: * -> *).
HasTezosRpc m =>
ContractAddress -> 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 (1 :% 1)) -> ClientM (Time (1 :% 1))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Time (1 :% 1)) -> ClientM (Time (1 :% 1)))
-> IO (Time (1 :% 1)) -> ClientM (Time (1 :% 1))
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 (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 (1 :% 1)
RatioNat -> Time Second
sec (RatioNat -> IO (Time (1 :% 1))) -> RatioNat -> IO (Time (1 :% 1))
forall a b. (a -> b) -> a -> b
$ (StringEncode Natural -> Natural
forall a. StringEncode a -> a
unStringEncode (StringEncode Natural -> Natural)
-> StringEncode Natural -> Natural
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> StringEncode Natural
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
        -- Round 'delta' to the nearest second, not smaller than 'delta'.
        -- A chain's time resolution is never smaller than a second,
        -- so if 'delta' is 0.1s, we actually need to wait at least 1s.
        deltaSec :: Time Second
        deltaSec :: Time Second
deltaSec = Time (1 :% 1) -> Time (1 :% 1)
forall (unit :: Rat). Time unit -> Time unit
ceilingUnit (Time (1 :% 1) -> Time (1 :% 1)) -> Time (1 :% 1) -> Time (1 :% 1)
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
$ forall (unitTo :: Rat) n (unit :: Rat).
(KnownDivRat unit unitTo, Num n) =>
Time unit -> n
toNum @Second Time (1 :% 1)
Time Second
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 (1 :% 1)
Time Second
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 (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
      -- In case we need to skip more than one level we'll jump ahead for
      -- 'cmiGetApproximateBlockInterval' for 'skippedLevels - 1' times.
      -- This way we are sure we won't end up in the middle (or towards the end)
      -- of the target level.
      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 (1 :% 1))
ClientM (Time Second)
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
* forall (unitTo :: Rat) n (unit :: Rat).
(KnownDivRat unit unitTo, Num n) =>
Time unit -> n
toNum @Second 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 (1 :% 1)
RatioNat -> Time Second
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
        -- A chain's time resolution is never smaller than a second, so with (less
        -- than) a level to go we can wait for 1s in loop until we reach the target.
        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 (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 ImplicitAddress
sender) (RunCode Contract cp st vd
rcContract Value
rcParameter Value
rcStorage Mutez
rcAmount Maybe Natural
rcLevel Maybe Timestamp
rcNow Mutez
rcBalance Maybe ImplicitAddress
rcSource) =
      IO (AsRPC st) -> ClientM (AsRPC st)
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
        -- Pattern match on the contract constructor to reveal
        -- a proof of `NiceStorage st`
        L.Contract{} <- Contract cp st vd -> MorleyClientM (Contract cp st vd)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contract cp st vd
rcContract
        Value' Instr (ToT (AsRPC st)) -> AsRPC st
forall a. IsoValue a => Value (ToT a) -> a
T.fromVal (Value' Instr (ToT (AsRPC st)) -> AsRPC st)
-> MorleyClientM (Value' Instr (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 RunContractParameters :: forall (cp :: T) (st :: T).
Contract cp st
-> Value
-> Value
-> Mutez
-> Maybe Timestamp
-> Maybe Natural
-> Mutez
-> Maybe ImplicitAddress
-> Maybe ImplicitAddress
-> RunContractParameters cp st
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
sender
          }
          (StorageScope (ToT st) => MorleyClientM (AsRPC st))
-> (NiceStorage st :- StorageScope (ToT st))
-> MorleyClientM (AsRPC st)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall a. NiceStorage a :- StorageScope (ToT a)
L.niceStorageEvi @st

clientFailure :: Builder -> ClientM a
clientFailure :: forall a. Builder -> ClientM a
clientFailure = TestError -> ClientM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TestError -> ClientM a)
-> (Builder -> TestError) -> Builder -> ClientM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
CustomTestError (Text -> TestError) -> (Builder -> Text) -> Builder -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

comment :: Text -> ClientM ()
comment :: Text -> ClientM ()
comment Text
msg = IO () -> ClientM ()
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 (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 (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
. AddressOrAlias kind -> MorleyClientM (Alias kind)
forall (m :: * -> *) (kind :: AddressKind).
(HasTezosClient m, L1AddressKind kind) =>
AddressOrAlias kind -> m (Alias kind)
Client.getAlias (AddressOrAlias kind -> MorleyClientM (Alias kind))
-> (KindedAddress kind -> AddressOrAlias kind)
-> KindedAddress kind
-> MorleyClientM (Alias kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> AddressOrAlias kind
forall (kind :: AddressKind).
KindedAddress kind -> AddressOrAlias kind
AddressResolved

getLastBlockTimestamp :: MorleyClientEnv -> ClientM UTCTime
getLastBlockTimestamp :: MorleyClientEnv -> ClientM UTCTime
getLastBlockTimestamp MorleyClientEnv
env = IO UTCTime -> ClientM UTCTime
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 (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 (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
  -> ImplicitAddress
  -> [OperationInfo ClevelandInput]
  -> ClientM [OperationInfo ClevelandResult]
runOperationBatch :: MorleyClientEnv
-> ImplicitAddress
-> [OperationInfo ClevelandInput]
-> ClientM [OperationInfo ClevelandResult]
runOperationBatch MorleyClientEnv
env ImplicitAddress
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 ImplicitAddress
moneybag} <- IORef ClientState -> ClientM ClientState
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef ClientState
istRef
  -- Note that tezos key reveal operation cost an additional fee
  -- so that's why we reveal keys in origination and transaction
  -- rather than doing it before scenario execution
  IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> ImplicitAddress -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
env ImplicitAddress
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 OriginationInfo ClevelandInput
uod ->
      OriginationData -> OperationInfo ClientInput
forall i. OriginationInfo i -> OperationInfo i
OpOriginate (OriginationData -> OperationInfo ClientInput)
-> ClientM OriginationData -> ClientM (OperationInfo ClientInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UntypedOriginateData 'NotLarge -> ClientM OriginationData
forall (m :: * -> *).
MonadThrow m =>
UntypedOriginateData 'NotLarge -> m OriginationData
convertOriginateUntypedData OriginationInfo ClevelandInput
UntypedOriginateData 'NotLarge
uod
    OpTransfer TransferInfo ClevelandInput
td ->
      OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationInfo ClientInput -> ClientM (OperationInfo ClientInput))
-> (TransactionData -> OperationInfo ClientInput)
-> TransactionData
-> ClientM (OperationInfo ClientInput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionData -> OperationInfo ClientInput
forall i. TransferInfo i -> OperationInfo i
OpTransfer (TransactionData -> ClientM (OperationInfo ClientInput))
-> TransactionData -> ClientM (OperationInfo ClientInput)
forall a b. (a -> b) -> a -> b
$ TransferData -> TransactionData
convertTransferData TransferInfo ClevelandInput
TransferData
td
    OpReveal RevealInfo ClevelandInput
key ->
      OperationInfo ClientInput -> ClientM (OperationInfo ClientInput)
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 :: PublicKey -> Maybe Mutez -> RevealData
RevealRPC.RevealData
        { rdPublicKey :: PublicKey
rdPublicKey = PublicKey
RevealInfo ClevelandInput
key
        , rdMbFee :: Maybe Mutez
rdMbFee = 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
$ ImplicitAddressOrAlias
-> [OperationInfo ClientInput]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations (ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
KindedAddress kind -> AddressOrAlias kind
AddressResolved ImplicitAddress
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
sender
          Mutez
realBalance <- ImplicitAddress -> MorleyClientM Mutez
forall (kind :: AddressKind) (m :: * -> *).
(HasTezosRpc m, L1AddressKind kind) =>
KindedAddress kind -> m Mutez
Client.getBalance ImplicitAddress
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 IsLabel "balance" (Name "balance")
Name "balance"
#balance -> Mutez
balance, Name "required" -> ("required" :! Mutez) -> Mutez
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "required" (Name "required")
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
$ ImplicitAddress
sender ImplicitAddress -> Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" balance of " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
realBalance Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" \n\
                              \is too low, need " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
required Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", but got " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
balance Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
                    let reportedDifference :: Mutez
reportedDifference = HasCallStack => Mutez -> Mutez -> Mutez
Mutez -> Mutez -> Mutez
unsafeSubMutez Mutez
required Mutez
balance
                        -- required >= balance should always be true if we got 'BalanceTooLow'
                    if Word
iter Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
                    -- on first iteration, we dry-run the transaction as moneybag (if possible)
                    -- and esitmate the required balance that way;
                    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 (f :: * -> *) a. Applicative f => a -> f a
pure Mutez
reportedDifference
                    -- on subsequent iterations (which run only if the first
                    -- wasn't enough), we rely on the reported `required` and `balance`,
                    -- NOTE: BalanceTooLow can be thrown either before fees are subtracted, or after.
                    -- In the former case, (required - balance == transfer_amount - real_balance)
                    -- In the latter case, (required - balance == transfer_amount - real_balance - fees)
                    -- Notice that fees are only included if real_balance >= transfer_amount.
                    -- Consequently, if transfer_amount > real_balance AND
                    -- transfer_amount + fees > real_balance + minimalMutez, the amount we transfer here
                    -- will be insufficient. TL;DR, it doesn't work for large transfer_amounts.
                    -- For batched transfers, this gets a bit more complicated, but the same principle
                    -- applies; unless total fees can exceed minimalMutez, or total transfer_amount
                    -- is large, it should work without looping.
                    else Mutez -> MorleyClientM Mutez
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
$ ImplicitAddress
sender ImplicitAddress -> Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" balance of " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
realBalance Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n\
                              \ is too low to pay storage fee"
                    -- since no required balance is reported, there is no choice
                    Mutez -> MorleyClientM Mutez
approximateRequired Mutez
realBalance
                      -- if running as moneybag failed for some reason, just throw in some tez
                      -- and hope for the best
                      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 (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
$ Builder
"Will transfer " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
amount Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" from " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
moneybag ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
          MorleyClientM OperationHash -> MorleyClientM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MorleyClientM OperationHash -> MorleyClientM ())
-> MorleyClientM OperationHash -> MorleyClientM ()
forall a b. (a -> b) -> a -> b
$ ImplicitAddress
-> ImplicitAddress
-> Mutez
-> EpName
-> ()
-> Maybe Mutez
-> MorleyClientM OperationHash
forall (m :: * -> *) t env (kind :: AddressKind).
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
 NiceParameter t, L1AddressKind kind) =>
ImplicitAddress
-> KindedAddress kind
-> Mutez
-> EpName
-> t
-> Maybe Mutez
-> m OperationHash
Client.lTransfer ImplicitAddress
moneybag ImplicitAddress
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) -- loop
      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
        -- dry-run as moneybag and estimate cost+burn+fees
        ([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
<$> ImplicitAddressOrAlias
-> [OperationInfo ClientInput]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations (ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
KindedAddress kind -> AddressOrAlias kind
AddressResolved ImplicitAddress
moneybag) [OperationInfo ClientInput]
ops'
        ProtocolParameters{Int
StringEncode Natural
TezosMutez
ppCostPerByte :: TezosMutez
ppMinimalBlockDelay :: StringEncode Natural
ppOriginationSize :: Int
ppOriginationSize :: ProtocolParameters -> Int
ppMinimalBlockDelay :: ProtocolParameters -> StringEncode Natural
ppCostPerByte :: ProtocolParameters -> TezosMutez
..} <- MorleyClientM ProtocolParameters
forall (m :: * -> *). HasTezosRpc m => m ProtocolParameters
Client.getProtocolParameters
        -- uses quite a bit of unsafe mutez arithmetic, but arguably
        -- if we end up running into overflow while computing the
        -- required balance, then we couldn't run these operations
        -- anyway.
        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
foldr HasCallStack => Mutez -> Mutez -> Mutez
Element [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 (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Mutez] -> Mutez
unsafeSumMutez [Natural] -> 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 OriginationInfo ClevelandInput
uod -> (UntypedOriginateData 'NotLarge -> Mutez
forall (large :: LargeOrigination).
UntypedOriginateData large -> Mutez
uodBalance OriginationInfo ClevelandInput
UntypedOriginateData 'NotLarge
uod, Natural
originationSz)
              OpTransfer TransferInfo ClevelandInput
td -> (TransferData -> Mutez
tdAmount TransferInfo ClevelandInput
TransferData
td, Natural
0)
              OpReveal RevealInfo ClevelandInput
_ -> (Mutez
zeroMutez, Natural
0)
            storageDiff :: AppliedResult -> Natural
storageDiff AppliedResult{[ContractAddress]
TezosInt64
arStorageSize :: AppliedResult -> TezosInt64
arPaidStorageDiff :: AppliedResult -> TezosInt64
arOriginatedContracts :: AppliedResult -> [ContractAddress]
arConsumedMilliGas :: AppliedResult -> TezosInt64
arAllocatedDestinationContracts :: AppliedResult -> TezosInt64
arAllocatedDestinationContracts :: TezosInt64
arOriginatedContracts :: [ContractAddress]
arPaidStorageDiff :: TezosInt64
arStorageSize :: TezosInt64
arConsumedMilliGas :: 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
$ Builder
"estimated amount needed is " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
required Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", but got " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
balance Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n\
                  \Storage size: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Natural
storageBurnInBytes Natural -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"; Operations cost: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
opsSum Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n\
                  \Fees: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
totalFees Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"; Storage burn cost: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
storageBurnInMutez Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
        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
sender
  [OperationInfo Result]
results <- IO [OperationInfo Result] -> ClientM [OperationInfo Result]
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
$
        Builder
"Refill of " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
sender ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" took " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Word
tookIters Word -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" 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
<$> ImplicitAddressOrAlias
-> [OperationInfo ClientInput]
-> MorleyClientM (Maybe OperationHash, [OperationInfo Result])
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
ImplicitAddressOrAlias
-> [OperationInfo ClientInput]
-> m (Maybe OperationHash, [OperationInfo Result])
Client.runOperations (ImplicitAddress -> ImplicitAddressOrAlias
forall (kind :: AddressKind).
KindedAddress kind -> AddressOrAlias kind
AddressResolved ImplicitAddress
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
    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
$ Builder
"Originated smart contract '" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Alias 'AddressKindContract
alias Alias 'AddressKindContract -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
        Builder
"' with address " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ContractAddress
OriginationInfo Result
addr
    OpReveal () -> 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)
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
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
<$> (IntOpEvent -> ClientM ContractEvent)
-> [IntOpEvent] -> ClientM [ContractEvent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IntOpEvent -> ClientM ContractEvent
intOpEventToContractEvent [IntOpEvent]
TransferInfo Result
ops
  OpOriginate OriginationInfo Result
ops -> OperationInfo ClevelandResult
-> ClientM (OperationInfo ClevelandResult)
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 (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

intOpEventToContractEvent :: IntOpEvent -> ClientM ContractEvent
intOpEventToContractEvent :: IntOpEvent -> ClientM ContractEvent
intOpEventToContractEvent IntOpEvent{Maybe MText
Maybe Expression
ContractAddress
Expression
ioeType :: IntOpEvent -> Expression
ioeTag :: IntOpEvent -> Maybe MText
ioeSource :: IntOpEvent -> ContractAddress
ioePayload :: IntOpEvent -> Maybe Expression
ioePayload :: Maybe Expression
ioeTag :: Maybe MText
ioeType :: Expression
ioeSource :: ContractAddress
..} = 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 (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
ioeType
  Maybe SomeAnnotatedValue
cePayload <- case Maybe Expression
ioePayload of
    Maybe Expression
Nothing -> Maybe SomeAnnotatedValue -> ClientM (Maybe SomeAnnotatedValue)
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 (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 ->
        Builder -> ClientM (Maybe SomeAnnotatedValue)
forall a. Builder -> ClientM a
clientFailure (Builder -> ClientM (Maybe SomeAnnotatedValue))
-> Builder -> ClientM (Maybe SomeAnnotatedValue)
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
          [ Builder
"Failed to decode event payload expression."
          , Builder
"Payload expression:"
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
forall p. Buildable p => p -> Builder
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)
          , Builder
"Decoding error:"
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ FromExpressionError -> Builder
forall p. Buildable p => p -> Builder
build FromExpressionError
err
          ]
  pure $ ContractEvent :: ContractAddress
-> Text -> Maybe SomeAnnotatedValue -> ContractEvent
ContractEvent
    { ceSource :: ContractAddress
ceSource = ContractAddress
ioeSource
    , 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
ioeTag
    , Maybe SomeAnnotatedValue
cePayload :: Maybe SomeAnnotatedValue
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 :: ImplicitAddressOrAlias
                  -> [OperationInfo Client.ClientInput]
                  -> Client.MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations :: ImplicitAddressOrAlias
-> [OperationInfo ClientInput]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations ImplicitAddressOrAlias
s = \case
  [] -> [(AppliedResult, Mutez)] -> MorleyClientM [(AppliedResult, Mutez)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  (OperationInfo ClientInput
x:[OperationInfo ClientInput]
xs) -> NonEmpty (AppliedResult, Mutez) -> [(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 (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
<$> ImplicitAddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> MorleyClientM (NonEmpty (AppliedResult, TezosMutez))
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
ImplicitAddressOrAlias
-> NonEmpty (OperationInfo ClientInput)
-> m (NonEmpty (AppliedResult, TezosMutez))
Client.dryRunOperationsNonEmpty ImplicitAddressOrAlias
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)
-- we really shouldn't get several errors of the same type here, so find only the first one
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
-- we really shouldn't get several errors of the same type here, so find only the first one
findCantPayStorageFee :: [RunError] -> Bool
findCantPayStorageFee
  (RunError
Client.CantPayStorageFee:[RunError]
_)
  = Bool
True
findCantPayStorageFee (RunError
_:[RunError]
xs) = [RunError] -> Bool
findCantPayStorageFee [RunError]
xs
findCantPayStorageFee [] = Bool
False

exceptionToTransferFailure :: RPC.ClientRpcError -> ClientM TransferFailure
exceptionToTransferFailure :: ClientRpcError -> ClientM TransferFailure
exceptionToTransferFailure = \case
  RPC.ContractFailed ContractAddress
addr Expression
expr -> TransferFailure -> ClientM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> ClientM TransferFailure)
-> TransferFailure -> ClientM TransferFailure
forall a b. (a -> b) -> a -> b
$ AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure (Address -> Maybe (Alias 'AddressKindContract) -> AddressAndAlias
AddressAndAlias (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr) Maybe (Alias 'AddressKindContract)
forall a. Maybe a
Nothing) (TransferFailureReason -> TransferFailure)
-> TransferFailureReason -> 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 Address
addr Expression
_ -> TransferFailure -> ClientM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> ClientM TransferFailure)
-> TransferFailure -> ClientM TransferFailure
forall a b. (a -> b) -> a -> b
$ AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure (Address -> Maybe (Alias 'AddressKindContract) -> AddressAndAlias
AddressAndAlias Address
addr Maybe (Alias 'AddressKindContract)
forall a. Maybe a
Nothing) TransferFailureReason
BadParameter
  RPC.EmptyTransaction ImplicitAddress
addr -> TransferFailure -> ClientM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> ClientM TransferFailure)
-> TransferFailure -> ClientM TransferFailure
forall a b. (a -> b) -> a -> b
$ AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure (Address -> Maybe (Alias 'AddressKindContract) -> AddressAndAlias
AddressAndAlias (ImplicitAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ImplicitAddress
addr) Maybe (Alias 'AddressKindContract)
forall a. Maybe a
Nothing) TransferFailureReason
EmptyTransaction
  RPC.ShiftOverflow ContractAddress
addr -> TransferFailure -> ClientM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> ClientM TransferFailure)
-> TransferFailure -> ClientM TransferFailure
forall a b. (a -> b) -> a -> b
$ AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure (Address -> Maybe (Alias 'AddressKindContract) -> AddressAndAlias
AddressAndAlias (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr) Maybe (Alias 'AddressKindContract)
forall a. Maybe a
Nothing) TransferFailureReason
ShiftOverflow
  RPC.GasExhaustion ContractAddress
addr -> TransferFailure -> ClientM TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return (TransferFailure -> ClientM TransferFailure)
-> TransferFailure -> ClientM TransferFailure
forall a b. (a -> b) -> a -> b
$ AddressAndAlias -> TransferFailureReason -> TransferFailure
TransferFailure (Address -> Maybe (Alias 'AddressKindContract) -> AddressAndAlias
AddressAndAlias (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
addr) Maybe (Alias 'AddressKindContract)
forall a. Maybe a
Nothing) TransferFailureReason
GasExhaustion
  ClientRpcError
internalError -> ClientRpcError -> ClientM TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientRpcError
internalError

exceptionHandler :: ClientM a -> ClientM a
exceptionHandler :: forall a. ClientM a -> ClientM a
exceptionHandler ClientM a
action = ClientM a -> ClientM (Either ClientRpcError a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try ClientM a
action ClientM (Either ClientRpcError a)
-> (Either ClientRpcError a -> ClientM a) -> ClientM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ClientRpcError
err -> ClientRpcError -> ClientM TransferFailure
exceptionToTransferFailure ClientRpcError
err ClientM TransferFailure
-> (TransferFailure -> ClientM a) -> ClientM a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TransferFailure -> ClientM a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
  Right a
res -> a -> ClientM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

resolveSpecificOrDefaultAlias :: SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias :: SpecificOrDefaultAlias -> ClientM ImplicitAlias
resolveSpecificOrDefaultAlias (SpecificAlias ImplicitAlias
alias) = ImplicitAlias -> ClientM ImplicitAlias
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
csMoneybagAddress :: Moneybag
csRefillableAddresses :: Set ImplicitAddress
csDefaultAliasCounter :: DefaultAliasCounter
csMoneybagAddress :: ClientState -> Moneybag
csRefillableAddresses :: ClientState -> Set ImplicitAddress
csDefaultAliasCounter :: ClientState -> DefaultAliasCounter
..} ->
    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

----------------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------------

convertOriginateUntypedData
  :: (MonadThrow m)
  => UntypedOriginateData 'NotLarge -> m Client.OriginationData
convertOriginateUntypedData :: forall (m :: * -> *).
MonadThrow m =>
UntypedOriginateData 'NotLarge -> m OriginationData
convertOriginateUntypedData UntypedOriginateData{Mutez
Contract
Value
Alias 'AddressKindContract
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: Alias 'AddressKindContract
uodContract :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Contract
uodStorage :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Value
uodBalance :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Mutez
uodName :: forall (large :: LargeOrigination).
UntypedOriginateData large -> Alias 'AddressKindContract
..} = do
  SomeContractAndStorage Contract cp st
contract Value st
storage <-
    m (Either TCError SomeContractAndStorage)
-> m SomeContractAndStorage
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft (m (Either TCError SomeContractAndStorage)
 -> m SomeContractAndStorage)
-> (Either TCError SomeContractAndStorage
    -> m (Either TCError SomeContractAndStorage))
-> Either TCError SomeContractAndStorage
-> m SomeContractAndStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TCError SomeContractAndStorage
-> m (Either TCError SomeContractAndStorage)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TCError SomeContractAndStorage -> m SomeContractAndStorage)
-> Either TCError SomeContractAndStorage
-> m SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ TypeCheckOptions
-> TypeCheckResult SomeContractAndStorage
-> Either TCError SomeContractAndStorage
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult SomeContractAndStorage
 -> Either TCError SomeContractAndStorage)
-> TypeCheckResult SomeContractAndStorage
-> Either TCError SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$
      Contract -> Value -> TypeCheckResult SomeContractAndStorage
typeCheckContractAndStorage Contract
uodContract Value
uodStorage
  OriginationData -> m OriginationData
forall (m :: * -> *) a. Monad m => a -> m a
return OriginationData :: forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Bool
-> Alias 'AddressKindContract
-> Mutez
-> Contract cp st
-> Value st
-> Maybe Mutez
-> OriginationData
Client.OriginationData
    { odReplaceExisting :: Bool
odReplaceExisting = Bool
True
    , odName :: Alias 'AddressKindContract
odName = Alias 'AddressKindContract
uodName
    , odBalance :: Mutez
odBalance = Mutez
uodBalance
    , odContract :: Contract cp st
odContract = Contract cp st
contract
    , odStorage :: Value st
odStorage = Value st
storage
    , odMbFee :: Maybe Mutez
odMbFee = Maybe Mutez
forall a. Maybe a
Nothing
    }

convertTransferData
  :: TransferData -> Client.TransactionData
convertTransferData :: TransferData -> TransactionData
convertTransferData TransferData{ tdParameter :: ()
tdParameter = v
param :: p, addr
Mutez
EpName
tdEntrypoint :: TransferData -> EpName
tdTo :: ()
tdEntrypoint :: EpName
tdAmount :: Mutez
tdTo :: addr
tdAmount :: TransferData -> Mutez
..} =
  TD (Value (ToT v)) -> TransactionData
forall (t :: T).
ParameterScope t =>
TD (Value t) -> TransactionData
Client.TransactionData TD :: forall t. L1Address -> Mutez -> EpName -> t -> Maybe Mutez -> TD t
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
param
    , tdMbFee :: Maybe Mutez
tdMbFee = Maybe Mutez
forall a. Maybe a
Nothing
    } (ParameterScope (ToT v) => TransactionData)
-> (NiceParameter v :- ParameterScope (ToT v)) -> TransactionData
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @p

-- | Runs 'Client.revealKeyUnlessRevealed' with given client environment.
revealKeyUnlessRevealed :: MorleyClientEnv -> ImplicitAddress -> IO ()
revealKeyUnlessRevealed :: MorleyClientEnv -> ImplicitAddress -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
env ImplicitAddress
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
$
  -- We don't use password protected accounts in cleveland.
  ImplicitAddress -> Maybe ScrubbedBytes -> MorleyClientM ()
forall env (m :: * -> *).
(WithClientLog env m, HasTezosRpc m, HasTezosClient m) =>
ImplicitAddress -> Maybe ScrubbedBytes -> m ()
Client.revealKeyUnlessRevealed ImplicitAddress
addr Maybe ScrubbedBytes
forall a. Maybe a
Nothing

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

-- | Signals an assertion failure during the execution of an action.
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
showList :: [TestError] -> ShowS
$cshowList :: [TestError] -> ShowS
show :: TestError -> String
$cshow :: TestError -> String
showsPrec :: Int -> TestError -> ShowS
$cshowsPrec :: Int -> TestError -> ShowS
Show

instance Exception TestError where
  displayException :: TestError -> String
displayException = TestError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

instance Buildable TestError where
  build :: TestError -> Builder
build (CustomTestError Text
msg) = Text -> Builder
forall p. Buildable p => p -> Builder
build Text
msg