module Test.Cleveland.Internal.Client
( ClientM (..)
, runClevelandT
, networkOpsImpl
, networkMiscImpl
, revealKeyUnlessRevealed
, setupMoneybagAddress
, ClientState(..)
, TestError(..)
, MoneybagConfigurationException (..)
, NetworkEnv (..)
, neMorleyClientEnvL
, neSecretKeyL
, neMoneybagAliasL
, InternalNetworkScenarioError(..)
) where
import Control.Lens
import qualified Data.Aeson.Text as J
import Data.Constraint (withDict, (\\))
import Data.Default (def)
import Data.Ratio ((%))
import qualified Data.Set 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 qualified Unsafe (fromIntegral)
import Lorentz (NicePackedValue, toAddress)
import Lorentz.Constraints.Scopes (NiceUnpackedValue, niceParameterEvi)
import Morley.Client
(AddressOrAlias(..), Alias, MorleyClientEnv, disableAlphanetWarning, runMorleyClientM)
import qualified Morley.Client as Client
import Morley.Client.Logging (logInfo, logWarning)
import Morley.Client.RPC.AsRPC (AsRPC, notesAsRPC, rpcSingIEvi)
import qualified Morley.Client.RPC.Error as RPC (ClientRpcError(..), RunCodeErrors(..))
import Morley.Client.RPC.Types
(AppliedResult(..), BlockConstants(bcHeader), BlockHeaderNoHash(bhnhLevel, bhnhTimestamp),
BlockId(..), OperationHash, OriginationScript(..),
ProtocolParameters(ProtocolParameters, ppCostPerByte, ppMinimalBlockDelay, ppOriginationSize))
import Morley.Micheline
(Expression, FromExpression(fromExpression), MichelinePrimitive(..), StringEncode(..), TezosInt64,
TezosMutez(unTezosMutez), _ExpressionPrim, _ExpressionSeq, mpaArgsL, mpaPrimL)
import Morley.Michelson.TypeCheck (typeCheckContractAndStorage, typeCheckingWith)
import Morley.Michelson.Typed (BigMapId, SomeAnnotatedValue(..), SomeContractAndStorage(..), toVal)
import qualified Morley.Michelson.Typed as T
import qualified Morley.Michelson.Untyped as U
import Morley.Tezos.Address (Address, mkKeyAddress)
import Morley.Tezos.Core as Tezos
(Mutez, Timestamp(..), addMutez, subMutez, timestampFromUTCTime, unsafeAddMutez, unsafeMkMutez,
unsafeMulMutez, unsafeSubMutez)
import Morley.Tezos.Crypto
import qualified Morley.Tezos.Crypto as Crypto
import Morley.Util.Exception
import Morley.Util.Lens (postfixLFields)
import Morley.Util.Named
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Exceptions (addCallStack)
import Test.Cleveland.Util (ceilingUnit)
data NetworkEnv = NetworkEnv
{ NetworkEnv -> MorleyClientEnv
neMorleyClientEnv :: MorleyClientEnv
, NetworkEnv -> Maybe SecretKey
neSecretKey :: Maybe Crypto.SecretKey
, NetworkEnv -> Alias
neMoneybagAlias :: Alias
}
makeLensesWith postfixLFields ''NetworkEnv
data MoneybagConfigurationException
= NoMoneybagAddress Alias
| TwoMoneybagKeys Alias SecretKey Address
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 Alias
alias -> [Builder] -> Builder
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
<> Alias -> Builder
forall p. Buildable p => p -> Builder
build Alias
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 Alias
alias SecretKey
envKey Address
existingAddress -> [Builder] -> Builder
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
+| Alias
alias Alias -> 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
<> Address -> Builder
forall p. Buildable p => p -> Builder
build Address
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 Address
csRefillableAddresses :: Set Address
, ClientState -> Moneybag
csMoneybagAddress :: Moneybag
}
newtype ClientM a = ClientM
{ ClientM a -> ReaderT (IORef ClientState) IO a
unClientM :: ReaderT (IORef ClientState) IO a
}
deriving newtype (a -> ClientM b -> ClientM a
(a -> b) -> ClientM a -> ClientM b
(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
<$ :: a -> ClientM b -> ClientM a
$c<$ :: forall a b. a -> ClientM b -> ClientM a
fmap :: (a -> b) -> ClientM a -> ClientM b
$cfmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
Functor, Functor ClientM
a -> ClientM a
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
ClientM a -> ClientM b -> ClientM b
ClientM a -> ClientM b -> ClientM a
ClientM (a -> b) -> ClientM a -> ClientM b
(a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
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
<* :: ClientM a -> ClientM b -> ClientM a
$c<* :: forall a b. ClientM a -> ClientM b -> ClientM a
*> :: ClientM a -> ClientM b -> ClientM b
$c*> :: forall a b. ClientM a -> ClientM b -> ClientM b
liftA2 :: (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
$cliftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
<*> :: ClientM (a -> b) -> ClientM a -> ClientM b
$c<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
pure :: a -> ClientM a
$cpure :: forall a. a -> ClientM a
$cp1Applicative :: Functor ClientM
Applicative, Applicative ClientM
a -> ClientM a
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
ClientM a -> (a -> ClientM b) -> ClientM b
ClientM a -> ClientM b -> ClientM b
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 :: a -> ClientM a
$creturn :: forall a. a -> ClientM a
>> :: ClientM a -> ClientM b -> ClientM b
$c>> :: forall a b. ClientM a -> ClientM b -> ClientM b
>>= :: ClientM a -> (a -> ClientM b) -> ClientM b
$c>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
$cp1Monad :: Applicative ClientM
Monad, Monad ClientM
Monad ClientM -> (forall a. IO a -> ClientM a) -> MonadIO ClientM
IO a -> ClientM a
forall a. IO a -> ClientM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ClientM a
$cliftIO :: forall a. IO a -> ClientM a
$cp1MonadIO :: Monad ClientM
MonadIO,
Monad ClientM
e -> ClientM a
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 :: e -> ClientM a
$cthrowM :: forall e a. Exception e => e -> ClientM a
$cp1MonadThrow :: Monad ClientM
MonadThrow, MonadThrow ClientM
MonadThrow ClientM
-> (forall e a.
Exception e =>
ClientM a -> (e -> ClientM a) -> ClientM a)
-> MonadCatch ClientM
ClientM a -> (e -> ClientM a) -> ClientM a
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 :: ClientM a -> (e -> ClientM a) -> ClientM a
$ccatch :: forall e a.
Exception e =>
ClientM a -> (e -> ClientM a) -> ClientM a
$cp1MonadCatch :: MonadThrow ClientM
MonadCatch, MonadReader (IORef ClientState))
data InternalNetworkScenarioError = TooManyRefillIterations Word Address
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 Address
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
+| Address
addr Address -> 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
runClevelandT :: NetworkEnv -> ClevelandT ClientM a -> IO a
runClevelandT :: NetworkEnv -> ClevelandT ClientM a -> IO a
runClevelandT NetworkEnv
env ClevelandT ClientM a
scenario = do
IO ()
disableAlphanetWarning
Moneybag
moneybagAddr <- NetworkEnv -> IO Moneybag
setupMoneybagAddress NetworkEnv
env
let caps :: ClevelandCaps ClientM
caps = ClevelandCaps :: forall (m :: * -> *).
Sender
-> Moneybag
-> ClevelandMiscImpl m
-> (Sender -> ClevelandOpsImpl m)
-> ClevelandCaps m
ClevelandCaps
{ ccSender :: Sender
ccSender = Address -> Sender
Sender (Address -> Sender) -> Address -> Sender
forall a b. (a -> b) -> a -> b
$ Moneybag -> Address
unMoneybag Moneybag
moneybagAddr
, ccMoneybag :: Moneybag
ccMoneybag = Moneybag
moneybagAddr
, ccMiscCap :: ClevelandMiscImpl ClientM
ccMiscCap = MorleyClientEnv -> ClevelandMiscImpl ClientM
networkMiscImpl (NetworkEnv -> MorleyClientEnv
neMorleyClientEnv 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 Address -> Moneybag -> ClientState
ClientState
{ csDefaultAliasCounter :: DefaultAliasCounter
csDefaultAliasCounter = Natural -> DefaultAliasCounter
DefaultAliasCounter Natural
0
, csRefillableAddresses :: Set Address
csRefillableAddresses = Set Address
forall a. Set a
Set.empty
, csMoneybagAddress :: Moneybag
csMoneybagAddress = Moneybag
moneybagAddr
}
let clientM :: ClientM a
clientM = ClevelandT ClientM a -> ClevelandCaps ClientM -> ClientM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ClevelandT ClientM a
scenario ClevelandCaps ClientM
caps
ReaderT (IORef ClientState) IO a -> IORef ClientState -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ClientM a -> ReaderT (IORef ClientState) IO a
forall a. ClientM a -> ReaderT (IORef ClientState) IO a
unClientM ClientM a
clientM) IORef ClientState
ist
setupMoneybagAddress :: NetworkEnv -> IO Moneybag
setupMoneybagAddress :: NetworkEnv -> IO Moneybag
setupMoneybagAddress (NetworkEnv MorleyClientEnv
env Maybe SecretKey
envKey Alias
envAlias) = do
Maybe Address
storageAddress <- MorleyClientEnv
-> MorleyClientM (Maybe Address) -> IO (Maybe Address)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM (Maybe Address) -> IO (Maybe Address))
-> MorleyClientM (Maybe Address) -> IO (Maybe Address)
forall a b. (a -> b) -> a -> b
$
AddressOrAlias -> MorleyClientM (Maybe Address)
forall (m :: * -> *).
HasTezosClient m =>
AddressOrAlias -> m (Maybe Address)
Client.resolveAddressMaybe (Alias -> AddressOrAlias
AddressAlias Alias
envAlias)
Address -> Moneybag
Moneybag (Address -> Moneybag) -> IO Address -> IO Moneybag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Maybe SecretKey
envKey, Maybe Address
storageAddress) of
(Maybe SecretKey
Nothing, Just Address
addr) -> Address -> IO Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure Address
addr
(Maybe SecretKey
Nothing, Maybe Address
Nothing) -> MoneybagConfigurationException -> IO Address
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MoneybagConfigurationException -> IO Address)
-> MoneybagConfigurationException -> IO Address
forall a b. (a -> b) -> a -> b
$ Alias -> MoneybagConfigurationException
NoMoneybagAddress Alias
envAlias
(Just SecretKey
ek, Just Address
sa)
| PublicKey -> Address
mkKeyAddress (SecretKey -> PublicKey
toPublic SecretKey
ek) Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
sa -> Address -> IO Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure Address
sa
| Bool
otherwise -> MoneybagConfigurationException -> IO Address
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MoneybagConfigurationException -> IO Address)
-> MoneybagConfigurationException -> IO Address
forall a b. (a -> b) -> a -> b
$ Alias -> SecretKey -> Address -> MoneybagConfigurationException
TwoMoneybagKeys Alias
envAlias SecretKey
ek Address
sa
(Just SecretKey
ek, Maybe Address
Nothing) -> do
MorleyClientEnv -> MorleyClientM () -> IO ()
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (Bool -> AliasOrAliasHint -> SecretKey -> MorleyClientM ()
forall (m :: * -> *).
HasTezosClient m =>
Bool -> AliasOrAliasHint -> SecretKey -> m ()
Client.importKey Bool
False (Alias -> AliasOrAliasHint
Client.AnAlias Alias
envAlias) SecretKey
ek)
return $ PublicKey -> Address
mkKeyAddress (SecretKey -> PublicKey
toPublic SecretKey
ek)
networkOpsImpl :: MorleyClientEnv -> Sender -> ClevelandOpsImpl ClientM
networkOpsImpl :: MorleyClientEnv -> Sender -> ClevelandOpsImpl ClientM
networkOpsImpl MorleyClientEnv
env (Sender Address
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 => [BaseOperationData] -> m [BaseOperationResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
{ coiRunOperationBatch :: HasCallStack =>
[BaseOperationData] -> ClientM [BaseOperationResult]
coiRunOperationBatch = MorleyClientEnv
-> Address -> [BaseOperationData] -> ClientM [BaseOperationResult]
runOperationBatch MorleyClientEnv
env Address
sender
}
networkMiscImpl :: MorleyClientEnv -> ClevelandMiscImpl ClientM
networkMiscImpl :: MorleyClientEnv -> ClevelandMiscImpl ClientM
networkMiscImpl MorleyClientEnv
env = (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)
-> (HasCallStack => Alias -> m Address)
-> (HasCallStack => SpecificOrDefaultAliasHint -> m Address)
-> (HasCallStack => SpecificOrDefaultAliasHint -> m Address)
-> (HasCallStack => ByteString -> Address -> m Signature)
-> (HasCallStack => Sender -> UntypedOriginateData -> m Address)
-> (HasCallStack => Text -> m ())
-> (HasCallStack => Address -> m Mutez)
-> (HasCallStack => Address -> 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, NicePackedValue k,
NiceUnpackedValue v) =>
BigMapId k v -> m (Maybe [v]))
-> (HasCallStack => Address -> m PublicKey)
-> (HasCallStack => Address -> m (Maybe KeyHash))
-> (HasCallStack => Address -> 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))
-> (Address -> m ())
-> 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 -> ClientM Address
cmiOriginateLargeUntyped = \Sender
sender UntypedOriginateData
untypedOriginateData -> do
(OperationHash
_, Address
res) <- MorleyClientEnv
-> Sender
-> (Bool
-> AliasHint
-> AddressOrAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> MorleyClientM (OperationHash, Address))
-> UntypedOriginateData
-> ClientM (OperationHash, Address)
runClientOrigination MorleyClientEnv
env
Sender
sender Bool
-> AliasHint
-> AddressOrAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> MorleyClientM (OperationHash, Address)
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
Bool
-> AliasHint
-> AddressOrAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> m (OperationHash, Address)
Client.originateLargeUntypedContract UntypedOriginateData
untypedOriginateData
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
+| UntypedOriginateData -> AliasHint
uodName UntypedOriginateData
untypedOriginateData AliasHint -> 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
<> Address -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Address
res
pure Address
res
, cmiSignBytes :: HasCallStack => ByteString -> Address -> ClientM Signature
cmiSignBytes = \ByteString
hash Address
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
env (MorleyClientM Signature -> IO Signature)
-> MorleyClientM Signature -> IO Signature
forall a b. (a -> b) -> a -> b
$
AddressOrAlias
-> Maybe ScrubbedBytes -> ByteString -> MorleyClientM Signature
forall (m :: * -> *).
HasTezosClient m =>
AddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature
Client.signBytes (Address -> AddressOrAlias
AddressResolved Address
signer) Maybe ScrubbedBytes
forall a. Maybe a
Nothing ByteString
hash
, cmiGenKey :: HasCallStack => SpecificOrDefaultAliasHint -> ClientM Address
cmiGenKey = \SpecificOrDefaultAliasHint
alias -> do
AliasHint
aliasHint <- SpecificOrDefaultAliasHint -> ClientM AliasHint
resolveSpecificOrDefaultAliasHint SpecificOrDefaultAliasHint
alias
IO Address -> ClientM Address
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Address -> ClientM Address) -> IO Address -> ClientM Address
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> MorleyClientM Address -> IO Address
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM Address -> IO Address)
-> (AliasOrAliasHint -> MorleyClientM Address)
-> AliasOrAliasHint
-> IO Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AliasOrAliasHint -> MorleyClientM Address
forall (m :: * -> *).
HasTezosClient m =>
AliasOrAliasHint -> m Address
Client.genKey (AliasOrAliasHint -> IO Address) -> AliasOrAliasHint -> IO Address
forall a b. (a -> b) -> a -> b
$ AliasHint -> AliasOrAliasHint
Client.AnAliasHint AliasHint
aliasHint
, cmiGenFreshKey :: HasCallStack => SpecificOrDefaultAliasHint -> ClientM Address
cmiGenFreshKey = \SpecificOrDefaultAliasHint
alias -> do
AliasHint
aliasHint <- SpecificOrDefaultAliasHint -> ClientM AliasHint
resolveSpecificOrDefaultAliasHint SpecificOrDefaultAliasHint
alias
IO Address -> ClientM Address
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Address -> ClientM Address) -> IO Address -> ClientM Address
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> MorleyClientM Address -> IO Address
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM Address -> IO Address)
-> (AliasOrAliasHint -> MorleyClientM Address)
-> AliasOrAliasHint
-> IO Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AliasOrAliasHint -> MorleyClientM Address
forall (m :: * -> *).
HasTezosClient m =>
AliasOrAliasHint -> m Address
Client.genFreshKey (AliasOrAliasHint -> IO Address) -> AliasOrAliasHint -> IO Address
forall a b. (a -> b) -> a -> b
$ AliasHint -> AliasOrAliasHint
Client.AnAliasHint AliasHint
aliasHint
, cmiGetBalance :: HasCallStack => Address -> ClientM Mutez
cmiGetBalance = HasCallStack => Address -> ClientM Mutez
Address -> ClientM Mutez
getBalanceHelper
, 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
env 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 :: Address -> ClientM ()
cmiMarkAddressRefillable = Address -> ClientM ()
setAddressRefillable
, cmiRegisterDelegate :: HasCallStack => Address -> ClientM ()
cmiRegisterDelegate = \Address
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
env (MorleyClientM () -> IO ()) -> MorleyClientM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Alias
alias <- AddressOrAlias -> MorleyClientM Alias
forall (m :: * -> *). HasTezosClient m => AddressOrAlias -> m Alias
Client.getAlias (Address -> AddressOrAlias
Client.AddressResolved Address
addr)
AliasOrAliasHint -> Maybe ScrubbedBytes -> MorleyClientM ()
forall (m :: * -> *).
HasTezosClient m =>
AliasOrAliasHint -> Maybe ScrubbedBytes -> m ()
Client.registerDelegate (Alias -> AliasOrAliasHint
Client.AnAlias Alias
alias) Maybe ScrubbedBytes
forall a. Maybe a
Nothing
, cmiComment :: HasCallStack => Text -> ClientM ()
cmiComment = HasCallStack => Text -> ClientM ()
Text -> ClientM ()
comment
, ClientM Natural
ClientM (Time Second)
ClientM Timestamp
HasCallStack => ClientM Natural
HasCallStack => ClientM (Time Second)
HasCallStack => ClientM Timestamp
HasCallStack => Address -> ClientM (Maybe KeyHash)
HasCallStack => Address -> ClientM PublicKey
HasCallStack => Address -> ClientM SomeAnnotatedValue
HasCallStack => Alias -> ClientM Address
HasCallStack => (Natural -> Natural) -> ClientM ()
Address -> ClientM (Maybe KeyHash)
Address -> ClientM PublicKey
Address -> ClientM SomeAnnotatedValue
Alias -> ClientM Address
(Natural -> Natural) -> ClientM ()
forall a. HasCallStack => Builder -> ClientM a
forall a. Builder -> ClientM a
forall k v.
(HasCallStack, NiceComparable k, NicePackedValue 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 (unit :: Rat).
(HasCallStack, KnownDivRat unit Second) =>
Time unit -> ClientM ()
forall (unit :: Rat).
KnownDivRat unit Second =>
Time unit -> ClientM ()
cmiGetApproximateBlockInterval :: HasCallStack => ClientM (Time Second)
cmiFailure :: forall a. HasCallStack => Builder -> ClientM a
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 => Address -> ClientM (Maybe KeyHash)
cmiGetPublicKey :: HasCallStack => Address -> ClientM PublicKey
cmiGetAllBigMapValuesMaybe :: forall k v.
(HasCallStack, NiceComparable k, NicePackedValue 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 => Address -> ClientM SomeAnnotatedValue
cmiResolveAddress :: HasCallStack => Alias -> ClientM Address
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 :: Address -> ClientM (Maybe KeyHash)
cmiGetPublicKey :: Address -> ClientM PublicKey
cmiResolveAddress :: Alias -> ClientM Address
cmiGetSomeStorage :: Address -> 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)
cmiFailure :: forall a. Builder -> ClientM a
..
}
where
cmiFailure :: Builder -> ClientM a
cmiFailure :: Builder -> ClientM a
cmiFailure = 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
cmiGetBigMapValueMaybe :: (NicePackedValue k, NiceUnpackedValue v) => BigMapId k v -> k -> ClientM (Maybe v)
cmiGetBigMapValueMaybe :: 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
env (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 :: 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
env (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 -> Const (First Expression) MichelinePrimAp)
-> Expression -> Const (First Expression) Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim
((MichelinePrimAp -> Const (First Expression) MichelinePrimAp)
-> Expression -> Const (First Expression) Expression)
-> ((Expression -> Const (First Expression) Expression)
-> MichelinePrimAp -> Const (First Expression) MichelinePrimAp)
-> Getting (First Expression) Expression Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp -> Bool)
-> Optic'
(->) (Const (First Expression)) MichelinePrimAp MichelinePrimAp
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\MichelinePrimAp
prim -> MichelinePrimAp
prim MichelinePrimAp
-> Getting MichelinePrimitive MichelinePrimAp MichelinePrimitive
-> MichelinePrimitive
forall s a. s -> Getting a s a -> a
^. Getting MichelinePrimitive MichelinePrimAp MichelinePrimitive
Lens' MichelinePrimAp MichelinePrimitive
mpaPrimL MichelinePrimitive -> MichelinePrimitive -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> MichelinePrimitive
MichelinePrimitive Text
"storage")
Optic'
(->) (Const (First Expression)) MichelinePrimAp MichelinePrimAp
-> ((Expression -> Const (First Expression) Expression)
-> MichelinePrimAp -> Const (First Expression) MichelinePrimAp)
-> (Expression -> Const (First Expression) Expression)
-> MichelinePrimAp
-> Const (First Expression) MichelinePrimAp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Expression] -> Const (First Expression) [Expression])
-> MichelinePrimAp -> Const (First Expression) MichelinePrimAp
Lens' MichelinePrimAp [Expression]
mpaArgsL
(([Expression] -> Const (First Expression) [Expression])
-> MichelinePrimAp -> Const (First Expression) MichelinePrimAp)
-> ((Expression -> Const (First Expression) Expression)
-> [Expression] -> Const (First Expression) [Expression])
-> (Expression -> Const (First Expression) Expression)
-> MichelinePrimAp
-> Const (First Expression) MichelinePrimAp
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
cmiFailure (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 Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @U.Ty Expression
storageTypeExpr of
Left FromExpressionError
err -> Builder -> ClientM Ty
forall a. Builder -> ClientM a
cmiFailure (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 :: Address -> ClientM SomeAnnotatedValue
cmiGetSomeStorage :: Address -> ClientM SomeAnnotatedValue
cmiGetSomeStorage Address
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
env (MorleyClientM OriginationScript -> ClientM OriginationScript)
-> MorleyClientM OriginationScript -> ClientM OriginationScript
forall a b. (a -> b) -> a -> b
$ Address -> MorleyClientM OriginationScript
forall (m :: * -> *).
HasTezosRpc m =>
Address -> m OriginationScript
Client.getContractScript Address
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 (AsRPC t))
-> (SingI (AsRPC t) => ClientM SomeAnnotatedValue)
-> ClientM SomeAnnotatedValue
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (SingI t :- SingI (AsRPC t)
forall (t :: T). SingI t :- SingI (AsRPC t)
rpcSingIEvi @t) do
case Expression -> Either FromExpressionError (Value (AsRPC t))
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @(T.Value (AsRPC t)) Expression
osStorage of
Right Value (AsRPC 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 (AsRPC t) -> Value (AsRPC t) -> SomeAnnotatedValue
forall (t :: T).
SingI t =>
Notes t -> Value t -> SomeAnnotatedValue
SomeAnnotatedValue (Notes t -> Notes (AsRPC t)
forall (t :: T). Notes t -> Notes (AsRPC t)
notesAsRPC Notes t
storageNotes) Value (AsRPC t)
storageValueRPC
Left FromExpressionError
err ->
Builder -> ClientM SomeAnnotatedValue
forall a. Builder -> ClientM a
cmiFailure (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 -> ClientM Address
cmiResolveAddress :: Alias -> ClientM Address
cmiResolveAddress = IO Address -> ClientM Address
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Address -> ClientM Address)
-> (Alias -> IO Address) -> Alias -> ClientM Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> MorleyClientM Address -> IO Address
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM Address -> IO Address)
-> (Alias -> MorleyClientM Address) -> Alias -> IO Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressOrAlias -> MorleyClientM Address
forall (m :: * -> *).
(MonadThrow m, HasTezosClient m) =>
AddressOrAlias -> m Address
Client.resolveAddress (AddressOrAlias -> MorleyClientM Address)
-> (Alias -> AddressOrAlias) -> Alias -> MorleyClientM Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> AddressOrAlias
AddressAlias
cmiGetPublicKey :: Address -> ClientM PublicKey
cmiGetPublicKey :: Address -> ClientM PublicKey
cmiGetPublicKey = IO PublicKey -> ClientM PublicKey
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PublicKey -> ClientM PublicKey)
-> (Address -> IO PublicKey) -> Address -> 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
env (MorleyClientM PublicKey -> IO PublicKey)
-> (Address -> MorleyClientM PublicKey) -> Address -> IO PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressOrAlias -> MorleyClientM PublicKey
forall (m :: * -> *).
HasTezosClient m =>
AddressOrAlias -> m PublicKey
Client.getPublicKey (AddressOrAlias -> MorleyClientM PublicKey)
-> (Address -> AddressOrAlias)
-> Address
-> MorleyClientM PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> AddressOrAlias
AddressResolved
getBalanceHelper :: Address -> ClientM Mutez
getBalanceHelper :: Address -> ClientM Mutez
getBalanceHelper = IO Mutez -> ClientM Mutez
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Mutez -> ClientM Mutez)
-> (Address -> IO Mutez) -> Address -> 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
env (MorleyClientM Mutez -> IO Mutez)
-> (Address -> MorleyClientM Mutez) -> Address -> IO Mutez
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> MorleyClientM Mutez
forall (m :: * -> *). HasTezosRpc m => Address -> m Mutez
Client.getBalance
cmiGetDelegate :: Address -> ClientM (Maybe KeyHash)
cmiGetDelegate :: Address -> 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))
-> (Address -> IO (Maybe KeyHash))
-> Address
-> 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
env (MorleyClientM (Maybe KeyHash) -> IO (Maybe KeyHash))
-> (Address -> MorleyClientM (Maybe KeyHash))
-> Address
-> IO (Maybe KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> MorleyClientM (Maybe KeyHash)
forall (m :: * -> *). HasTezosRpc m => Address -> 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
env
cmiGetLevel :: ClientM Natural
cmiGetLevel :: ClientM Natural
cmiGetLevel = MorleyClientEnv -> ClientM Natural
getLastBlockLevel MorleyClientEnv
env
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
env (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 :: Time unit -> ClientM ()
cmiAdvanceTime Time unit
delta = do
let
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
$ Time unit -> Time Second
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second Time unit
delta
deltaSec' :: NominalDiffTime
deltaSec' :: NominalDiffTime
deltaSec' = Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime) -> Pico -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Time (1 :% 1) -> Pico
forall (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
env
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
env
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
env
let targetLevel :: Natural
targetLevel = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max (Natural -> Natural
targetLevelFn Natural
lastLevel) Natural
lastLevel
let skippedLevels :: Natural
skippedLevels = Natural
targetLevel Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
lastLevel
Bool -> ClientM () -> ClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
skippedLevels Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0) (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> ClientM () -> ClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
skippedLevels Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
1) (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ do
Time (1 :% 1)
minBlockInterval <- ClientM (Time (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
* Time (1 :% 1) -> Natural
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
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
comment :: Text -> ClientM ()
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 :: MorleyClientEnv -> Address -> ClientM Alias
getAlias :: MorleyClientEnv -> Address -> ClientM Alias
getAlias MorleyClientEnv
env = IO Alias -> ClientM Alias
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Alias -> ClientM Alias)
-> (Address -> IO Alias) -> Address -> ClientM Alias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyClientEnv -> MorleyClientM Alias -> IO Alias
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM Alias -> IO Alias)
-> (Address -> MorleyClientM Alias) -> Address -> IO Alias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressOrAlias -> MorleyClientM Alias
forall (m :: * -> *). HasTezosClient m => AddressOrAlias -> m Alias
Client.getAlias (AddressOrAlias -> MorleyClientM Alias)
-> (Address -> AddressOrAlias) -> Address -> MorleyClientM Alias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> AddressOrAlias
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
. (HasCallStack, Integral Int64, Integral Natural) =>
Int64 -> Natural
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 -> Address -> [BaseOperationData] -> ClientM [BaseOperationResult]
runOperationBatch :: MorleyClientEnv
-> Address -> [BaseOperationData] -> ClientM [BaseOperationResult]
runOperationBatch MorleyClientEnv
env Address
sender [BaseOperationData]
ops = do
IORef ClientState
istRef <- ClientM (IORef ClientState)
forall r (m :: * -> *). MonadReader r m => m r
ask
ClientState{csMoneybagAddress :: ClientState -> Moneybag
csMoneybagAddress=Moneybag Address
moneybag} <- IORef ClientState -> ClientM ClientState
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef ClientState
istRef
IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv -> Address -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
env Address
sender
[Either TransactionData OriginationData]
ops' <- [BaseOperationData]
-> (BaseOperationData
-> ClientM (Either TransactionData OriginationData))
-> ClientM [Either TransactionData OriginationData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [BaseOperationData]
ops \case
OriginateOp UntypedOriginateData
uod ->
OriginationData -> Either TransactionData OriginationData
forall a b. b -> Either a b
Right (OriginationData -> Either TransactionData OriginationData)
-> ClientM OriginationData
-> ClientM (Either TransactionData OriginationData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UntypedOriginateData -> ClientM OriginationData
forall (m :: * -> *).
MonadThrow m =>
UntypedOriginateData -> m OriginationData
convertOriginateUntypedData UntypedOriginateData
uod
TransferOp TransferData
td ->
Either TransactionData OriginationData
-> ClientM (Either TransactionData OriginationData)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TransactionData OriginationData
-> ClientM (Either TransactionData OriginationData))
-> (TransactionData -> Either TransactionData OriginationData)
-> TransactionData
-> ClientM (Either TransactionData OriginationData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionData -> Either TransactionData OriginationData
forall a b. a -> Either a b
Left (TransactionData
-> ClientM (Either TransactionData OriginationData))
-> TransactionData
-> ClientM (Either TransactionData OriginationData)
forall a b. (a -> b) -> a -> b
$ TransferData -> TransactionData
convertTransferData TransferData
td
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
$ AddressOrAlias
-> [Either TransactionData OriginationData]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations (Address -> AddressOrAlias
AddressResolved Address
sender) [Either TransactionData OriginationData]
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 -> Address -> InternalNetworkScenarioError
TooManyRefillIterations Word
iter Address
sender
Mutez
realBalance <- Address -> MorleyClientM Mutez
forall (m :: * -> *). HasTezosRpc m => Address -> m Mutez
Client.getBalance Address
sender
let handleRunErrors :: [RunError] -> MorleyClientM Mutez
handleRunErrors [RunError]
errs'
| Just (Mutez
required, Mutez
balance) <- [RunError] -> Maybe (Mutez, 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
$ Address
sender Address -> 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
if Word
iter Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
then Mutez -> MorleyClientM Mutez
approximateRequired Mutez
realBalance
MorleyClientM Mutez
-> (SomeException -> MorleyClientM Mutez) -> MorleyClientM Mutez
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
_ :: SomeException) -> Mutez -> MorleyClientM Mutez
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutez
reportedDifference
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
$ Address
sender Address -> 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"
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
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
+| Address
moneybag Address -> 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
$ Address
-> Address
-> Mutez
-> EpName
-> ()
-> Maybe Mutez
-> MorleyClientM OperationHash
forall (m :: * -> *) t env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m,
NiceParameter t) =>
Address
-> Address
-> Mutez
-> EpName
-> t
-> Maybe Mutez
-> m OperationHash
Client.lTransfer Address
moneybag Address
sender Mutez
amount EpName
U.DefEpName () Maybe Mutez
forall a. Maybe a
Nothing
Word -> MorleyClientM Word
refill (Word
iter Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
addSafetyMutez :: Mutez -> Mutez
addSafetyMutez Mutez
x = Mutez -> Maybe Mutez -> Mutez
forall a. a -> Maybe a -> a
fromMaybe Mutez
x (Maybe Mutez -> Mutez) -> Maybe Mutez -> Mutez
forall a b. (a -> b) -> a -> b
$ Mutez -> Mutez -> Maybe Mutez
addMutez Mutez
x Mutez
safetyMutez
minimalMutez :: Mutez
minimalMutez = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez Word64
5e5
safetyMutez :: Mutez
safetyMutez = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez Word64
100
safetyStorage :: Natural
safetyStorage = Natural
20
approximateRequired :: Mutez -> MorleyClientM Mutez
approximateRequired Mutez
balance = do
([AppliedResult]
appliedResults, [Mutez]
fees) <- [(AppliedResult, Mutez)] -> ([AppliedResult], [Mutez])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(AppliedResult, Mutez)] -> ([AppliedResult], [Mutez]))
-> MorleyClientM [(AppliedResult, Mutez)]
-> MorleyClientM ([AppliedResult], [Mutez])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressOrAlias
-> [Either TransactionData OriginationData]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations (Address -> AddressOrAlias
AddressResolved Address
moneybag) [Either TransactionData OriginationData]
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
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 = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez Word64
0
originationSz :: Natural
originationSz = Int -> Natural
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
$ (BaseOperationData -> (Mutez, Natural))
-> [BaseOperationData] -> [(Mutez, Natural)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map BaseOperationData -> (Mutez, Natural)
opcostAndOriginationCount [BaseOperationData]
ops
costPerByte :: Mutez
costPerByte = TezosMutez -> Mutez
unTezosMutez TezosMutez
ppCostPerByte
opcostAndOriginationCount :: BaseOperationData -> (Mutez, Natural)
opcostAndOriginationCount = \case
OriginateOp UntypedOriginateData
uod -> (UntypedOriginateData -> Mutez
uodBalance UntypedOriginateData
uod, Natural
originationSz)
TransferOp TransferData
td -> (TransferData -> Mutez
tdAmount TransferData
td, Natural
0)
storageDiff :: AppliedResult -> Natural
storageDiff AppliedResult{[Address]
TezosInt64
arStorageSize :: AppliedResult -> TezosInt64
arPaidStorageDiff :: AppliedResult -> TezosInt64
arOriginatedContracts :: AppliedResult -> [Address]
arConsumedGas :: AppliedResult -> TezosInt64
arAllocatedDestinationContracts :: AppliedResult -> TezosInt64
arAllocatedDestinationContracts :: TezosInt64
arOriginatedContracts :: [Address]
arPaidStorageDiff :: TezosInt64
arStorageSize :: TezosInt64
arConsumedGas :: TezosInt64
..} = Natural
safetyStorage Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ TezosInt64 -> Natural
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 <- Address -> ClientM Bool
isAddressRefillable Address
sender
[Either () Address]
results <- IO [Either () Address] -> ClientM [Either () Address]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Either () Address] -> ClientM [Either () Address])
-> IO [Either () Address] -> ClientM [Either () Address]
forall a b. (a -> b) -> a -> b
$ MorleyClientEnv
-> MorleyClientM [Either () Address] -> IO [Either () Address]
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env (MorleyClientM [Either () Address] -> IO [Either () Address])
-> MorleyClientM [Either () Address] -> IO [Either () Address]
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
+| Address
sender Address -> 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, [Either () Address]) -> [Either () Address]
forall a b. (a, b) -> b
snd ((Maybe OperationHash, [Either () Address]) -> [Either () Address])
-> MorleyClientM (Maybe OperationHash, [Either () Address])
-> MorleyClientM [Either () Address]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressOrAlias
-> [Either TransactionData OriginationData]
-> MorleyClientM (Maybe OperationHash, [Either () Address])
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
AddressOrAlias
-> [Either TransactionData OriginationData]
-> m (Maybe OperationHash, [Either () Address])
Client.runOperations (Address -> AddressOrAlias
AddressResolved Address
sender) [Either TransactionData OriginationData]
ops'
let results' :: [BaseOperationResult]
results' = [Either () Address]
results [Either () Address]
-> (Either () Address -> BaseOperationResult)
-> [BaseOperationResult]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Left () ->
BaseOperationResult
TransferResult
Right Address
addr ->
Address -> BaseOperationResult
OriginateResult Address
addr
[BaseOperationResult]
-> (Element [BaseOperationResult] -> ClientM ()) -> ClientM ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ [BaseOperationResult]
results' ((Element [BaseOperationResult] -> ClientM ()) -> ClientM ())
-> (Element [BaseOperationResult] -> ClientM ()) -> ClientM ()
forall a b. (a -> b) -> a -> b
$ \case
OriginateResult addr -> do
Alias
alias <- MorleyClientEnv -> Address -> ClientM Alias
getAlias MorleyClientEnv
env Address
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
alias Alias -> 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
<> Address -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Address
addr
Element [BaseOperationResult]
_ -> ClientM ()
forall (f :: * -> *). Applicative f => f ()
pass
return [BaseOperationResult]
results'
dryRunOperations :: AddressOrAlias
-> [Either Client.TransactionData Client.OriginationData]
-> Client.MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations :: AddressOrAlias
-> [Either TransactionData OriginationData]
-> MorleyClientM [(AppliedResult, Mutez)]
dryRunOperations AddressOrAlias
s = \case
[] -> [(AppliedResult, Mutez)] -> MorleyClientM [(AppliedResult, Mutez)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
(Either TransactionData OriginationData
x:[Either TransactionData OriginationData]
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
<$> AddressOrAlias
-> NonEmpty (Either TransactionData OriginationData)
-> MorleyClientM (NonEmpty (AppliedResult, TezosMutez))
forall (m :: * -> *) env.
(HasTezosRpc m, HasTezosClient m, WithClientLog env m) =>
AddressOrAlias
-> NonEmpty (Either TransactionData OriginationData)
-> m (NonEmpty (AppliedResult, TezosMutez))
Client.dryRunOperationsNonEmpty AddressOrAlias
s (Either TransactionData OriginationData
x Either TransactionData OriginationData
-> [Either TransactionData OriginationData]
-> NonEmpty (Either TransactionData OriginationData)
forall a. a -> [a] -> NonEmpty a
:| [Either TransactionData OriginationData]
xs)
findBalanceTooLow :: [Client.RunError] -> Maybe (Mutez, Mutez)
findBalanceTooLow :: [RunError] -> Maybe (Mutez, Mutez)
findBalanceTooLow
(Client.BalanceTooLow (N Mutez
balance) (N Mutez
required):[RunError]
_)
= (Mutez, Mutez) -> Maybe (Mutez, Mutez)
forall a. a -> Maybe a
Just (Mutez
required, Mutez
balance)
findBalanceTooLow (RunError
_:[RunError]
xs) = [RunError] -> Maybe (Mutez, Mutez)
findBalanceTooLow [RunError]
xs
findBalanceTooLow [] = Maybe (Mutez, Mutez)
forall a. Maybe a
Nothing
findCantPayStorageFee :: [Client.RunError] -> Bool
findCantPayStorageFee :: [RunError] -> Bool
findCantPayStorageFee
(RunError
Client.CantPayStorageFee:[RunError]
_)
= Bool
True
findCantPayStorageFee (RunError
_:[RunError]
xs) = [RunError] -> Bool
findCantPayStorageFee [RunError]
xs
findCantPayStorageFee [] = Bool
False
exceptionToTransferFailure :: RPC.ClientRpcError -> ClientM TransferFailure
exceptionToTransferFailure :: ClientRpcError -> ClientM TransferFailure
exceptionToTransferFailure = \case
RPC.ContractFailed Address
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure Address
addr (TransferFailureReason -> TransferFailure)
-> TransferFailureReason -> TransferFailure
forall a b. (a -> b) -> a -> b
$ ExpressionOrTypedValue
-> Maybe InstrCallStack -> TransferFailureReason
FailedWith (Expression -> ExpressionOrTypedValue
EOTVExpression Expression
expr) Maybe InstrCallStack
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure Address
addr TransferFailureReason
BadParameter
RPC.EmptyTransaction Address
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure Address
addr TransferFailureReason
EmptyTransaction
RPC.ShiftOverflow Address
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure Address
addr TransferFailureReason
ShiftOverflow
RPC.GasExhaustion Address
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
$ Address -> TransferFailureReason -> TransferFailure
TransferFailure Address
addr 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 :: 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
runClientOrigination
:: MorleyClientEnv
-> Sender
-> ( Bool
-> AliasHint
-> AddressOrAlias
-> Mutez
-> U.Contract
-> U.Value
-> Maybe Mutez
-> Client.MorleyClientM (OperationHash, Address)
)
-> UntypedOriginateData
-> ClientM (OperationHash, Address)
runClientOrigination :: MorleyClientEnv
-> Sender
-> (Bool
-> AliasHint
-> AddressOrAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> MorleyClientM (OperationHash, Address))
-> UntypedOriginateData
-> ClientM (OperationHash, Address)
runClientOrigination MorleyClientEnv
env (Sender Address
sender) Bool
-> AliasHint
-> AddressOrAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> MorleyClientM (OperationHash, Address)
mkScenario (UntypedOriginateData{Contract
Value
Mutez
AliasHint
uodContract :: UntypedOriginateData -> Contract
uodStorage :: UntypedOriginateData -> Value
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: AliasHint
uodBalance :: UntypedOriginateData -> Mutez
uodName :: UntypedOriginateData -> AliasHint
..}) = do
let originationScenario :: MorleyClientM (OperationHash, Address)
originationScenario =
Bool
-> AliasHint
-> AddressOrAlias
-> Mutez
-> Contract
-> Value
-> Maybe Mutez
-> MorleyClientM (OperationHash, Address)
mkScenario Bool
True AliasHint
uodName (Address -> AddressOrAlias
AddressResolved Address
sender)
Mutez
uodBalance Contract
uodContract Value
uodStorage Maybe Mutez
forall a. Maybe a
Nothing
IO (OperationHash, Address) -> ClientM (OperationHash, Address)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (OperationHash, Address) -> ClientM (OperationHash, Address))
-> IO (OperationHash, Address) -> ClientM (OperationHash, Address)
forall a b. (a -> b) -> a -> b
$ do
MorleyClientEnv -> Address -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
env Address
sender
MorleyClientEnv
-> MorleyClientM (OperationHash, Address)
-> IO (OperationHash, Address)
forall a. MorleyClientEnv -> MorleyClientM a -> IO a
runMorleyClientM MorleyClientEnv
env MorleyClientM (OperationHash, Address)
originationScenario
resolveSpecificOrDefaultAliasHint :: SpecificOrDefaultAliasHint -> ClientM AliasHint
resolveSpecificOrDefaultAliasHint :: SpecificOrDefaultAliasHint -> ClientM AliasHint
resolveSpecificOrDefaultAliasHint (SpecificAliasHint AliasHint
aliasHint) =
AliasHint -> ClientM AliasHint
forall (m :: * -> *) a. Monad m => a -> m a
return AliasHint
aliasHint
resolveSpecificOrDefaultAliasHint (SpecificOrDefaultAliasHint
DefaultAliasHint) = 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 }
return $ Natural -> AliasHint
mkDefaultAlias Natural
counter
setAddressRefillable :: Address -> ClientM ()
setAddressRefillable :: Address -> ClientM ()
setAddressRefillable Address
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 Address
DefaultAliasCounter
Moneybag
csMoneybagAddress :: Moneybag
csRefillableAddresses :: Set Address
csDefaultAliasCounter :: DefaultAliasCounter
csMoneybagAddress :: ClientState -> Moneybag
csRefillableAddresses :: ClientState -> Set Address
csDefaultAliasCounter :: ClientState -> DefaultAliasCounter
..} ->
ClientState
st{csRefillableAddresses :: Set Address
csRefillableAddresses=Address -> Set Address -> Set Address
forall a. Ord a => a -> Set a -> Set a
Set.insert Address
addr Set Address
csRefillableAddresses}
isAddressRefillable :: Address -> ClientM Bool
isAddressRefillable :: Address -> ClientM Bool
isAddressRefillable Address
addr = do
IORef ClientState
stRef <- ClientM (IORef ClientState)
forall r (m :: * -> *). MonadReader r m => m r
ask
Address -> Set Address -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Address
addr (Set Address -> Bool)
-> (ClientState -> Set Address) -> ClientState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> Set Address
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
convertOriginateUntypedData
:: (MonadThrow m)
=> UntypedOriginateData -> m Client.OriginationData
convertOriginateUntypedData :: UntypedOriginateData -> m OriginationData
convertOriginateUntypedData UntypedOriginateData{Contract
Value
Mutez
AliasHint
uodContract :: Contract
uodStorage :: Value
uodBalance :: Mutez
uodName :: AliasHint
uodContract :: UntypedOriginateData -> Contract
uodStorage :: UntypedOriginateData -> Value
uodBalance :: UntypedOriginateData -> Mutez
uodName :: UntypedOriginateData -> AliasHint
..} = 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
-> AliasHint
-> Mutez
-> Contract cp st
-> Value st
-> Maybe Mutez
-> OriginationData
Client.OriginationData
{ odReplaceExisting :: Bool
odReplaceExisting = Bool
True
, odName :: AliasHint
odName = AliasHint
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
EpName
Mutez
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. Address -> Mutez -> EpName -> t -> Maybe Mutez -> TD t
Client.TD
{ tdReceiver :: Address
tdReceiver = addr -> Address
forall a. ToAddress a => a -> Address
toAddress 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)
-> (((SingI (ToT v), FailOnOperationFound (ContainsOp (ToT v)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT v))),
KnownValue v)
:- ParameterScope (ToT v))
-> TransactionData
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT v), FailOnOperationFound (ContainsOp (ToT v)),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT v))),
KnownValue v)
:- ParameterScope (ToT v)
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @p
revealKeyUnlessRevealed :: MorleyClientEnv -> Address -> IO ()
revealKeyUnlessRevealed :: MorleyClientEnv -> Address -> IO ()
revealKeyUnlessRevealed MorleyClientEnv
env Address
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
$
Address -> Maybe ScrubbedBytes -> MorleyClientM ()
forall env (m :: * -> *).
(WithClientLog env m, HasTezosRpc m, HasTezosClient m) =>
Address -> Maybe ScrubbedBytes -> m ()
Client.revealKeyUnlessRevealed Address
addr Maybe ScrubbedBytes
forall a. Maybe a
Nothing
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