diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,71 @@ +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 ===== diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/morley-client.cabal b/morley-client.cabal --- a/morley-client.cabal +++ b/morley-client.cabal @@ -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: diff --git a/src/Morley/Client.hs b/src/Morley/Client.hs --- a/src/Morley/Client.hs +++ b/src/Morley/Client.hs @@ -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 diff --git a/src/Morley/Client/Action.hs b/src/Morley/Client/Action.hs --- a/src/Morley/Client/Action.hs +++ b/src/Morley/Client/Action.hs @@ -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 diff --git a/src/Morley/Client/Action/Common.hs b/src/Morley/Client/Action/Common.hs --- a/src/Morley/Client/Action/Common.hs +++ b/src/Morley/Client/Action/Common.hs @@ -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. -- diff --git a/src/Morley/Client/Action/Delegation.hs b/src/Morley/Client/Action/Delegation.hs new file mode 100644 --- /dev/null +++ b/src/Morley/Client/Action/Delegation.hs @@ -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) diff --git a/src/Morley/Client/Action/Operation.hs b/src/Morley/Client/Action/Operation.hs --- a/src/Morley/Client/Action/Operation.hs +++ b/src/Morley/Client/Action/Operation.hs @@ -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." diff --git a/src/Morley/Client/Action/Origination.hs b/src/Morley/Client/Action/Origination.hs --- a/src/Morley/Client/Action/Origination.hs +++ b/src/Morley/Client/Action/Origination.hs @@ -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 diff --git a/src/Morley/Client/Action/Origination/Large.hs b/src/Morley/Client/Action/Origination/Large.hs --- a/src/Morley/Client/Action/Origination/Large.hs +++ b/src/Morley/Client/Action/Origination/Large.hs @@ -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 diff --git a/src/Morley/Client/Action/Reveal.hs b/src/Morley/Client/Action/Reveal.hs --- a/src/Morley/Client/Action/Reveal.hs +++ b/src/Morley/Client/Action/Reveal.hs @@ -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 diff --git a/src/Morley/Client/Action/Transaction.hs b/src/Morley/Client/Action/Transaction.hs --- a/src/Morley/Client/Action/Transaction.hs +++ b/src/Morley/Client/Action/Transaction.hs @@ -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 diff --git a/src/Morley/Client/App.hs b/src/Morley/Client/App.hs --- a/src/Morley/Client/App.hs +++ b/src/Morley/Client/App.hs @@ -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 diff --git a/src/Morley/Client/Env.hs b/src/Morley/Client/Env.hs deleted file mode 100644 --- a/src/Morley/Client/Env.hs +++ /dev/null @@ -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 }) diff --git a/src/Morley/Client/Full.hs b/src/Morley/Client/Full.hs --- a/src/Morley/Client/Full.hs +++ b/src/Morley/Client/Full.hs @@ -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 + } diff --git a/src/Morley/Client/Init.hs b/src/Morley/Client/Init.hs --- a/src/Morley/Client/Init.hs +++ b/src/Morley/Client/Init.hs @@ -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 diff --git a/src/Morley/Client/OnlyRPC.hs b/src/Morley/Client/OnlyRPC.hs --- a/src/Morley/Client/OnlyRPC.hs +++ b/src/Morley/Client/OnlyRPC.hs @@ -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 diff --git a/src/Morley/Client/Parser.hs b/src/Morley/Client/Parser.hs --- a/src/Morley/Client/Parser.hs +++ b/src/Morley/Client/Parser.hs @@ -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 {..} diff --git a/src/Morley/Client/RPC/API.hs b/src/Morley/Client/RPC/API.hs --- a/src/Morley/Client/RPC/API.hs +++ b/src/Morley/Client/RPC/API.hs @@ -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' diff --git a/src/Morley/Client/RPC/Class.hs b/src/Morley/Client/RPC/Class.hs --- a/src/Morley/Client/RPC/Class.hs +++ b/src/Morley/Client/RPC/Class.hs @@ -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) diff --git a/src/Morley/Client/RPC/Error.hs b/src/Morley/Client/RPC/Error.hs --- a/src/Morley/Client/RPC/Error.hs +++ b/src/Morley/Client/RPC/Error.hs @@ -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 diff --git a/src/Morley/Client/RPC/Getters.hs b/src/Morley/Client/RPC/Getters.hs --- a/src/Morley/Client/RPC/Getters.hs +++ b/src/Morley/Client/RPC/Getters.hs @@ -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. diff --git a/src/Morley/Client/RPC/Types.hs b/src/Morley/Client/RPC/Types.hs --- a/src/Morley/Client/RPC/Types.hs +++ b/src/Morley/Client/RPC/Types.hs @@ -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 diff --git a/src/Morley/Client/TezosClient.hs b/src/Morley/Client/TezosClient.hs --- a/src/Morley/Client/TezosClient.hs +++ b/src/Morley/Client/TezosClient.hs @@ -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 diff --git a/src/Morley/Client/TezosClient/Class.hs b/src/Morley/Client/TezosClient/Class.hs --- a/src/Morley/Client/TezosClient/Class.hs +++ b/src/Morley/Client/TezosClient/Class.hs @@ -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: . - 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 diff --git a/src/Morley/Client/TezosClient/Impl.hs b/src/Morley/Client/TezosClient/Impl.hs --- a/src/Morley/Client/TezosClient/Impl.hs +++ b/src/Morley/Client/TezosClient/Impl.hs @@ -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: . + -} + 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 ":
" + parseLine :: Text -> (Text, Text) + parseLine = first (T.dropEnd 2) . T.breakOnEnd ": " diff --git a/src/Morley/Client/TezosClient/Parser.hs b/src/Morley/Client/TezosClient/Parser.hs --- a/src/Morley/Client/TezosClient/Parser.hs +++ b/src/Morley/Client/TezosClient/Parser.hs @@ -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 $ diff --git a/src/Morley/Client/TezosClient/Types.hs b/src/Morley/Client/TezosClient/Types.hs --- a/src/Morley/Client/TezosClient/Types.hs +++ b/src/Morley/Client/TezosClient/Types.hs @@ -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. diff --git a/src/Morley/Client/Types.hs b/src/Morley/Client/Types.hs --- a/src/Morley/Client/Types.hs +++ b/src/Morley/Client/Types.hs @@ -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 diff --git a/src/Morley/Client/Util.hs b/src/Morley/Client/Util.hs --- a/src/Morley/Client/Util.hs +++ b/src/Morley/Client/Util.hs @@ -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 diff --git a/test/Test/BigMapGet.hs b/test/Test/BigMapGet.hs --- a/test/Test/BigMapGet.hs +++ b/test/Test/BigMapGet.hs @@ -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 _) = diff --git a/test/Test/ErrorJSONParser.hs b/test/Test/ErrorJSONParser.hs new file mode 100644 --- /dev/null +++ b/test/Test/ErrorJSONParser.hs @@ -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" diff --git a/test/Test/Fees.hs b/test/Test/Fees.hs --- a/test/Test/Fees.hs +++ b/test/Test/Fees.hs @@ -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 diff --git a/test/Test/KeyRevealing.hs b/test/Test/KeyRevealing.hs --- a/test/Test/KeyRevealing.hs +++ b/test/Test/KeyRevealing.hs @@ -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 diff --git a/test/Test/Origination.hs b/test/Test/Origination.hs --- a/test/Test/Origination.hs +++ b/test/Test/Origination.hs @@ -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 diff --git a/test/Test/ParameterTypeGet.hs b/test/Test/ParameterTypeGet.hs --- a/test/Test/ParameterTypeGet.hs +++ b/test/Test/ParameterTypeGet.hs @@ -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 diff --git a/test/Test/Parser.hs b/test/Test/Parser.hs --- a/test/Test/Parser.hs +++ b/test/Test/Parser.hs @@ -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` diff --git a/test/Test/ReadBigMapValue.hs b/test/Test/ReadBigMapValue.hs --- a/test/Test/ReadBigMapValue.hs +++ b/test/Test/ReadBigMapValue.hs @@ -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)] } diff --git a/test/Test/Transaction.hs b/test/Test/Transaction.hs --- a/test/Test/Transaction.hs +++ b/test/Test/Transaction.hs @@ -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 diff --git a/test/Test/Util.hs b/test/Test/Util.hs --- a/test/Test/Util.hs +++ b/test/Test/Util.hs @@ -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. diff --git a/test/TestM.hs b/test/TestM.hs --- a/test/TestM.hs +++ b/test/TestM.hs @@ -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 diff --git a/test/data/constants.json b/test/data/constants.json new file mode 100644 --- /dev/null +++ b/test/data/constants.json @@ -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 +}