morley-client 0.2.1 → 0.3.0
raw patch · 43 files changed
+1355/−701 lines, 43 filesdep −nameddep −universum
Dependencies removed: named, universum
Files
- CHANGES.md +66/−0
- README.md +1/−1
- app/Main.hs +13/−12
- morley-client.cabal +8/−9
- src/Morley/Client.hs +10/−7
- src/Morley/Client/Action.hs +4/−2
- src/Morley/Client/Action/Common.hs +51/−36
- src/Morley/Client/Action/Delegation.hs +65/−0
- src/Morley/Client/Action/Operation.hs +38/−24
- src/Morley/Client/Action/Origination.hs +32/−25
- src/Morley/Client/Action/Origination/Large.hs +12/−10
- src/Morley/Client/Action/Reveal.hs +26/−20
- src/Morley/Client/Action/Transaction.hs +32/−37
- src/Morley/Client/App.hs +2/−2
- src/Morley/Client/Env.hs +0/−42
- src/Morley/Client/Full.hs +70/−6
- src/Morley/Client/Init.hs +16/−40
- src/Morley/Client/OnlyRPC.hs +8/−11
- src/Morley/Client/Parser.hs +30/−25
- src/Morley/Client/RPC/API.hs +6/−8
- src/Morley/Client/RPC/Class.hs +2/−2
- src/Morley/Client/RPC/Error.hs +5/−3
- src/Morley/Client/RPC/Getters.hs +8/−10
- src/Morley/Client/RPC/Types.hs +148/−61
- src/Morley/Client/TezosClient.hs +8/−2
- src/Morley/Client/TezosClient/Class.hs +31/−16
- src/Morley/Client/TezosClient/Impl.hs +381/−134
- src/Morley/Client/TezosClient/Parser.hs +1/−1
- src/Morley/Client/TezosClient/Types.hs +6/−6
- src/Morley/Client/Types.hs +5/−1
- src/Morley/Client/Util.hs +4/−4
- test/Test/BigMapGet.hs +6/−7
- test/Test/ErrorJSONParser.hs +42/−0
- test/Test/Fees.hs +4/−3
- test/Test/KeyRevealing.hs +4/−4
- test/Test/Origination.hs +6/−6
- test/Test/ParameterTypeGet.hs +6/−6
- test/Test/Parser.hs +2/−2
- test/Test/ReadBigMapValue.hs +1/−1
- test/Test/Transaction.hs +3/−2
- test/Test/Util.hs +61/−78
- test/TestM.hs +34/−35
- test/data/constants.json +97/−0
CHANGES.md view
@@ -1,5 +1,71 @@ <!-- Unreleased: append new entries here --> +0.3.0+=====+* [!1281](https://gitlab.com/morley-framework/morley/-/merge_requests/1281)+ Use the new binaries names, `octez-client` and `octez-node`+* [!1270](https://gitlab.com/morley-framework/morley/-/merge_requests/1270)+ Remove key prefix in reveal operation+* [!1285](https://gitlab.com/morley-framework/morley/-/merge_requests/1285)+ Make revealKey API less confusing+ + Removed redundant `sender` parameter from functions in+ `Morley.Client.Action.Reveal`. They now accept a public key and optionally+ fee instead, since the sender is uniquely determined by the public key.+* [!1287](https://gitlab.com/morley-framework/morley/-/merge_requests/1287)+ Get rid of RpcNoOperationsRun error+ + Introduce `runTransactionsNonEmpty` to `Morley.Client.Action.Transaction`.+ + Remove `RpcNoOperationsRun` constructor from `IncorrectRpcResponse` as it+ can't in fact be thrown.+* [!1266](https://gitlab.com/morley-framework/morley/-/merge_requests/1266)+ Overload `getAlias`+ + Overloaded `getAlias` and `getAliasMaybe`+ to work with `SomeAddressOrAlias`.+ + `getAlias` and `getAliasMaybe` now check that the alias actually exists.+ + Replaced the `findAddress` and `getAliasEither` methods from+ the `HasTezosClient` typeclass with `getAliasesAndAddresses`.+* [!1259](https://gitlab.com/morley-framework/morley/-/merge_requests/1259)+ More options for handling duplicate alias in morley-client+ + Added new datatype `Morley.Client.AliasBehavior`.+ + Various origination functions and datatypes now use this datatype instead of+ a boolean flag.+ + `DuplicateAlias` error is now part of `TezosClientError`.+* [!1258](https://gitlab.com/morley-framework/morley/-/merge_requests/1258)+ Support implicit contract delegates and setting delegates during origination+ + Fix a small potential bug in RPC error code decoders.+ + Parse `deleagate.already_active` error+ + Support getting delegates for implicit addresses+ + Support setting contract delegate during origination+* [!1260](https://gitlab.com/morley-framework/morley/-/merge_requests/1260)+ Add `SomeAddressOrAlias`+ + Overloaded `resolveAddress` and `resolveAddressMaybe` to work with+ `SomeAddressOrAlias`.+ + Replaced the `transfer --to-implicit` and `--to-contract` options with a+ single `--to` option.+ + Replaced the `resolveAddressMaybe` method from the `HasTezosClient`+ typeclass with `findAddress`.+* [!1226](https://gitlab.com/morley-framework/morley/-/merge_requests/1226)+ Implement delegation operation via RPC+* [!1257](https://gitlab.com/morley-framework/morley/-/merge_requests/1257)+ Export `Morley.Client.Action.Common.runErrorsToClientError` utility for+ converting `[RunError]` to `ClientRpcError`+* [!1244](https://gitlab.com/morley-framework/morley/-/merge_requests/1244)+ Smarter initial gas limit estimation+* [!1249](https://gitlab.com/morley-framework/morley/-/merge_requests/1249)+ Add getAliasMaybe and getAliasEither to morley-client+* [!1227](https://gitlab.com/morley-framework/morley/-/merge_requests/1227)+ Add timestamp to morley-client logs+ + Omit source locations from logs when verbosity is `<=2`.+* [!1242](https://gitlab.com/morley-framework/morley/-/merge_requests/1242)+ Use `Constrained` utility existential+* [!1247](https://gitlab.com/morley-framework/morley/-/merge_requests/1247)+ Refactor MorleyClientEnv+ + Removed `MorleyClientEnv'`, constructor now lives in `MorleyClientEnv`+ + Removed `Morley.Client.Env` module+ + `MorleyClientEnv`, `mkMorleyClientEnv` and `MorleyClientEnv` lenses moved to `Morley.Client.Full`+* [!1237](https://gitlab.com/morley-framework/morley/-/merge_requests/1237)+ Handle unregistered_delegate error in morley-client+* [!1215](https://gitlab.com/morley-framework/morley/-/merge_requests/1215)+ Output contract events in morley-client binary 0.2.1 =====
README.md view
@@ -4,7 +4,7 @@ It is intended to be used both as a library and as a tool. `morley-client` uses the [Tezos RPC API](https://tezos.gitlab.io/developer/rpc.html)-to interact with a remote (or local) `tezos-node` and uses the `tezos-client`+to interact with a remote (or local) `octez-node` and uses the `octez-client` binary for some operations, such as signing and local contract manipulations. IMPORTANT: `morley-client` is still actively developed and unstable.
app/Main.hs view
@@ -8,7 +8,7 @@ import Control.Exception.Safe (throwString) import Data.Aeson qualified as Aeson import Data.Default (def)-import Fmt (pretty)+import Fmt (blockListF, pretty) import GHC.IO.Encoding (setFileSystemEncoding) import Options.Applicative qualified as Opt import System.IO (utf8)@@ -24,7 +24,6 @@ import Morley.Michelson.Typed.Value (Value'(..)) import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address-import Morley.Tezos.Address.Alias import Morley.Tezos.Core (prettyTez) import Morley.Util.Exception (throwLeft) import Morley.Util.Main (wrapMain)@@ -36,19 +35,19 @@ contract <- liftIO $ prepareContract oaMbContractFile let originator = oaOriginateFrom (operationHash, contractAddr) <-- originateUntypedContract True oaContractName originator oaInitialBalance- contract oaInitialStorage oaMbFee+ originateUntypedContract OverwriteDuplicateAlias oaContractName originator oaInitialBalance+ contract oaInitialStorage oaMbFee oaDelegate putTextLn "Contract was successfully deployed." putTextLn $ "Operation hash: " <> pretty operationHash putTextLn $ "Contract address: " <> formatAddress contractAddr - Transfer TransferArgs{taDestination = SomeAddressOrAlias taDestination, ..} -> do+ Transfer TransferArgs{..} -> do sendAddress <- resolveAddress taSender destAddress <- resolveAddress taDestination- operationHash :: OperationHash <- case destAddress of- ContractAddress _ -> do- contract <- getContract destAddress+ (operationHash :: OperationHash, contractEvents :: [IntOpEvent]) <- case destAddress of+ Constrained destContract@ContractAddress{} -> do+ contract <- getContract destContract SomeContract fullContract <- throwLeft $ pure $ typeCheckingWith def $ typeCheckContract contract case fullContract of@@ -59,14 +58,16 @@ tcOriginatedContracts <- getContractsParameterTypes addrs parameter <- throwLeft $ pure $ typeCheckingWith def $ typeVerifyParameter @cp tcOriginatedContracts taParameter- transfer sendAddress destAddress taAmount U.DefEpName parameter taMbFee- ImplicitAddress _ -> case taParameter of- U.ValueUnit -> transfer sendAddress destAddress taAmount U.DefEpName VUnit Nothing+ transfer sendAddress destContract taAmount U.DefEpName parameter taMbFee+ Constrained destImplicit@ImplicitAddress {} -> case taParameter of+ U.ValueUnit -> transfer sendAddress destImplicit taAmount U.DefEpName VUnit Nothing _ -> throwString ("The transaction parameter must be 'Unit' " <> "when transferring to an implicit account")- TxRollupAddress _ -> throwString "Only smart contracts can call txr1 addresses" putTextLn $ "Transaction was successfully sent.\nOperation hash " <> pretty operationHash <> "."+ unless (null contractEvents) do+ putTextLn $ "Additionally, the following contract events were emitted:"+ putTextLn $ pretty $ blockListF contractEvents GetBalance addrOrAlias -> do balance <- getBalance =<< resolveAddress addrOrAlias
morley-client.cabal view
@@ -5,9 +5,9 @@ -- see: https://github.com/sol/hpack name: morley-client-version: 0.2.1+version: 0.3.0 synopsis: Client to interact with the Tezos blockchain-description: A client to interact with the Tezos blockchain, by use of the tezos-node RPC and/or of the tezos-client binary.+description: A client to interact with the Tezos blockchain, by use of the octez-node RPC and/or of the octez-client binary. category: Blockchain homepage: https://gitlab.com/morley-framework/morley bug-reports: https://gitlab.com/morley-framework/morley/-/issues@@ -20,6 +20,7 @@ extra-source-files: CHANGES.md README.md+ test/data/constants.json source-repository head type: git@@ -31,6 +32,7 @@ Morley.Client.Action Morley.Client.Action.Batched Morley.Client.Action.Common+ Morley.Client.Action.Delegation Morley.Client.Action.Operation Morley.Client.Action.Origination Morley.Client.Action.Origination.Large@@ -38,7 +40,6 @@ Morley.Client.Action.SizeCalculation Morley.Client.Action.Transaction Morley.Client.App- Morley.Client.Env Morley.Client.Full Morley.Client.Init Morley.Client.Logging@@ -120,7 +121,7 @@ ViewPatterns DerivingStrategies DeriveAnyClass- ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -Wno-unused-packages+ ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode build-depends: aeson , aeson-casing@@ -145,11 +146,9 @@ , morley , morley-prelude , mtl- , named , optparse-applicative , process , random- , safe-exceptions , scientific , servant , servant-client@@ -158,7 +157,6 @@ , syb , text , time- , universum , unliftio default-language: Haskell2010 @@ -219,7 +217,7 @@ UndecidableInstances UndecidableSuperClasses ViewPatterns- ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -Wno-unused-packages+ ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode build-depends: aeson , base-noprelude >=4.7 && <5@@ -239,6 +237,7 @@ Ingredients Test.Addresses Test.BigMapGet+ Test.ErrorJSONParser Test.Errors Test.Fees Test.KeyRevealing@@ -304,7 +303,7 @@ UndecidableInstances UndecidableSuperClasses ViewPatterns- ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -Wno-unused-packages -threaded -eventlog -rtsopts "-with-rtsopts=-N -A64m -AL256m"+ ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -threaded -eventlog -rtsopts "-with-rtsopts=-N -A64m -AL256m" build-tool-depends: tasty-discover:tasty-discover build-depends:
src/Morley/Client.hs view
@@ -1,8 +1,8 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | Morley client that connects with real Tezos network through RPC and tezos-client binary.--- For more information please refer to README.+-- | Morley client that connects with real Tezos network through RPC and+-- the @octez-client@ binary. For more information please refer to README. module Morley.Client ( -- * Command line parser parserInfo@@ -11,8 +11,7 @@ -- * Full client monad and environment , MorleyClientM , MorleyClientConfig (..)- , MorleyClientEnv' (..)- , MorleyClientEnv+ , MorleyClientEnv (..) , runMorleyClientM , mkMorleyClientEnv -- ** Lens@@ -67,10 +66,16 @@ , readBigMapValueMaybe , readBigMapValue - -- * @tezos-client@+ -- * @octez-client@ , HasTezosClient (..)+ , Resolve(ResolvedAddress, ResolvedAlias)+ , ResolveError(..)+ , getAlias+ , getAliasMaybe , resolveAddress+ , resolveAddressMaybe , TezosClientError (..)+ , AliasBehavior (..) -- * Util , disableAlphanetWarning@@ -82,9 +87,7 @@ import Options.Applicative qualified as Opt import Morley.Client.Action-import Morley.Client.Env import Morley.Client.Full-import Morley.Client.Init import Morley.Client.OnlyRPC import Morley.Client.Parser import Morley.Client.RPC
src/Morley/Client/Action.hs view
@@ -2,10 +2,11 @@ -- SPDX-License-Identifier: LicenseRef-MIT-OA -- | High-level actions implemented in abstract monads that--- require both RPC and @tezos-client@ functionality.+-- require both RPC and @octez-client@ functionality. module Morley.Client.Action- ( module Morley.Client.Action.Operation+ ( module Morley.Client.Action.Delegation+ , module Morley.Client.Action.Operation , module Morley.Client.Action.Origination , module Morley.Client.Action.Transaction , module Morley.Client.Action.SizeCalculation@@ -14,6 +15,7 @@ ) where import Morley.Client.Action.Common (ClientInput, revealKeyUnlessRevealed)+import Morley.Client.Action.Delegation import Morley.Client.Action.Operation import Morley.Client.Action.Origination import Morley.Client.Action.SizeCalculation
src/Morley/Client/Action/Common.hs view
@@ -9,6 +9,7 @@ , TransactionData(..) , OriginationData(..) , RevealData(..)+ , DelegationData(..) , ClientInput , addOperationPrefix , buildTxDataWithAlias@@ -24,6 +25,7 @@ , mkOriginationScript , revealKeyUnlessRevealed , handleOperationResult+ , runErrorsToClientError ) where import Control.Lens (Prism')@@ -93,17 +95,23 @@ -- | Data for a single origination in a batch data OriginationData = forall cp st. (ParameterScope cp, StorageScope st) => OriginationData- { odReplaceExisting :: Bool+ { odAliasBehavior :: AliasBehavior , odName :: ContractAlias , odBalance :: Mutez , odContract :: T.Contract cp st , odStorage :: T.Value st+ , odDelegate :: Maybe KeyHash , odMbFee :: Maybe Mutez } +data DelegationData = DelegationData+ { ddDelegate :: Maybe KeyHash+ , ddMbFee :: Maybe Mutez+ }+ data RevealData = RevealData { rdPublicKey :: PublicKey- -- TODO [#516]: extract mbFee out of 'TransactionData', 'OriginationData'+ -- TODO [#516]: extract mbFee out of 'TransactionData', 'OriginationData', 'DelegationData' -- and here, try to delete 'RevealData' datatype and pass 'PublicKey' instead , rdMbFee :: Maybe Mutez }@@ -114,6 +122,7 @@ type TransferInfo ClientInput = TransactionData type OriginationInfo ClientInput = OriginationData type RevealInfo ClientInput = RevealData+ type DelegationInfo ClientInput = DelegationData toParametersInternals :: ParameterScope t@@ -201,42 +210,48 @@ OperationApplied result -> first (result <>) OperationFailed errors -> second (Just errors <>) - -- When an error happens, we will get a list of 'RunError' in response.- -- This list often contains more than one item.- -- We tested which errors are returned in certain scenarios and added- -- handling of such scenarios here.- -- We don't rely on any specific order of errors and on the number of errors.- -- For example, in case of bad parameter this number can be different. handleErrors :: MonadThrow m => [RunError] -> m a handleErrors errs- | Just address <- findError _RuntimeError- , Just expr <- findError _ScriptRejected- = throwM $ ContractFailed address expr- -- This case should be removed once 006 is finally deprecated- | Just address <- findError _BadContractParameter- , Just (_, expr) <- findError _InvalidSyntacticConstantError- = throwM $ BadParameter address expr- | Just address <- findError _BadContractParameter- , Just (_, expr) <- findError _InvalidConstant- = throwM $ BadParameter address expr- | Just address <- findError _BadContractParameter- , Just notation <- findError _InvalidContractNotation- = throwM $ BadParameter address (expressionString notation)- | Just address <- findError _REEmptyTransaction- = throwM $ EmptyTransaction address- | Just address <- findError _RuntimeError- , Just _ <- findError _ScriptOverflow- = throwM $ ShiftOverflow address- | Just address <- findError _RuntimeError- , Just _ <- findError _GasExhaustedOperation- = throwM $ GasExhaustion address- | Just address <- findError _PreviouslyRevealedKey- = throwM $ KeyAlreadyRevealed address- | otherwise- = throwM $ UnexpectedRunErrors errs- where- findError :: Prism' RunError a -> Maybe a- findError prism = fmap head . nonEmpty . mapMaybe (preview prism) $ errs+ | Just err <- runErrorsToClientError errs = throwM err+ | otherwise = throwM $ UnexpectedRunErrors errs+++-- | When an error happens, we will get a list of 'RunError' in response. This+-- list often contains more than one item. We tested which errors are returned+-- in certain scenarios and added handling of such scenarios here. We don't rely+-- on any specific order of errors and on the number of errors. For example, in+-- case of bad parameter this number can be different.+runErrorsToClientError :: [RunError] -> Maybe ClientRpcError+runErrorsToClientError errs+ | Just address <- findError _RuntimeError+ , Just expr <- findError _ScriptRejected+ = pure $ ContractFailed address expr+ -- This case should be removed once 006 is finally deprecated+ | Just address <- findError _BadContractParameter+ , Just (_, expr) <- findError _InvalidSyntacticConstantError+ = pure $ BadParameter address expr+ | Just address <- findError _BadContractParameter+ , Just (_, expr) <- findError _InvalidConstant+ = pure $ BadParameter address expr+ | Just address <- findError _BadContractParameter+ , Just notation <- findError _InvalidContractNotation+ = pure $ BadParameter address (expressionString notation)+ | Just address <- findError _REEmptyTransaction+ = pure $ EmptyTransaction address+ | Just address <- findError _RuntimeError+ , Just _ <- findError _ScriptOverflow+ = pure $ ShiftOverflow address+ | Just address <- findError _RuntimeError+ , Just _ <- findError _GasExhaustedOperation+ = pure $ GasExhaustion address+ | Just address <- findError _PreviouslyRevealedKey+ = pure $ KeyAlreadyRevealed address+ | Just address <- findError _UnregisteredDelegate+ = pure $ DelegateNotRegistered address+ | otherwise = Nothing+ where+ findError :: Prism' RunError a -> Maybe a+ findError prism = fmap head . nonEmpty . mapMaybe (preview prism) $ errs -- | Reveal key for implicit address if necessary. --
+ src/Morley/Client/Action/Delegation.hs view
@@ -0,0 +1,65 @@+-- SPDX-FileCopyrightText: 2022 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++module Morley.Client.Action.Delegation+ ( setDelegateOp+ , registerDelegateOp+ ) where++import Colog.Core.Class (HasLog)+import Colog.Message (Message)++import Morley.Client.Action.Common+import Morley.Client.Action.Operation+import Morley.Client.RPC.Class+import Morley.Client.RPC.Types+import Morley.Client.TezosClient.Class+import Morley.Client.Types+import Morley.Tezos.Address+import Morley.Tezos.Address.Alias+import Morley.Tezos.Crypto++-- | Set or revoke a delegate for the sender.+-- To set a supply @Just delegate@ as the second argument.+-- To withdraw a delegate supply @Nothing@ as the second argument.+--+-- Some notes on delegations:+--+-- Implicit Accounts can either be /registered delegates/, have no delegate,+-- or have a delegate set without being /registered delegates/ themselves.+--+-- For example imagine two implicit addresses Alice and Bob:+-- * Alice registers as delegate using `registerDelegateOp`. This means that Alice delegates to Alice.+-- * Bob sets Alice as his delegate. This delegates Bob's staking rights to Alice.+--+-- Now, Alice can't change their delegate, because that would revoke Alice as delegate and make+-- Bob's delegation void. So @setDelegateOp alice Nothing@ would throw a @FailedUnDelegation alice@ exception.+--+-- However, Bob, not beeing a /registered delegate/ can:+-- * Revoke the delegation to alice @setDelegateOp bob Nothing@+-- * Delegate to another "registered delegate": @registerDelegateOp charly >> setDelegateOp bob charly@+-- * Become a registered delegate himself: @registerDelegateOp bob@+--+-- Smart Contracts can also delegate to /registered delegates/, but can't be /registered delegates/ themselves.+--+setDelegateOp+ :: ( HasTezosRpc m+ , HasTezosClient m+ , MonadReader env m+ , HasLog env Message m)+ => ImplicitAddressOrAlias+ -> Maybe KeyHash+ -> m OperationHash+setDelegateOp sender delegate =+ fmap fst . runOperationsNonEmpty sender . one . OpDelegation $ DelegationData delegate Nothing++-- | Register the sender as its delegate and become a "registered delegate"+-- Alias for @setDelegateOp sender (Just sender)@+registerDelegateOp+ :: ( HasTezosRpc m+ , HasTezosClient m+ , MonadReader env m+ , HasLog env Message m)+ => KeyHash+ -> m OperationHash+registerDelegateOp sender = setDelegateOp (AddressResolved . ImplicitAddress $ sender) (Just sender)
src/Morley/Client/Action/Operation.hs view
@@ -6,9 +6,8 @@ ( Result , runOperations , runOperationsNonEmpty- -- helpers+ -- * helpers , dryRunOperationsNonEmpty- , DuplicateAlias (..) ) where import Control.Lens (has, (%=), (&~))@@ -17,7 +16,7 @@ import Data.Ratio ((%)) import Data.Singletons (Sing, SingI, sing) import Data.Text qualified as T-import Fmt (Buildable(..), blockListF, blockListF', listF, nameF, pretty, (+|), (|+))+import Fmt (blockListF, blockListF', listF, nameF, pretty, (+|), (|+)) import Morley.Client.Action.Common import Morley.Client.Logging@@ -33,6 +32,8 @@ import Morley.Tezos.Core import Morley.Tezos.Crypto import Morley.Util.ByteString+import Morley.Util.Constrained+import Morley.Util.Named -- | Designates output of an operation. data Result@@ -40,12 +41,14 @@ type TransferInfo Result = [IntOpEvent] type OriginationInfo Result = ContractAddress type RevealInfo Result = ()+ type DelegationInfo Result = () logOperations :: forall (runMode :: RunMode) env m kind. ( WithClientLog env m , HasTezosClient m- , SingI runMode -- We don't ask aliases with 'tezos-client' in 'DryRun' mode+ , MonadThrow m+ , SingI runMode -- We don't ask aliases with @octez-client@ in 'DryRun' mode , L1AddressKind kind ) => AddressOrAlias kind@@ -67,6 +70,8 @@ odName orig |+ " (temporary alias)" (OpReveal rv, mbAlias) -> "Key " +| rdPublicKey rv |+ maybe "" (\a -> " (" +| a |+ ")") mbAlias+ (OpDelegation delegate, mbAlias) ->+ "Key Hash " +| ddDelegate delegate |+ maybe "" (\a -> " (" +| a |+ ")") mbAlias sender' <- case sender of addr@AddressResolved{} -> case runMode of@@ -77,12 +82,15 @@ aliases <- case runMode of SRealRun -> forM ops $ \case- OpTransfer (TransactionData tx) -> case tdReceiver tx of- MkConstrainedAddress addr -> Just . pretty <$> (getAlias $ AddressResolved addr)+ OpTransfer (TransactionData tx) -> withConstrained (tdReceiver tx) $+ fmap (Just . pretty) . getAlias . AddressResolved OpOriginate _ -> pure Nothing OpReveal r -> Just . pretty <$> (getAlias . AddressResolved . mkKeyAddress $ rdPublicKey r)+ OpDelegation d ->+ maybe (pure Nothing)+ (fmap (Just . pretty) . getAlias . AddressResolved . ImplicitAddress) $ ddDelegate d SDryRun -> pure $ ops $> Nothing logInfo $ T.strip $ -- strip trailing newline@@ -186,13 +194,13 @@ -> m (RunResult runMode) runOperationsNonEmptyHelper retryCount sender operations = do logOperations @runMode sender operations- -- If any aliases we intend to create already exist, we want to fail- -- now, rather than after contract origination.+ -- If we intend to fail on duplicate aliases, we want to fail now, rather than+ -- after contract origination. forM_ operations $ \case- OpOriginate OriginationData{..} -> unless odReplaceExisting $ do+ OpOriginate OriginationData{odAliasBehavior = ForbidDuplicateAlias, ..} -> do resolved <- resolveAddressMaybe (AddressAlias odName)- whenJust resolved $ const $ throwM DuplicateAlias- _ -> pure ()+ whenJust resolved $ const $ throwM $ DuplicateAlias (unAlias odName)+ _ -> pass senderAddress <- resolveAddress sender mbPassword <- getKeyPassword senderAddress when (isRealRun @runMode && mayNeedSenderRevealing (toList operations)) $@@ -202,7 +210,7 @@ OperationConstants{..} <- preProcessOperation senderAddress let convertOps i = WithCommonOperationData commonData . \case- OpTransfer (TransactionData TD {tdReceiver=MkConstrainedAddress tdReceiver, ..}) ->+ OpTransfer (TransactionData TD {tdReceiver=Constrained tdReceiver, ..}) -> OpTransfer TransactionOperation { toDestination = MkAddress tdReceiver , toAmount = TezosMutez tdAmount@@ -211,20 +219,29 @@ OpOriginate OriginationData{..} -> OpOriginate OriginationOperation { ooBalance = TezosMutez odBalance+ , ooDelegate = odDelegate , ooScript = mkOriginationScript odContract odStorage } OpReveal RevealData{..} -> OpReveal RevealOperation { roPublicKey = rdPublicKey }+ OpDelegation DelegationData{..} ->+ OpDelegation DelegationOperation+ { doDelegate = ddDelegate+ } where- commonData = mkCommonOperationData senderAddress (ocCounter + i) pp+ commonData = mkCommonOperationData pp+ ! #sender senderAddress+ ! #counter (ocCounter + i)+ ! #num_operations (fromIntegral (length operations)) let opsToRun = NE.zipWith convertOps (1 :| [(2 :: TezosInt64)..]) operations mbFees = operations <&> \case OpTransfer (TransactionData TD {..}) -> tdMbFee OpOriginate OriginationData{..} -> odMbFee OpReveal RevealData{..} -> rdMbFee+ OpDelegation DelegationData {..} -> ddMbFee -- Perform run_operation with dumb signature in order -- to estimate gas cost, storage size and paid storage diff@@ -266,7 +283,9 @@ MkAddress ContractAddress{} -> gasSafetyGuard MkAddress TxRollupAddress{} -> gasSafetyGuard OpReveal _ -> 0- let storageLimit = computeStorageLimit [ar] pp + 20 -- similarly to tezos-client, we add 20 for safety+ OpDelegation _ -> 0+ let storageLimit = computeStorageLimit [ar] pp + 20+ -- similarly to @octez-client@, we add 20 for safety let gasLimit = ceiling (arConsumedMilliGas ar % 1000) + additionalGas updateCommonDataForFee fee = updateCommonData gasLimit storageLimit (TezosMutez fee)@@ -348,14 +367,15 @@ throwM RpcOriginatedNoContracts (OpOriginate OriginationData{..}, [addr]) -> do logDebug $ "Saving " +| addr |+ " for " +| odName |+ "\n"- rememberContract odReplaceExisting addr odName- alias <- getAlias $ AddressResolved addr- logInfo $ "Originated contract: " <> pretty alias+ rememberContract odAliasBehavior addr odName+ logInfo $ "Originated contract: " <> pretty odName return $ OpOriginate addr (OpOriginate _, addrs@(_ : _ : _)) -> throwM $ RpcOriginatedMoreContracts addrs (OpReveal _, _) -> return $ OpReveal ()+ (OpDelegation _, _) ->+ return $ OpDelegation () forM_ ars2 logStatistics return (operationHash, opsRes) `catch` \case@@ -375,6 +395,7 @@ OpTransfer{} -> True OpOriginate{} -> True OpReveal{} -> False+ OpDelegation{} -> True logStatistics :: AppliedResult -> m () logStatistics ar = do@@ -382,10 +403,3 @@ logInfo $ "Consumed milli-gas: " <> showTezosInt64 (arConsumedMilliGas ar) logInfo $ "Storage size: " <> showTezosInt64 (arStorageSize ar) logInfo $ "Paid storage size diff: " <> showTezosInt64 (arPaidStorageDiff ar)--data DuplicateAlias = DuplicateAlias- deriving stock Show-instance Exception DuplicateAlias where- displayException = pretty-instance Buildable DuplicateAlias where- build DuplicateAlias = "Attempted to create an alias that already exists."
src/Morley/Client/Action/Origination.hs view
@@ -1,7 +1,7 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | Functions to originate smart contracts via @tezos-client@ and node RPC.+-- | Functions to originate smart contracts via @octez-client@ and node RPC. module Morley.Client.Action.Origination ( originateContract , originateContracts@@ -74,15 +74,16 @@ , StorageScope st , ParameterScope cp )- => Bool+ => AliasBehavior -> ContractAlias -> ImplicitAddressOrAlias -> Mutez -> Contract cp st -> Value st -> Maybe Mutez+ -> Maybe L.KeyHash -> m (OperationHash, ContractAddress)-originateContract odReplaceExisting odName sender' odBalance odContract odStorage odMbFee = do+originateContract odAliasBehavior odName sender' odBalance odContract odStorage odMbFee odDelegate = do (hash, contracts) <- originateContracts sender' [OriginationData{..}] singleOriginatedContract hash contracts @@ -93,19 +94,20 @@ , HasTezosClient m , WithClientLog env m )- => Bool+ => AliasBehavior -> ContractAlias -> ImplicitAddressOrAlias -> Mutez -> U.Contract -> U.Value -> Maybe Mutez+ -> Maybe L.KeyHash -> m (OperationHash, ContractAddress)-originateUntypedContract replaceExisting name sender' balance uContract initialStorage mbFee = do+originateUntypedContract aliasBehavior name sender' balance uContract initialStorage mbFee mbDelegate = do SomeContractAndStorage contract storage <- throwLeft . pure . typeCheckingWith def $ typeCheckContractAndStorage uContract initialStorage- originateContract replaceExisting name sender' balance contract storage mbFee+ originateContract aliasBehavior name sender' balance contract storage mbFee mbDelegate -- | Lorentz version of 'originateContracts' lOriginateContracts@@ -129,15 +131,16 @@ , NiceStorage st , NiceParameterFull cp )- => Bool+ => AliasBehavior -> ContractAlias -> ImplicitAddressOrAlias -> Mutez -> L.Contract cp st vd -> st -> Maybe Mutez+ -> Maybe L.KeyHash -> m (OperationHash, ContractAddress)-lOriginateContract lodReplaceExisting lodName sender' lodBalance lodContract lodStorage lodMbFee = do+lOriginateContract lodAliasBehavior lodName sender' lodBalance lodContract lodStorage lodMbFee lodDelegate = do (hash, contracts) <- lOriginateContracts sender' [LOriginationData{..}] singleOriginatedContract @m hash contracts @@ -185,15 +188,16 @@ , StorageScope st , ParameterScope cp )- => Bool+ => AliasBehavior -> ContractAlias -> ImplicitAddressOrAlias -> Mutez -> Contract cp st -> Value st -> Maybe Mutez+ -> Maybe L.KeyHash -> m (OperationHash, ContractAddress)-originateLargeContract odReplaceExisting odName sender' odBalance odContract odStorage odMbFee = do+originateLargeContract odAliasBehavior odName sender' odBalance odContract odStorage odMbFee odDelegate = do (hash, contracts) <- originateLargeContracts sender' [OriginationData{..}] singleOriginatedContract @m hash contracts @@ -204,19 +208,20 @@ , HasTezosClient m , WithClientLog env m )- => Bool+ => AliasBehavior -> ContractAlias -> ImplicitAddressOrAlias -> Mutez -> U.Contract -> U.Value -> Maybe Mutez+ -> Maybe L.KeyHash -> m (OperationHash, ContractAddress)-originateLargeUntypedContract replaceExisting name sender' balance uContract initialStorage mbFee = do+originateLargeUntypedContract aliasBehavior name sender' balance uContract initialStorage mbFee mbDelegate = do SomeContractAndStorage contract storage <- throwLeft . pure . typeCheckingWith def $ typeCheckContractAndStorage uContract initialStorage- originateLargeContract replaceExisting name sender' balance contract storage mbFee+ originateLargeContract aliasBehavior name sender' balance contract storage mbFee mbDelegate -- | Lorentz version of 'originateLargeContracts' lOriginateLargeContracts@@ -240,15 +245,16 @@ , NiceStorage st , NiceParameterFull cp )- => Bool+ => AliasBehavior -> ContractAlias -> ImplicitAddressOrAlias -> Mutez -> L.Contract cp st vd -> st -> Maybe Mutez+ -> Maybe L.KeyHash -> m (OperationHash, ContractAddress)-lOriginateLargeContract lodReplaceExisting lodName sender' lodBalance lodContract lodStorage lodMbFee = do+lOriginateLargeContract lodAliasBehavior lodName sender' lodBalance lodContract lodStorage lodMbFee lodDelegate = do (hash, contracts) <- lOriginateLargeContracts sender' [LOriginationData{..}] singleOriginatedContract @m hash contracts @@ -259,26 +265,27 @@ -- | Lorentz version of 'OriginationData' data LOriginationData = forall cp st vd. (NiceParameterFull cp, NiceStorage st) => LOriginationData- { lodReplaceExisting :: Bool+ { lodAliasBehavior :: AliasBehavior , lodName :: ContractAlias , lodBalance :: Mutez , lodContract :: L.Contract cp st vd , lodStorage :: st+ , lodDelegate :: Maybe L.KeyHash , lodMbFee :: Maybe Mutez } convertLOriginationData :: LOriginationData -> OriginationData convertLOriginationData LOriginationData {..} = case lodContract of (_ :: L.Contract cp st vd) ->- withDict (niceStorageEvi @st) $- withDict (niceParameterEvi @cp) $ OriginationData- { odReplaceExisting = lodReplaceExisting- , odName = lodName- , odBalance = lodBalance- , odContract = L.toMichelsonContract lodContract- , odStorage = toVal lodStorage- , odMbFee = lodMbFee- }+ OriginationData+ { odAliasBehavior = lodAliasBehavior+ , odName = lodName+ , odBalance = lodBalance+ , odContract = L.toMichelsonContract lodContract+ , odStorage = toVal lodStorage+ , odDelegate = lodDelegate+ , odMbFee = lodMbFee+ } -- | Checks that the origination result for a single contract is indeed one. singleOriginatedContract
src/Morley/Client/Action/Origination/Large.hs view
@@ -3,7 +3,7 @@ -- TODO [#606]: reconsider the implementation --- | Functions to originate large smart contracts via @tezos-client@ and node RPC.+-- | Functions to originate large smart contracts via @octez-client@ and node RPC. -- -- This is based on a workaround leveraging the lack of gas cost limits on -- internal transactions produced by @CREATE_CONTRACT@.@@ -55,6 +55,7 @@ import Morley.Michelson.Untyped.Annotation (annQ, noAnn) import Morley.Tezos.Address import Morley.Tezos.Address.Alias+import Morley.Util.Constrained -- | Just a utility type to hold 'SomeLargeContractOriginator' and its large -- contract 'OriginationData'.@@ -218,17 +219,19 @@ -- the large contract of the given 'OriginationData' for the sender -- t'ImplicitAddress'. mkLargeOriginatorData- :: ImplicitAddress -> LargeOriginationData+ :: ImplicitAddress+ -> LargeOriginationData -> OriginationData mkLargeOriginatorData sender' LargeOriginationData{..} = case largeOriginator of SomeLargeContractOriginator heavyVal origContract _origLambda -> OriginationData- { odReplaceExisting = odReplaceExisting $ largeContractData+ { odAliasBehavior = odAliasBehavior largeContractData , odName = ContractAlias $ "largeOriginator." <> unAlias (odName largeContractData) , odBalance = zeroMutez -- Note ^ we don't transfer any balance here, we instead do it as part of the -- last transaction (where it will be transferred to the large contract) , odContract = origContract , odStorage = mkLargeOriginatorStore heavyVal sender'+ , odDelegate = odDelegate largeContractData , odMbFee = odMbFee largeContractData } @@ -243,14 +246,14 @@ SomeLargeContractOriginator _ _ origLambda -> let lambdaChunks = divideValueInChunks origLambda doRunLambda = TransactionData @'T.TUnit $ TD- { tdReceiver = MkConstrainedAddress originatorAddr+ { tdReceiver = Constrained originatorAddr , tdAmount = odBalance , tdEpName = eprName $ Call @"run_lambda" , tdParam = VUnit , tdMbFee = odMbFee } mkLoadLambda bytes = TransactionData @'T.TBytes $ TD- { tdReceiver = MkConstrainedAddress originatorAddr+ { tdReceiver = Constrained originatorAddr , tdAmount = zeroMutez , tdEpName = eprName $ Call @"load_lambda" , tdParam = VBytes bytes@@ -273,11 +276,10 @@ -- and also something went wrong if this has a big_map or ticket in its *value* let completedStore = fromExpression @(Value (LargeOriginatorStore 'T.TUnit)) expr case completedStore of- Right (VPair (_, VOr (Left largeVAddr))) -> do- MkConstrainedAddress largeAddr <- pure $ fromVal @Address largeVAddr- case largeAddr of- ContractAddress{} -> do- rememberContract odReplaceExisting largeAddr odName+ Right (VPair (_, VOr (Left largeVAddr))) ->+ withConstrained (fromVal @Address largeVAddr) \case+ largeAddr@ContractAddress{} -> do+ rememberContract odAliasBehavior largeAddr odName pure largeAddr _ -> error "impossible" _ -> throwM RpcOriginatedNoContracts
src/Morley/Client/Action/Reveal.hs view
@@ -19,48 +19,54 @@ import Morley.Client.RPC.Types import Morley.Client.TezosClient (HasTezosClient) import Morley.Client.Types-import Morley.Tezos.Address+import Morley.Tezos.Address (mkKeyAddress) import Morley.Tezos.Address.Alias (AddressOrAlias(..))+import Morley.Tezos.Core (Mutez)+import Morley.Tezos.Crypto (PublicKey) -- | Reveal given key. --+-- Note that sender is implicitly defined by the key being revealed, as you can+-- only reveal your own key.+-- -- This is a variation of key revealing method that tries to use solely RPC.--- TODO [#873] remove HasTezosClient dependency revealKey+-- TODO [#873] remove HasTezosClient dependency :: forall m env. ( HasTezosRpc m , HasTezosClient m , WithClientLog env m )- => ImplicitAddress- -> RevealData+ => PublicKey+ -> Maybe Mutez -> m OperationHash-revealKey sender revealing = do- (mOpHash, _) <- runOperations (AddressResolved sender) [OpReveal revealing]- case mOpHash of- Just hash -> return hash- _ -> throwM RpcNoOperationsRun+revealKey rdPublicKey rdMbFee =+ fmap fst . runOperationsNonEmpty (AddressResolved sender) . one $ OpReveal RevealData{..}+ where+ sender = mkKeyAddress rdPublicKey -- | Reveal given key.--- TODO [#873] remove HasTezosClient dependency+--+-- Note that sender is implicitly defined by the key being revealed, as you can+-- only reveal your own key. revealKeyUnlessRevealed+-- TODO [#873] remove HasTezosClient dependency :: forall m env. ( HasTezosRpc m , HasTezosClient m , WithClientLog env m )- => ImplicitAddress- -> RevealData+ => PublicKey+ -> Maybe Mutez -> m ()-revealKeyUnlessRevealed sender param = do+revealKeyUnlessRevealed key mbFee = do -- An optimization for the average case, but we can't rely on it in -- distributed environment- mManagerKey <- getManagerKey sender- case mManagerKey of+ let sender = mkKeyAddress key+ getManagerKey sender >>= \case Just _ -> logDebug $ sender |+ " address has already revealed key"- Nothing -> ignoreAlreadyRevealedError $ void (revealKey sender param)+ Nothing -> ignoreAlreadyRevealedError . void $ revealKey key mbFee where- ignoreAlreadyRevealedError action =- action `catch` \case- RunCodeErrors [PreviouslyRevealedKey _] -> pass- e -> throwM e+ ignoreAlreadyRevealedError = flip catch \case+ RunCodeErrors [PreviouslyRevealedKey _] -> pass+ e -> throwM e
src/Morley/Client/Action/Transaction.hs view
@@ -1,6 +1,6 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA--- | Functions to submit transactions via @tezos-client@ and node RPC.+-- | Functions to submit transactions via @octez-client@ and node RPC. module Morley.Client.Action.Transaction ( runTransactions@@ -21,7 +21,6 @@ import Morley.Client.Action.Operation import Morley.Client.Logging import Morley.Client.RPC.Class-import Morley.Client.RPC.Error import Morley.Client.RPC.Types import Morley.Client.TezosClient.Class import Morley.Client.Types@@ -32,9 +31,8 @@ import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (Mutez) --- | Perform sequence of transactions to the contract, each transactions should be--- defined via @EntrypointParam t@. Returns operation hash and block in which--- this operation appears or @Nothing@ in case empty list was provided.+-- | Perform sequence of transactions to the contract. Returns operation hash+-- and a list of RPC responses, or 'Nothing' in case an empty list was provided. runTransactions :: forall m env. ( HasTezosRpc m@@ -42,11 +40,24 @@ , WithClientLog env m ) => ImplicitAddress -> [TransactionData]- -> m (Maybe OperationHash)-runTransactions sender transactions = do- (opHash, _) <- runOperations (AddressResolved sender) (OpTransfer <$> transactions)- return opHash+ -> m (Maybe (OperationHash, [OperationInfo Result]))+runTransactions sender transactions = runMaybeT do+ ts <- hoistMaybe $ nonEmpty transactions+ lift $ second toList <$> runTransactionsNonEmpty sender ts +-- | Perform sequence of transactions to the contract. Returns operation hash+-- and a list of RPC responses.+runTransactionsNonEmpty+ :: forall m env.+ ( HasTezosRpc m+ , HasTezosClient m+ , WithClientLog env m+ )+ => ImplicitAddress -> NonEmpty TransactionData+ -> m (OperationHash, NonEmpty (OperationInfo Result))+runTransactionsNonEmpty sender =+ runOperationsNonEmpty (AddressResolved sender) . map OpTransfer+ -- | Lorentz version of 'TransactionData'. data LTransactionData where LTransactionData ::@@ -62,20 +73,13 @@ ) => ImplicitAddress -> [LTransactionData]- -> m (Maybe OperationHash)+ -> m (Maybe (OperationHash, [OperationInfo Result])) lRunTransactions sender transactions = runTransactions sender $ map convertLTransactionData transactions where convertLTransactionData :: LTransactionData -> TransactionData- convertLTransactionData (LTransactionData (TD {..} :: TD t))=- withDict (niceParameterEvi @t) $- TransactionData TD- { tdReceiver = tdReceiver- , tdEpName = tdEpName- , tdAmount = tdAmount- , tdParam = T.toVal tdParam- , tdMbFee = tdMbFee- }+ convertLTransactionData (LTransactionData TD{tdParam=T.toVal -> tdParam, ..}) =+ TransactionData TD{..} transfer :: forall m t env kind.@@ -91,20 +95,13 @@ -> EpName -> T.Value t -> Maybe Mutez- -> m OperationHash-transfer from to amount epName param mbFee = do- res <- runTransactions from $- [TransactionData TD- { tdReceiver = MkConstrainedAddress to- , tdAmount = amount- , tdEpName = epName- , tdParam = param- , tdMbFee = mbFee- }- ]- case res of- Just hash -> return hash- _ -> throwM RpcNoOperationsRun+ -> m (OperationHash, [IntOpEvent])+transfer from (Constrained -> tdReceiver) tdAmount tdEpName tdParam tdMbFee =+ (fmap . second) (getEvents . toList) . runTransactionsNonEmpty from . one $ TransactionData TD{..}+ where+ getEvents = concatMap \case+ OpTransfer i -> i+ _ -> [] lTransfer :: forall m t env kind.@@ -120,7 +117,5 @@ -> EpName -> t -> Maybe Mutez- -> m OperationHash-lTransfer from to amount epName param mbFee =- withDict (niceParameterEvi @t) $- transfer from to amount epName (T.toVal param) mbFee+ -> m (OperationHash, [IntOpEvent])+lTransfer from to amount epName = transfer from to amount epName . T.toVal
src/Morley/Client/App.hs view
@@ -192,7 +192,7 @@ retryOnceOnTimeout ... fmap unTezosMutez ... API.getBalance API.nodeMethods getDelegateImpl ::- (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> ContractAddress -> m (Maybe KeyHash)+ (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> L1Address -> m (Maybe KeyHash) getDelegateImpl = retryOnceOnTimeout ... API.getDelegate API.nodeMethods @@ -349,7 +349,7 @@ -- | Helper function that retries action once in case of timeout. If retry ended up with timeout -- as well, action is considered failed. It's safe to retry read-only actions that don't update chain state--- or @tezos-client@ config/environment.+-- or @octez-client@ config/environment. retryOnceOnTimeout :: (MonadUnliftIO m, MonadThrow m) => m a -> m a retryOnceOnTimeout = retryOnTimeout False
− src/Morley/Client/Env.hs
@@ -1,42 +0,0 @@--- SPDX-FileCopyrightText: 2021 Oxhead Alpha--- SPDX-License-Identifier: LicenseRef-MIT-OA---- | Runtime environment for @morley-client@.--module Morley.Client.Env- ( MorleyClientEnv' (..)-- -- * Lens- , mceTezosClientL- , mceLogActionL- , mceSecretKeyL- , mceClientEnvL- ) where--import Control.Lens (lens)-import Morley.Util.Lens (makeLensesWith, postfixLFields)-import Servant.Client (ClientEnv)--import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519--import Morley.Client.Logging (ClientLogAction)-import Morley.Client.TezosClient.Types---- | Runtime environment for morley client.-data MorleyClientEnv' m = MorleyClientEnv- { mceTezosClient :: TezosClientEnv- -- ^ Environment for @tezos-client@.- , mceLogAction :: ClientLogAction m- -- ^ Action used to log messages.- , mceSecretKey :: Maybe Ed25519.SecretKey- -- ^ Pass if you want to sign operations manually or leave it- -- to tezos-client- , mceClientEnv :: ClientEnv- -- ^ Environment necessary to make HTTP calls.- }--makeLensesWith postfixLFields ''MorleyClientEnv'--instance HasTezosClientEnv (MorleyClientEnv' m) where- tezosClientEnvL =- lens mceTezosClient (\mce tce -> mce { mceTezosClient = tce })
src/Morley/Client/Full.hs view
@@ -4,26 +4,58 @@ -- | Implementation of full-featured Morley client. module Morley.Client.Full- ( MorleyClientEnv+ ( MorleyClientEnv(..)+ , MorleyClientConfig (..) , MorleyClientM , runMorleyClientM+ , mkMorleyClientEnv+ , mkLogAction+ -- * Lens+ , mceTezosClientL+ , mceLogActionL+ , mceSecretKeyL+ , mceClientEnvL+ , mccEndpointUrlL+ , mccTezosClientPathL+ , mccMbTezosClientDataDirL+ , mccVerbosityL+ , mccSecretKeyL ) where import Colog (HasLog(..), Message) import Network.HTTP.Types (Status(..))+import Servant.Client (ClientEnv) import Servant.Client.Core (Request, Response, RunClient(..))+import System.Environment (lookupEnv) import UnliftIO (MonadUnliftIO) import Morley.Client.App-import Morley.Client.Env (MorleyClientEnv'(..))+import Morley.Client.Init+import Morley.Client.Logging (ClientLogAction) import Morley.Client.RPC.Class+import Morley.Client.RPC.HttpClient import Morley.Client.TezosClient.Class+import Morley.Client.TezosClient.Impl (getTezosClientConfig) import Morley.Client.TezosClient.Impl qualified as TezosClient+import Morley.Client.TezosClient.Types import Morley.Tezos.Crypto (Signature(..)) import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519+import Morley.Util.Lens (makeLensesWith, postfixLFields) -type MorleyClientEnv = MorleyClientEnv' MorleyClientM +-- | Runtime environment for morley client.+data MorleyClientEnv = MorleyClientEnv+ { mceTezosClient :: TezosClientEnv+ -- ^ Environment for @octez-client@.+ , mceLogAction :: ClientLogAction MorleyClientM+ -- ^ Action used to log messages.+ , mceSecretKey :: Maybe Ed25519.SecretKey+ -- ^ Pass if you want to sign operations manually or leave it+ -- to @octez-client@.+ , mceClientEnv :: ClientEnv+ -- ^ Environment necessary to make HTTP calls.+ }+ newtype MorleyClientM a = MorleyClientM { unMorleyClientM :: ReaderT MorleyClientEnv IO a } deriving newtype@@ -36,6 +68,11 @@ runMorleyClientM :: MorleyClientEnv -> MorleyClientM a -> IO a runMorleyClientM env client = runReaderT (unMorleyClientM client) env +makeLensesWith postfixLFields ''MorleyClientEnv++instance HasTezosClientEnv MorleyClientEnv where+ tezosClientEnvL = mceTezosClientL+ instance HasLog MorleyClientEnv Message MorleyClientM where getLogAction = mceLogAction setLogAction action mce = mce { mceLogAction = action }@@ -47,14 +84,12 @@ Just sk -> pure . SignatureEd25519 $ Ed25519.sign sk opHash Nothing -> TezosClient.signBytes senderAlias mbPassword opHash rememberContract = failOnTimeout ... TezosClient.rememberContract- resolveAddressMaybe = retryOnceOnTimeout ... TezosClient.resolveAddressMaybe- getAlias = retryOnceOnTimeout ... TezosClient.getAlias+ getAliasesAndAddresses = retryOnceOnTimeout ... TezosClient.getAliasesAndAddresses genFreshKey = retryOnceOnTimeout ... TezosClient.genFreshKey genKey = failOnTimeout ... TezosClient.genKey -- Key revealing cannot be safely retried, so we're not trying to recover it -- from @ECONNRESET@. revealKey = failOnTimeout ... TezosClient.revealKey- registerDelegate = failOnTimeout ... TezosClient.registerDelegate getKeyPassword = retryOnceOnTimeout . TezosClient.getKeyPassword instance RunClient MorleyClientM where@@ -88,3 +123,32 @@ getChainId = getChainIdImpl getManagerKeyAtBlock = getManagerKeyImpl waitForOperation = (asks mceClientEnv >>=) . waitForOperationImpl+++-- | Construct 'MorleyClientEnv'.+--+-- * @octez-client@ path is taken from 'MorleyClientConfig', but can be+-- overridden using @MORLEY_TEZOS_CLIENT@ environment variable.+-- * Node data is taken from @octez-client@ config and can be overridden+-- by 'MorleyClientConfig'.+-- * The rest is taken from 'MorleyClientConfig' as is.+mkMorleyClientEnv :: MorleyClientConfig -> IO MorleyClientEnv+mkMorleyClientEnv MorleyClientConfig{..} = do+ envTezosClientPath <- lookupEnv "MORLEY_TEZOS_CLIENT"+ let tezosClientPath = fromMaybe mccTezosClientPath envTezosClientPath+ TezosClientConfig {..} <- getTezosClientConfig tezosClientPath mccMbTezosClientDataDir+ let+ endpointUrl = fromMaybe tcEndpointUrl mccEndpointUrl+ tezosClientEnv = TezosClientEnv+ { tceEndpointUrl = endpointUrl+ , tceTezosClientPath = tezosClientPath+ , tceMbTezosClientDataDir = mccMbTezosClientDataDir+ }++ clientEnv <- newClientEnv endpointUrl+ pure MorleyClientEnv+ { mceTezosClient = tezosClientEnv+ , mceLogAction = mkLogAction mccVerbosity+ , mceSecretKey = mccSecretKey+ , mceClientEnv = clientEnv+ }
src/Morley/Client/Init.hs view
@@ -3,8 +3,7 @@ -- | Morley client initialization. module Morley.Client.Init- ( MorleyClientConfig (..)- , mkMorleyClientEnv+ ( MorleyClientConfig(..) , mkLogAction -- * Lens@@ -15,17 +14,13 @@ , mccSecretKeyL ) where -import Colog (cmap, fmtMessage, logTextStderr, msgSeverity)-import Colog.Core (Severity(..), filterBySeverity)+import Colog+ (Msg(..), Severity(..), cmapM, defaultFieldMap, filterBySeverity, fmtRichMessageCustomDefault,+ logTextStderr, msgSeverity, showSeverity, showSourceLoc, showTime, upgradeMessageAction) import Morley.Util.Lens import Servant.Client (BaseUrl(..))-import System.Environment (lookupEnv) -import Morley.Client.Env import Morley.Client.Logging (ClientLogAction, logFlush)-import Morley.Client.RPC.HttpClient-import Morley.Client.TezosClient.Impl (getTezosClientConfig)-import Morley.Client.TezosClient.Types import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519 -- | Data necessary for morley client initialization.@@ -33,10 +28,10 @@ { mccEndpointUrl :: Maybe BaseUrl -- ^ URL of tezos endpoint on which operations are performed , mccTezosClientPath :: FilePath- -- ^ Path to @tezos-client@ binary through which operations are+ -- ^ Path to @octez-client@ binary through which operations are -- performed , mccMbTezosClientDataDir :: Maybe FilePath- -- ^ Path to @tezos-client@ data directory.+ -- ^ Path to @octez-client@ data directory. , mccVerbosity :: Word -- ^ Verbosity level. @0@ means that only important messages will be -- printed. The greater this value is, the more messages will be@@ -46,43 +41,24 @@ -- ^ Custom secret key to use for signing. } deriving stock Show -makeLensesWith postfixLFields ''MorleyClientConfig --- | Construct 'MorleyClientEnv'.------ * @tezos-client@ path is taken from 'MorleyClientConfig', but can be--- overridden using @MORLEY_TEZOS_CLIENT@ environment variable.--- * Node data is taken from @tezos-client@ config and can be overridden--- by 'MorleyClientConfig'.--- * The rest is taken from 'MorleyClientConfig' as is.-mkMorleyClientEnv :: MonadIO m => MorleyClientConfig -> IO (MorleyClientEnv' m)-mkMorleyClientEnv MorleyClientConfig{..} = do- envTezosClientPath <- lookupEnv "MORLEY_TEZOS_CLIENT"- let tezosClientPath = fromMaybe mccTezosClientPath envTezosClientPath- TezosClientConfig {..} <- getTezosClientConfig tezosClientPath mccMbTezosClientDataDir- let- endpointUrl = fromMaybe tcEndpointUrl mccEndpointUrl- tezosClientEnv = TezosClientEnv- { tceEndpointUrl = endpointUrl- , tceTezosClientPath = tezosClientPath- , tceMbTezosClientDataDir = mccMbTezosClientDataDir- }-- clientEnv <- newClientEnv endpointUrl- pure MorleyClientEnv- { mceTezosClient = tezosClientEnv- , mceLogAction = mkLogAction mccVerbosity- , mceSecretKey = mccSecretKey- , mceClientEnv = clientEnv- }+makeLensesWith postfixLFields ''MorleyClientConfig -- | Make appropriate 'ClientLogAction' based on verbosity specified by the user. mkLogAction :: MonadIO m => Word -> ClientLogAction m mkLogAction verbosity =- filterBySeverity severity msgSeverity (fmtMessage `cmap` logTextStderrFlush)+ filterBySeverity severity msgSeverity $+ upgradeMessageAction defaultFieldMap $+ flip fmtRichMessageCustomDefault fmt `cmapM` logTextStderrFlush where severity = case verbosity of 0 -> Warning 1 -> Info _ -> Debug logTextStderrFlush = logTextStderr <> logFlush stderr+ -- NB: ignoring thread id because it's not informative here+ fmt _ (maybe "" showTime -> time) Msg{..} =+ showSeverity msgSeverity+ <> time+ <> (if verbosity > 2 then showSourceLoc msgStack else mempty)+ <> msgText
src/Morley/Client/OnlyRPC.hs view
@@ -2,7 +2,7 @@ -- SPDX-License-Identifier: LicenseRef-MIT-OA -- | An alternative implementation of @morley-client@ that does not require--- @tezos-client@ and has some limitations because of that (not all methods+-- @octez-client@ and has some limitations because of that (not all methods -- are implemented). module Morley.Client.OnlyRPC@@ -16,7 +16,7 @@ import Colog (HasLog(..), Message) import Control.Lens (at) import Data.Map.Strict qualified as Map-import Fmt ((+|), (|+))+import Fmt (pretty, (+|), (|+)) import Servant.Client (BaseUrl, ClientEnv) import Servant.Client.Core (RunClient(..)) import UnliftIO (MonadUnliftIO)@@ -123,22 +123,19 @@ -- Stateful actions that simply do nothing because there is no persistent state. rememberContract = \_ _ _ -> pass - -- We return a dummy value here, because this function is used in a lot of+ -- We return a dummy alias here, because this function is used in a lot of -- places and with an exception here it's not possible to send transactions. -- So be aware of this and do not rely on this value!- -- TODO [#652]: consider using a `Map` instead- getAlias = \case- AddressResolved x -> case x of- ContractAddress{} -> pure $ ContractAlias "MorleyOnlyRpc"- ImplicitAddress{} -> pure $ ImplicitAlias "MorleyOnlyRpc"- AddressAlias a -> pure a+ -- TODO [#652] [#910]: consider using a `Map` instead+ getAliasesAndAddresses = do+ implicitAddrs <- asks moreSecretKeys+ pure $+ keys implicitAddrs <&> \implicitAddr -> ("MorleyOnlyRpc", pretty implicitAddr) -- Actions that are not supported and simply throw exceptions. genKey _ = throwM $ UnsupportedByOnlyRPC "genKey" genFreshKey _ = throwM $ UnsupportedByOnlyRPC "genFreshKey" revealKey _ _ = throwM $ UnsupportedByOnlyRPC "revealKey"- resolveAddressMaybe _ = throwM $ UnsupportedByOnlyRPC "resolveAddressMaybe"- registerDelegate _ _ = throwM $ UnsupportedByOnlyRPC "registerDelegate" instance RunClient MorleyOnlyRpcM where runRequestAcceptStatus statuses req = do
src/Morley/Client/Parser.hs view
@@ -26,7 +26,9 @@ import Options.Applicative.Help.Pretty (Doc, linebreak) import Servant.Client (BaseUrl(..), parseBaseUrl) -import Morley.CLI (addressOrAliasOption, mutezOption, parserInfo, valueOption)+import Morley.CLI+ (addressOrAliasOption, keyHashOption, mutezOption, parserInfo, someAddressOrAliasOption,+ valueOption) import Morley.Client.Init import Morley.Client.RPC.Types (BlockId(HeadId)) import Morley.Michelson.Untyped qualified as U@@ -34,6 +36,7 @@ import Morley.Tezos.Address.Alias import Morley.Tezos.Address.Kinds import Morley.Tezos.Core+import Morley.Tezos.Crypto import Morley.Util.CLI (mkCLOptionParser, mkCommandParser) import Morley.Util.Named @@ -55,6 +58,7 @@ , oaInitialStorage :: U.Value , oaOriginateFrom :: ImplicitAddressOrAlias , oaMbFee :: Maybe Mutez+ , oaDelegate :: Maybe KeyHash } data GetScriptSizeArgs = GetScriptSizeArgs@@ -94,7 +98,7 @@ verboseSwitch :: Opt.Parser () verboseSwitch = Opt.flag' () . mconcat $ [ short 'V'- , help "Increase verbosity (pass several times to increase further)"+ , help "Increase verbosity (pass several times to increase further)." ] -- | Parses URL of the Tezos node.@@ -102,21 +106,21 @@ endpointOption = optional . option baseUrlReader $ long "endpoint" <> short 'E'- <> help "URL of the remote Tezos node"+ <> help "URL of the remote Tezos node." <> metavar "URL" pathOption :: Opt.Parser FilePath pathOption = strOption $ mconcat [ short 'I', long "client-path", metavar "PATH"- , help "Path to tezos-client binary"- , value "tezos-client"+ , help "Path to `octez-client` binary."+ , value "octez-client" , Opt.showDefault ] dataDirOption :: Opt.Parser (Maybe FilePath) dataDirOption = optional $ strOption $ mconcat [ short 'd', long "data-dir", metavar "PATH"- , help "Path to tezos-client data directory"+ , help "Path to `octez-client` data directory." ] feeOption :: Opt.Parser (Maybe Mutez)@@ -148,11 +152,11 @@ originateCmd = mkCommandParser "originate" (Originate <$> originateArgsOption)- "Originate passed contract on real network"+ "Originate passed contract on real network." transferCmd = mkCommandParser "transfer" (Transfer <$> transferArgsOption)- "Perform a transfer to the given contract with given amount and parameter"+ "Perform a transfer to the given contract with given amount and parameter." getBalanceCmd = mkCommandParser "get-balance" ((GetBalance <$>@@ -195,42 +199,47 @@ mutezOption (Just zeroMutez) (#name :! "initial-balance")- (#help :! "Inital balance of the contract")+ (#help :! "Inital balance of the contract.") oaInitialStorage <- valueOption Nothing (#name :! "initial-storage")- (#help :! "Initial contract storage value")+ (#help :! "Initial contract storage value.") oaOriginateFrom <- addressOrAliasOption Nothing (#name :! "from")- (#help :! "Address or alias of address from which origination is performed")+ (#help :! "Address or alias of address from which origination is performed.") oaMbFee <- feeOption+ oaDelegate <- optional $+ keyHashOption+ Nothing+ (#name :! "delegate")+ (#help :! "Key hash of the contract's delegate") pure $ OriginateArgs {..} getScriptSizeArgsOption :: Opt.Parser GetScriptSizeArgs getScriptSizeArgsOption = GetScriptSizeArgs <$> scriptFileOption <*> valueOption Nothing (#name :! "storage")- (#help :! "Contract storage value")+ (#help :! "Contract storage value.") mbContractFileOption :: Opt.Parser (Maybe FilePath) mbContractFileOption = optional . strOption $ mconcat [ long "contract", metavar "FILEPATH"- , help "Path to contract file"+ , help "Path to contract file." ] scriptFileOption :: Opt.Parser FilePath scriptFileOption = strOption $ mconcat [ long "script", metavar "FILEPATH"- , help "Path to script file"+ , help "Path to script file." ] contractNameOption :: Opt.Parser ContractAlias contractNameOption = fmap ContractAlias . strOption $ mconcat [ long "contract-name" , value "stdin"- , help "Alias of originated contract"+ , help "Alias of originated contract." ] transferArgsOption :: Opt.Parser TransferArgs@@ -239,26 +248,22 @@ addressOrAliasOption Nothing (#name :! "from")- (#help :! "Address or alias from which transfer is performed")+ (#help :! "Address or alias from which transfer is performed.") taDestination <-- SomeAddressOrAlias <$> addressOrAliasOption @'AddressKindImplicit- Nothing- (#name :! "to-implicit")- (#help :! "Address or alias of the transfer's destination implicit address")- <|> SomeAddressOrAlias <$> addressOrAliasOption @'AddressKindContract+ someAddressOrAliasOption Nothing- (#name :! "to-contract")- (#help :! "Address or alias of the transfer's destination contract")+ (#name :! "to")+ (#help :! "Address or alias of the transfer's destination.") taAmount <- mutezOption (Just zeroMutez) (#name :! "amount")- (#help :! "Transfer amount")+ (#help :! "Transfer amount.") taParameter <- valueOption Nothing (#name :! "parameter")- (#help :! "Transfer parameter")+ (#help :! "Transfer parameter.") taMbFee <- feeOption pure $ TransferArgs {..}
src/Morley/Client/RPC/API.hs view
@@ -1,8 +1,7 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | This module contains servant types for tezos-node--- RPC API.+-- | This module contains servant types for @octez-node@ RPC API. module Morley.Client.RPC.API ( NodeMethods (..) , nodeMethods@@ -63,7 +62,7 @@ -- It takes a big_map ID instead of a contract ID, so it naturally supports -- contracts with multiple big maps. -- The 'script_expr' is the `Script-expression-ID-Hash` obtained by either:- -- 1) calling `tezos-client hash data '123' of type int`.+ -- 1) calling `octez-client hash data '123' of type int`. -- 2) or using 'Lorentz.Pack.valueToScriptExpr' and then base58 encode it. Capture "block_id" BlockId :> "context" :> "big_maps" :> Capture "big_map_id" Natural@@ -80,7 +79,7 @@ :> Capture "contract" Address' :> "balance" :> Get '[JSON] TezosMutez :<|> Capture "block_id" BlockId :> "context" :> "contracts"- :> Capture "contract" ContractAddress' :> "delegate" :> Get '[JSON] KeyHash :<|>+ :> Capture "contract" Address' :> "delegate" :> Get '[JSON] KeyHash :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "address" ImplicitAddress' :> "manager_key" :> Get '[JSON] (Maybe PublicKey) :<|>@@ -140,7 +139,7 @@ , getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression , getBigMapValuesAtBlock :: BlockId -> Natural -> Maybe Natural -> Maybe Natural -> m Expression , getBalance :: BlockId -> Address -> m TezosMutez- , getDelegate :: BlockId -> ContractAddress -> m (Maybe KeyHash)+ , getDelegate :: BlockId -> L1Address -> m (Maybe KeyHash) , getScriptSizeAtBlock :: BlockId -> CalcSize -> m ScriptSize , forgeOperation :: BlockId -> ForgeOperation -> m HexJSONByteString , runOperation :: BlockId -> RunOperation -> m RunOperationResult@@ -162,8 +161,8 @@ , getStorageAtBlock = withKindedAddress' getStorageAtBlock' , getBigMap = withKindedAddress' getBigMap' , getBalance = withAddress' getBalance'- , getDelegate = \block addr -> do- result <- try $ getDelegate' block (KindedAddress' addr)+ , getDelegate = \block (Constrained addr) -> do+ result <- try $ getDelegate' block (Address' $ MkAddress addr) case result of Left (FailureResponse _ Response{responseStatusCode=Status{statusCode = 404}}) -> pure Nothing@@ -175,7 +174,6 @@ where withKindedAddress' f blockId = f blockId . KindedAddress' withAddress' f blockId = f blockId . Address'- getDelegate' :: BlockId -> ContractAddress' -> m KeyHash (getBlockHash :<|> getCounter' :<|> getScript'
src/Morley/Client/RPC/Class.hs view
@@ -69,11 +69,11 @@ -- ^ Get all big map values at some block by the big map's ID and the optional offset and length. getBalanceAtBlock :: BlockId -> Address -> m Mutez -- ^ Get balance for given address.- getDelegateAtBlock :: BlockId -> ContractAddress -> m (Maybe KeyHash)+ getDelegateAtBlock :: BlockId -> L1Address -> m (Maybe KeyHash) -- ^ Get delegate for given address. runCodeAtBlock :: BlockId -> RunCode -> m RunCodeResult -- ^ Emulate contract call. This RPC endpoint does the same as- -- @tezos-client run script@ command does.+ -- @octez-client run script@ command does. getChainId :: m ChainId -- ^ Get current @ChainId@ getManagerKeyAtBlock :: BlockId -> ImplicitAddress -> m (Maybe PublicKey)
src/Morley/Client/RPC/Error.hs view
@@ -48,6 +48,10 @@ -- ^ A key has already been revealed. ImplicitAddress -- ^ The address corresponding to the key.+ | DelegateNotRegistered+ -- ^ Address not registered as delegate+ ImplicitAddress+ -- ^ The address in question. | ClientInternalError -- ^ An error that RPC considers internal occurred. These errors -- are considered internal by mistake, they are actually quite@@ -71,6 +75,7 @@ ShiftOverflow addr -> addr |+ " failed due to shift overflow" GasExhaustion addr -> addr |+ " failed due to gas exhaustion" KeyAlreadyRevealed addr -> "Key for " +| addr |+ " has already been revealed"+ DelegateNotRegistered addr -> addr |+ " not registered as delegate" ClientInternalError err -> build err instance Exception ClientRpcError where@@ -119,7 +124,6 @@ data IncorrectRpcResponse = RpcUnexpectedSize Int Int | RpcOriginatedNoContracts- | RpcNoOperationsRun | RpcOriginatedMoreContracts [ContractAddress] deriving stock Show @@ -133,8 +137,6 @@ mconcat (map ((<> "\n") . build) addresses) |+ "" RpcOriginatedNoContracts -> "Operation expected to originate a contract, but produced nothing"- RpcNoOperationsRun ->- "No operations was run" instance Exception IncorrectRpcResponse where displayException = pretty
src/Morley/Client/RPC/Getters.hs view
@@ -39,7 +39,7 @@ import Network.HTTP.Types.Status (statusCode) import Servant.Client (ClientError(..), responseStatusCode) -import Lorentz (NicePackedValue, NiceUnpackedValue, niceUnpackedValueEvi, valueToScriptExpr)+import Lorentz (NicePackedValue, NiceUnpackedValue, valueToScriptExpr) import Lorentz.Value import Morley.Micheline import Morley.Michelson.TypeCheck.TypeCheck@@ -120,10 +120,9 @@ => BigMapId k v -> k -> m v readBigMapValue (BigMapId bigMapId) key = getBigMapValue bigMapId scriptExpr >>= \expr ->- withDict (niceUnpackedValueEvi @v) $- case fromVal <$> fromExpression expr of- Right v -> pure v- Left _ -> throwM $ ValueDecodeFailure "big map value" (demote @(ToT k))+ case fromVal <$> fromExpression expr of+ Right v -> pure v+ Left _ -> throwM $ ValueDecodeFailure "big map value" (demote @(ToT k)) where scriptExpr = encodeBase58Check $ valueToScriptExpr key @@ -148,10 +147,9 @@ => BigMapId k v -> m [v] readAllBigMapValues (BigMapId bigMapId) = getBigMapValues bigMapId Nothing Nothing >>= \expr ->- withDict (niceUnpackedValueEvi @v) $- case fromVal <$> fromExpression expr of- Right v -> pure v- Left _ -> throwM $ ValueDecodeFailure "big map value " (demote @(ToT v))+ case fromVal <$> fromExpression expr of+ Right v -> pure v+ Left _ -> throwM $ ValueDecodeFailure "big map value " (demote @(ToT v)) data ContractNotFound = ContractNotFound ContractAddress deriving stock Show@@ -253,7 +251,7 @@ getScriptSize = getScriptSizeAtBlock HeadId -- | 'getDelegateAtBlock' applied to the head block.-getDelegate :: HasTezosRpc m => ContractAddress -> m (Maybe KeyHash)+getDelegate :: HasTezosRpc m => L1Address -> m (Maybe KeyHash) getDelegate = getDelegateAtBlock HeadId -- | 'runCodeAtBlock' applied to the head block.
src/Morley/Client/RPC/Types.hs view
@@ -1,8 +1,7 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | This module contains various types which are used in--- tezos-node RPC API.+-- | This module contains various types which are used in @octez-node@ RPC API. -- -- Documentation for RPC API can be found e. g. [here](http://tezos.gitlab.io/010/rpc.html) -- (010 is the protocol, change to the desired one).@@ -23,6 +22,7 @@ , BlockId (..) , BlockOperation (..) , CommonOperationData (..)+ , DelegationOperation (..) , ForgeOperation (..) , GetBigMap (..) , CalcSize(..)@@ -77,6 +77,7 @@ , _ScriptOverflow , _PreviouslyRevealedKey , _GasExhaustedOperation+ , _UnregisteredDelegate -- * Lenses , wcoCommonDataL@@ -91,6 +92,7 @@ import Data.Default (Default(..)) import Data.Fixed (Milli) import Data.List (isSuffixOf)+import Data.Ratio ((%)) import Data.Text qualified as T import Data.Time (UTCTime) import Fmt (Buildable(..), pretty, unwordsF, (+|), (|+))@@ -105,9 +107,10 @@ import Morley.Michelson.Text (MText) import Morley.Tezos.Address import Morley.Tezos.Core (Mutez, tz, zeroMutez)-import Morley.Tezos.Crypto (PublicKey, Signature, decodeBase58CheckWithPrefix, formatSignature)+import Morley.Tezos.Crypto+ (KeyHash, PublicKey, Signature, decodeBase58CheckWithPrefix, formatSignature) import Morley.Util.CLI (HasCLReader(..), eitherReader)-import Morley.Util.Named (arg, pattern (:!), (:!), (<:!>))+import Morley.Util.Named import Morley.Util.Text (dquotes) mergeObjects :: HasCallStack => Value -> Value -> Value@@ -121,6 +124,7 @@ type TransferInfo RPCInput = TransactionOperation type OriginationInfo RPCInput = OriginationOperation type RevealInfo RPCInput = RevealOperation+ type DelegationInfo RPCInput = DelegationOperation type OperationInput = WithCommonOperationData (OperationInfo RPCInput) @@ -204,6 +208,11 @@ , ioePayload :: Maybe Expression } +instance Buildable IntOpEvent where+ build IntOpEvent{..} =+ "Contract event with source: " +| ioeSource |+ ", tag: " +| ioeTag |+ ", type: " +| ioeType |++ ", and payload: " +| ioePayload |+ ""+ instance FromJSON IntOpEvent where parseJSON = withObject "internal_operation_data_event" \o -> do IntOpEvent <$> o .: "source" <*> o .: "type" <*> o .:? "tag" <*> o .:? "payload"@@ -327,8 +336,30 @@ -- ^ Minimal delay between two blocks, this constant is new in V010. , ppCostPerByte :: TezosMutez -- ^ Burn cost per storage byte+ , ppHardGasLimitPerBlock :: TezosInt64+ -- ^ Gas limit for a single block. } +-- | Details of a @BadStack@ error.+data BadStackInformation = BadStackInformation+ { bsiLocation :: Int+ , bsiStackPortion :: Int+ , bsiPrim :: Text+ , bsiStack :: Expression+ } deriving stock (Eq, Show)++instance FromJSON BadStackInformation where+ parseJSON = withObject "BadStack" $ \o -> BadStackInformation+ <$> o .: "location"+ <*> o .: "relevant_stack_portion"+ <*> o .: "primitive_name"+ <*> o .: "wrong_stack_type"++instance Buildable BadStackInformation where+ build (BadStackInformation loc stack_portion prim stack_type) =+ "Bad Stack in location " +| loc |+ " stack portion " +| stack_portion |++ " on primitive " +| prim |+ " with (wrong) stack type " +| stack_type |+ ""+ -- | Errors that are sent as part of operation result in an OK -- response (status 200). They are semi-formally defined as errors -- that can happen when a contract is executed and something goes@@ -363,63 +394,63 @@ | PreviouslyRevealedKey ImplicitAddress | NonExistingContract Address | InvalidB58Check Text+ | UnregisteredDelegate ImplicitAddress+ | FailedUnDelegation ImplicitAddress+ | DelegateAlreadyActive+ | IllTypedContract Expression+ | IllTypedData Expression Expression+ | BadStack BadStackInformation+ | ForbiddenZeroAmountTicket deriving stock Show instance FromJSON RunError where parseJSON = withObject "preapply error" $ \o -> do id' <- o .: "id"- case id' of- x | "runtime_error" `isSuffixOf` x ->- RuntimeError <$> o .: "contract_handle"- x | "script_rejected" `isSuffixOf` x ->- ScriptRejected <$> o .: "with"- x | "bad_contract_parameter" `isSuffixOf` x ->- BadContractParameter <$> o .: "contract"- x | "invalid_constant" `isSuffixOf` x ->- InvalidConstant <$> o .: "expected_type" <*> o .: "wrong_expression"- x | "invalid_contract" `isSuffixOf` x ->- InvalidContract <$> o.: "contract"- x | "inconsistent_types" `isSuffixOf` x ->- InconsistentTypes <$> o .: "first_type" <*> o .: "other_type"- x | "invalid_primitive" `isSuffixOf` x ->+ decode id'+ [ "runtime_error" ~> RuntimeError <$> o .: "contract_handle"+ , "script_rejected" ~> ScriptRejected <$> o .: "with"+ , "bad_contract_parameter" ~> BadContractParameter <$> o .: "contract"+ , "invalid_constant" ~> InvalidConstant <$> o .: "expected_type" <*> o .: "wrong_expression"+ , "invalid_contract" ~> InvalidContract <$> o.: "contract"+ , "inconsistent_types" ~> InconsistentTypes <$> o .: "first_type" <*> o .: "other_type"+ , "invalid_primitive" ~> InvalidPrimitive <$> o .: "expected_primitive_names" <*> o .: "wrong_primitive_name"- x | "invalidSyntacticConstantError" `isSuffixOf` x ->+ , "invalidSyntacticConstantError" ~> InvalidSyntacticConstantError <$> o .: "expectedForm" <*> o .: "wrongExpression"- x | "invalid_expression_kind" `isSuffixOf` x ->+ , "invalid_expression_kind" ~> InvalidExpressionKind <$> o .: "expected_kinds" <*> o .: "wrong_kind"- x | "invalid_contract_notation" `isSuffixOf` x ->- InvalidContractNotation <$> o .: "notation"- x | "unexpected_contract" `isSuffixOf` x ->- pure UnexpectedContract- x | "ill_formed_type" `isSuffixOf` x ->- IllFormedType <$> o .: "ill_formed_expression"- x | "unexpected_operation" `isSuffixOf` x ->- pure UnexpectedOperation- x | "empty_transaction" `isSuffixOf` x ->- REEmptyTransaction <$> o .: "contract"- x | "script_overflow" `isSuffixOf` x ->- pure ScriptOverflow- x | "gas_exhausted.operation" `isSuffixOf` x ->- pure GasExhaustedOperation- x | "tez.addition_overflow" `isSuffixOf` x ->- MutezAdditionOverflow <$> o .: "amounts"- x | "tez.subtraction_underflow" `isSuffixOf` x ->- MutezSubtractionUnderflow <$> o .: "amounts"- x | "tez.multiplication_overflow" `isSuffixOf` x ->+ , "invalid_contract_notation" ~> InvalidContractNotation <$> o .: "notation"+ , "unexpected_contract" ~> pure UnexpectedContract+ , "ill_formed_type" ~> IllFormedType <$> o .: "ill_formed_expression"+ , "unexpected_operation" ~> pure UnexpectedOperation+ , "empty_transaction" ~> REEmptyTransaction <$> o .: "contract"+ , "script_overflow" ~> pure ScriptOverflow+ , "gas_exhausted.operation" ~> pure GasExhaustedOperation+ , "tez.addition_overflow" ~> MutezAdditionOverflow <$> o .: "amounts"+ , "tez.subtraction_underflow" ~> MutezSubtractionUnderflow <$> o .: "amounts"+ , "tez.multiplication_overflow" ~> MutezMultiplicationOverflow <$> o .: "amount" <*> o .: "multiplicator"- x | "cannot_pay_storage_fee" `isSuffixOf` x ->- pure CantPayStorageFee- x | "balance_too_low" `isSuffixOf` x -> do+ , "cannot_pay_storage_fee" ~> pure CantPayStorageFee+ , "balance_too_low"~> do balance <- unTezosMutez <$> o .: "balance" amount <- unTezosMutez <$> o .: "amount" return $ BalanceTooLow (#balance :! balance) (#required :! amount)- x | "previously_revealed_key" `isSuffixOf` x ->- PreviouslyRevealedKey <$> o .: "contract"- x | "non_existing_contract" `isSuffixOf` x ->- NonExistingContract <$> o .: "contract"- x | "invalid_b58check" `isSuffixOf` x ->- InvalidB58Check <$> o .: "input"- _ -> fail ("unknown id: " <> id')+ , "previously_revealed_key" ~> PreviouslyRevealedKey <$> o .: "contract"+ , "non_existing_contract" ~> NonExistingContract <$> o .: "contract"+ , "invalid_b58check" ~> InvalidB58Check <$> o .: "input"+ , "unregistered_delegate" ~> UnregisteredDelegate <$> o .: "hash"+ , "no_deletion" ~> FailedUnDelegation <$> o .: "delegate"+ , "delegate.already_active" ~> pure DelegateAlreadyActive+ , "ill_typed_contract" ~> IllTypedContract <$> o .: "ill_typed_code"+ , "ill_typed_data" ~> IllTypedData <$> o .: "expected_type" <*> o .: "ill_typed_expression"+ , "bad_stack" ~> BadStack <$> parseJSON (Object o)+ , "forbidden_zero_amount_ticket" ~> pure ForbiddenZeroAmountTicket+ ]+ where+ infix 0 ~>+ (~>) = (,)+ decode x xs = fromMaybe (fail $ "unknown id: " <> x) $+ snd <$> find (\(k, _) -> ('.' : k) `isSuffixOf` x) xs instance Buildable RunError where build = \case@@ -478,6 +509,18 @@ "Contract is not registered: " +| addr |+ "" InvalidB58Check input -> "Failed to read a valid b58check_encoding data from \"" +| input |+ "\""+ UnregisteredDelegate addr ->+ addr |+ " is not registered as delegate"+ FailedUnDelegation addr ->+ "Failed to withdraw delegation for: " +| addr |+ ""+ DelegateAlreadyActive ->+ "Delegate already active"+ IllTypedContract expr ->+ "Ill typed contract: " +| expr |+ ""+ IllTypedData expected ill_typed ->+ "Ill typed data: Expected type " +| expected |+ ", ill typed expression: " +| ill_typed |+ ""+ BadStack info -> build info+ ForbiddenZeroAmountTicket -> "Forbidden zero amount ticket" -- | Errors that are sent as part of an "Internal Server Error" -- response (HTTP code 500).@@ -513,11 +556,11 @@ instance FromJSON InternalError where parseJSON = withObject "internal error" $ \o -> o .: "id" >>= \case- x | "counter_in_the_past" `isSuffixOf` x ->+ x | ".counter_in_the_past" `isSuffixOf` x -> CounterInThePast <$> o .: "contract" <*> (#expected <:!> parseCounter o "expected") <*> (#found <:!> parseCounter o "found")- x | "unrevealed_key" `isSuffixOf` x ->+ x | ".unrevealed_key" `isSuffixOf` x -> UnrevealedKey <$> o .: "contract" "failure" -> Failure <$> o .: "msg" x -> fail ("unknown id: " <> x)@@ -611,18 +654,49 @@ -- | Create 'CommonOperationData' based on current blockchain protocol parameters -- and sender info. This data is used for operation simulation. --+-- @num_operations@ parameter can be used for smarter gas limit estimation. If+-- 'Nothing', the gas limit is set to 'ppHardGasLimitPerOperation', but that+-- puts a hard low limit on the number of operations that will fit into one+-- batch. If @num_operations@ is set, then gas limit is estimated as+--+-- \[+-- \mathrm{min}\left(\mathbf{hard\_gas\_limit\_per\_operation},+-- \left\lceil \frac{\mathbf{hard\_gas\_limit\_per\_block}}+-- {num\_operations}\right\rceil\right)+-- \]+--+-- This works well enough for the case of many small operations, but will break+-- when there is one big one and a lot of small ones. That said, specifying+-- @num_operations@ will work in all cases where not specifying it would, and+-- then some, so it's recommended to specify it whenever possible.+--+-- @num_operations@ is assumed to be greater than @0@, otherwise it'll be+-- silently ignored.+-- -- Fee isn't accounted during operation simulation, so it's safe to use zero amount.--- Real operation fee is calculated later using 'tezos-client'.+-- Real operation fee is calculated later using @octez-client@. mkCommonOperationData- :: ImplicitAddress -> TezosInt64 -> ProtocolParameters+ :: ProtocolParameters+ -> "sender" :! ImplicitAddress+ -> "counter" :! TezosInt64+ -> "num_operations" :? Int64 -> CommonOperationData-mkCommonOperationData source counter ProtocolParameters{..} = CommonOperationData- { codSource = source- , codFee = TezosMutez zeroMutez- , codCounter = counter- , codGasLimit = ppHardGasLimitPerOperation- , codStorageLimit = ppHardStorageLimitPerOperation- }+mkCommonOperationData ProtocolParameters{..} source counter mNumOp =+ CommonOperationData+ { codSource = arg #sender source+ , codFee = TezosMutez zeroMutez+ , codCounter = arg #counter counter+ , codGasLimit = estGasLimitPerOperation+ , codStorageLimit = ppHardStorageLimitPerOperation+ }+ where+ estGasLimitPerOperation+ | Just numOp <- argF #num_operations mNumOp+ , numOp > 0+ = StringEncode $+ min (unStringEncode ppHardGasLimitPerOperation) $ ceiling $+ unStringEncode ppHardGasLimitPerBlock % numOp+ | otherwise = ppHardGasLimitPerOperation instance ToJSON CommonOperationData where toJSON CommonOperationData{..} = object@@ -674,6 +748,7 @@ -- through Tezos RPC interface data OriginationOperation = OriginationOperation { ooBalance :: TezosMutez+ , ooDelegate :: Maybe KeyHash , ooScript :: OriginationScript } @@ -690,6 +765,18 @@ ] instance ToJSONObject RevealOperation +data DelegationOperation = DelegationOperation+ { doDelegate :: Maybe KeyHash+ -- ^ 'Nothing' removes delegate, 'Just' sets it+ }++instance ToJSON DelegationOperation where+ toJSON DelegationOperation{..} = object $+ [ "kind" .= String "delegation" ]+ <> maybeToList (("delegate" .=) <$> doDelegate)++instance ToJSONObject DelegationOperation+ -- | @$operation@ in Tezos docs. data BlockOperation = BlockOperation { boHash :: Text@@ -792,7 +879,7 @@ [ "kind" .= String "origination" , "balance" .= ooBalance , "script" .= ooScript- ]+ ] <> maybeToList (("delegate" .=) <$> ooDelegate) instance ToJSONObject OriginationOperation instance ToJSON ForgeOperation where
src/Morley/Client/TezosClient.hs view
@@ -2,15 +2,21 @@ -- -- SPDX-License-Identifier: LicenseRef-MIT-TQ --- | Interface to @tezos-client@ (and its implementation).+-- | Interface to @octez-client@ (and its implementation). module Morley.Client.TezosClient ( module Morley.Client.TezosClient.Class , module Morley.Client.TezosClient.Types , TezosClientError (..)+ , AliasBehavior (..)+ , Resolve(ResolvedAddress, ResolvedAlias)+ , ResolveError(..) , resolveAddress+ , resolveAddressMaybe+ , getAlias+ , getAliasMaybe ) where import Morley.Client.TezosClient.Class-import Morley.Client.TezosClient.Impl (TezosClientError(..), resolveAddress)+import Morley.Client.TezosClient.Impl import Morley.Client.TezosClient.Types
src/Morley/Client/TezosClient/Class.hs view
@@ -1,11 +1,12 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | Abstraction layer for @tezos-client@ functionality.--- We use it to fake @tezos-client@ in tests.+-- | Abstraction layer for @octez-client@ functionality.+-- We use it to fake @octez-client@ in tests. module Morley.Client.TezosClient.Class ( HasTezosClient (..)+ , AliasBehavior (..) ) where import Data.ByteArray (ScrubbedBytes)@@ -14,10 +15,25 @@ import Morley.Tezos.Address.Alias import Morley.Tezos.Crypto --- | Type class that provides interaction with @tezos-client@ binary+-- | How to save the originated contract address.+data AliasBehavior+ = DontSaveAlias+ -- ^ Don't save the newly originated contract address.+ | KeepDuplicateAlias+ -- ^ If an alias already exists, keep it, don't save the newly originated+ -- contract address.+ | OverwriteDuplicateAlias+ -- ^ If an alias already exists, replace it with the address of the newly+ -- originated contract.+ | ForbidDuplicateAlias+ -- ^ If an alias already exists, throw an exception without doing the+ -- origination+ deriving stock (Eq, Ord, Enum)++-- | Type class that provides interaction with @octez-client@ binary class (Monad m) => HasTezosClient m where signBytes :: ImplicitAddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature- -- ^ Sign an operation with @tezos-client@.+ -- ^ Sign an operation with @octez-client@. genKey :: ImplicitAlias -> m ImplicitAddress -- ^ Generate a secret key and store it with given alias. -- If a key with this alias already exists, the corresponding address@@ -28,21 +44,20 @@ -- the existing key when given alias is already stored. revealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> m () -- ^ Reveal public key associated with given implicit account.- rememberContract :: Bool -> ContractAddress -> ContractAlias -> m ()+ rememberContract :: AliasBehavior -> ContractAddress -> ContractAlias -> m () -- ^ Associate the given contract with alias. -- The 'Bool' variable indicates whether or not we should replace already -- existing contract alias or not.- resolveAddressMaybe :: AddressOrAlias kind -> m (Maybe (KindedAddress kind))- -- ^ Retrieve an address from given address or alias. If address or alias does not exist- -- returns `Nothing`- getAlias :: L1AddressKind kind => AddressOrAlias kind -> m (Alias kind)- -- ^ Retrieve an alias from given address using @tezos-client@. The- -- primary (and probably only) reason this function exists is that- -- @tezos-client sign@ command only works with aliases. It was- -- reported upstream: <https://gitlab.com/tezos/tezos/-/issues/836>.- registerDelegate :: ImplicitAlias -> Maybe ScrubbedBytes -> m ()- -- ^ Register a given address as delegate- -- TODO [#869] move to HasTezosRpc+ getAliasesAndAddresses :: m [(Text, Text)]+ -- ^ Retrieves a list with all known aliases and respective addresses.+ --+ -- Note that an alias can be ambiguous: it can refer to BOTH a contract and an implicit account.+ -- When an alias "abc" is ambiguous, the list will contain two entries:+ --+ -- > ("abc", "KT1...")+ -- > ("key:abc", "tz1...")+ --+ -- TODO [#910]: Cache this and turn it into a 'Morley.Util.Bimap'. getKeyPassword :: ImplicitAddress -> m (Maybe ScrubbedBytes) -- ^ Get password for secret key associated with given address -- in case this key is password-protected. Obtained password is used
src/Morley/Client/TezosClient/Impl.hs view
@@ -1,21 +1,24 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | Interface to the @tezos-client@ executable expressed in Haskell types.+-- | Interface to the @octez-client@ executable expressed in Haskell types. module Morley.Client.TezosClient.Impl ( TezosClientError (..) - -- * @tezos-client@ api+ -- * @octez-client@ api , signBytes , rememberContract , importKey , genKey , genFreshKey , revealKey- , resolveAddressMaybe+ , ResolveError(..)+ , Resolve(..) , resolveAddress+ , resolveAddressMaybe , getAlias+ , getAliasMaybe , getPublicKey , getSecretKey , getTezosClientConfig@@ -24,8 +27,12 @@ , calcRevealFee , getKeyPassword , registerDelegate+ , getAliasesAndAddresses -- * Internals+ , findAddress+ , FindAddressResult(..)+ , CallMode(..) , callTezosClient , callTezosClientStrict ) where@@ -44,10 +51,13 @@ import Text.Printf (printf) import UnliftIO.IO (hGetEcho, hSetEcho) +import Data.Constraint ((\\))+import Data.Singletons (demote) import Lorentz.Value import Morley.Client.Logging import Morley.Client.RPC.Types-import Morley.Client.TezosClient.Class qualified as Class (HasTezosClient(resolveAddressMaybe))+import Morley.Client.TezosClient.Class (AliasBehavior(..))+import Morley.Client.TezosClient.Class qualified as Class (HasTezosClient(..)) import Morley.Client.TezosClient.Parser import Morley.Client.TezosClient.Types import Morley.Client.Util (readScrubbedBytes, scrubbedBytesToString)@@ -57,7 +67,9 @@ import Morley.Tezos.Address.Alias import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto+import Morley.Util.Interpolate (itu) import Morley.Util.Peano+import Morley.Util.Sing (castSing) import Morley.Util.SizedList.Types ----------------------------------------------------------------------------@@ -65,22 +77,16 @@ ---------------------------------------------------------------------------- -- | A data type for all /predicatable/ errors that can happen during--- @tezos-client@ usage.+-- @octez-client@ usage. data TezosClientError = UnexpectedClientFailure- -- ^ @tezos-client@ call unexpectedly failed (returned non-zero exit code).+ -- ^ @octez-client@ call unexpectedly failed (returned non-zero exit code). -- The error contains the error code, stdout and stderr contents. Int -- ^ Exit code Text -- ^ stdout Text -- ^ stderr -- These errors represent specific known scenarios.- | UnknownAddressAlias- -- ^ Could not find an address with given name.- Text -- ^ Name of address which is eventually used- | UnknownAddress- -- ^ Could not find an address.- Address -- ^ Address that is not present in local tezos cache | AlreadyRevealed -- ^ Public key of the given address is already revealed. ImplicitAlias -- ^ Address alias that has already revealed its key@@ -94,21 +100,21 @@ Text -- ^ Raw counter Text -- ^ Raw address | EConnreset- -- ^ Network error with which @tezos-client@ fails from time to time.+ -- ^ Network error with which @octez-client@ fails from time to time. -- Note: the errors below most likely indicate that something is wrong in our code.- -- Maybe we made a wrong assumption about tezos-client or just didn't consider some case.- -- Another possible reason that a broken tezos-client is used.+ -- Maybe we made a wrong assumption about @octez-client@ or just didn't consider some case.+ -- Another possible reason that a broken @octez-client@ is used. | ConfigParseError String -- ^ A parse error occurred during config parsing. | TezosClientCryptoParseError Text CryptoParseError- -- ^ @tezos-client@ produced a cryptographic primitive that we can't parse.+ -- ^ @octez-client@ produced a cryptographic primitive that we can't parse. | TezosClientParseAddressError Text ParseAddressError- -- ^ @tezos-client@ produced an address that we can't parse.+ -- ^ @octez-client@ produced an address that we can't parse. | TezosClientParseFeeError Text Text- -- ^ @tezos-client@ produced invalid output for parsing baker fee+ -- ^ @octez-client@ produced invalid output for parsing baker fee | TezosClientUnexpectedOutputFormat Text- -- ^ @tezos-client@ printed a string that doesn't match the format we expect.+ -- ^ @octez-client@ printed a string that doesn't match the format we expect. | CantRevealContract -- ^ Given alias is a contract and cannot be revealed. ImplicitAlias -- ^ Address alias of implicit account@@ -118,24 +124,30 @@ -- ^ Given alias is an empty implicit contract. ImplicitAlias -- ^ Address alias of implicit contract | TezosClientUnexpectedSignatureOutput Text- -- ^ @tezos-client sign bytes@ produced unexpected output format+ -- ^ @octez-client sign bytes@ produced unexpected output format | TezosClientParseEncryptionTypeError Text Text- -- ^ @tezos-client@ produced invalid output for parsing secret key encryption type.- deriving stock (Show, Eq)+ -- ^ @octez-client@ produced invalid output for parsing secret key encryption type.+ | DuplicateAlias Text+ -- ^ Tried to save alias, but such alias already exists.+ | AmbiguousAlias Text ContractAddress ImplicitAddress+ -- ^ Expected an alias to be associated with either an implicit address or a+ -- contract address, but it was associated with both.+ | AliasTxRollup Text (KindedAddress 'AddressKindTxRollup)+ -- ^ Expected an alias to be associated with either+ -- an implicit address or a contract address,+ -- but it was associated with a transaction rollup address.+ | ResolveError ResolveError +deriving stock instance Show TezosClientError+ instance Exception TezosClientError where displayException = pretty instance Buildable TezosClientError where build = \case UnexpectedClientFailure errCode output errOutput ->- "tezos-client unexpectedly failed with error code " +| errCode |++ "`octez-client` unexpectedly failed with error code " +| errCode |+ ". Stdout:\n" +| output |+ "\nStderr:\n" +| errOutput |+ ""- UnknownAddressAlias name ->- "Could not find an address with name " <> build name <> "."- UnknownAddress uaddr ->- "Could not find an associated name for the given address " <>- build uaddr <> "." AlreadyRevealed alias -> "The address alias " <> build alias <> " is already revealed" InvalidOperationHash hash ->@@ -143,20 +155,20 @@ " because this hash is invalid." CounterIsAlreadyUsed counter addr -> "Counter " +| counter |+ " already used for " +| addr |+ "."- EConnreset -> "tezos-client call failed with 'Unix.ECONNRESET' error."+ EConnreset -> "`octez-client` call failed with 'Unix.ECONNRESET' error." ConfigParseError err -> "A parse error occurred during config parsing: " <> build err TezosClientCryptoParseError txt err ->- "tezos-client produced a cryptographic primitive that we can't parse: " +|+ "`octez-client` produced a cryptographic primitive that we can't parse: " +| txt |+ ".\n The error is: " +| err |+ "." TezosClientParseAddressError txt err ->- "tezos-client produced an address that we can't parse: " +|+ "`octez-client` produced an address that we can't parse: " +| txt |+ ".\n The error is: " +| err |+ "." TezosClientParseFeeError txt err ->- "tezos-client produced invalid output for parsing baker fee: " +|+ "`octez-client` produced invalid output for parsing baker fee: " +| txt |+ ".\n Parsing error is: " +| err |+ "" TezosClientUnexpectedOutputFormat txt ->- "tezos-client printed a string that doesn't match the format we expect:\n" <>+ "`octez-client` printed a string that doesn't match the format we expect:\n" <> build txt CantRevealContract alias -> "Contracts (" <> build alias <> ") cannot be revealed"@@ -165,26 +177,40 @@ EmptyImplicitContract alias -> "Empty implicit contract (" <> build alias <> ")" TezosClientUnexpectedSignatureOutput txt ->- "'tezos-client sign bytes' call returned a signature in format we don't expect:\n" <>+ "`octez-client sign bytes` call returned a signature in format we don't expect:\n" <> build txt TezosClientParseEncryptionTypeError txt err ->- "tezos-client produced invalid output for parsing secret key encryption type: " +|+ "`octez-client` produced invalid output for parsing secret key encryption type: " +| txt |+ ".\n Parsing error is: " +| err |+ ""+ DuplicateAlias alias -> "Attempted to save alias '" +| alias |+ "', but it already exists"+ AmbiguousAlias aliasText contractAddr implicitAddr ->+ [itu|+ The alias '#{aliasText}' is assigned to both:+ * a contract address: #{contractAddr}+ * and an implicit address: #{implicitAddr}+ Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate.+ |]+ AliasTxRollup aliasText txRollupAddr ->+ [itu|+ Expected the alias '#{aliasText}' to be assigned to either a contract or an implicit account,+ but it's assigned to a transaction rollup address: #{txRollupAddr}.+ |]+ ResolveError err -> build err ---------------------------------------------------------------------------- -- API ---------------------------------------------------------------------------- --- Note: if we try to sign with an unknown alias, tezos-client will+-- Note: if we try to sign with an unknown alias, @octez-client@ will -- report a fatal error (assert failure) to stdout. It's bad. It's -- reported in two issues: https://gitlab.com/tezos/tezos/-/issues/653 -- and https://gitlab.com/tezos/tezos/-/issues/813. -- I (@gromak) currently think it's better to wait for it to be resolved upstream. -- Currently we will throw 'TezosClientUnexpectedOutputFormat' error.--- | Sign an arbtrary bytestring using @tezos-client@.+-- | Sign an arbtrary bytestring using @octez-client@. -- Secret key of the address corresponding to give 'AddressOrAlias' must be known. signBytes- :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)+ :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m) => ImplicitAddressOrAlias -> Maybe ScrubbedBytes -> ByteString@@ -270,7 +296,7 @@ _ <- callTezosClient errHandler- ["reveal", "key", "for", "key:" <> toCmdArg alias] ClientMode mbPassword+ ["reveal", "key", "for", toCmdArg alias] ClientMode mbPassword logDebug $ "Successfully revealed key for " +| alias |+ "" @@ -294,63 +320,7 @@ logDebug $ "Successfully registered " +| alias |+ " as delegate" --- | Return 'KindedAddress' corresponding to given 'AddressOrAlias', covered in @Maybe@.--- Return @Nothing@ if address alias is unknown-resolveAddressMaybe- :: forall env m kind. (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)- => AddressOrAlias kind- -> m (Maybe (KindedAddress kind))-resolveAddressMaybe addressOrAlias = case addressOrAlias of- AddressResolved addr -> pure . Just $ addr- AddressAlias alias -> do- logDebug $ "Resolving " +| alias |+ ""- let- parse alias' = T.stripPrefix (alias' <> ":")- findSatisfyingAddresses alias' output = mapMaybe (parse alias') . lines $ output- aliasText = unAlias alias-- output <- case alias of- ImplicitAlias{} -> callListKnown "addresses"- ContractAlias{} -> callListKnown "contracts"-- let- maybeAddress = safeHead $ findSatisfyingAddresses aliasText output-- liftIO case maybeAddress of- Nothing -> pure Nothing- Just addrPlainText -> Just <$> do- let addrText = fromMaybe addrPlainText $ safeHead $ words addrPlainText- either (throwM . TezosClientParseAddressError addrText) pure $ case alias of- ContractAlias{} -> parseKindedAddress @'AddressKindContract addrText- ImplicitAlias{} -> parseKindedAddress @'AddressKindImplicit addrText---- | Return 'Alias' corresponding to given 'AddressOrAlias'.-getAlias- :: forall kind env m- . ( WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m- , L1AddressKind kind)- => AddressOrAlias kind- -> m (Alias kind)-getAlias = usingImplicitOrContractKind @kind $ \case- AddressAlias alias -> pure alias- AddressResolved address -> do- logDebug $ "Getting an alias for " <> pretty address- output <- case address of- ImplicitAddress{} -> callListKnown "addresses"- ContractAddress{} -> callListKnown "contracts"- let- parse address' line = case T.splitOn (": " <> pretty address') line of- [_noMatch] -> Nothing- (alias : _) -> Just alias- _ -> Nothing-- liftIO case safeHead . mapMaybe (parse address). lines $ output of- Nothing -> throwM $ UnknownAddress $ MkAddress address- Just alias -> case address of- ImplicitAddress{} -> pure $ ImplicitAlias alias- ContractAddress{} -> pure $ ContractAlias alias---- | Call tezos-client to list known addresses or contracts+-- | Call @octez-client@ to list known addresses or contracts callListKnown :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) => String -> m Text@@ -359,7 +329,7 @@ -- | Return 'PublicKey' corresponding to given 'AddressOrAlias'. getPublicKey- :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)+ :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m) => ImplicitAddressOrAlias -> m PublicKey getPublicKey addrOrAlias = do@@ -377,7 +347,7 @@ -- | Return 'SecretKey' corresponding to given 'AddressOrAlias'. getSecretKey- :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)+ :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m) => ImplicitAddressOrAlias -> m SecretKey getSecretKey addrOrAlias = do@@ -398,20 +368,25 @@ -- already exists, this function does nothing. rememberContract :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)- => Bool+ => AliasBehavior -> ContractAddress -> ContractAlias -> m ()-rememberContract replaceExisting contractAddress name = do- let+rememberContract aliasBehavior address alias = case aliasBehavior of+ DontSaveAlias ->+ logInfo $ "Not saving " +| address |+ " as " +| alias |+ " as requested"+ OverwriteDuplicateAlias ->+ void $ callTezosClient (\_ _ -> pure False) (args <> ["--force"]) MockupMode Nothing+ _ -> do+ let errHandler _ errOut+ | isAlreadyExistsError errOut = case aliasBehavior of+ KeepDuplicateAlias -> pure True+ ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias+ | otherwise = pure False+ void $ callTezosClient errHandler args MockupMode Nothing+ where+ args = ["remember", "contract", toCmdArg alias, pretty address] isAlreadyExistsError = T.isInfixOf "already exists"- errHandler _ errOut = pure (isAlreadyExistsError errOut)- args = ["remember", "contract", toCmdArg name, pretty contractAddress]- _ <-- callTezosClient errHandler- (if replaceExisting then args <> ["--force"] else args)- MockupMode Nothing- pure () importKey :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)@@ -430,7 +405,7 @@ MockupMode Nothing pure name --- | Read @tezos-client@ configuration.+-- | Read @octez-client@ configuration. getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig getTezosClientConfig client mbDataDir = do t <- readProcessWithExitCode' client@@ -442,7 +417,7 @@ (ExitFailure errCode, toText -> output, toText -> errOutput) -> throwM $ UnexpectedClientFailure errCode output errOutput --- | Calc baker fee for transfer using @tezos-client@.+-- | Calc baker fee for transfer using @octez-client@. calcTransferFee :: ( WithClientLog env m, HasTezosClientEnv env , MonadIO m, MonadCatch m@@ -460,7 +435,7 @@ withSomePeano (fromIntegralOverflowing $ length transferFeeDatas) $ \(_ :: Proxy n) -> toList <$> feeOutputParser @n output --- | Calc baker fee for origination using @tezos-client@.+-- | Calc baker fee for origination using @octez-client@. calcOriginationFee :: ( UntypedValScope st, WithClientLog env m, HasTezosClientEnv env , MonadIO m, MonadCatch m@@ -479,9 +454,9 @@ case fees of singleFee :< Nil -> return singleFee --- | Calc baker fee for revealing using @tezos-client@.+-- | Calc baker fee for revealing using @octez-client@. ----- Note that @tezos-client@ does not support passing an address here,+-- Note that @octez-client@ does not support passing an address here, -- at least at the moment of writing. calcRevealFee :: ( WithClientLog env m, HasTezosClientEnv env@@ -513,7 +488,7 @@ -- | Get password for secret key associated with given address -- in case this key is password-protected getKeyPassword- :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadMask m)+ :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadMask m, Class.HasTezosClient m) => ImplicitAddress -> m (Maybe ScrubbedBytes) getKeyPassword key = (getAlias $ AddressResolved key) >>= getKeyPassword' where@@ -540,23 +515,23 @@ ---------------------------------------------------------------------------- -- Helpers--- All interesting @tezos-client@ functionality is supposed to be+-- All interesting @octez-client@ functionality is supposed to be -- exported as functions with types closely resembling inputs of--- respective @tezos-client@ functions. If something is not+-- respective @octez-client@ functions. If something is not -- available, consider adding it here. But if it is not feasible, -- you can use these two functions directly to constructor a custom--- @tezos-client@ call.+-- @octez-client@ call. ---------------------------------------------------------------------------- --- | Datatype that represents modes for calling node from @tezos-client@.+-- | Datatype that represents modes for calling node from @octez-client@. data CallMode = MockupMode- -- ^ Mode in which @tezos-client@ doesn't perform any actual RPC calls to the node+ -- ^ Mode in which @octez-client@ doesn't perform any actual RPC calls to the node -- and use mock instead. | ClientMode- -- ^ Normal mode in which @tezos-client@ performs all necessary RPC calls to the node.+ -- ^ Normal mode in which @octez-client@ performs all necessary RPC calls to the node. --- | Call @tezos-client@ with given arguments. Arguments defined by+-- | Call @octez-client@ with given arguments. Arguments defined by -- config are added automatically. The second argument specifies what -- should be done in failure case. It takes stdout and stderr -- output. Possible handling:@@ -618,7 +593,7 @@ | "Unix.ECONNRESET" `T.isInfixOf` errOutput = throwM EConnreset checkEConnreset _ = pass - -- Helper function that retries @tezos-client@ call action in case of @ECONNRESET@.+ -- Helper function that retries @octez-client@ call action in case of @ECONNRESET@. -- Note that this error cannot appear in case of 'MockupMode' call. retryEConnreset :: CallMode -> m a -> m a retryEConnreset MockupMode action = action@@ -634,7 +609,7 @@ maxRetryAmount = 5 --- | Call tezos-client and expect success.+-- | Call @octez-client@ and expect success. callTezosClientStrict :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) => [String] -> CallMode -> Maybe ScrubbedBytes -> m Text@@ -662,15 +637,287 @@ "ERROR!! There was an error in executing `" <> toText fp <> "` program. Is the \ \ executable available in PATH ?" --- | Return 'KindedAddress' corresponding to given 'AddressOrAlias'.+data ResolveError where+ REAliasNotFound :: Text -> ResolveError+ -- ^ Could not find an address with given alias.+ REWrongKind :: Alias expectedKind -> Address -> ResolveError+ -- ^ Expected an alias to be associated with an implicit address, but it was+ -- associated with a contract address, or vice-versa.+ REAddressNotFound :: KindedAddress kind -> ResolveError+ -- ^ Could not find an alias with given address.++deriving stock instance Show ResolveError++instance Buildable ResolveError where+ build = \case+ REWrongKind (alias :: Alias expectedKind) (Constrained (addr :: KindedAddress actualKind)) ->+ [itu|+ Expected the alias '#{alias}' to be assigned to an address of kind '#{demotedExpectedKind}',+ but it's assigned to an address of kind '#{demotedActualKind}': #{addr}.+ |]+ where+ demotedExpectedKind = demote @expectedKind \\ aliasKindSanity alias :: AddressKind+ demotedActualKind = demote @actualKind \\ addressKindSanity addr :: AddressKind+ REAliasNotFound aliasText ->+ [itu|Could not find the alias '#{aliasText}'.|]+ REAddressNotFound addr ->+ [itu|Could not find an alias for the address '#{addr}'.|]++class Resolve addressOrAlias where+ type ResolvedAddress addressOrAlias :: Type+ type ResolvedAlias addressOrAlias :: Type++ -- | Looks up the address associated with the given @addressOrAlias@.+ --+ -- When the alias is associated with __both__ an implicit and a contract address:+ --+ -- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+ -- unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+ -- * The 'AddressOrAlias' instance will return the address with the requested kind.+ resolveAddressEither+ :: forall m env+ . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+ => addressOrAlias+ -> m (Either ResolveError (ResolvedAddress addressOrAlias))++ {- | Looks up the alias associated with the given @addressOrAlias@.++ When the alias is associated with __both__ an implicit and a contract address:++ * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+ unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+ * The 'AddressOrAlias' instance will return the alias of the address with the requested kind.++ The primary (and probably only) reason this function exists is that+ @octez-client sign@ command only works with aliases. It was+ reported upstream: <https://gitlab.com/tezos/tezos/-/issues/836>.+ -}+ getAliasEither+ :: forall m env+ . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+ => addressOrAlias+ -> m (Either ResolveError (ResolvedAlias addressOrAlias))++instance Resolve (AddressOrAlias kind) where+ type ResolvedAddress (AddressOrAlias kind) = KindedAddress kind+ type ResolvedAlias (AddressOrAlias kind) = Alias kind++ resolveAddressEither+ :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+ => AddressOrAlias kind -> m (Either ResolveError (KindedAddress kind))+ resolveAddressEither = \case+ AddressResolved addr -> pure $ Right addr+ aoa@(AddressAlias alias) -> do+ findAddress (unAlias alias) >>= \case+ FARNone -> pure $ Left $ REAliasNotFound (pretty aoa)+ FARUnambiguous (Constrained addr) ->+ pure $ maybeToRight (REWrongKind alias (Constrained addr)) $+ castSing addr \\ addressKindSanity addr \\ aliasKindSanity alias+ FARAmbiguous contractAddr implicitAddr ->+ withDict (aliasKindSanity alias) $+ usingImplicitOrContractKind @kind+ case sing @kind of+ SAddressKindContract -> pure $ Right contractAddr+ SAddressKindImplicit -> pure $ Right implicitAddr++ getAliasEither+ :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+ => AddressOrAlias kind -> m (Either ResolveError (Alias kind))+ getAliasEither = \case+ aoa@(AddressAlias alias) ->+ -- Check if the alias exists+ ($> alias) <$> resolveAddressEither aoa+ AddressResolved addr -> do+ aliasesAndAddresses <- Class.getAliasesAndAddresses+ case fst <$> find (\(_, addr') -> addr' == pretty addr) aliasesAndAddresses of+ Nothing -> pure $ Left $ REAddressNotFound addr+ Just aliasText -> do+ -- This alias _might_ belong to both an implicit account and a contract,+ -- in which case it might be prefixed with "key".+ -- If so, we have to strip the prefix.+ let aliasTextWithoutPrefix = fromMaybe aliasText $ T.stripPrefix "key:" aliasText+ pure $ Right $ mkAlias @kind aliasTextWithoutPrefix \\ addressKindSanity addr++instance Resolve SomeAddressOrAlias where+ type ResolvedAddress SomeAddressOrAlias = L1Address+ type ResolvedAlias SomeAddressOrAlias = SomeAlias++ resolveAddressEither+ :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+ => SomeAddressOrAlias -> m (Either ResolveError L1Address)+ resolveAddressEither = \case+ SAOAKindUnspecified aliasText -> do+ findAddress aliasText >>= \case+ FARNone -> pure $ Left $ REAliasNotFound aliasText+ FARUnambiguous addr -> pure $ Right addr+ FARAmbiguous contractAddr implicitAddr -> throwM $ AmbiguousAlias aliasText contractAddr implicitAddr+ SAOAKindSpecified aoa ->+ fmap Constrained <$> resolveAddressEither aoa \\ addressOrAliasKindSanity aoa++ getAliasEither+ :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+ => SomeAddressOrAlias -> m (Either ResolveError SomeAlias)+ getAliasEither = \case+ SAOAKindSpecified aoa -> do+ fmap SomeAlias+ <$> getAliasEither aoa \\ addressOrAliasKindSanity aoa+ aoa@(SAOAKindUnspecified aliasText) -> do+ -- Find out whether this alias is associated with an implicit address or a contract,+ -- and return an @Alias kind@ of the correct kind.+ resolveAddressEither aoa <&> fmap+ \(Constrained (addr :: KindedAddress kind)) ->+ SomeAlias $ mkAlias @kind aliasText \\ addressKindSanity addr++-- | Looks up the address associated with the given @addressOrAlias@.+--+-- Will throw a 'TezosClientError' if @addressOrAlias@ is an alias and:+--+-- * the alias does not exist.+-- * the alias exists but its address is of the wrong kind.+--+-- When the alias is associated with __both__ an implicit and a contract address:+--+-- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+-- unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+-- * The 'AddressOrAlias' instance will return the address with the requested kind. resolveAddress- :: (MonadThrow m, Class.HasTezosClient m)- => AddressOrAlias kind- -> m (KindedAddress kind)-resolveAddress addr = case addr of- AddressResolved addrResolved -> pure addrResolved- alias@(AddressAlias originatorName) ->- Class.resolveAddressMaybe alias >>= (\case- Nothing -> throwM $ UnknownAddressAlias (unAlias originatorName)- Just existingAddress -> return existingAddress- )+ :: forall addressOrAlias m env+ . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)+ => addressOrAlias+ -> m (ResolvedAddress addressOrAlias)+resolveAddress = resolveAddressEither >=> either (throwM . ResolveError) pure++-- | Looks up the address associated with the given @addressOrAlias@.+--+-- Will return 'Nothing' if @addressOrAlias@ is an alias and:+--+-- * the alias does not exist.+-- * the alias exists but its address is of the wrong kind.+--+-- When the alias is associated with __both__ an implicit and a contract address:+--+-- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+-- unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+-- * The 'AddressOrAlias' instance will return the address with the requested kind.+resolveAddressMaybe+ :: forall addressOrAlias m env+ . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)+ => addressOrAlias+ -> m (Maybe (ResolvedAddress addressOrAlias))+resolveAddressMaybe aoa =+ rightToMaybe <$> resolveAddressEither aoa++{- | Looks up the alias associated with the given @addressOrAlias@.++Will throw a 'TezosClientError' if @addressOrAlias@:++ * is an address that is not associated with any alias.+ * is an alias that does not exist.+ * is an alias that exists but its address is of the wrong kind.++When the alias is associated with __both__ an implicit and a contract address:++ * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+ unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+ * The 'AddressOrAlias' instance will return the alias.+-}+getAlias+ :: forall addressOrAlias m env+ . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)+ => addressOrAlias+ -> m (ResolvedAlias addressOrAlias)+getAlias = getAliasEither >=> either (throwM . ResolveError) pure++{- | Looks up the alias associated with the given @addressOrAlias@.++Will return 'Nothing' if @addressOrAlias@:++ * is an address that is not associated with any alias.+ * is an alias that does not exist.+ * is an alias that exists but its address is of the wrong kind.++When the alias is associated with __both__ an implicit and a contract address:++ * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+ unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+ * The 'AddressOrAlias' instance will return the alias.+-}+getAliasMaybe+ :: forall addressOrAlias m env+ . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)+ => addressOrAlias+ -> m (Maybe (ResolvedAlias addressOrAlias))+getAliasMaybe aoa =+ rightToMaybe <$> getAliasEither aoa++{- | Finds the implicit/contract addresses assigned to the given alias.++Note that an alias can be ambiguous: it can refer to __both__ a contract and an+implicit account. When an alias "abc" is ambiguous, @octez-client list known+contracts@ will return two entries with the following format:++> abc: KT1...+> key:abc: tz1...++So, in order to check whether the alias is ambiguous, we check whether both+"abc" and "key:abc" are present in the output.++If only "abc" is present, then we know it's not ambiguous (and it refers to+__either__ a contract or an implicit account).+-}+findAddress+ :: forall m env+ . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+ => Text+ -> m FindAddressResult+findAddress aliasText = do+ logDebug $ "Resolving " +| aliasText |+ ""+ aliasesAndAddresses <- Class.getAliasesAndAddresses++ let find' alias = snd <$> find (\(alias', _) -> alias' == alias) aliasesAndAddresses++ case (find' aliasText, find' ("key:" <> aliasText)) of+ (Nothing, _) -> pure FARNone+ (Just firstMatch, Nothing) -> FARUnambiguous <$> parseL1Address firstMatch+ (Just contractAddrText, Just implicitAddrText) -> do+ contractAddr <-+ either (throwM . TezosClientParseAddressError contractAddrText) pure $+ parseKindedAddress @'AddressKindContract contractAddrText+ implicitAddr <-+ either (throwM . TezosClientParseAddressError implicitAddrText) pure $+ parseKindedAddress @'AddressKindImplicit implicitAddrText+ pure $ FARAmbiguous contractAddr implicitAddr+ where+ parseL1Address :: Text -> m L1Address+ parseL1Address addrText =+ either (throwM . TezosClientParseAddressError addrText) pure .+ parseConstrainedAddress $ addrText++-- | Whether an alias is associated with an implicit address, a contract address, or both.+data FindAddressResult+ = FARUnambiguous L1Address+ | FARAmbiguous ContractAddress ImplicitAddress+ | FARNone++{- | Calls @octez-client list known contracts@ and returns+a list of @(alias, address)@ pairs.++Note that an alias can be ambiguous: it can refer to __both__ a contract and an implicit account.+When an alias "abc" is ambiguous, the list will contain two entries:++> ("abc", "KT1...")+> ("key:abc", "tz1...")+-}+getAliasesAndAddresses+ :: forall m env+ . (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)+ => m [(Text, Text)]+getAliasesAndAddresses =+ parseOutput <$> callListKnown "contracts"+ where+ parseOutput :: Text -> [(Text, Text)]+ parseOutput = fmap parseLine . lines++ -- Note: each line has the format "<alias>: <address>"+ parseLine :: Text -> (Text, Text)+ parseLine = first (T.dropEnd 2) . T.breakOnEnd ": "
src/Morley/Client/TezosClient/Parser.hs view
@@ -49,7 +49,7 @@ showErrorComponent UnexpectedEncryptionType = "Unexpected secret key encryption type occurred" --- | Function to parse baker fee from given @tezos-client@ output.+-- | Function to parse baker fee from given @octez-client@ output. parseBakerFeeFromOutput :: forall n. (SingIPeano n) => Text -> Either FeeParserException (SizedList n TezosMutez) parseBakerFeeFromOutput output = first FeeParserException $
src/Morley/Client/TezosClient/Types.hs view
@@ -1,7 +1,7 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | Types used for interaction with @tezos-client@.+-- | Types used for interaction with @octez-client@. module Morley.Client.TezosClient.Types ( CmdArg (..)@@ -39,7 +39,7 @@ import Morley.Tezos.Core import Morley.Tezos.Crypto --- | An object that can be put as argument to a tezos-client command-line call.+-- | An object that can be put as argument to a @octez-client@ command-line call. class CmdArg a where -- | Render an object as a command-line argument. toCmdArg :: a -> String@@ -90,17 +90,17 @@ | LedgerKey deriving stock (Eq, Show) --- | Configuration maintained by @tezos-client@, see its @config@ subcommands--- (e. g. @tezos-client config show@).+-- | Configuration maintained by @octez-client@, see its @config@ subcommands+-- (e. g. @octez-client config show@). -- Only the field we are interested in is present here. newtype TezosClientConfig = TezosClientConfig { tcEndpointUrl :: BaseUrl } deriving stock Show --- | For reading tezos-client config.+-- | For reading @octez-client@ config. instance FromJSON TezosClientConfig where parseJSON = withObject "node info" $ \o -> TezosClientConfig <$> o .: "endpoint" --- | Runtime environment for @tezos-client@ bindings.+-- | Runtime environment for @octez-client@ bindings. data TezosClientEnv = TezosClientEnv { tceEndpointUrl :: BaseUrl -- ^ URL of tezos node on which operations are performed.
src/Morley/Client/Types.hs view
@@ -8,6 +8,7 @@ , _OpTransfer , _OpOriginate , _OpReveal+ , _OpDelegation ) where import Control.Lens (makePrisms)@@ -20,21 +21,24 @@ type family TransferInfo i :: Type type family OriginationInfo i :: Type type family RevealInfo i :: Type+ type family DelegationInfo i :: Type data OperationInfo i = OpTransfer (TransferInfo i) | OpOriginate (OriginationInfo i) | OpReveal (RevealInfo i)+ | OpDelegation (DelegationInfo i) -- Requiring 'ToJSONObject' in superclass as those different types of operation -- must be distinguishable and that is usually done by a special field instance- Each '[ToJSONObject] [TransferInfo i, OriginationInfo i, RevealInfo i] =>+ Each '[ToJSONObject] [TransferInfo i, OriginationInfo i, RevealInfo i, DelegationInfo i] => ToJSON (OperationInfo i) where toJSON = \case OpTransfer op -> toJSON op OpOriginate op -> toJSON op OpReveal op -> toJSON op+ OpDelegation op -> toJSON op instance ToJSON (OperationInfo i) => ToJSONObject (OperationInfo i) makePrisms ''OperationInfo
src/Morley/Client/Util.hs view
@@ -16,7 +16,7 @@ , withLevel , withNow - -- * @tezos-client@ password-related helpers+ -- * @octez-client@ password-related helpers , scrubbedBytesToString , readScrubbedBytes ) where@@ -43,12 +43,12 @@ import Morley.Tezos.Core (Mutez, Timestamp(..), zeroMutez) import Morley.Util.Exception as E (throwLeft) --- | Sets the environment variable for disabling tezos-client+-- | Sets the environment variable for disabling @octez-client@'s -- "not a mainnet" warning disableAlphanetWarning :: IO () disableAlphanetWarning = setEnv "TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER" "YES" --- | Convert 'EpName' to the textual representation used by RPC and tezos-client.+-- | Convert 'EpName' to the textual representation used by RPC and @octez-client@. epNameToTezosEp :: EpName -> Text epNameToTezosEp = \case DefEpName -> "default"@@ -161,7 +161,7 @@ readScrubbedBytes :: MonadIO m => m ScrubbedBytes readScrubbedBytes = convert <$> liftIO BS.getLine --- | Convert @ScrubbedBytes@ to @String@, so that it can be passed to @tezos-client@+-- | Convert @ScrubbedBytes@ to @String@, so that it can be passed to @octez-client@ -- as a stdin scrubbedBytesToString :: ScrubbedBytes -> String scrubbedBytesToString = decodeUtf8 . convert @ScrubbedBytes @ByteString
test/Test/BigMapGet.hs view
@@ -20,7 +20,6 @@ import Morley.Client.RPC.Types import Morley.Michelson.Typed import Morley.Tezos.Address-import Morley.Tezos.Address.Alias import Test.Addresses import Test.Util import TestM@@ -31,8 +30,8 @@ assertHeadBlockId blkId st <- get case lookup addr (fsContracts st) of- Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved addr- Just ContractState{..} -> case csContractData of+ Nothing -> throwM $ UnknownAccount $ Constrained addr+ Just AccountState{..} -> case asAccountData of ContractData _ mbBigMap -> case mbBigMap of Nothing -> throwM $ ContractDoesntHaveBigMap $ MkAddress addr Just ContractStateBigMap{..} -> case lookup (encodeBase58Check $ expressionToScriptExpr bmKey) csbmMap of@@ -45,7 +44,7 @@ fakeStateWithBigMapContract = defaultFakeState { fsContracts = fromList $ [ (contractAddress1, dumbContractState- { csContractData = (csContractData dumbContractState) & \case+ { asAccountData = (asAccountData dumbContractState) & \case ContractData os _ -> ContractData os $ Just $ mapToContractStateBigMap @Integer @Integer bigMapId $ fromList [(2, 3), (3, 5)] })@@ -84,9 +83,9 @@ handleUnknownContract (Right _) = assertFailure "Big map get unexpectedly didn't fail." handleUnknownContract (Left e) =- shouldThrow (throwM e) $ \case- UnknownContract _ -> True- _ -> False+ shouldThrow (throwM e) \case+ UnknownAccount _ -> True+ _ -> False handleValueNotFound :: Either SomeException a -> Assertion handleValueNotFound (Right _) =
+ test/Test/ErrorJSONParser.hs view
@@ -0,0 +1,42 @@+-- SPDX-FileCopyrightText: 2022 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++{-# OPTIONS_GHC -Wno-orphans #-}++module Test.ErrorJSONParser+ ( test_RunErrorJSONParser+ , test_InternalErrorJSONParser+ ) where++import Data.Aeson (eitherDecodeStrict)+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase, (@?=))++import Morley.Client.RPC.Types+import Morley.Tezos.Address (ta)+import Morley.Util.Interpolate (i, itu)++deriving stock instance Eq RunError+deriving stock instance Eq InternalError++test_RunErrorJSONParser :: TestTree+test_RunErrorJSONParser = testCase "RunError JSON parser is strict in error names" do+ eitherDecodeStrict @RunError [i|{"id": "some.prefix.delegate.already_active"}|]+ @?= Right DelegateAlreadyActive+ eitherDecodeStrict @RunError [i|{"id": "some.prefix_delegate.already_active"}|]+ @?= Left "Error in $: unknown id: some.prefix_delegate.already_active"++test_InternalErrorJSONParser :: TestTree+test_InternalErrorJSONParser = testCase "InternalError JSON parser is strict in error names" do+ eitherDecodeStrict @InternalError [itu|+ { "id": "some.prefix.unrevealed_key"+ , "contract": "tz1fsFpWk691ncq1xwS62dbotECB67B13gfC"+ }+ |]+ @?= Right (UnrevealedKey [ta|tz1fsFpWk691ncq1xwS62dbotECB67B13gfC|])+ eitherDecodeStrict @InternalError [itu|+ { "id": "some.prefix_unrevealed_key"+ , "contract": "tz1fsFpWk691ncq1xwS62dbotECB67B13gfC"+ }+ |]+ @?= Left "Error in $: unknown id: some.prefix_unrevealed_key"
test/Test/Fees.hs view
@@ -10,6 +10,7 @@ import Test.Tasty.HUnit (testCase) import Lorentz qualified as L+import Morley.Client (AliasBehavior(..)) import Morley.Client.Action.Origination import Morley.Client.Action.Transaction import Morley.Client.RPC.Types@@ -25,7 +26,7 @@ :: FakeState fakeState = defaultFakeState { fsContracts = fromList $ one $ (contractAddress2, dumbContractState)- , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitContractState)+ , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitState) } countForgesHandlers :: Handlers $ TestT (State Word)@@ -92,9 +93,9 @@ , testCase "One origination" let forgeCalls = runForgesCountingTest $- lOriginateContract True "c"+ lOriginateContract OverwriteDuplicateAlias "c" (AddressResolved genesisAddress1) [tz|10u|]- averageContract () Nothing+ averageContract () Nothing Nothing in forgeCalls @?= sum [ 2 -- for fees adjustment , 1 -- check on fees being on par
test/Test/KeyRevealing.hs view
@@ -21,8 +21,8 @@ fakeState :: FakeState fakeState = defaultFakeState { fsImplicits = one ( genesisAddress1- , dumbImplicitContractState- { csContractData = ImplicitContractData $ Just dumbManagerKey }+ , dumbImplicitState+ { asAccountData = ImplicitData $ Just dumbManagerKey } ) } @@ -72,8 +72,8 @@ void $ transfer from to [tz|10u|] DefEpName (toVal ()) Nothing originateDummy addr =- lOriginateContract True "dummy" (AddressResolved addr) [tz|10u|]- dumbLorentzContract () Nothing+ lOriginateContract OverwriteDuplicateAlias "dummy" (AddressResolved addr) [tz|10u|]+ dumbLorentzContract () Nothing Nothing -- | Handlers which don't allow to reveal key. noRevealHandlers :: (Monad m) => TestHandlers m
test/Test/Origination.hs view
@@ -23,7 +23,7 @@ :: FakeState fakeState = defaultFakeState { fsContracts = fromList $ one $ (contractAddress2, dumbContractState)- , fsImplicits = fromList $ one $ (genesisAddress1, dumbImplicitContractState)+ , fsImplicits = fromList $ one $ (genesisAddress1, dumbImplicitState) } dumbLorentzContract :: L.Contract Integer () ()@@ -34,12 +34,12 @@ test_lRunTransactionsUnit = testGroup "Mock test transaction sending" [ testCase "Successful origination" $ handleSuccess $ runFakeTest chainOperationHandlers fakeState $- lOriginateContract True "dummy" (AddressResolved genesisAddress1) [tz|100500u|]- dumbLorentzContract () Nothing+ lOriginateContract OverwriteDuplicateAlias "dummy" (AddressResolved genesisAddress1) [tz|100500u|]+ dumbLorentzContract () Nothing Nothing , testCase "Originator doesn't exist" $ handleUnknownContract $ runFakeTest chainOperationHandlers fakeState $- lOriginateContract True "dummy" (AddressResolved genesisAddress3) [tz|100500u|]- dumbLorentzContract () Nothing+ lOriginateContract OverwriteDuplicateAlias "dummy" (AddressResolved genesisAddress3) [tz|100500u|]+ dumbLorentzContract () Nothing Nothing ] where handleSuccess :: Either SomeException a -> Assertion@@ -51,5 +51,5 @@ assertFailure "Origination unexpectedly didn't fail." handleUnknownContract (Left e) = shouldThrow (throwM e) $ \case- UnknownContract _ -> True+ ResolveError REAddressNotFound{} -> True _ -> False
test/Test/ParameterTypeGet.hs view
@@ -30,11 +30,11 @@ L.cdr L.# L.nil L.# L.pair buildSmartContractState- :: ContractAlias -> L.Contract param () () -> ContractState 'AddressKindContract-buildSmartContractState alias contract = ContractState- { csCounter = 100500- , csAlias = alias- , csContractData = ContractData+ :: ContractAlias -> L.Contract param () () -> AccountState 'AddressKindContract+buildSmartContractState alias contract = AccountState+ { asCounter = 100500+ , asAlias = alias+ , asAccountData = ContractData OriginationScript { osCode = toExpression contract, osStorage = toExpression $ toVal () } Nothing }@@ -56,7 +56,7 @@ [ (smartContractAddr1, buildSmartContractState "lol" (testContract @Natural)) , (smartContractAddr2, buildSmartContractState "kek" (testContract @Bool)) ]- , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitContractState)+ , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitState) } test_parameterTypeGetUnit :: TestTree
test/Test/Parser.hs view
@@ -17,7 +17,7 @@ import Morley.Util.SizedList qualified as SL test_bakerFeeParser :: TestTree-test_bakerFeeParser = testGroup "tezos-client baker fee parser"+test_bakerFeeParser = testGroup "`octez-client` baker fee parser" [ testCase "resulted fee is multiplied by 1e6" $ parseBakerFeeFromOutput @1 "Fee to the baker: ꜩ0.056008\n" `shouldBe` Right (one $ TezosMutez [tz|56008u|])@@ -30,7 +30,7 @@ ] test_secretKeyEncriptionParser :: TestTree-test_secretKeyEncriptionParser = testGroup "tezos-client baker fee parser"+test_secretKeyEncriptionParser = testGroup "`octez-client` baker fee parser" [ testCase "unencrypted type can be parsed" $ parseSecretKeyEncryption "Secret Key: unencrypted:edsk4TybjbpfhcQ81R5FnxkoZy14ZyXRUzfbXrmPgqKRpcGPJanAgY" `shouldBe`
test/Test/ReadBigMapValue.hs view
@@ -26,7 +26,7 @@ fakeStateWithBigMapContract = defaultFakeState { fsContracts = fromList $ [ (contractAddress1, dumbContractState- { csContractData = (csContractData dumbContractState) & \case+ { asAccountData = (asAccountData dumbContractState) & \case ContractData os _ -> ContractData os $ Just $ mapToContractStateBigMap @Integer @Integer validBigMapId $ fromList [(2, 3), (3, 5)] }
test/Test/Transaction.hs view
@@ -10,6 +10,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) +import Morley.Client (ResolveError(..), TezosClientError(..)) import Morley.Client.Action.Transaction import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress3) import Morley.Michelson.Untyped.Entrypoints@@ -22,7 +23,7 @@ :: FakeState fakeState = defaultFakeState { fsContracts = fromList $ one (contractAddress2, dumbContractState)- , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitContractState)+ , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitState) } test_lRunTransactionsUnit :: TestTree@@ -50,5 +51,5 @@ assertFailure "Transaction sending unexpectedly didn't fail." handleUnknownContract (Left e) = shouldThrow (throwM e) $ \case- UnknownContract _ -> True+ ResolveError REAddressNotFound{} -> True _ -> False
test/Test/Util.hs view
@@ -5,7 +5,7 @@ module Test.Util ( chainOperationHandlers , dumbContractState- , dumbImplicitContractState+ , dumbImplicitState , dumbManagerKey , mapToContractStateBigMap , handleGetBigMapValue@@ -22,7 +22,7 @@ import Data.ByteString.Lazy qualified as LBS (toStrict) import Data.Map as Map (elems, insert, lookup, toList) import Data.Singletons (demote)-import Fmt ((+|), (|+))+import Fmt (pretty, (+|), (|+)) import Network.HTTP.Types.Status (status404) import Network.HTTP.Types.Version (http20) import Servant.Client.Core@@ -33,6 +33,7 @@ import Lorentz.Constraints import Lorentz.Pack import Morley.Client.RPC.Types+import Morley.Client.TezosClient (AliasBehavior(..), TezosClientError(DuplicateAlias)) import Morley.Client.Types import Morley.Micheline import Morley.Michelson.Typed@@ -59,11 +60,11 @@ } -- | Initial simple contract fake state.-dumbContractState :: ContractState 'AddressKindContract-dumbContractState = ContractState- { csCounter = 100500- , csAlias = "genesis2"- , csContractData = ContractData+dumbContractState :: AccountState 'AddressKindContract+dumbContractState = AccountState+ { asCounter = 100500+ , asAlias = "genesis2"+ , asAccountData = ContractData OriginationScript { osCode = toExpression $ compileLorentz L.drop , osStorage = toExpression $ toVal ()@@ -71,11 +72,11 @@ Nothing } -dumbImplicitContractState :: ContractState 'AddressKindImplicit-dumbImplicitContractState = ContractState- { csCounter = 100500- , csAlias = "genesis1"- , csContractData = ImplicitContractData Nothing+dumbImplicitState :: AccountState 'AddressKindImplicit+dumbImplicitState = AccountState+ { asCounter = 100500+ , asAlias = "genesis1"+ , asAccountData = ImplicitData Nothing } -- | Fake handlers used for transaction sending and contract origination.@@ -93,8 +94,7 @@ , hSignBytes = \_ _ -> pure . SignatureEd25519 . Ed25519.sign testSecretKey , hWaitForOperation = id- , hGetAlias = handleGetAlias- , hResolveAddressMaybe = handleResolveAddressMaybe+ , hGetAliasesAndAddresses = handleGetAliasesAndAddresses , hRememberContract = handleRememberContract , hGetKeyPassword = \_ -> pure Nothing , hGenKey = handleGenKey@@ -132,8 +132,8 @@ assertHeadBlockId blk FakeState{..} <- get case lookup addr fsImplicits of- Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved addr- Just ContractState{..} -> pure $ csCounter+ Nothing -> throwM $ UnknownAccount $ Constrained addr+ Just AccountState{..} -> pure $ asCounter handleGetBlockConstants :: MonadState FakeState m@@ -198,32 +198,35 @@ case wcoCustom op of -- Ensure that transaction sender exists OpTransfer TransactionOperation{..} -> case lookup codSource fsImplicits of- Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved codSource- Just ContractState{..} -> do+ Nothing -> throwM $ UnknownAccount $ Constrained codSource+ Just AccountState{..} -> do -- Ensure that sender counter matches- unless (csCounter + 1 == codCounter) (throwM CounterMismatch)+ unless (asCounter + 1 == codCounter) (throwM CounterMismatch) case toDestination of MkAddress dest@ContractAddress{} -> case lookup dest fsContracts of- Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved dest+ Nothing -> throwM $ UnknownAccount $ Constrained dest Just _ -> pure [] MkAddress dest@ImplicitAddress{} -> case lookup dest fsImplicits of- Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved dest+ Nothing -> throwM $ UnknownAccount $ Constrained dest Just _ -> pure [] MkAddress TxRollupAddress{} -> error "tx rollup unsupported" -- Ensure that originator exists OpOriginate _ -> case lookup codSource fsImplicits of- Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved codSource- Just ContractState{..} -> do+ Nothing -> throwM $ UnknownAccount $ Constrained codSource+ Just AccountState{..} -> do -- Ensure that originator counter matches- unless (csCounter + 1 == codCounter) (throwM CounterMismatch)+ unless (asCounter + 1 == codCounter) (throwM CounterMismatch) pure [dummyContractAddr] where dummyContractAddr = [ta|KT1LZwEZqbqtLYhwzaidBp6So9LgYDpkpEv7|] OpReveal _ -> -- We do not care about reveals at the moment return []+ OpDelegation _ ->+ -- We do not care about delegations at the moment+ return [] where CommonOperationData{..} = wcoCommon op @@ -244,7 +247,7 @@ FakeState{..} <- get case lookup addr fsContracts of Nothing -> throwM $ err404 path- Just ContractState{..} -> case csContractData of+ Just AccountState{..} -> case asAccountData of ContractData script _ -> pure script where path = "/chains/main/blocks/head/context/contracts/" <> formatAddress addr <> "/script"@@ -256,7 +259,7 @@ let allBigMaps :: [ContractStateBigMap] = catMaybes $- Map.elems (fsContracts st) <&> \cs -> case (csContractData cs) of+ Map.elems (fsContracts st) <&> \cs -> case (asAccountData cs) of ContractData _ bigMapMaybe -> bigMapMaybe -- Check if a big_map with the given ID exists and, if so, check@@ -270,43 +273,41 @@ where path = "/chains/main/blocks/head/context/big_maps/" <> show bigMapId <> "/" <> scriptExpr -handleRememberContract :: Monad m => Bool -> ContractAddress -> ContractAlias -> TestT m ()+handleRememberContract :: Monad m => AliasBehavior -> ContractAddress -> ContractAlias -> TestT m ()+handleRememberContract DontSaveAlias _ _ = pass handleRememberContract replaceExisting addr alias = do let- cs = dumbContractState { csAlias = alias }+ cs = dumbContractState { asAlias = alias } remember addr' cs' FakeState{..} = modify $ \s -> s { fsContracts = insert addr' cs' fsContracts } st@FakeState{..} <- get case lookup addr fsContracts of Nothing -> remember addr cs st- _ -> bool pass (remember addr cs st) replaceExisting+ _ -> case replaceExisting of+ KeepDuplicateAlias -> pass+ OverwriteDuplicateAlias -> remember addr cs st+ ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias handleGenKey :: Monad m => ImplicitAlias -> TestT m ImplicitAddress handleGenKey alias = do let addr = detGenKeyAddress (encodeUtf8 $ unAlias alias)- newContractState = dumbImplicitContractState { csAlias = alias }+ newAccountState = dumbImplicitState { asAlias = alias } modify $ \s ->- s & fsImplicitsL . at addr ?~ newContractState+ s & fsImplicitsL . at addr ?~ newAccountState pure addr -handleGetAlias- :: forall m kind. (Monad m, HasCallStack)- => AddressOrAlias kind -> TestT m (Alias kind)-handleGetAlias = \case- AddressAlias alias -> pure alias- AddressResolved addr -> do- FakeState{..} <- get- case addr of- ContractAddress{} -> go addr fsContracts- ImplicitAddress{} -> go addr fsImplicits- TxRollupAddress{} -> error "tx rollup unsupported"+handleGetAliasesAndAddresses+ :: forall m. Monad m+ => TestT m [(Text, Text)]+handleGetAliasesAndAddresses = do+ FakeState{fsContracts, fsImplicits} <- get+ pure $ convert fsContracts <> convert fsImplicits where- go :: KindedAddress kind -> Map (KindedAddress kind) (ContractState kind) -> TestT m (Alias kind)- go addr m = case lookup addr m of- Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved addr- Just ContractState{..} -> pure $ csAlias+ convert :: Map (KindedAddress kind) (AccountState kind) -> [(Text, Text)]+ convert m =+ Map.toList m <&> \(addr, AccountState{asAlias}) -> (pretty asAlias, pretty addr) handleGetManagerKey :: (Monad m) => BlockId -> ImplicitAddress -> TestT m (Maybe PublicKey) handleGetManagerKey blk addr = do@@ -314,9 +315,9 @@ s <- get let mbCs = s ^. fsImplicitsL . at addr case mbCs of- Just ContractState{..} -> case csContractData of- ImplicitContractData mbManagerKey -> pure mbManagerKey- Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved addr+ Just AccountState{..} -> case asAccountData of+ ImplicitData mbManagerKey -> pure mbManagerKey+ Nothing -> throwM $ UnknownAccount $ Constrained addr -- In scenarios where the system under test checks for 404 errors, we -- use this function to fake and simulate those errors.@@ -338,40 +339,22 @@ , responseBody = "Contract with given address not found" } -handleResolveAddressMaybe- :: forall m kind. Monad m- => AddressOrAlias kind- -> TestT m (Maybe (KindedAddress kind))-handleResolveAddressMaybe = \case- AddressResolved addr -> pure (Just addr)- AddressAlias alias -> do- FakeState{..} <- get- case alias of- ImplicitAlias{} -> go fsImplicits- ContractAlias{} -> go fsContracts- where- checkAlias (_, ContractState { csAlias = alias' }) = alias == alias'- go :: Map (KindedAddress kind) (ContractState kind) -> TestT m (Maybe (KindedAddress kind))- go m = case find checkAlias $ Map.toList m of- Just (addr, _) -> pure (Just addr)- Nothing -> pure Nothing- handleRevealKey :: Monad m => ImplicitAlias -> Maybe ScrubbedBytes -> TestT m () handleRevealKey alias _ = do- contracts <- gets (Map.toList . fsImplicits)- let contracts' = filter (\(_, ContractState{..}) -> csAlias == alias) contracts- case contracts' of- [] -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressAlias alias- [(addr, cs@ContractState{..})] ->- case csContractData of- ImplicitContractData (Just _) ->+ accounts <- gets (Map.toList . fsImplicits)+ let accounts' = filter (\(_, AccountState{..}) -> asAlias == alias) accounts+ case accounts' of+ [] -> throwM $ UnknownAlias alias+ [(addr, cs@AccountState{..})] ->+ case asAccountData of+ ImplicitData (Just _) -> throwM $ AlreadyRevealed $ MkAddress addr- ImplicitContractData Nothing ->+ ImplicitData Nothing -> -- We don't care about the public key itself, but only its presence.- let newContractState = cs { csContractData = ImplicitContractData $ Just dumbManagerKey }- in modify $ \s -> s & fsImplicitsL . at addr ?~ newContractState+ let newAccountState = cs { asAccountData = ImplicitData $ Just dumbManagerKey }+ in modify $ \s -> s & fsImplicitsL . at addr ?~ newAccountState _ ->- error $ "Multiple contracts have alias '" +| alias |++ error $ "Multiple accounts have alias '" +| alias |+ "'. This is most likely a bug in tests." -- | Dummy public key used in fake tests.
test/TestM.hs view
@@ -3,17 +3,16 @@ {-# OPTIONS_GHC -Wno-orphans #-} --- | Module that defines some basic infrastructure--- for faking tezos-node RPC interaction.+-- | Module that defines some basic infrastructure for faking @octez-node@ RPC+-- interaction. module TestM- ( ContractData (..)- , ContractState (..)+ ( AccountData (..)+ , AccountState (..) , ContractStateBigMap (..) , Handlers (..) , FakeState (..) , TestError (..) , TestHandlers (..)- , SomeAddressOrAlias (..) , TestM , TestT , defaultHandlers@@ -30,7 +29,9 @@ import Colog.Message (Message) import Control.Lens (makeLensesFor) import Control.Monad.Catch.Pure (CatchT(..))+import Data.Aeson (eitherDecodeStrict) import Data.ByteArray (ScrubbedBytes)+import Data.ByteString (readFile) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Fmt (pretty) @@ -76,7 +77,7 @@ , hRunCode :: BlockId -> RunCode -> m RunCodeResult , hGetChainId :: m ChainId , hGetManagerKey :: BlockId -> ImplicitAddress -> m (Maybe PublicKey)- , hGetDelegateAtBlock :: BlockId -> ContractAddress -> m (Maybe KeyHash)+ , hGetDelegateAtBlock :: BlockId -> L1Address -> m (Maybe KeyHash) -- HasTezosClient , hSignBytes :: ImplicitAddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature@@ -84,11 +85,9 @@ , hGenFreshKey :: ImplicitAlias -> m ImplicitAddress , hRevealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> m () , hWaitForOperation :: m OperationHash -> m OperationHash- , hRememberContract :: Bool -> ContractAddress -> ContractAlias -> m ()- , hResolveAddressMaybe :: forall kind. AddressOrAlias kind -> m (Maybe (KindedAddress kind))- , hGetAlias :: forall kind. AddressOrAlias kind -> m (Alias kind)+ , hRememberContract :: AliasBehavior -> ContractAddress -> ContractAlias -> m ()+ , hGetAliasesAndAddresses :: m [(Text, Text)] , hGetKeyPassword :: ImplicitAddress -> m (Maybe ScrubbedBytes)- , hRegisterDelegate :: ImplicitAlias -> Maybe ScrubbedBytes -> m () -- HasLog , hLogAction :: ClientLogAction m@@ -124,27 +123,25 @@ , hRevealKey = \_ _ -> throwM $ UnexpectedClientCall "revealKey" , hWaitForOperation = \_ -> throwM $ UnexpectedRpcCall "waitForOperation" , hRememberContract = \_ _ _ -> throwM $ UnexpectedClientCall "hRememberContract"- , hResolveAddressMaybe = \_ -> throwM $ UnexpectedRpcCall "resolveAddressMaybe"- , hGetAlias = \_ -> throwM $ UnexpectedRpcCall "getAlias"+ , hGetAliasesAndAddresses = throwM $ UnexpectedRpcCall "getAliasesAndAddresses" , hGetKeyPassword = \_ -> throwM $ UnexpectedClientCall "getKeyPassword"- , hRegisterDelegate = \_ _ -> throwM $ UnexpectedClientCall "registerDelegate" , hLogAction = mempty } --- | Type to represent contract state in the @FakeState@.+-- | Type to represent account state in the @FakeState@. -- This type can represent both implicit accounts and contracts.-data ContractState k = ContractState- { csCounter :: TezosInt64- , csAlias :: Alias k- , csContractData :: ContractData k+data AccountState k = AccountState+ { asCounter :: TezosInt64+ , asAlias :: Alias k+ , asAccountData :: AccountData k } -data ContractData k where- ContractData :: OriginationScript -> Maybe ContractStateBigMap -> ContractData 'AddressKindContract- ImplicitContractData :: Maybe PublicKey -> ContractData 'AddressKindImplicit+data AccountData k where+ ContractData :: OriginationScript -> Maybe ContractStateBigMap -> AccountData 'AddressKindContract+ ImplicitData :: Maybe PublicKey -> AccountData 'AddressKindImplicit --- | Type to represent big_map in @ContractState@.+-- | Type to represent big_map in @AccountState@. data ContractStateBigMap = ContractStateBigMap { csbmKeyType :: Expression , csbmValueType :: Expression@@ -156,7 +153,7 @@ newtype TestHandlers m = TestHandlers {unTestHandlers :: Handlers (TestT m)} -type AddressMap k = Map (KindedAddress k) (ContractState k)+type AddressMap k = Map (KindedAddress k) (AccountState k) -- | Type to represent chain state in mock tests. data FakeState = FakeState@@ -186,8 +183,16 @@ } , bcHash = BlockHash $ pretty blkId }- , fsProtocolParameters = ProtocolParameters 257 1040000 60000 15- (TezosMutez [tz|250u|])+ , fsProtocolParameters = $(do+ -- This file is the output of /chains/main/blocks/head/context/constants+ -- testnet RPC endpoint. Update it with protocol revisions as needed using+ -- scripts/update-morley-client-test-protocol-parameters.sh+ content <- liftIO $ readFile "test/data/constants.json"+ case eitherDecodeStrict @ProtocolParameters content of+ Left err -> fail err+ Right{} -> [|unsafe $ eitherDecodeStrict @ProtocolParameters content|]+ -- ok to use unsafe here as we've just successfully decoded the value.+ ) } type TestT m = StateT FakeState (ReaderT (TestHandlers m) (CatchT m))@@ -216,7 +221,8 @@ = AlreadyRevealed Address | UnexpectedRpcCall Text | UnexpectedClientCall Text- | UnknownContract SomeAddressOrAlias+ | UnknownAccount Address+ | UnknownAlias ImplicitAlias | ContractDoesntHaveBigMap Address | InvalidChainId | InvalidProtocol@@ -247,18 +253,11 @@ rememberContract replaceExisting addr alias = do h <- getHandler hRememberContract h replaceExisting addr alias- resolveAddressMaybe addr = do- h <- ask >>= \t -> pure $ hResolveAddressMaybe $ unTestHandlers t- h addr- getAlias originator = do- h <- ask >>= \t -> pure $ hGetAlias $ unTestHandlers t- h originator+ getAliasesAndAddresses = do+ join $ getHandler hGetAliasesAndAddresses getKeyPassword addr = do h <- getHandler hGetKeyPassword h addr- registerDelegate kh pw = do- h <- getHandler hRegisterDelegate- h kh pw instance Monad m => HasTezosRpc (TestT m) where getBlockHash block = do
+ test/data/constants.json view
@@ -0,0 +1,97 @@+{+ "proof_of_work_nonce_size": 8,+ "nonce_length": 32,+ "max_anon_ops_per_block": 132,+ "max_operation_data_length": 32768,+ "max_proposals_per_delegate": 20,+ "max_micheline_node_count": 50000,+ "max_micheline_bytes_limit": 50000,+ "max_allowed_global_constants_depth": 10000,+ "cache_layout_size": 3,+ "michelson_maximum_type_size": 2001,+ "sc_max_wrapped_proof_binary_size": 30000,+ "sc_rollup_message_size_limit": 4096,+ "preserved_cycles": 3,+ "blocks_per_cycle": 4096,+ "blocks_per_commitment": 32,+ "nonce_revelation_threshold": 256,+ "blocks_per_stake_snapshot": 256,+ "cycles_per_voting_period": 1,+ "hard_gas_limit_per_operation": "1040000",+ "hard_gas_limit_per_block": "5200000",+ "proof_of_work_threshold": "-1",+ "minimal_stake": "6000000000",+ "vdf_difficulty": "2000000000",+ "seed_nonce_revelation_tip": "125000",+ "origination_size": 257,+ "baking_reward_fixed_portion": "10000000",+ "baking_reward_bonus_per_slot": "4286",+ "endorsing_reward_per_slot": "2857",+ "cost_per_byte": "250",+ "hard_storage_limit_per_operation": "60000",+ "quorum_min": 2000,+ "quorum_max": 7000,+ "min_proposal_quorum": 500,+ "liquidity_baking_subsidy": "2500000",+ "liquidity_baking_toggle_ema_threshold": 1000000000,+ "max_operations_time_to_live": 120,+ "minimal_block_delay": "15",+ "delay_increment_per_round": "5",+ "consensus_committee_size": 7000,+ "consensus_threshold": 4667,+ "minimal_participation_ratio": {+ "numerator": 2,+ "denominator": 3+ },+ "max_slashing_period": 2,+ "frozen_deposits_percentage": 10,+ "double_baking_punishment": "640000000",+ "ratio_of_frozen_deposits_slashed_per_double_endorsement": {+ "numerator": 1,+ "denominator": 2+ },+ "testnet_dictator": "tz1Xf8zdT3DbAX9cHw3c3CXh79rc4nK4gCe8",+ "cache_script_size": 100000000,+ "cache_stake_distribution_cycles": 8,+ "cache_sampler_state_cycles": 8,+ "tx_rollup_enable": true,+ "tx_rollup_origination_size": 4000,+ "tx_rollup_hard_size_limit_per_inbox": 500000,+ "tx_rollup_hard_size_limit_per_message": 5000,+ "tx_rollup_max_withdrawals_per_batch": 15,+ "tx_rollup_commitment_bond": "10000000000",+ "tx_rollup_finality_period": 40000,+ "tx_rollup_withdraw_period": 40000,+ "tx_rollup_max_inboxes_count": 40100,+ "tx_rollup_max_messages_per_inbox": 1010,+ "tx_rollup_max_commitments_count": 80100,+ "tx_rollup_cost_per_byte_ema_factor": 120,+ "tx_rollup_max_ticket_payload_size": 2048,+ "tx_rollup_rejection_max_proof_size": 30000,+ "tx_rollup_sunset_level": 10000000,+ "dal_parametric": {+ "feature_enable": false,+ "number_of_slots": 256,+ "number_of_shards": 2048,+ "endorsement_lag": 1,+ "availability_threshold": 50,+ "slot_size": 1048576,+ "redundancy_factor": 16,+ "page_size": 4096+ },+ "sc_rollup_enable": false,+ "sc_rollup_origination_size": 6314,+ "sc_rollup_challenge_window_in_blocks": 20160,+ "sc_rollup_max_number_of_messages_per_commitment_period": 300000000,+ "sc_rollup_stake_amount": "10000000000",+ "sc_rollup_commitment_period_in_blocks": 30,+ "sc_rollup_max_lookahead_in_blocks": 30000,+ "sc_rollup_max_active_outbox_levels": 20160,+ "sc_rollup_max_outbox_messages_per_level": 100,+ "sc_rollup_number_of_sections_in_dissection": 32,+ "sc_rollup_timeout_period_in_blocks": 20160,+ "sc_rollup_max_number_of_cemented_commitments": 5,+ "zk_rollup_enable": false,+ "zk_rollup_origination_size": 4000,+ "zk_rollup_min_pending_to_process": 10+}