morley-client 0.1.0 → 0.1.1

raw patch · 45 files changed

+703/−1916 lines, 45 filesdep −template-haskelldep −th-reify-manydep −vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: template-haskell, th-reify-many, vector

API changes (from Hackage documentation)

Files

• CHANGES.md +27/−0
• LICENSE +3/−1
• app/Main.hs +14/−12
• morley-client.cabal +16/−15
• src/Morley/Client.hs +7/−11
• src/Morley/Client/Action.hs +4/−4
• src/Morley/Client/Action/Batched.hs +25/−13
• src/Morley/Client/Action/Common.hs +38/−11
• src/Morley/Client/Action/Operation.hs +77/−50
• src/Morley/Client/Action/Origination.hs +9/−7
• src/Morley/Client/Action/Origination/Large.hs +8/−8
• src/Morley/Client/Action/Reveal.hs +63/−0
• src/Morley/Client/Action/Transaction.hs +5/−5
• src/Morley/Client/App.hs +8/−9
• src/Morley/Client/Env.hs +3/−4
• src/Morley/Client/Full.hs +5/−20
• src/Morley/Client/Init.hs +3/−4
• src/Morley/Client/Logging.hs +1/−1
• src/Morley/Client/OnlyRPC.hs +4/−5
• src/Morley/Client/Parser.hs +13/−10
• src/Morley/Client/RPC/API.hs +2/−3
• src/Morley/Client/RPC/AsRPC.hs +0/−745
• src/Morley/Client/RPC/Class.hs +2/−3
• src/Morley/Client/RPC/Error.hs +8/−4
• src/Morley/Client/RPC/Getters.hs +4/−5
• src/Morley/Client/RPC/QueryFixedParam.hs +2/−3
• src/Morley/Client/RPC/Types.hs +101/−60
• src/Morley/Client/TezosClient/Class.hs +5/−5
• src/Morley/Client/TezosClient/Impl.hs +42/−20
• src/Morley/Client/TezosClient/Parser.hs +23/−19
• src/Morley/Client/TezosClient/Types.hs +4/−5
• src/Morley/Client/Types.hs +24/−0
• src/Morley/Client/Util.hs +44/−31
• src/Morley/Util/Batching.hs +4/−5
• test/Test/AsRPC.hs +0/−658
• test/Test/BigMapGet.hs +3/−4
• test/Test/Fees.hs +6/−7
• test/Test/KeyRevealing.hs +6/−7
• test/Test/Origination.hs +5/−6
• test/Test/ParameterTypeGet.hs +7/−8
• test/Test/Parser.hs +9/−9
• test/Test/ReadBigMapValue.hs +2/−3
• test/Test/Transaction.hs +6/−7
• test/Test/Util.hs +48/−101
• test/TestM.hs +13/−8

@@ -1,6 +1,33 @@ <!-- Unreleased: append new entries here -->  +0.1.1+=====+* [!1094](https://gitlab.com/morley-framework/morley/-/merge_requests/1094)+  Deprecate morley language extensions+  + Morley language extensions now require `--deprecated-morley-extensions` flag to parse.+* [!1077](https://gitlab.com/morley-framework/morley/-/merge_requests/1077)+  Ithaca changes: Use `head~2` block in the `branch` field of RPC operations.+* [!1034](https://gitlab.com/morley-framework/morley/-/merge_requests/1034)+  Add key revealing that uses only RPC.+* [!965](https://gitlab.com/morley-framework/morley/-/merge_requests/965)+  Use Morley's fixed-size lists+  + Use `SizedList` for `feeOutputParser`+* [!1072](https://gitlab.com/morley-framework/morley/-/merge_requests/1072)+  Add `runCode` to Cleveland+  + `runContract` now supports parameter/storage values in their RPC+    representation (i.e. with bigmap IDs).+* [!1070](https://gitlab.com/morley-framework/morley/-/merge_requests/1070)+  Simplify cleveland's internals & public api+  + Removed `runContractSimple`, added `runContractParameters` and lenses.+* [!1060](https://gitlab.com/morley-framework/morley/-/merge_requests/1060)+  Move `AsRPC` type family to `morley`+* [!978](https://gitlab.com/morley-framework/morley/-/merge_requests/978)+  Make it difficult to misuse 'Show'+  + Use `Buildable` and `pretty` preferrentially.+  + Add `Buildable` instances to that effect for `FeeParserException`, `SecretKeyEncryptionParserException`.+  + Use `displayException` instead of `show` where appropriate.+ 0.1.0 ===== Initial release.

@@ -1,4 +1,6 @@-MIT License Copyright (c) 2020 Tocqueville Group+MIT License+Copyright (c) 2021-2022 Oxhead Alpha+Copyright (c) 2019-2021 Tocqueville Group  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,17 +1,19 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA +-- TODO [#712]: Remove this next major release+{-# OPTIONS_GHC -Wno-deprecations #-}+ module Main   ( main   ) where  import Control.Exception.Safe (throwString)-import qualified Data.Aeson as Aeson+import Data.Aeson qualified as Aeson import Data.Default (def) import Fmt (pretty) import GHC.IO.Encoding (setFileSystemEncoding)-import qualified Options.Applicative as Opt+import Options.Applicative qualified as Opt import System.IO (utf8)  import Morley.Client@@ -19,21 +21,21 @@ import Morley.Client.RPC (BlockOperation(..), OperationResp(..)) import Morley.Client.RPC.Getters import Morley.Client.Util (extractAddressesFromValue)-import Morley.Michelson.Runtime (prepareContract)+import Morley.Michelson.Runtime (prepareContract, prepareContractExt) import Morley.Michelson.TypeCheck (typeCheckContract, typeCheckingWith, typeVerifyParameter) import Morley.Michelson.Typed (Contract, Contract'(..), SomeContract(..)) import Morley.Michelson.Typed.Value (Value'(..))-import qualified Morley.Michelson.Untyped as U+import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address (Address(..), formatAddress) import Morley.Tezos.Core (prettyTez) import Morley.Util.Exception (throwLeft) import Morley.Util.Main (wrapMain) -mainImpl :: ClientArgsRaw -> MorleyClientM ()-mainImpl cmd =+mainImpl :: Bool -> ClientArgsRaw -> MorleyClientM ()+mainImpl exts cmd =   case cmd of     Originate OriginateArgs{..} -> do-      contract <- liftIO $ prepareContract oaMbContractFile+      contract <- liftIO $ (if exts then prepareContractExt else prepareContract) oaMbContractFile       let originator = oaOriginateFrom       (operationHash, contractAddr) <-         originateUntypedContract True oaContractName originator oaInitialBalance@@ -95,6 +97,6 @@   setFileSystemEncoding utf8    disableAlphanetWarning-  ClientArgs parsedConfig cmd <- Opt.execParser morleyClientInfo+  ClientArgs parsedConfig exts cmd <- Opt.execParser morleyClientInfo   env <- mkMorleyClientEnv parsedConfig-  runMorleyClientM env (mainImpl cmd)+  runMorleyClientM env (mainImpl exts cmd)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morley-client-version:        0.1.0+version:        0.1.1 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. category:       Blockchain@@ -13,7 +13,7 @@ bug-reports:    https://gitlab.com/morley-framework/morley/-/issues author:         Serokell, Tocqueville Group maintainer:     Serokell <hi@serokell.io>-copyright:      2020 Tocqueville Group+copyright:      2019-2021 Tocqueville Group, 2021-2022 Oxhead Alpha license:        MIT license-file:   LICENSE build-type:     Simple@@ -34,6 +34,7 @@       Morley.Client.Action.Operation       Morley.Client.Action.Origination       Morley.Client.Action.Origination.Large+      Morley.Client.Action.Reveal       Morley.Client.Action.Transaction       Morley.Client.App       Morley.Client.Env@@ -45,7 +46,6 @@       Morley.Client.RPC       Morley.Client.RPC.Aeson       Morley.Client.RPC.API-      Morley.Client.RPC.AsRPC       Morley.Client.RPC.Class       Morley.Client.RPC.Error       Morley.Client.RPC.Getters@@ -57,6 +57,7 @@       Morley.Client.TezosClient.Impl       Morley.Client.TezosClient.Parser       Morley.Client.TezosClient.Types+      Morley.Client.Types       Morley.Client.Util       Morley.Util.Batching   other-modules:@@ -86,24 +87,26 @@       FlexibleInstances       GADTs       GeneralizedNewtypeDeriving+      ImportQualifiedPost       LambdaCase       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns       NegativeLiterals-      NumericUnderscores       NumDecimals+      NumericUnderscores       OverloadedLabels       OverloadedStrings       PatternSynonyms       PolyKinds-      QuasiQuotes       QuantifiedConstraints+      QuasiQuotes       RankNTypes       RecordWildCards       RecursiveDo       ScopedTypeVariables       StandaloneDeriving+      StandaloneKindSignatures       StrictData       TemplateHaskell       TupleSections@@ -151,13 +154,10 @@     , servant-client-core     , singletons     , syb-    , template-haskell     , text-    , th-reify-many     , time     , universum     , unliftio-    , vector   default-language: Haskell2010  executable morley-client@@ -187,24 +187,26 @@       FlexibleInstances       GADTs       GeneralizedNewtypeDeriving+      ImportQualifiedPost       LambdaCase       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns       NegativeLiterals-      NumericUnderscores       NumDecimals+      NumericUnderscores       OverloadedLabels       OverloadedStrings       PatternSynonyms       PolyKinds-      QuasiQuotes       QuantifiedConstraints+      QuasiQuotes       RankNTypes       RecordWildCards       RecursiveDo       ScopedTypeVariables       StandaloneDeriving+      StandaloneKindSignatures       StrictData       TemplateHaskell       TupleSections@@ -232,7 +234,6 @@   main-is: Main.hs   other-modules:       Ingredients-      Test.AsRPC       Test.BigMapGet       Test.Fees       Test.KeyRevealing@@ -268,24 +269,26 @@       FlexibleInstances       GADTs       GeneralizedNewtypeDeriving+      ImportQualifiedPost       LambdaCase       MultiParamTypeClasses       MultiWayIf       NamedFieldPuns       NegativeLiterals-      NumericUnderscores       NumDecimals+      NumericUnderscores       OverloadedLabels       OverloadedStrings       PatternSynonyms       PolyKinds-      QuasiQuotes       QuantifiedConstraints+      QuasiQuotes       RankNTypes       RecordWildCards       RecursiveDo       ScopedTypeVariables       StandaloneDeriving+      StandaloneKindSignatures       StrictData       TemplateHaskell       TupleSections@@ -320,10 +323,8 @@     , safe-exceptions     , servant-client-core     , singletons-    , syb     , tasty     , tasty-ant-xml     , tasty-hunit-compat-    , template-haskell     , time   default-language: Haskell2010

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- 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.@@ -34,6 +33,9 @@   -- * RPC   , BlockId (..)   , HasTezosRpc (..)+  , OperationInfo (..)+  , OperationInfoDescriptor (..)+  , RPCInput   , getContract   , getImplicitContractCounter   , getContractStorage@@ -64,12 +66,6 @@   , readContractBigMapValue   , readBigMapValueMaybe   , readBigMapValue-  -- ** AsRPC-  , AsRPC-  , deriveRPC-  , deriveRPCWithStrategy-  , deriveManyRPC-  , deriveManyRPCWithStrategy    -- * @tezos-client@   , Alias@@ -90,7 +86,7 @@   , Opt.ParserInfo -- Needed for tests   ) where -import qualified Options.Applicative as Opt+import Options.Applicative qualified as Opt  import Morley.Client.Action import Morley.Client.Env@@ -99,6 +95,6 @@ import Morley.Client.OnlyRPC import Morley.Client.Parser import Morley.Client.RPC-import Morley.Client.RPC.AsRPC import Morley.Client.TezosClient+import Morley.Client.Types import Morley.Client.Util

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | High-level actions implemented in abstract monads that -- require both RPC and @tezos-client@ functionality.@@ -9,10 +8,11 @@   ( module Morley.Client.Action.Operation   , module Morley.Client.Action.Origination   , module Morley.Client.Action.Transaction+  , ClientInput   , revealKeyUnlessRevealed   ) where -import Morley.Client.Action.Common (revealKeyUnlessRevealed)+import Morley.Client.Action.Common (ClientInput, revealKeyUnlessRevealed) import Morley.Client.Action.Operation import Morley.Client.Action.Origination import Morley.Client.Action.Transaction

@@ -1,15 +1,16 @@--- SPDX-FileCopyrightText: 2021 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Primitives for running batched operations with a neat interface. module Morley.Client.Action.Batched   ( OperationsBatch (..)   , originateContractM   , runTransactionM+  , revealKeyM   , runOperationsBatch   ) where +import Control.Lens (Prism') import Fmt (Buildable(..))  import Morley.Client.Action.Common@@ -18,6 +19,7 @@ import Morley.Client.RPC.Class import Morley.Client.RPC.Types import Morley.Client.TezosClient+import Morley.Client.Types import Morley.Tezos.Address import Morley.Util.Batching @@ -38,8 +40,8 @@ newtype OperationsBatch a = OperationsBatch   { unOperationsBatch       :: BatchingM-          (Either TransactionData OriginationData)-          (Either () Address)+          (OperationInfo ClientInput)+          (OperationInfo Result)           BatchedOperationError           a   } deriving newtype (Functor, Applicative)@@ -52,19 +54,29 @@     UnexpectedOperationResult ->       "Got unexpected operation type within result of batched operation" +-- | A helper to run some operation.+--+-- It accepts+runOperationM+  :: (inp -> OperationInfo ClientInput)+  -> (Prism' (OperationInfo Result) out)+  -> inp+  -> OperationsBatch out+runOperationM wrapInp unwrapOut inp = OperationsBatch $+  wrapInp inp `submitThenParse`+    maybeToRight UnexpectedOperationResult . (^? unwrapOut)+ -- | Perform transaction within a batch. runTransactionM :: TransactionData -> OperationsBatch ()-runTransactionM td = OperationsBatch $-  Left td `submitThenParse` \case-    Left () -> pass-    Right _ -> Left UnexpectedOperationResult+runTransactionM = runOperationM OpTransfer _OpTransfer  -- | Perform origination within a batch. originateContractM :: OriginationData -> OperationsBatch Address-originateContractM od = OperationsBatch $-  Right od `submitThenParse` \case-    Left _ -> Left UnexpectedOperationResult-    Right addr -> return addr+originateContractM = runOperationM OpOriginate _OpOriginate++-- | Perform key revealing within a batch.+revealKeyM :: RevealData -> OperationsBatch ()+revealKeyM = runOperationM OpReveal _OpReveal  -- | Execute a batch. runOperationsBatch

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Module with functions that used in both transaction sending and contract -- origination.@@ -9,6 +8,8 @@   , TD (..)   , TransactionData(..)   , OriginationData(..)+  , RevealData(..)+  , ClientInput   , addOperationPrefix   , buildTxDataWithAlias   , getAppliedResults@@ -28,7 +29,7 @@ import Data.ByteArray (ScrubbedBytes) import Data.ByteString (cons) import Data.Default (def)-import Fmt (Buildable(..), Builder, pretty, (+|), (|+))+import Fmt (Buildable(..), Builder, (+|), (|+))  import Morley.Client.Logging (WithClientLog, logDebug) import Morley.Client.RPC.Class@@ -36,10 +37,11 @@ import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Client.TezosClient+import Morley.Client.Types import Morley.Client.Util import Morley.Micheline (TezosInt64, TezosMutez(..), toExpression) import Morley.Micheline.Expression (Expression(ExpressionString))-import qualified Morley.Michelson.Typed as T+import Morley.Michelson.Typed qualified as T import Morley.Michelson.Typed.Scope import Morley.Michelson.Untyped.Entrypoints import Morley.Tezos.Address@@ -97,6 +99,20 @@   , odMbFee :: Maybe Mutez   } +data RevealData = RevealData+  { rdPublicKey :: PublicKey+    -- TODO [#516]: extract mbFee out of 'TransactionData', 'OriginationData'+    -- and here, try to delete 'RevealData' datatype and pass 'PublicKey' instead+  , rdMbFee :: Maybe Mutez+  }++-- | Standard operation input in morley-client interface.+data ClientInput+instance OperationInfoDescriptor ClientInput where+  type TransferInfo ClientInput = TransactionData+  type OriginationInfo ClientInput = OriginationData+  type RevealInfo ClientInput = RevealData+ toParametersInternals   :: ParameterScope t   => EpName@@ -118,7 +134,19 @@ preProcessOperation   :: (HasTezosRpc m) => Address -> m OperationConstants preProcessOperation sourceAddr = do-  ocLastBlockHash <- getHeadBlock+  -- NOTE: The block hash returned by this function will be used in the "branch"+  -- field of other operations (e.g. `run_operation`, `forge` and `preapply`).+  --+  -- As of the introduction of the `ithaca` protocol and+  -- the Tenderbake consensus algorithm, it is no longer safe to use the `head` block+  -- as the branch of those operations, because that block "is not necessarily final".+  --+  -- Instead, we should use the `head~2` block.+  --+  -- See:+  --   * https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html+  --   * https://web.archive.org/web/20220305165704/https://tezos.gitlab.io/protocols/012_ithaca.html+  ocLastBlockHash <- getBlockHash FinalHeadId   ocBlockConstants <- getBlockConstants (BlockHashId ocLastBlockHash)   let ocFeeConstants = def   ocCounter <- getImplicitContractCounter sourceAddr@@ -188,6 +216,8 @@       | Just address <- findError _RuntimeError       , Just _ <- findError _GasExhaustedOperation         = throwM $ GasExhaustion address+      | Just address <- findError _PreviouslyRevealedKey+        = throwM $ KeyAlreadyRevealed address       | otherwise         = throwM $ UnexpectedRunErrors errs       where@@ -217,7 +247,7 @@   -- Here and further we mostly follow the Tezos implementation:   -- https://gitlab.com/tezos/tezos/-/blob/14d6dafd23eeafe30d931a41d43c99b1ebed5373/src/proto_alpha/lib_client/injection.ml#L584 -  unsafeMkMutez . ceiling . sum $+  unsafe . mkMutez @Word64 . ceiling . sum $     [ toRational $ unMutez fcBase     , toRational fcMutezPerOpByte * toRational opSize     , toRational fcMutezPerGas * toRational gasLimit@@ -277,11 +307,8 @@   }  stubSignature :: Signature-stubSignature = unsafeParseSignature+stubSignature = unsafe $ parseSignature   "edsigtXomBKi5CTRf5cjATJWSyaRvhfYNHqSUGrn4SdbYRcGwQrUGjzEfQDTuqHhuA8b2d8NarZjz8TRf65WkpQmo423BtomS8Q"-  where-    unsafeParseSignature :: HasCallStack => Text -> Signature-    unsafeParseSignature = either (error . pretty) id . parseSignature  addOperationPrefix :: ByteString -> ByteString addOperationPrefix = cons 0x03

@@ -1,19 +1,20 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Implementation of generic operations submission. module Morley.Client.Action.Operation-  ( runOperations+  ( Result+  , runOperations   , runOperationsNonEmpty   -- helpers   , dryRunOperationsNonEmpty   ) where +import Control.Lens (has, (%=), (&~)) import Data.List (zipWith4)-import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty qualified as NE import Data.Singletons (Sing, SingI, sing)-import qualified Data.Text as T+import Data.Text qualified as T import Fmt (blockListF', listF, pretty, (+|), (|+))  import Morley.Client.Action.Common@@ -23,11 +24,19 @@ import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Client.TezosClient+import Morley.Client.Types import Morley.Micheline (StringEncode(..), TezosInt64, TezosMutez(..)) import Morley.Tezos.Address import Morley.Tezos.Crypto import Morley.Util.ByteString +-- | Designates output of an operation.+data Result+instance OperationInfoDescriptor Result where+  type TransferInfo Result = ()+  type OriginationInfo Result = Address+  type RevealInfo Result = ()+ logOperations   :: forall (runMode :: RunMode) env m.      ( WithClientLog env m@@ -35,21 +44,24 @@      , SingI runMode -- We don't ask aliases with 'tezos-client' in 'DryRun' mode      )   => AddressOrAlias-  -> NonEmpty (Either TransactionData OriginationData)+  -> NonEmpty (OperationInfo ClientInput)   -> m () logOperations sender ops = do   let runMode = sing @runMode        opName =-        if | all isLeft ops -> "transactions"-           | all isRight ops -> "originations"+        if | all (has _OpTransfer) ops -> "transactions"+           | all (has _OpOriginate) ops -> "originations"+           | all (has _OpReveal) ops -> "reveals"            | otherwise -> "operations"        buildOp = \case-        (Left tx, mbAlias) ->+        (OpTransfer tx, mbAlias) ->           buildTxDataWithAlias mbAlias tx-        (Right orig, _) ->+        (OpOriginate orig, _) ->           odName orig |+ " (temporary alias)"+        (OpReveal rv, mbAlias) ->+          "Key " +| rdPublicKey rv |+ maybe "" (\a -> " (" +| a |+ ")") mbAlias    sender' <- case sender of     addr@AddressResolved{} -> case runMode of@@ -60,10 +72,12 @@   aliases <- case runMode of     SRealRun ->       forM ops $ \case-        Left (TransactionData tx) ->+        OpTransfer (TransactionData tx) ->           Just <$> (getAlias . AddressResolved $ tdReceiver tx)-        _ ->+        OpOriginate _ ->           pure Nothing+        OpReveal r ->+          Just <$> (getAlias . AddressResolved . mkKeyAddress $ rdPublicKey r)     SDryRun -> pure $ ops $> Nothing    logInfo $ T.strip $ -- strip trailing newline@@ -81,8 +95,8 @@      , WithClientLog env m      )   => AddressOrAlias-  -> [Either TransactionData OriginationData]-  -> m (Maybe OperationHash, [Either () Address])+  -> [OperationInfo ClientInput]+  -> m (Maybe OperationHash, [OperationInfo Result]) runOperations sender operations = case operations of   [] -> return (Nothing, [])   op : ops -> do@@ -100,8 +114,8 @@      , WithClientLog env m      )   => AddressOrAlias-  -> NonEmpty (Either TransactionData OriginationData)-  -> m (OperationHash, NonEmpty (Either () Address))+  -> NonEmpty (OperationInfo ClientInput)+  -> m (OperationHash, NonEmpty (OperationInfo Result)) runOperationsNonEmpty sender operations =   runOperationsNonEmptyHelper @'RealRun sender operations @@ -117,7 +131,7 @@ -- @runOperationsNonEmptyHelper@. type family RunResult (a :: RunMode) where   RunResult 'DryRun = NonEmpty (AppliedResult, TezosMutez)-  RunResult 'RealRun = (OperationHash, NonEmpty (Either () Address))+  RunResult 'RealRun = (OperationHash, NonEmpty (OperationInfo Result))  data SingRunResult :: RunMode -> Type where   SDryRun :: SingRunResult 'DryRun@@ -142,7 +156,7 @@      , WithClientLog env m      )   => AddressOrAlias-  -> NonEmpty (Either TransactionData OriginationData)+  -> NonEmpty (OperationInfo ClientInput)   -> m (NonEmpty (AppliedResult, TezosMutez)) dryRunOperationsNonEmpty sender operations =   runOperationsNonEmptyHelper @'DryRun sender operations@@ -158,38 +172,43 @@      , SingI runMode      )   => AddressOrAlias-  -> NonEmpty (Either TransactionData OriginationData)+  -> NonEmpty (OperationInfo ClientInput)   -> m (RunResult runMode) runOperationsNonEmptyHelper sender operations = do   logOperations @runMode sender operations   senderAddress <- resolveAddress sender   prohibitContractSender senderAddress $ head operations   mbPassword <- getKeyPassword senderAddress-  when (isRealRun @runMode) $+  when (isRealRun @runMode && mayNeedSenderRevealing (toList operations)) $     revealKeyUnlessRevealed senderAddress mbPassword    pp <- getProtocolParameters   OperationConstants{..} <- preProcessOperation senderAddress -  let convertOps i = \case-        Left (TransactionData TD {..}) ->-          Left TransactionOperation+  let convertOps i = OperationInput commonData . \case+        OpTransfer (TransactionData TD {..}) ->+          OpTransfer TransactionOperation           { toDestination = tdReceiver-          , toCommonData = commonData           , toAmount = TezosMutez tdAmount           , toParameters = toParametersInternals tdEpName tdParam           }-        Right OriginationData{..} ->-          Right OriginationOperation-          { ooCommonData = commonData-          , ooBalance = TezosMutez odBalance+        OpOriginate OriginationData{..} ->+          OpOriginate OriginationOperation+          { ooBalance = TezosMutez odBalance           , ooScript = mkOriginationScript odContract odStorage           }+        OpReveal RevealData{..} ->+          OpReveal RevealOperation+          { roPublicKey = rdPublicKey+          }         where           commonData = mkCommonOperationData senderAddress (ocCounter + i) pp    let opsToRun = NE.zipWith convertOps (1 :| [(2 :: TezosInt64)..]) operations-      mbFees = map (either (\(TransactionData TD {..}) -> tdMbFee) odMbFee) operations+      mbFees = operations <&> \case+        OpTransfer (TransactionData TD {..}) -> tdMbFee+        OpOriginate OriginationData{..} -> odMbFee+        OpReveal RevealData{..} -> rdMbFee    -- Perform run_operation with dumb signature in order   -- to estimate gas cost, storage size and paid storage diff@@ -204,7 +223,7 @@   results <- getAppliedResults (Left runOp)    let -- Learn how to forge given operations-      forgeOp :: NonEmpty (Either TransactionOperation OriginationOperation) -> m ByteString+      forgeOp :: NonEmpty OperationInput -> m ByteString       forgeOp ops =         fmap unHexJSONByteString . forgeOperation $ ForgeOperation           { foBranch = ocLastBlockHash@@ -226,13 +245,11 @@             updateCommonData gasLimit storageLimit (TezosMutez fee)        (_fee, op, mReadySignedOp) <- convergingFee-        @(Either TransactionOperation OriginationOperation)+        @OperationInput         @(Maybe (Signature, ByteString))  -- ready operation and its signature         (\fee ->-          return $ bimap-            (toCommonDataL %~ updateCommonDataForFee fee)-            (ooCommonDataL %~ updateCommonDataForFee fee)-            opToRun+          return $ opToRun &~+            oiCommonDataL %= updateCommonDataForFee fee           )         (\op -> do           forgedOp <- forgeOp $ one op@@ -287,35 +304,41 @@   ars2 <- getAppliedResults (Right preApplyOp)   case sing @runMode of     SDryRun -> do-      let fees = flip map updOps $ \case-            Left (TransactionOperation commonData _ _ _) -> codFee commonData-            Right (OriginationOperation commonData _ _) -> codFee commonData+      let fees = map (codFee . oiCommonData) updOps       return $ NE.zip ars2 fees     SRealRun -> do       operationHash <- injectOperation (HexJSONByteString signedOp)       waitForOperation operationHash       let contractAddrs = arOriginatedContracts <$> ars2       opsRes <- forM (NE.zip operations contractAddrs) $ \case-        (Left _, []) ->-          return $ Left ()-        (Left _, addrs) -> do+        (OpTransfer _, []) ->+          return $ OpTransfer ()+        (OpTransfer _, addrs) -> do           logInfo . T.strip $             "The following contracts were originated during transactions: " +|             listF addrs |+ ""-          return $ Left ()-        (Right _, []) ->+          return $ OpTransfer ()+        (OpOriginate _, []) ->           throwM RpcOriginatedNoContracts-        (Right OriginationData{..}, [addr]) -> do+        (OpOriginate OriginationData{..}, [addr]) -> do           logDebug $ "Saving " +| addr |+ " for " +| odName |+ "\n"           rememberContract odReplaceExisting addr (AnAliasHint odName)           alias <- getAlias $ AddressResolved addr           logInfo $ "Originated contract: " <> pretty alias-          return $ Right addr-        (Right _, addrs@(_ : _ : _)) ->+          return $ OpOriginate addr+        (OpOriginate _, addrs@(_ : _ : _)) ->           throwM $ RpcOriginatedMoreContracts addrs+        (OpReveal _, _) ->+          return $ OpReveal ()       forM_ ars2 logStatistics       return (operationHash, opsRes)   where+    mayNeedSenderRevealing :: [OperationInfo i] -> Bool+    mayNeedSenderRevealing = any \case+      OpTransfer{} -> True+      OpOriginate{} -> True+      OpReveal{} -> False+     logStatistics :: AppliedResult -> m ()     logStatistics ar = do       let showTezosInt64 = show . unStringEncode@@ -323,8 +346,12 @@       logInfo $ "Storage size: " <> showTezosInt64 (arStorageSize ar)       logInfo $ "Paid storage size diff: " <> showTezosInt64 (arPaidStorageDiff ar) -    prohibitContractSender :: Address -> Either TransactionData OriginationData -> m ()+    prohibitContractSender :: Address -> OperationInfo ClientInput -> m ()     prohibitContractSender addr op = case (addr, op) of       (KeyAddress _, _) -> pass-      (ContractAddress _, Left _) -> throwM $ ContractSender addr "transfer"-      (ContractAddress _, Right _) -> throwM $ ContractSender addr "origination"+      (ContractAddress _, op') -> throwM $ ContractSender addr (opName op')++    opName = \case+      OpTransfer _ -> "transfer"+      OpOriginate _ -> "origination"+      OpReveal _ -> "reveal"

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Functions to originate smart contracts via @tezos-client@ and node RPC. module Morley.Client.Action.Origination@@ -25,7 +24,7 @@   ) where  import Data.Default (def)-import qualified Lorentz as L+import Lorentz qualified as L import Lorentz.Constraints import Morley.Client.Action.Common import Morley.Client.Action.Operation@@ -36,10 +35,11 @@ import Morley.Client.RPC.Error import Morley.Client.RPC.Types import Morley.Client.TezosClient+import Morley.Client.Types import Morley.Michelson.TypeCheck (typeCheckContractAndStorage, typeCheckingWith) import Morley.Michelson.Typed (Contract, IsoValue(..), SomeContractAndStorage(..), Value) import Morley.Michelson.Typed.Scope-import qualified Morley.Michelson.Untyped as U+import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address import Morley.Tezos.Core import Morley.Util.Exception@@ -57,10 +57,12 @@   -> [OriginationData]   -> m (Maybe OperationHash, [Address]) originateContracts sender originations = do-  (opHash, res) <- runOperations sender (Right <$> originations)+  (opHash, res) <- runOperations sender (OpOriginate <$> originations)   return (opHash, fromOrigination <$> res)   where-    fromOrigination = either (error "Unexpected transaction") id+    fromOrigination = \case+      OpOriginate r -> r+      _ -> error "Unexpectedly not origination"  -- | Originate single contract originateContract

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2021 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- TODO: ideally the "originator" contract would be the same for every large -- contract, but due to a bug (tezos/tezos/1154) we cannot push @big_map@s right@@ -40,7 +39,7 @@  import Prelude hiding (concat, drop, swap) -import qualified Data.ByteString.Lazy as LBS+import Data.ByteString.Lazy qualified as LBS  import Lorentz import Morley.Client.Action.Common@@ -50,7 +49,8 @@ import Morley.Client.TezosClient import Morley.Micheline (fromExpression) import Morley.Michelson.Interpret.Pack (packValue)-import qualified Morley.Michelson.Typed as T+import Morley.Michelson.Parser (notes)+import Morley.Michelson.Typed qualified as T import Morley.Michelson.Typed.Instr import Morley.Michelson.Typed.Scope import Morley.Michelson.Typed.Util (PushableStorageSplit(..), splitPushableStorage)@@ -129,7 +129,7 @@   => T.Contract LargeOriginatorParam (LargeOriginatorStore heavy) largeContractOriginator = T.Contract{..}   where-    epsNotes = T.NTOr noAnn [annQ|load_lambda|] [annQ|run_lambda|] T.starNotes T.starNotes+    epsNotes = [notes|or (bytes %load_lambda) (unit %run_lambda)|]     cParamNotes = fromRight T.starParamNotes $ T.mkParamNotes epsNotes noAnn      stateNotes = T.NTOr noAnn [annQ|originated|] [annQ|loading|] T.starNotes T.starNotes@@ -224,7 +224,7 @@   SomeLargeContractOriginator heavyVal origContract _origLambda -> OriginationData     { odReplaceExisting = odReplaceExisting $ largeContractData     , odName = "largeOriginator." <> odName largeContractData-    , odBalance = toMutez 0+    , 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@@ -251,7 +251,7 @@               }             mkLoadLambda bytes = TransactionData @'T.TBytes $ TD               { tdReceiver = originatorAddr-              , tdAmount   = toMutez 0+              , tdAmount   = zeroMutez               , tdEpName   = eprName $ Call @"load_lambda"               , tdParam    = VBytes bytes               , tdMbFee    = odMbFee

@@ -0,0 +1,63 @@+-- SPDX-FileCopyrightText: 2022 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++-- | Functions to reveal keys via node RPC.+module Morley.Client.Action.Reveal+  ( RevealData (..)+  , revealKey+  , revealKeyUnlessRevealed+  ) where++import Fmt ((|+))++import Morley.Client.Action.Common hiding (revealKeyUnlessRevealed)+import Morley.Client.Action.Operation+import Morley.Client.Logging+import Morley.Client.RPC.Class+import Morley.Client.RPC.Error+import Morley.Client.RPC.Getters+import Morley.Client.RPC.Types+import Morley.Client.TezosClient (AddressOrAlias(..), HasTezosClient)+import Morley.Client.Types+import Morley.Tezos.Address++-- | Reveal given key.+--+-- This is a variation of key revealing method that tries to use solely RPC.+revealKey+  :: forall m env.+     ( HasTezosRpc m+     , HasTezosClient m+     , WithClientLog env m+     )+  => Address+  -> RevealData+  -> m OperationHash+revealKey sender revealing = do+  (mOpHash, _) <- runOperations (AddressResolved sender) [OpReveal revealing]+  case mOpHash of+    Just hash -> return hash+    _ -> throwM RpcNoOperationsRun++-- | Reveal given key.+revealKeyUnlessRevealed+  :: forall m env.+     ( HasTezosRpc m+     , HasTezosClient m+     , WithClientLog env m+     )+  => Address+  -> RevealData+  -> m ()+revealKeyUnlessRevealed sender param = do+  -- An optimization for the average case, but we can't rely on it in+  -- distributed environment+  mManagerKey <- getManagerKey sender+  case mManagerKey of+    Just _  -> logDebug $ sender |+ " address has already revealed key"+    Nothing -> ignoreAlreadyRevealedError $ void (revealKey sender param)+  where+    ignoreAlreadyRevealedError action =+      action `catch` \case+        RunCodeErrors [PreviouslyRevealedKey _] -> pass+        e -> throwM e

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA -- | Functions to submit transactions via @tezos-client@ and node RPC.  module Morley.Client.Action.Transaction@@ -26,7 +25,8 @@ import Morley.Client.RPC.Types import Morley.Client.TezosClient.Class import Morley.Client.TezosClient.Types-import qualified Morley.Michelson.Typed as T+import Morley.Client.Types+import Morley.Michelson.Typed qualified as T import Morley.Michelson.Typed.Scope import Morley.Michelson.Untyped.Entrypoints import Morley.Tezos.Address@@ -44,7 +44,7 @@   => Address -> [TransactionData]   -> m (Maybe OperationHash) runTransactions sender transactions = do-  (opHash, _) <- runOperations (AddressResolved sender) (Left <$> transactions)+  (opHash, _) <- runOperations (AddressResolved sender) (OpTransfer <$> transactions)   return opHash  -- | Lorentz version of 'TransactionData'.

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Functions useful for implementing instances of type classes from this package. -- Monads and actual instances are defined in separate modules.@@ -40,10 +39,11 @@   , handleInvalidCounterRpc   ) where +import Unsafe qualified (fromIntegral, (!!))+ import Control.Concurrent (threadDelay)-import qualified Data.Aeson as Aeson-import qualified Data.Binary.Builder as Binary-import Data.List ((!!))+import Data.Aeson qualified as Aeson+import Data.Binary.Builder qualified as Binary import Data.Text (isInfixOf) import Fmt (Buildable(..), Builder, build, pretty, (+|), (|+)) import Network.HTTP.Types (Status(..), renderQuery)@@ -54,11 +54,10 @@ import System.Random (randomRIO) import UnliftIO (MonadUnliftIO) import UnliftIO.Timeout (timeout)-import qualified Unsafe (fromIntegral)  import Morley.Client.Logging (WithClientLog, logDebug) import Morley.Client.RPC-import qualified Morley.Client.RPC.API as API+import Morley.Client.RPC.API qualified as API import Morley.Micheline (Expression, TezosInt64, TezosNat, unTezosMutez) import Morley.Tezos.Address (Address) import Morley.Tezos.Core (ChainId, Mutez, parseChainId)@@ -286,7 +285,7 @@ waitBeforeRetry :: (MonadIO m, HasTezosRpc m, WithClientLog env m) => m () waitBeforeRetry = do   i <- liftIO $-    (blockAwaitAmounts !!) <$> randomRIO (0, length blockAwaitAmounts - 1)+    (blockAwaitAmounts Unsafe.!!) <$> randomRIO (0, length blockAwaitAmounts - 1)   logDebug $ "Invalid counter error occurred, retrying the request after " <> show i <> " blocks"   ProtocolParameters {..} <- getProtocolParameters   -- Invalid counter error may occur in case we try to perform multiple operations

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Runtime environment for @morley-client@. @@ -18,7 +17,7 @@ import Morley.Util.Lens (makeLensesWith, postfixLFields) import Servant.Client (ClientEnv) -import qualified Morley.Tezos.Crypto.Ed25519 as Ed25519+import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519  import Morley.Client.Logging (ClientLogAction) import Morley.Client.TezosClient.Types

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2021 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  {-# LANGUAGE InstanceSigs #-} @@ -21,11 +20,10 @@ import Morley.Client.Env (MorleyClientEnv'(..)) import Morley.Client.RPC.Class import Morley.Client.TezosClient.Class-import Morley.Client.TezosClient.Impl (TezosClientError(..))-import qualified Morley.Client.TezosClient.Impl as TezosClient+import Morley.Client.TezosClient.Impl qualified as TezosClient import Morley.Client.TezosClient.Types import Morley.Tezos.Crypto (Signature(..))-import qualified Morley.Tezos.Crypto.Ed25519 as Ed25519+import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519  type MorleyClientEnv = MorleyClientEnv' MorleyClientM @@ -40,7 +38,7 @@ -- in case of invalid counter error. runMorleyClientM :: MorleyClientEnv -> MorleyClientM a -> IO a runMorleyClientM env client =-  runReaderT (unMorleyClientM (retryInvalidCounter client)) env+  runReaderT (unMorleyClientM client) env  instance HasLog MorleyClientEnv Message MorleyClientM where   getLogAction = mceLogAction@@ -102,16 +100,3 @@   runCodeAtBlock = runCodeImpl   getChainId = getChainIdImpl   getManagerKeyAtBlock = getManagerKeyImpl---- | Helper function that retries 'MorleyClientM' action in case of counter error.-retryInvalidCounter :: forall a. MorleyClientM a -> MorleyClientM a-retryInvalidCounter action = do-  action `catch` handleInvalidCounterRpc retryAction-         `catch` handleTezosClientError-  where-    handleTezosClientError :: TezosClientError -> MorleyClientM a-    handleTezosClientError = \case-      CounterIsAlreadyUsed _ _ -> retryAction-      anotherErr -> throwM anotherErr--    retryAction = waitBeforeRetry >> retryInvalidCounter action

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Morley client initialization. module Morley.Client.Init@@ -28,7 +27,7 @@ import Morley.Client.RPC.HttpClient import Morley.Client.TezosClient.Impl (getTezosClientConfig) import Morley.Client.TezosClient.Types-import qualified Morley.Tezos.Crypto.Ed25519 as Ed25519+import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519  -- | Data necessary for morley client initialization. data MorleyClientConfig = MorleyClientConfig

@@ -20,8 +20,8 @@   , logFlush   ) where --- Implicit import should be fine because it's a tiny re-export module. import Colog+  (LogAction(..), Message, WithLog, logDebug, logError, logException, logInfo, logWarning) import System.IO (hFlush)  -- | 'LogAction' with fixed message parameter.

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2021 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- 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@@ -16,7 +15,7 @@  import Colog (HasLog(..), Message) import Control.Lens (at)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Fmt ((+|), (|+)) import Servant.Client (BaseUrl, ClientEnv) import Servant.Client.Core (RunClient(..))@@ -133,7 +132,6 @@    -- Stateful actions that simply do nothing because there is no persistent state.   rememberContract = \_ _ _ -> pass-  importKey = \_ _ _ -> pass    -- We return a dummy value here, because this function is used in a lot of   -- places and with an exception here it's not possible to send transactions.@@ -144,6 +142,7 @@   -- Actions that are not supported and simply throw exceptions.   genKey _ = throwM $ UnsupportedByOnlyRPC "genKey"   genFreshKey _ = throwM $ UnsupportedByOnlyRPC "genFreshKey"+  importKey _ _ _ = throwM $ UnsupportedByOnlyRPC "importKey"   revealKey _ _ = throwM $ UnsupportedByOnlyRPC "revealKey"   resolveAddressMaybe _ = throwM $ UnsupportedByOnlyRPC "resolveAddressMaybe"   getPublicKey _ = throwM $ UnsupportedByOnlyRPC "getPublicKey"

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Morley.Client.Parser   ( ClientArgs (..)@@ -22,7 +21,7 @@  import Options.Applicative   (ReadM, eitherReader, help, long, metavar, option, short, strOption, subparser, value)-import qualified Options.Applicative as Opt+import Options.Applicative qualified as Opt import Options.Applicative.Help.Pretty (Doc, linebreak) import Servant.Client (BaseUrl(..), parseBaseUrl) @@ -30,13 +29,13 @@ import Morley.Client.Init import Morley.Client.RPC.Types (BlockId(HeadId)) import Morley.Client.TezosClient.Types (AddressOrAlias, AliasHint)-import qualified Morley.Michelson.Untyped as U+import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Core import Morley.Util.CLI (mkCLOptionParser, mkCommandParser) import Morley.Util.Named  data ClientArgs-  = ClientArgs MorleyClientConfig ClientArgsRaw+  = ClientArgs MorleyClientConfig Bool ClientArgsRaw  data ClientArgsRaw   = Originate OriginateArgs@@ -72,7 +71,11 @@  -- | Parser for the @morley-client@ executable. clientParser :: Opt.Parser ClientArgs-clientParser = ClientArgs <$> clientConfigParser (pure Nothing) <*> argsRawParser+clientParser = ClientArgs <$> clientConfigParser (pure Nothing) <*> enableExtsOption <*> argsRawParser+  where+    enableExtsOption = Opt.switch $+      long "deprecated-morley-extensions" <>+      help "Enable parsing deprecated Morley extensions"  clientConfigParser :: Opt.Parser (Maybe Text) -> Opt.Parser MorleyClientConfig clientConfigParser prefixParser = do@@ -184,7 +187,7 @@   oaContractName <- contractNameOption   oaInitialBalance <-     mutezOption-      (Just (toMutez 0))+      (Just zeroMutez)       (#name :! "initial-balance")       (#help :! "Inital balance of the contract")   oaInitialStorage <-@@ -227,7 +230,7 @@       (#help :! "Address or alias of the contract that receives transfer")   taAmount <-     mutezOption-      (Just (toMutez 0))+      (Just zeroMutez)       (#name :! "amount")       (#help :! "Transfer amount")   taParameter <-@@ -267,4 +270,4 @@  -- | Utility reader to use in parsing 'BaseUrl'. baseUrlReader :: ReadM BaseUrl-baseUrlReader = eitherReader $ first show . parseBaseUrl+baseUrlReader = eitherReader $ first displayException . parseBaseUrl

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | This module contains servant types for tezos-node -- RPC API.

@@ -1,745 +0,0 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ---- TODO [#549]: remove this pragma-{-# OPTIONS_GHC -Wno-deprecations #-}---- | This module contains a type family for converting a type to its RPC representation,--- and TemplateHaskell functions for deriving RPC representations for custom types.-module Morley.Client.RPC.AsRPC-  ( AsRPC-  , deriveRPC-  , deriveRPCWithStrategy-  , deriveManyRPC-  , deriveManyRPCWithStrategy-  -- * Conversions-  , valueAsRPC-  , notesAsRPC-  -- * Entailments-  , rpcSingIEvi-  , rpcHasNoOpEvi-  , rpcHasNoBigMapEvi-  , rpcHasNoNestedBigMapsEvi-  , rpcHasNoContractEvi-  , rpcStorageScopeEvi-  ) where--import Prelude hiding (Type)--import Control.Lens.Plated (universe)-import Data.Constraint (Dict(..), (***), (:-)(Sub), (\\))-import qualified Data.List as List ((\\))-import Data.Singletons (Sing, withSingI)-import qualified GHC.Generics as G-import Language.Haskell.TH-  (Con(InfixC, NormalC, RecC), Cxt, Dec(DataD, NewtypeD, TySynD, TySynInstD),-  DerivStrategy(AnyclassStrategy), Info(TyConI), Kind, Loc(loc_module), Name, Q, TyLit(StrTyLit),-  TySynEqn(..), TyVarBndr, Type(..), cxt, location, mkName, nameBase, reify, reifyInstances,-  standaloneDerivWithStrategyD)-import Language.Haskell.TH.ReifyMany (reifyManyTyCons)-import Language.Haskell.TH.ReifyMany.Internal (decConcreteNames)--import Lorentz hiding (TAddress, TSignature, drop, not)-import qualified Lorentz as L-import Lorentz.Extensible (Extensible)-import Morley.Michelson.Typed-  (ContractPresence(ContractAbsent), HasNoBigMap, HasNoContract, HasNoNestedBigMaps, HasNoOp,-  Notes(..), OpPresence(..), SingI(sing), SingT(..), StorageScope, T(..), Value'(..),-  checkContractTypePresence, checkOpPresence)-import Morley.Util.Named hiding (Name(..))-import Morley.Util.TH (isTypeAlias, lookupTypeNameOrFail)--{-# ANN module ("HLint: ignore Avoid lambda using `infix`" :: Text) #-}--------------------------------------------------------------------------------- AsRPC--------------------------------------------------------------------------------- | A type-level function that maps a type to its Tezos RPC representation.------ For example, when we retrieve a contract's storage using the Tezos RPC, all its 'BigMap's will be replaced--- by 'BigMapId's.------ So if a contract has a storage of type @T@, when we call the Tezos RPC--- to retrieve it, we must deserialize the micheline expression to the type @AsRPC T@.------ > AsRPC (BigMap Integer MText) ~ BigMapId Integer MText--- > AsRPC [BigMap Integer MText] ~ [BigMapId Integer MText]--- > AsRPC (MText, (Address, BigMap Integer MText)) ~ (MText, (Address, BigMapId Integer MText))------ The following law holds IFF a type @t@ has an IsoValue instance:------ > ToT (AsRPC t) ~ AsRPC (ToT t)----type family AsRPC (a :: k) :: k---- Value-type instance AsRPC (Value' instr t) = Value' instr (AsRPC t)-type instance AsRPC 'TKey = 'TKey-type instance AsRPC 'TUnit = 'TUnit-type instance AsRPC 'TSignature = 'TSignature-type instance AsRPC 'TChainId = 'TChainId-type instance AsRPC ('TOption t) = 'TOption (AsRPC t)-type instance AsRPC ('TList t) = 'TList (AsRPC t)-type instance AsRPC ('TSet t) = 'TSet t-type instance AsRPC 'TOperation = 'TOperation-type instance AsRPC ('TContract t) = 'TContract t-type instance AsRPC ('TTicket t) = 'TTicket t-type instance AsRPC ('TPair t1 t2) = 'TPair (AsRPC t1) (AsRPC t2)-type instance AsRPC ('TOr t1 t2) = 'TOr (AsRPC t1) (AsRPC t2)-type instance AsRPC ('TLambda t1 t2) = 'TLambda t1 t2-type instance AsRPC ('TMap k v) = 'TMap k (AsRPC v)-type instance AsRPC ('TBigMap _ _) = 'TNat-type instance AsRPC 'TInt = 'TInt-type instance AsRPC 'TNat = 'TNat-type instance AsRPC 'TString = 'TString-type instance AsRPC 'TBytes = 'TBytes-type instance AsRPC 'TMutez = 'TMutez-type instance AsRPC 'TBool = 'TBool-type instance AsRPC 'TKeyHash = 'TKeyHash-type instance AsRPC 'TTimestamp = 'TTimestamp-type instance AsRPC 'TAddress = 'TAddress-type instance AsRPC 'TNever = 'TNever-type instance AsRPC 'TBls12381Fr = 'TBls12381Fr-type instance AsRPC 'TBls12381G1 = 'TBls12381G1-type instance AsRPC 'TBls12381G2 = 'TBls12381G2-type instance AsRPC 'TChest = 'TChest-type instance AsRPC 'TChestKey = 'TChestKey---- Morley types---- Note: We don't recursively apply @AsRPC@ to @k@ or @v@ because--- bigmaps cannot contain nested bigmaps.--- If this constraint is ever lifted, we'll have to change this instance--- to @BigMapId k (AsRPC v)@-type instance AsRPC (BigMap k v) = BigMapId k v-type instance AsRPC Integer = Integer-type instance AsRPC Natural = Natural-type instance AsRPC MText = MText-type instance AsRPC Bool = Bool-type instance AsRPC ByteString = ByteString-type instance AsRPC Mutez = Mutez-type instance AsRPC KeyHash = KeyHash-type instance AsRPC Timestamp = Timestamp-type instance AsRPC Address = Address-type instance AsRPC EpAddress = EpAddress-type instance AsRPC (L.TAddress p vd) = L.TAddress p vd-type instance AsRPC (FutureContract p) = FutureContract p-type instance AsRPC PublicKey = PublicKey-type instance AsRPC Signature = Signature-type instance AsRPC ChainId = ChainId-type instance AsRPC Never = Never-type instance AsRPC Bls12381Fr = Bls12381Fr-type instance AsRPC Bls12381G1 = Bls12381G1-type instance AsRPC Bls12381G2 = Bls12381G2-type instance AsRPC () = ()-type instance AsRPC [a] = [AsRPC a]-type instance AsRPC (Maybe a) = Maybe (AsRPC a)-type instance AsRPC (Either l r) = Either (AsRPC l) (AsRPC r)-type instance AsRPC (a, b) = (AsRPC a, AsRPC b)-type instance AsRPC (Set a) = Set a-type instance AsRPC (Map k v) = Map k (AsRPC v)-type instance AsRPC Operation = Operation-type instance AsRPC (Identity a) = Identity (AsRPC a)-type instance AsRPC (NamedF Identity a name) = NamedF Identity (AsRPC a) name-type instance AsRPC (NamedF Maybe a name) = NamedF Maybe (AsRPC a) name-type instance AsRPC (a, b, c) = (AsRPC a, AsRPC b, AsRPC c)-type instance AsRPC (a, b, c, d) = (AsRPC a, AsRPC b, AsRPC c, AsRPC d)-type instance AsRPC (a, b, c, d, e) = (AsRPC a, AsRPC b, AsRPC c, AsRPC d, AsRPC e)-type instance AsRPC (a, b, c, d, e, f) = (AsRPC a, AsRPC b, AsRPC c, AsRPC d, AsRPC e, AsRPC f)-type instance AsRPC (a, b, c, d, e, f, g) = (AsRPC a, AsRPC b, AsRPC c, AsRPC d, AsRPC e, AsRPC f, AsRPC g)-type instance AsRPC (ContractRef arg) = ContractRef arg-type instance AsRPC Chest = Chest-type instance AsRPC ChestKey = ChestKey---- Lorentz types-type instance AsRPC (Packed a) = Packed a-type instance AsRPC (L.TSignature a) = L.TSignature a-type instance AsRPC (Hash alg a) = Hash alg a-type instance AsRPC (L.TAddress cp) = L.TAddress cp-type instance AsRPC Empty = Empty-type instance AsRPC (Extensible x) = Extensible x-type instance AsRPC (View_ a r) = View_ a r-type instance AsRPC (Void_ a r) = Void_ a r-type instance AsRPC (UParam entries) = UParam entries-type instance AsRPC (inp :-> out) = inp :-> out-type instance AsRPC (ShouldHaveEntrypoints a) = ShouldHaveEntrypoints a-type instance AsRPC (ParameterWrapper deriv cp) = ParameterWrapper deriv (AsRPC cp)-type instance AsRPC L.OpenChest = L.OpenChest-type instance AsRPC (L.ChestT a) = L.ChestT a-type instance AsRPC (L.OpenChestT a) = L.OpenChestT a--------------------------------------------------------------------------------- Derive RPC repr--------------------------------------------------------------------------------- | Derive an RPC representation for a type, as well as instances for 'Generic', 'IsoValue' and 'AsRPC'.------ > data ExampleStorage a b = ExampleStorage--- >   { esField1 :: Integer--- >   , esField2 :: [BigMap Integer MText]--- >   , esField3 :: a--- >   }--- >   deriving stock Generic--- >   deriving anyclass IsoValue--- >--- > deriveRPC "ExampleStorage"------ Will generate:------ > data ExampleStorageRPC a b = ExampleStorageRPC--- >   { esField1RPC :: AsRPC Integer--- >   , esField2RPC :: AsRPC [BigMap Integer MText]--- >   , esField3RPC :: AsRPC a--- >   }--- >--- > type instance AsRPC (ExampleStorage a b) = ExampleStorageRPC a b--- > deriving anyclass instance (IsoValue (AsRPC a), IsoValue (AsRPC b)) => IsoValue (ExampleStorageRPC a b)--- > instance Generic (ExampleStorageRPC a b) where--- >   ...-deriveRPC :: String -> Q [Dec]-deriveRPC typeStr = deriveRPCWithStrategy typeStr haskellBalanced---- | Recursively enumerate @data@, @newtype@ and @type@ declarations,--- and derives an RPC representation for each type that doesn't yet have one.------ You can also pass in a list of types for which you _don't_ want--- an RPC representation to be derived.------ In this example, 'deriveManyRPC' will generate an RPC--- representation for @A@ and @B@,--- but not for @C@ (because we explicitly said we don't want one)--- or @D@ (because it already has one).------ > data B = B--- > data C = C--- > data D = D--- > deriveRPC "D"--- >--- > data A = A B C D--- > deriveManyRPC "A" ["C"]-deriveManyRPC :: String -> [String] -> Q [Dec]-deriveManyRPC typeStr skipTypes =-  deriveManyRPCWithStrategy typeStr skipTypes haskellBalanced---- | Same as 'deriveManyRPC', but uses a custom strategy for deriving a 'Generic' instance.-deriveManyRPCWithStrategy :: String -> [String] -> GenericStrategy -> Q [Dec]-deriveManyRPCWithStrategy typeStr skipTypes gs = do-  skipTypeNames <- traverse lookupTypeNameOrFail skipTypes-  typeName <- lookupTypeNameOrFail typeStr-  whenM (isTypeAlias typeName) $ fail $ typeStr <> " is a 'type' alias but not 'data' or 'newtype'."-  allTypeNames <- findWithoutInstance typeName-  join <$> forM (allTypeNames List.\\ skipTypeNames) \name -> deriveRPCWithStrategy' name gs-  where--    -- | Recursively enumerate @data@, @newtype@ and @type@ declarations,-    -- and returns the names of only @data@ and @newtype@ of those that-    -- don't yet have an 'AsRPC' instance. Type aliases don't need instances-    -- and respectively there is no need to derive 'AsRPC' for them.-    findWithoutInstance :: Name -> Q [Name]-    findWithoutInstance typeName =-      fmap fst <$>-        reifyManyTyCons-          (\(name, dec) ->-            ifM (isTypeAlias name)-              (pure (False, decConcreteNames dec))-              (ifM (hasRPCInstance name)-                (pure (False, []))-                (pure (True, decConcreteNames dec)))-          )-          [typeName]--    hasRPCInstance :: Name -> Q Bool-    hasRPCInstance typeName = do-      deriveFullTypeFromName typeName >>= \case-        Nothing ->-          fail $ "Found a field with a type that is neither a 'data' nor a 'newtype' nor a 'type': "-            <> show typeName-        Just typ ->-          not . null <$> reifyInstances ''AsRPC [typ]--    -- | Given a type name, return the corresponding type expression-    -- (applied to any type variables, if necessary).-    ---    -- For example, assuming a data type like @data F a b = ...@ exists in the type environment,-    -- then @deriveFullTypeFromName ''F@ will return the type expression @[t|F a b|]@.-    ---    -- Note that only @data@, @newtype@ and @type@ declarations are supported at the moment.-    deriveFullTypeFromName :: Name -> Q (Maybe Type)-    deriveFullTypeFromName typeName = do-      typeInfo <- reify typeName-      case typeInfo of-        TyConI (DataD _ _ vars mKind _ _) -> Just <$> deriveFullType typeName mKind vars-        TyConI (NewtypeD _ _ vars mKind _ _) -> Just <$> deriveFullType typeName mKind vars-        TyConI (TySynD _ vars _) -> Just <$> deriveFullType typeName Nothing vars-        _ -> pure Nothing---- | Same as 'deriveRPC', but uses a custom strategy for deriving a 'Generic' instance.-deriveRPCWithStrategy :: String -> GenericStrategy -> Q [Dec]-deriveRPCWithStrategy typeStr gs = do-  typeName <- lookupTypeNameOrFail typeStr-  whenM (isTypeAlias typeName) $ fail $ typeStr <> " is a 'type' alias but not 'data' or 'newtype'."-  deriveRPCWithStrategy' typeName gs--deriveRPCWithStrategy' :: Name -> GenericStrategy -> Q [Dec]-deriveRPCWithStrategy' typeName gs = do-  (_, decCxt, mKind, tyVars, constructors) <- reifyDataType typeName--  -- TODO: use `reifyInstances` to check that 'AsRPC' exists for `fieldType`-  -- Print user-friendly error msg if it doesn't.-  let typeNameRPC = convertName typeName-  constructorsRPC <- traverse convertConstructor constructors-  fieldTypesRPC <- getFieldTypes constructorsRPC--  derivedType <- deriveFullType typeName mKind tyVars-  derivedTypeRPC <- deriveFullType typeNameRPC mKind tyVars--  -- Note: we can't use `makeRep0Inline` to derive a `Rep` instance for `derivedTypeRPC`-  -- It internally uses `reify` to lookup info about `derivedTypeRPC`, and because `derivedTypeRPC` hasn't-  -- been spliced *yet*, the lookup fails.-  -- So, instead, we fetch the `Rep` instance for `derivedType`, and-  -- append "RPC" to the type/constructor/field names in its metadata.-  ---  -- If, for some reason, we find out that this approach doesn't work for some edge cases,-  -- we should get rid of it and patch the @generic-deriving@ package to export a version of `makeRep0Inline`-  -- that doesn't use `reify` (it should be easy enough).-  repInstance <- reifyRepInstance typeName derivedType-  currentModuleName <- loc_module <$> location-  let repTypeRPC = convertRep currentModuleName repInstance-  typeDecOfRPC <- mkTypeDeclaration typeName decCxt typeNameRPC tyVars mKind constructorsRPC--  mconcat <$> sequence-    [ pure . one $ typeDecOfRPC-    , mkAsRPCInstance derivedType derivedTypeRPC-    , mkIsoValueInstance fieldTypesRPC derivedTypeRPC-    , customGeneric' (Just repTypeRPC) typeNameRPC derivedTypeRPC constructorsRPC gs-    ]--  where-    -- | Given the field type @FieldType a b@, returns @AsRPC (FieldType a b)@.-    convertFieldType :: Type -> Type-    convertFieldType tp = ConT ''AsRPC `AppT` tp--    convertNameStr :: String -> String-    convertNameStr s = s <> "RPC"--    convertName :: Name -> Name-    convertName = mkName . convertNameStr . nameBase--    -- | Given the constructor-    -- @C { f :: Int }@,-    -- returns the constructor-    -- @CRPC { fRPC :: AsRPC Int }@.-    convertConstructor :: Con -> Q Con-    convertConstructor = \case-      RecC conName fields -> pure $-        RecC-          (convertName conName)-          (fields <&> \(fieldName, fieldBang, fieldType) ->-            (convertName fieldName, fieldBang, convertFieldType fieldType)-          )-      NormalC conName fields -> pure $-        NormalC (convertName conName) (second convertFieldType <$> fields)-      InfixC fieldType1 conName fieldType2 -> pure $-        InfixC (second convertFieldType fieldType1) (convertName conName) (second convertFieldType fieldType2)-      constr -> fail $ "Unsupported constructor for '" <> show typeName <> "': " <> show constr--    -- | Get a list of all the unique types of all the fields of all the given constructors.-    getFieldTypes :: [Con] -> Q [Type]-    getFieldTypes constrs = ordNub . join <$> forM constrs \case-      RecC _ fields -> pure $ fields <&> \(_, _, fieldType) -> fieldType-      NormalC _ fields -> pure $ snd <$> fields-      InfixC field1 _ field2 -> pure [snd field1, snd field2]-      constr -> fail $ "Unsupported constructor for '" <> show typeName <> "': " <> show constr--    mkTypeDeclaration :: Name -> Cxt -> Name -> [TyVarBndr] -> Maybe Kind -> [Con] -> Q Dec-    mkTypeDeclaration tyName decCxt typeNameRPC tyVars mKind constructorsRPC = do-      typeInfo <- reify tyName-      case typeInfo of-        TyConI DataD {} -> pure $ DataD decCxt typeNameRPC tyVars mKind constructorsRPC []-        TyConI NewtypeD {} -> (case constructorsRPC of-          [con] -> pure $ NewtypeD decCxt typeNameRPC tyVars mKind con []-          _ -> fail "Newtype has only one constructor")-        _ -> fail $ "Only newtypes and data types are supported, but '" <>-          show tyName <> "' is:\n" <> show typeInfo--    -- | Traverse a 'Rep' type and:-    ---    -- 1. Inspect its metadata and append @RPC@ to the type/constructor/field names.-    -- 2. Convert field types (e.g. @T@ becomes @AsRPC T@).-    -- 3. Replace the Rep's module name with the name of the module of where this Q is being spliced.-    convertRep :: String -> TySynEqn -> Type-    convertRep currentModuleName (TySynEqn _tyVars _lhs rhs) = go rhs-      where-        go :: Type -> Type-        go = \case-          -- Rename type name and module name-          PromotedT t `AppT` LitT (StrTyLit tyName) `AppT` LitT (StrTyLit _moduleName)-            | t == 'G.MetaData-            -> PromotedT t `AppT` LitT (StrTyLit (convertNameStr tyName)) `AppT` LitT (StrTyLit currentModuleName)-          -- Rename constructor names-          PromotedT t `AppT` LitT (StrTyLit conName)-            | t == 'G.MetaCons-            -> PromotedT t `AppT` LitT (StrTyLit (convertNameStr conName))-          -- Rename field names-          PromotedT t `AppT` (PromotedT just `AppT` LitT (StrTyLit fieldName))-            | t == 'G.MetaSel-            -> PromotedT t `AppT` (PromotedT just `AppT` LitT (StrTyLit (convertNameStr fieldName)))-          -- Replace field type @T@ with @AsRPC T@-          ConT x `AppT` fieldType-            | x == ''G.Rec0-            -> ConT x `AppT` convertFieldType fieldType-          x `AppT` y -> go x `AppT` go y-          x -> x--    -- | Lookup the generic 'Rep' type instance for the given type.-    reifyRepInstance :: Name -> Type -> Q TySynEqn-    reifyRepInstance name tp =-      reifyInstances ''G.Rep [tp] >>= \case-        [TySynInstD repInstance] -> pure repInstance-        (_:_) -> fail $ "Found multiple instances of 'Generic' for '" <> show name <> "'."-        [] -> fail $ "Type '" <> show name <> "' must implement 'Generic'."--    -- | Given the type @Foo a b = Foo a@, generate an 'IsoValue' instance like:-    ---    -- > deriving anyclass instance IsoValue (AsRPC a) => IsoValue (FooRPC a b)-    ---    -- Note that if a type variable @t@ is a phantom type variable, then no @IsoValue (AsRPC t)@-    -- constraint is generated for it.-    mkIsoValueInstance :: [Type] -> Type -> Q [Dec]-    mkIsoValueInstance fieldTypes tp =-      one <$> standaloneDerivWithStrategyD (Just AnyclassStrategy) constraints [t|IsoValue $(pure tp)|]-      where-        constraints :: Q Cxt-        constraints =-          cxt $ filter hasTyVar fieldTypes <&> \fieldType ->-            [t|IsoValue $(pure fieldType)|]--        hasTyVar :: Type -> Bool-        hasTyVar ty =-          flip any (universe ty) \case-            VarT _ -> True-            _ -> False--    mkAsRPCInstance :: Type -> Type -> Q [Dec]-    mkAsRPCInstance tp tpRPC =-      [d|-        type instance AsRPC $(pure tp) = $(pure tpRPC)-      |]--------------------------------------------------------------------------------- Conversions--------------------------------------------------------------------------------- | Replace all big_maps in a value with the respective big_map IDs.------ Throws an error if it finds a big_map without an ID.-valueAsRPC :: HasCallStack => Value t -> Value (AsRPC t)-valueAsRPC v =-  case v of-    VKey {} -> v-    VUnit {} -> v-    VSignature {} -> v-    VChainId {} -> v-    VChest {} -> v-    VChestKey {} -> v-    VOption (vMaybe :: Maybe (Value elem)) ->-      withDict (rpcSingIEvi @elem) $-        VOption $ valueAsRPC <$> vMaybe-    VList (vList :: [Value elem]) ->-      withDict (rpcSingIEvi @elem) $-        VList $ valueAsRPC <$> vList-    VSet {} -> v-    VOp {} -> v-    VContract {} -> v-    VTicket {} -> v-    VPair (x, y) -> VPair (valueAsRPC x, valueAsRPC y)-    VOr (vEither :: Either (Value l) (Value r)) ->-      withDict (rpcSingIEvi @l *** rpcSingIEvi @r) $-        case vEither of-          Right r -> VOr (Right (valueAsRPC r))-          Left l -> VOr (Left (valueAsRPC l))-    VLam {} -> v-    VMap (vMap :: Map (Value k) (Value v)) ->-      withDict (rpcSingIEvi @v) $-        VMap $ valueAsRPC <$> vMap-    VBigMap (Just bmId) _ -> VNat bmId-    VBigMap Nothing _ ->-      error $ unlines-        [ "Expected all big_maps to have an ID, but at least one big_map didn't."-        , "This is most likely a bug."-        ]-    VInt {} -> v-    VNat {} -> v-    VString {} -> v-    VBytes {} -> v-    VMutez {} -> v-    VBool {} -> v-    VKeyHash {} -> v-    VTimestamp {} -> v-    VAddress {} -> v-    VBls12381Fr {} -> v-    VBls12381G1 {} -> v-    VBls12381G2 {} -> v---- | Replace all @big_map@ annotations in a value with @nat@ annotations.-notesAsRPC :: Notes t -> Notes (AsRPC t)-notesAsRPC notes =-  case notes of-    NTKey {} -> notes-    NTUnit {} -> notes-    NTSignature {} -> notes-    NTChainId {} -> notes-    NTChest {} -> notes-    NTChestKey {} -> notes-    NTOption typeAnn elemNotes -> NTOption typeAnn $ notesAsRPC elemNotes-    NTList typeAnn elemNotes -> NTList typeAnn $ notesAsRPC elemNotes-    NTSet {} -> notes-    NTOperation {} -> notes-    NTContract {} -> notes-    NTTicket {} -> notes-    NTPair typeAnn fieldAnn1 fieldAnn2 varAnn1 varAnn2 notes1 notes2 ->-      NTPair typeAnn fieldAnn1 fieldAnn2 varAnn1 varAnn2 (notesAsRPC notes1) (notesAsRPC notes2)-    NTOr typeAnn fieldAnn1 fieldAnn2 notes1 notes2 ->-      NTOr typeAnn fieldAnn1 fieldAnn2 (notesAsRPC notes1) (notesAsRPC notes2)-    NTLambda {} -> notes-    NTMap typeAnn keyAnns valueNotes -> NTMap typeAnn keyAnns (notesAsRPC valueNotes)-    NTBigMap typeAnn _ _ -> NTNat typeAnn-    NTInt {} -> notes-    NTNat {} -> notes-    NTString {} -> notes-    NTBytes {} -> notes-    NTMutez {} -> notes-    NTBool {} -> notes-    NTKeyHash {} -> notes-    NTTimestamp {} -> notes-    NTAddress {} -> notes-    NTBls12381Fr {} -> notes-    NTBls12381G1 {} -> notes-    NTBls12381G2 {} -> notes-    NTNever {} -> notes--------------------------------------------------------------------------------- Entailments--------------------------------------------------------------------------------- | A proof that if a singleton exists for @t@,--- then so it does for @AsRPC t@.-rpcSingIEvi :: forall (t :: T). SingI t :- SingI (AsRPC t)-rpcSingIEvi =-  Sub $-    case sing @t of-      STKey -> Dict-      STUnit {} -> Dict-      STSignature {} -> Dict-      STChainId {} -> Dict-      STChest {} -> Dict-      STChestKey {} -> Dict-      STOption (s :: Sing elem) -> withSingI s $ Dict \\ rpcSingIEvi @elem-      STList (s :: Sing elem) -> withSingI s $  Dict \\ rpcSingIEvi @elem-      STSet (s :: Sing elem) -> withSingI s $ Dict \\ rpcSingIEvi @elem-      STOperation {} -> Dict-      STContract {} -> Dict-      STTicket {} -> Dict-      STPair (sa :: Sing a) (sb :: Sing b) ->-        withSingI sa $ withSingI sb $-          Dict \\ rpcSingIEvi @a \\ rpcSingIEvi @b-      STOr (sl :: Sing l) (sr :: Sing r) ->-        withSingI sl $ withSingI sr $-          Dict \\ rpcSingIEvi @l \\ rpcSingIEvi @r-      STLambda {} -> Dict-      STMap (sk :: Sing k) (sv :: Sing v) ->-        withSingI sk $ withSingI sv $-          Dict \\ rpcSingIEvi @k \\ rpcSingIEvi @v-      STBigMap {} -> Dict-      STInt {} -> Dict-      STNat {} -> Dict-      STString {} -> Dict-      STBytes {} -> Dict-      STMutez {} -> Dict-      STBool {} -> Dict-      STKeyHash {} -> Dict-      STBls12381Fr {} -> Dict-      STBls12381G1 {} -> Dict-      STBls12381G2 {} -> Dict-      STTimestamp {} -> Dict-      STAddress {} -> Dict-      STNever {} -> Dict---- | A proof that if @t@ does not contain any operations, then neither does @AsRPC t@.-rpcHasNoOpEvi :: forall (t :: T). (SingI t, HasNoOp t) => HasNoOp t :- HasNoOp (AsRPC t)-rpcHasNoOpEvi = rpcHasNoOpEvi' sing--rpcHasNoOpEvi'-  :: HasNoOp t-  => Sing t-  -> HasNoOp t :- HasNoOp (AsRPC t)-rpcHasNoOpEvi' sng = Sub $ case sng of-  STKey -> Dict-  STUnit {} -> Dict-  STSignature {} -> Dict-  STChainId {} -> Dict-  STChest {} -> Dict-  STChestKey {} -> Dict-  STOption s -> Dict \\ rpcHasNoOpEvi' s-  STList s -> Dict \\ rpcHasNoOpEvi' s-  STSet s -> Dict \\ rpcHasNoOpEvi' s-  STContract {} -> Dict-  STTicket {} -> Dict-  STPair sa sb -> case checkOpPresence sa of-    OpAbsent -> Dict \\ rpcHasNoOpEvi' sa \\ rpcHasNoOpEvi' sb-  STOr sl sr -> case checkOpPresence sl of-    OpAbsent -> Dict \\ rpcHasNoOpEvi' sl \\ rpcHasNoOpEvi' sr-  STLambda {} -> Dict-  STMap _ sv -> case checkOpPresence sv of-    OpAbsent -> Dict \\ rpcHasNoOpEvi' sv-  STBigMap {} -> Dict-  STInt {} -> Dict-  STNat {} -> Dict-  STString {} -> Dict-  STBytes {} -> Dict-  STMutez {} -> Dict-  STBool {} -> Dict-  STKeyHash {} -> Dict-  STBls12381Fr {} -> Dict-  STBls12381G1 {} -> Dict-  STBls12381G2 {} -> Dict-  STTimestamp {} -> Dict-  STAddress {} -> Dict-  STNever {} -> Dict---- | A proof that @AsRPC (Value t)@ does not contain big_maps.-rpcHasNoBigMapEvi :: forall (t :: T). SingI t => Dict (HasNoBigMap (AsRPC t))-rpcHasNoBigMapEvi = rpcHasNoBigMapEvi' (sing @t)--rpcHasNoBigMapEvi' :: Sing t -> Dict (HasNoBigMap (AsRPC t))-rpcHasNoBigMapEvi' = \case-  STKey -> Dict-  STUnit {} -> Dict-  STSignature {} -> Dict-  STChainId {} -> Dict-  STChest {} -> Dict-  STChestKey {} -> Dict-  STOption s -> Dict \\ rpcHasNoBigMapEvi' s-  STList s -> Dict \\ rpcHasNoBigMapEvi' s-  STSet s -> Dict \\ rpcHasNoBigMapEvi' s-  STOperation {} -> Dict-  STContract {} -> Dict-  STTicket {} -> Dict-  STPair sa sb -> Dict \\ rpcHasNoBigMapEvi' sa \\ rpcHasNoBigMapEvi' sb-  STOr sl sr -> Dict \\ rpcHasNoBigMapEvi' sl \\ rpcHasNoBigMapEvi' sr-  STLambda {} -> Dict-  STMap sk sv -> Dict \\ rpcHasNoBigMapEvi' sk \\ rpcHasNoBigMapEvi' sv-  STBigMap {} -> Dict-  STInt {} -> Dict-  STNat {} -> Dict-  STString {} -> Dict-  STBytes {} -> Dict-  STMutez {} -> Dict-  STBool {} -> Dict-  STKeyHash {} -> Dict-  STBls12381Fr {} -> Dict-  STBls12381G1 {} -> Dict-  STBls12381G2 {} -> Dict-  STTimestamp {} -> Dict-  STAddress {} -> Dict-  STNever {} -> Dict---- | A proof that @AsRPC (Value t)@ does not contain big_maps.-rpcHasNoNestedBigMapsEvi-  :: forall (t :: T).-     SingI t-  => Dict (HasNoNestedBigMaps (AsRPC t))-rpcHasNoNestedBigMapsEvi = rpcHasNoNestedBigMapsEvi' (sing @t)--rpcHasNoNestedBigMapsEvi' :: Sing t -> Dict (HasNoNestedBigMaps (AsRPC t))-rpcHasNoNestedBigMapsEvi' = \case-  STKey -> Dict-  STUnit {} -> Dict-  STSignature {} -> Dict-  STChainId {} -> Dict-  STChest {} -> Dict-  STChestKey {} -> Dict-  STOption s -> Dict \\ rpcHasNoNestedBigMapsEvi' s-  STList s -> Dict \\ rpcHasNoNestedBigMapsEvi' s-  STSet s -> Dict \\ rpcHasNoNestedBigMapsEvi' s-  STOperation {} -> Dict-  STContract {} -> Dict-  STTicket {} -> Dict-  STPair sa sb ->-    Dict \\ rpcHasNoNestedBigMapsEvi' sa \\ rpcHasNoNestedBigMapsEvi' sb-  STOr sl sr ->-    Dict \\ rpcHasNoNestedBigMapsEvi' sl \\ rpcHasNoNestedBigMapsEvi' sr-  STLambda {} -> Dict-  STMap sk sv ->-    Dict \\ rpcHasNoNestedBigMapsEvi' sk \\ rpcHasNoNestedBigMapsEvi' sv-  STBigMap {} -> Dict-  STInt {} -> Dict-  STNat {} -> Dict-  STString {} -> Dict-  STBytes {} -> Dict-  STMutez {} -> Dict-  STBool {} -> Dict-  STKeyHash {} -> Dict-  STBls12381Fr {} -> Dict-  STBls12381G1 {} -> Dict-  STBls12381G2 {} -> Dict-  STTimestamp {} -> Dict-  STAddress {} -> Dict-  STNever {} -> Dict---- | A proof that if @t@ does not contain any contract values, then neither does @AsRPC t@.-rpcHasNoContractEvi-  :: forall (t :: T).-     (SingI t, HasNoContract t)-  => HasNoContract t :- HasNoContract (AsRPC t)-rpcHasNoContractEvi = rpcHasNoContractEvi' sing--rpcHasNoContractEvi'-  :: HasNoContract t-  => Sing t-  -> HasNoContract t :- HasNoContract (AsRPC t)-rpcHasNoContractEvi' sng = Sub $ case sng of-  STKey -> Dict-  STUnit {} -> Dict-  STSignature {} -> Dict-  STChainId {} -> Dict-  STChest {} -> Dict-  STChestKey {} -> Dict-  STOption s -> Dict \\ rpcHasNoContractEvi' s-  STList s -> Dict \\ rpcHasNoContractEvi' s-  STSet _ -> Dict-  STOperation {} -> Dict-  STTicket {} -> Dict-  STPair sa sb -> case checkContractTypePresence sa of-    ContractAbsent ->-      Dict \\ rpcHasNoContractEvi' sa \\ rpcHasNoContractEvi' sb-  STOr sl sr -> case checkContractTypePresence sl of-    ContractAbsent ->-      Dict \\ rpcHasNoContractEvi' sl \\ rpcHasNoContractEvi' sr-  STLambda {} -> Dict-  STMap _ sv -> Dict \\ rpcHasNoContractEvi' sv-  STBigMap {} -> Dict-  STInt {} -> Dict-  STNat {} -> Dict-  STString {} -> Dict-  STBytes {} -> Dict-  STMutez {} -> Dict-  STBool {} -> Dict-  STKeyHash {} -> Dict-  STBls12381Fr {} -> Dict-  STBls12381G1 {} -> Dict-  STBls12381G2 {} -> Dict-  STTimestamp {} -> Dict-  STAddress {} -> Dict-  STNever {} -> Dict---- | A proof that if @t@ is a valid storage type, then so is @AsRPC t@.-rpcStorageScopeEvi :: forall (t :: T). StorageScope t :- StorageScope (AsRPC t)-rpcStorageScopeEvi =-  Sub $ Dict-    \\ rpcSingIEvi @t-    \\ rpcHasNoOpEvi @t-    \\ rpcHasNoNestedBigMapsEvi @t-    \\ rpcHasNoContractEvi @t

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | An abstraction layer over RPC implementation. -- The primary reason it exists is to make it possible to mock

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Various errors that can happen in the RPC part of @morley-client@. module Morley.Client.RPC.Error@@ -11,7 +10,7 @@   ) where  import Fmt (Buildable(..), blockListF, pretty, (+|), (|+))-import qualified Text.Show (show)+import Text.Show qualified (show)  import Morley.Micheline (Expression) import Morley.Tezos.Address@@ -45,6 +44,10 @@     -- ^ A smart contract execution failed due gas exhaustion.     Address     -- ^ Smart contract address.+  | KeyAlreadyRevealed+    -- ^ A key has already been revealed.+    Address+    -- ^ The address corresponding to the key.   | ClientInternalError     -- ^ An error that RPC considers internal occurred. These errors     -- are considered internal by mistake, they are actually quite@@ -67,6 +70,7 @@     EmptyTransaction addr -> build (REEmptyTransaction addr)     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"     ClientInternalError err -> build err  instance Exception ClientRpcError where

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Some read-only actions (wrappers over RPC calls). @@ -38,7 +37,7 @@ import Fmt (Buildable(..), pretty, (+|), (|+)) import Network.HTTP.Types.Status (statusCode) import Servant.Client (ClientError(..), responseStatusCode)-import qualified Text.Show+import Text.Show qualified  import Lorentz (NicePackedValue, NiceUnpackedValue, niceUnpackedValueEvi, valueToScriptExpr) import Lorentz.Value@@ -46,7 +45,7 @@ import Morley.Michelson.TypeCheck.TypeCheck   (SomeParamType(..), TcOriginatedContracts, mkSomeParamType) import Morley.Michelson.Typed-import qualified Morley.Michelson.Untyped as U+import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address import Morley.Tezos.Crypto (encodeBase58Check) import Morley.Util.ByteString

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2021 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Morley.Client.RPC.QueryFixedParam   ( QueryFixedParam

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | This module contains various types which are used in -- tezos-node RPC API.@@ -30,6 +29,7 @@   , InternalOperation (..)   , OperationContent (..)   , OperationHash (..)+  , OperationInput (..)   , OperationResp (..)   , OperationResult (..)   , OriginationOperation (..)@@ -37,12 +37,14 @@   , ParametersInternal (..)   , PreApplyOperation (..)   , ProtocolParameters (..)+  , RevealOperation (..)   , RunCode (..)   , RunCodeResult (..)   , RunMetadata (..)   , RunOperation (..)   , RunOperationInternal (..)   , RunOperationResult (..)+  , RPCInput   , TransactionOperation (..)   , combineResults   , mkCommonOperationData@@ -66,11 +68,11 @@   , _UnexpectedOperation   , _REEmptyTransaction   , _ScriptOverflow+  , _PreviouslyRevealedKey   , _GasExhaustedOperation    -- * Lenses-  , toCommonDataL-  , ooCommonDataL+  , oiCommonDataL   ) where  import Control.Lens (makeLensesFor, makePrisms)@@ -81,53 +83,73 @@ import Data.Default (Default(..)) import Data.Fixed (Milli) import Data.List (isSuffixOf)-import qualified Data.Text as T+import Data.Text qualified as T import Data.Time (UTCTime)-import Data.Vector (fromList)-import Fmt (Buildable(..), pretty, (+|), (|+))+import Fmt (Buildable(..), pretty, unwordsF, (+|), (|+)) import Servant.API (ToHttpApiData(..))  import Data.Aeson.Types (Parser) import Morley.Client.RPC.Aeson (morleyClientAesonOptions)+import Morley.Client.Types import Morley.Micheline   (Expression(..), MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosInt64,   TezosMutez(..), TezosNat) import Morley.Tezos.Address (Address)-import Morley.Tezos.Core (Mutez, toMutez, zeroMutez)-import Morley.Tezos.Crypto (Signature, decodeBase58CheckWithPrefix, formatSignature)+import Morley.Tezos.Core (Mutez, tz, zeroMutez)+import Morley.Tezos.Crypto (PublicKey, Signature, decodeBase58CheckWithPrefix, formatSignature) import Morley.Util.CLI (HasCLReader(..), eitherReader)-import Morley.Util.Named (pattern (:!), pattern N, (:!), (<:!>))+import Morley.Util.Named (arg, pattern (:!), (:!), (<:!>)) import Morley.Util.Text (dquotes) +mergeObjects :: HasCallStack => Value -> Value -> Value+mergeObjects (Object a) (Object b) = Object (a <> b)+mergeObjects (Object _) _ = error "Right part is not an Object"+mergeObjects _ _ = error "Left part is not an Object"++-- | Designates an input RPC data that we supply to perform an operation.+data RPCInput+instance OperationInfoDescriptor RPCInput where+  type TransferInfo RPCInput = TransactionOperation+  type OriginationInfo RPCInput = OriginationOperation+  type RevealInfo RPCInput = RevealOperation++instance ToJSON (OperationInfo RPCInput) where+  toJSON = \case+    OpTransfer op -> toJSON op+    OpOriginate op -> toJSON op+    OpReveal op -> toJSON op++data OperationInput = OperationInput+  { oiCommonData :: CommonOperationData+  , oiCustom :: OperationInfo RPCInput+  }++instance ToJSON OperationInput where+  toJSON OperationInput{..} =+    toJSON oiCommonData `mergeObjects` toJSON oiCustom+ data ForgeOperation = ForgeOperation   { foBranch :: Text-  , foContents :: NonEmpty (Either TransactionOperation OriginationOperation)+  , foContents :: NonEmpty OperationInput   } -contentsToJSON :: NonEmpty (Either TransactionOperation OriginationOperation) -> Value-contentsToJSON = Array . fromList . toList .-  map (\case-          Right transOp -> toJSON transOp-          Left origOp -> toJSON origOp-      )- instance ToJSON ForgeOperation where   toJSON ForgeOperation{..} = object     [ "branch" .= toString foBranch-    , ("contents", contentsToJSON foContents)+    , "contents" .= foContents     ]  data RunOperationInternal = RunOperationInternal   { roiBranch :: Text-  , roiContents :: NonEmpty (Either TransactionOperation OriginationOperation)+  , roiContents :: NonEmpty OperationInput   , roiSignature :: Signature   }  instance ToJSON RunOperationInternal where   toJSON RunOperationInternal{..} = object     [ "branch" .= toString roiBranch-    , ("contents", contentsToJSON roiContents)-    , "signature" .= toJSON roiSignature+    , "contents" .= roiContents+    , "signature" .= roiSignature     ]  data RunOperation = RunOperation@@ -138,14 +160,14 @@ data PreApplyOperation = PreApplyOperation   { paoProtocol :: Text   , paoBranch :: Text-  , paoContents :: NonEmpty (Either TransactionOperation OriginationOperation)+  , paoContents :: NonEmpty OperationInput   , paoSignature :: Signature   }  instance ToJSON PreApplyOperation where   toJSON PreApplyOperation{..} = object     [ "branch" .= toString paoBranch-    , ("contents", contentsToJSON paoContents)+    , "contents" .= paoContents     , "protocol" .= toString paoProtocol     , "signature" .= formatSignature paoSignature     ]@@ -222,7 +244,7 @@ -- | At the moment of writing, Tezos always uses these constants. instance Default FeeConstants where   def = FeeConstants-    { fcBase = toMutez 100+    { fcBase = [tz|100u|]     , fcMutezPerGas = 0.1     , fcMutezPerOpByte = 1     }@@ -233,6 +255,9 @@ data BlockId   = HeadId   -- ^ Identifier referring to the head block.+  | FinalHeadId+  -- ^ Identifier of the most recent block guaranteed to have been finalized.+  -- See: https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html#operations   | GenesisId   -- ^ Identifier referring to the genesis block.   | LevelId Natural@@ -246,6 +271,7 @@ instance ToHttpApiData BlockId where   toUrlPiece = \case     HeadId -> "head"+    FinalHeadId -> "head~2"     GenesisId -> "genesis"     LevelId x -> toUrlPiece x     BlockHashId hash -> toUrlPiece hash@@ -254,6 +280,7 @@ instance Buildable BlockId where   build = \case     HeadId -> "head"+    FinalHeadId -> "head~2"     GenesisId -> "genesis"     LevelId x -> "block at level " <> build x     BlockHashId hash -> "block with hash " <> build hash@@ -264,6 +291,7 @@ parseBlockId :: Text -> Maybe BlockId parseBlockId t   | t == "head" = Just HeadId+  | t == "head~2" = Just FinalHeadId   | t == "genesis" = Just GenesisId   | Right lvl <- readEither t = Just (LevelId lvl)   | Just depthTxt <- "head~" `T.stripPrefix` t@@ -333,6 +361,7 @@   | MutezMultiplicationOverflow TezosInt64 TezosInt64   | CantPayStorageFee   | BalanceTooLow ("balance" :! Mutez) ("required" :! Mutez)+  | PreviouslyRevealedKey Address   | NonExistingContract Address   deriving stock Show @@ -384,6 +413,8 @@           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"       _ -> fail ("unknown id: " <> id')@@ -427,18 +458,20 @@       "Contract failed due to gas exhaustion"     MutezAdditionOverflow amounts ->       "A contract failed due to mutez addition overflow when adding following values:\n" +|-      mconcat (intersperse (" " :: Text) $ map show amounts) |+ ""+      unwordsF amounts |+ ""     MutezSubtractionUnderflow amounts ->       "A contract failed due to mutez subtraction underflow when subtracting following values:\n" +|-      mconcat (intersperse (" " :: Text) $ map show amounts) |+ ""+      unwordsF amounts |+ ""     MutezMultiplicationOverflow amount multiplicator ->       "A contract failed due to mutez multiplication overflow when multiplying" +|       amount |+ " by " +| multiplicator |+ ""     CantPayStorageFee ->       "Balance is too low to pay storage fee"-    BalanceTooLow (N balance) (N required) ->+    BalanceTooLow (arg #balance -> balance) (arg #required -> required) ->       "Balance is too low, \       \current balance: " +| balance |+ ", but required: " +| required |+ ""+    PreviouslyRevealedKey addr ->+      "Key for " +| addr |+ " has already been revealed"     NonExistingContract addr ->       "Contract is not registered: " +| addr |+ "" @@ -464,7 +497,7 @@  instance Buildable InternalError where   build = \case-    CounterInThePast addr (N expected) (N found) ->+    CounterInThePast addr (arg #expected -> expected) (arg #found -> found) ->       "Expected counter " +| expected |+ " for " +| addr |+ "but got: " +|       found |+ ""     UnrevealedKey addr ->@@ -598,31 +631,30 @@   , codStorageLimit = ppHardStorageLimitPerOperation   } -commonDataToValueList :: CommonOperationData -> [(Text, Value)]-commonDataToValueList CommonOperationData{..} =-  [ "source" .= codSource-  , "fee" .= codFee-  , "counter" .= codCounter-  , "gas_limit" .= codGasLimit-  , "storage_limit" .= codStorageLimit-  ]+instance ToJSON CommonOperationData where+  toJSON CommonOperationData{..} = object+    [ "source" .= codSource+    , "fee" .= codFee+    , "counter" .= codCounter+    , "gas_limit" .= codGasLimit+    , "storage_limit" .= codStorageLimit+    ] -parseCommonOperationData :: Object -> Parser CommonOperationData-parseCommonOperationData obj = do-  codSource <- obj .: "source"-  codFee <- obj .: "fee"-  codCounter <- obj .: "counter"-  codGasLimit <- obj .: "gas_limit"-  codStorageLimit <- obj .: "storage_limit"-  pure CommonOperationData {..}+instance FromJSON CommonOperationData where+  parseJSON = withObject "common operation data" $ \o -> do+    codSource <- o .: "source"+    codFee <- o .: "fee"+    codCounter <- o .: "counter"+    codGasLimit <- o .: "gas_limit"+    codStorageLimit <- o .: "storage_limit"+    pure CommonOperationData {..}  -- | All the data needed to perform a transaction through -- Tezos RPC interface. -- For additional information, please refer to RPC documentation -- http://tezos.gitlab.io/api/rpc.html data TransactionOperation = TransactionOperation-  { toCommonData :: CommonOperationData-  , toAmount :: TezosMutez+  { toAmount :: TezosMutez   , toDestination :: Address   , toParameters :: ParametersInternal   }@@ -630,14 +662,13 @@ instance ToJSON TransactionOperation where   toJSON TransactionOperation{..} = object $     [ "kind" .= String "transaction"-    , "amount" .= toJSON toAmount-    , "destination" .= toJSON toDestination-    , "parameters" .= toJSON toParameters-    ] <> commonDataToValueList toCommonData+    , "amount" .= toAmount+    , "destination" .= toDestination+    , "parameters" .= toParameters+    ]  instance FromJSON TransactionOperation where   parseJSON = withObject "TransactionOperation" $ \obj -> do-    toCommonData <- parseCommonOperationData obj     toAmount <- obj .: "amount"     toDestination <- obj .: "destination"     toParameters <- fromMaybe defaultParametersInternal <$> obj .:? "parameters"@@ -651,18 +682,29 @@ -- | All the data needed to perform contract origination -- through Tezos RPC interface data OriginationOperation = OriginationOperation-  { ooCommonData :: CommonOperationData-  , ooBalance :: TezosMutez+  { ooBalance :: TezosMutez   , ooScript :: OriginationScript   }  instance ToJSON OriginationOperation where   toJSON OriginationOperation{..} = object $     [ "kind" .= String "origination"-    , "balance" .= toJSON ooBalance-    , "script" .= toJSON ooScript-    ] <> commonDataToValueList ooCommonData+    , "balance" .= ooBalance+    , "script" .= ooScript+    ] +-- | All the data needed to perform key revealing+-- through Tezos RPC interface+data RevealOperation = RevealOperation+  { roPublicKey :: PublicKey+  }++instance ToJSON RevealOperation where+  toJSON RevealOperation{..} = object $+    [ "kind" .= String "reveal"+    , "public_key" .= roPublicKey+    ]+ -- | @$operation@ in Tezos docs. data BlockOperation = BlockOperation   { boHash :: Text@@ -729,5 +771,4 @@   parseJSON v = maybe GetBigMapNotFound GetBigMapResult <$> parseJSON v  makePrisms ''RunError-makeLensesFor [("toCommonData", "toCommonDataL")] ''TransactionOperation-makeLensesFor [("ooCommonData", "ooCommonDataL")] ''OriginationOperation+makeLensesFor [("oiCommonData", "oiCommonDataL")] ''OperationInput

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Abstraction layer for @tezos-client@ functionality. -- We use it to mock @tezos-client@ in tests.@@ -38,10 +37,11 @@   -- ^ Associate the given contract with alias.   -- The 'Bool' variable indicates whether or not we should replace already   -- existing contract alias or not.-  importKey :: Bool -> AliasOrAliasHint -> SecretKey -> m ()-  -- ^ Saves 'SecretKey' via @tezos-client@ with given alias associated.+  importKey :: Bool -> AliasOrAliasHint -> SecretKey -> m Alias+  -- ^ Saves 'SecretKey' via @tezos-client@ with given alias or hint associated.   -- The 'Bool' variable indicates whether or not we should replace already   -- existing alias key or not.+  -- The returned 'Alias' is the alias under which the key will be accessible.   resolveAddressMaybe :: AddressOrAlias -> m (Maybe Address)   -- ^ Retrieve an address from given address or alias. If address or alias does not exist   -- returns `Nothing`

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Interface to the @tezos-client@ executable expressed in Haskell types. @@ -22,6 +21,7 @@   , getTezosClientConfig   , calcTransferFee   , calcOriginationFee+  , calcRevealFee   , getKeyPassword   , registerDelegate @@ -32,13 +32,14 @@   , prefixNameM   ) where +import Unsafe qualified ((!!))+ import Colourista (formatWith, red) import Control.Exception (IOException, throwIO) import Data.Aeson (eitherDecodeStrict, encode) import Data.ByteArray (ScrubbedBytes)-import qualified Data.ByteString.Lazy.Char8 as C (unpack)-import Data.List ((!!))-import qualified Data.Text as T+import Data.ByteString.Lazy.Char8 qualified as C (unpack)+import Data.Text qualified as T import Fmt (Buildable(..), pretty, (+|), (|+)) import System.Exit (ExitCode(..)) import System.Process (readProcessWithExitCode)@@ -48,7 +49,7 @@ import Lorentz.Value import Morley.Client.Logging import Morley.Client.RPC.Types-import qualified Morley.Client.TezosClient.Class as Class (HasTezosClient(resolveAddressMaybe))+import Morley.Client.TezosClient.Class qualified as Class (HasTezosClient(resolveAddressMaybe)) import Morley.Client.TezosClient.Parser import Morley.Client.TezosClient.Types import Morley.Client.Util (readScrubbedBytes, scrubbedBytesToString)@@ -56,6 +57,8 @@ import Morley.Michelson.Typed.Scope import Morley.Tezos.Address import Morley.Tezos.Crypto+import Morley.Util.Peano+import Morley.Util.SizedList.Types  ---------------------------------------------------------------------------- -- Errors@@ -385,7 +388,7 @@   => Bool   -> AliasOrAliasHint   -> SecretKey-  -> m ()+  -> m Alias importKey replaceExisting alias key = do   name <- prefixNameM alias   let@@ -396,7 +399,7 @@     callTezosClient errHandler     (if replaceExisting then args <> ["--force"] else args)     MockupMode Nothing-  pure ()+  pure name  -- | Read @tezos-client@ configuration. getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig@@ -421,7 +424,8 @@     [ "multiple", "transfers", "from", pretty from, "using"     , C.unpack $ encode transferFeeDatas, "--burn-cap", showBurnCap burnCap, "--dry-run"     ] ClientMode mbPassword-  feeOutputParser output $ length transferFeeDatas+  withSomePeano (fromIntegralOverflowing $ length transferFeeDatas) $+    \(_ :: Proxy n) -> toList <$> feeOutputParser @n output  -- | Calc baker fee for origination using @tezos-client@. calcOriginationFee@@ -438,16 +442,34 @@     , toCmdArg cofdStorage, "--burn-cap"     , showBurnCap cofdBurnCap, "--dry-run"     ] ClientMode cofdMbFromPassword-  fees <- feeOutputParser output 1+  fees <- feeOutputParser @1 output   case fees of-    [singleFee] -> return singleFee-    _ -> error "Expecting to parse single fee, parsed more"+    singleFee :< Nil -> return singleFee -feeOutputParser :: (MonadIO m, MonadThrow m) => Text -> Int -> m [TezosMutez]-feeOutputParser output n =-  case parseBakerFeeFromOutput output n of+-- | Calc baker fee for revealing using @tezos-client@.+--+-- Note that @tezos-client@ does not support passing an address here,+-- at least at the moment of writing.+calcRevealFee+  :: ( WithClientLog env m, HasTezosClientEnv env+     , MonadIO m, MonadCatch m+     )+  => Alias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez+calcRevealFee alias mbPassword burnCap = do+  output <- callTezosClientStrict+    [ "reveal", "key", "for", toCmdArg alias+    , "--burn-cap", showBurnCap burnCap+    , "--dry-run"+    ] ClientMode mbPassword+  fees <- feeOutputParser @1 output+  case fees of+    singleFee :< Nil -> return singleFee++feeOutputParser :: forall n m. (SingIPeano n, MonadIO m, MonadThrow m) => Text -> m (SizedList n TezosMutez)+feeOutputParser output =+  case parseBakerFeeFromOutput @n output of     Right fee -> return fee-    Left err -> throwM $ TezosClientParseFeeError output $ show err+    Left err -> throwM $ TezosClientParseFeeError output $ pretty err  showBurnCap :: TezosInt64 -> String showBurnCap x = printf "%.6f" $ (fromIntegralToRealFrac @TezosInt64 @Float x) / 1000@@ -472,7 +494,7 @@       encryptionType <-         case parseSecretKeyEncryption output of           Right t -> return t-          Left err -> throwM $ TezosClientParseEncryptionTypeError output $ show err+          Left err -> throwM $ TezosClientParseEncryptionTypeError output $ pretty err       case encryptionType of         EncryptedKey -> do           putTextLn $ "Please enter password for '" <> pretty alias <> "':"@@ -558,7 +580,7 @@       "Counter" `T.isPrefixOf` errOutput && "already used for contract" `T.isInfixOf` errOutput = do         let splittedErrOutput = words errOutput         liftIO $ throwM $-          CounterIsAlreadyUsed (splittedErrOutput !! 1) (splittedErrOutput !! 5)+          CounterIsAlreadyUsed (splittedErrOutput Unsafe.!! 1) (splittedErrOutput Unsafe.!! 5)     checkCounterError _ = pass     checkEConnreset :: Text -> m ()     checkEConnreset errOutput@@ -606,7 +628,7 @@       throwIO e      errorMsg =-      "ERROR!! There was an error in executing `" <> (show fp) <> "` program. Is the \+      "ERROR!! There was an error in executing `" <> toText fp <> "` program. Is the \       \ executable available in PATH ?"  prefixName :: Maybe Text -> AliasOrAliasHint -> Alias

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Parsers that are used in "Morley.Client.TezosClient.Impl" module Morley.Client.TezosClient.Parser@@ -9,34 +8,39 @@   ) where  import Data.Scientific (Scientific)-import Text.Megaparsec (choice, count, customFailure)-import qualified Text.Megaparsec as P (Parsec, parse, skipManyTill)+import Fmt (Buildable(..))+import Text.Megaparsec (choice, customFailure)+import Text.Megaparsec qualified as P (Parsec, parse, skipManyTill) import Text.Megaparsec.Char (newline, printChar, space) import Text.Megaparsec.Char.Lexer (lexeme, scientific, symbol) import Text.Megaparsec.Error (ParseErrorBundle, ShowErrorComponent(..), errorBundlePretty)-import qualified Text.Show (show)  import Morley.Client.TezosClient.Types (SecretKeyEncryption(..)) import Morley.Micheline+import Morley.Michelson.Parser.Helpers (count) import Morley.Tezos.Core+import Morley.Util.SizedList.Types+import Unsafe qualified (unsafeM)  type Parser = P.Parsec Void Text  data FeeParserException = FeeParserException (ParseErrorBundle Text Void)-  deriving stock Eq--instance Show FeeParserException where-  show (FeeParserException bundle) = errorBundlePretty bundle+  deriving stock (Eq, Show)  instance Exception FeeParserException where-  displayException = show+  displayException (FeeParserException bundle) = errorBundlePretty bundle +instance Buildable FeeParserException where+  build = build . displayException+  -- this might seem backwards, but it's more efficient than converting to then from text+  -- which would have to happen in displayException if we define it in terms of build.+ data SecretKeyEncryptionParserException =   SecretKeyEncryptionParserException (ParseErrorBundle Text UnexpectedEncryptionType)-  deriving stock Eq+  deriving stock (Eq, Show) -instance Show SecretKeyEncryptionParserException where-  show (SecretKeyEncryptionParserException bundle) = errorBundlePretty bundle+instance Buildable SecretKeyEncryptionParserException where+  build (SecretKeyEncryptionParserException bundle) = build $ errorBundlePretty bundle  data UnexpectedEncryptionType = UnexpectedEncryptionType   deriving stock (Eq, Ord, Show)@@ -47,18 +51,18 @@  -- | Function to parse baker fee from given @tezos-client@ output. parseBakerFeeFromOutput-  :: Text -> Int -> Either FeeParserException [TezosMutez]-parseBakerFeeFromOutput output n = first FeeParserException $-  P.parse (count n bakerFeeParser) "" output+  :: forall n. (SingIPeano n) => Text -> Either FeeParserException (SizedList n TezosMutez)+parseBakerFeeFromOutput output = first FeeParserException $+  P.parse (count @n bakerFeeParser) "" output   where     bakerFeeParser :: Parser TezosMutez     bakerFeeParser = do       num <- P.skipManyTill (printChar <|> newline) $ do         void $ symbol space "Fee to the baker: "         P.skipManyTill printChar $ lexeme (newline >> pass) scientific-      either (fail . toString) pure $ scientificToMutez num+      Unsafe.unsafeM $ scientificToMutez num     scientificToMutez :: Scientific -> Either Text TezosMutez-    scientificToMutez x = fmap TezosMutez . mkMutez @Word64 $ floor $ x * 1e6+    scientificToMutez x = fmap TezosMutez $ mkMutez @Word64 $ floor $ x * 1e6  parseSecretKeyEncryption   :: Text -> Either SecretKeyEncryptionParserException SecretKeyEncryption

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Types used for interaction with @tezos-client@. @@ -39,7 +38,7 @@ import Data.Fixed (E6, Fixed(..)) import Fmt (Buildable(..), pretty) import Morley.Util.Lens (makeLensesWith, postfixLFields)-import qualified Options.Applicative as Opt+import Options.Applicative qualified as Opt import Servant.Client (BaseUrl(..), showBaseUrl) import Text.Hex (encodeHex) @@ -49,7 +48,7 @@ import Morley.Micheline import Morley.Michelson.Printer import Morley.Michelson.Typed (Contract, EpName, Value)-import qualified Morley.Michelson.Typed as T+import Morley.Michelson.Typed qualified as T import Morley.Tezos.Address (Address, parseAddress) import Morley.Tezos.Core import Morley.Tezos.Crypto

@@ -0,0 +1,24 @@+-- SPDX-FileCopyrightText: 2022 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++module Morley.Client.Types+  ( OperationInfoDescriptor (..)+  , OperationInfo (..)+  , _OpTransfer+  , _OpOriginate+  , _OpReveal+  ) where++import Control.Lens (makePrisms)++class OperationInfoDescriptor (i :: Type) where+  type family TransferInfo i :: Type+  type family OriginationInfo i :: Type+  type family RevealInfo i :: Type++data OperationInfo i+  = OpTransfer (TransferInfo i)+  | OpOriginate (OriginationInfo i)+  | OpReveal (RevealInfo i)++makePrisms ''OperationInfo

@@ -1,33 +1,38 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Morley.Client.Util   ( epNameToTezosEp   , extractAddressesFromValue   , disableAlphanetWarning+  -- * @runContract@   , runContract-  , runContractSimple   , RunContractParameters(..)+  , runContractParameters+  , withBalance+  , withAmount+  , withSender+  , withSource -  -- tezos-client password-related helpers+  -- * @tezos-client@ password-related helpers   , scrubbedBytesToString   , readScrubbedBytes   ) where +import Control.Lens (makeLensesFor) import Data.ByteArray (ScrubbedBytes, convert)-import qualified Data.ByteString as BS (getLine)+import Data.ByteString qualified as BS (getLine) import Data.Constraint ((\\)) import Generics.SYB (everything, mkQ) import System.Environment (setEnv) -import Morley.Client.RPC.AsRPC (AsRPC, rpcHasNoBigMapEvi, rpcStorageScopeEvi)+import Morley.AsRPC (AsRPC, MaybeRPC, rpcStorageScopeEvi) import Morley.Client.RPC.Class import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Micheline import Morley.Michelson.Text-import qualified Morley.Michelson.Typed as T (Contract, ParameterScope, StorageScope, Value)+import Morley.Michelson.Typed qualified as T import Morley.Michelson.Typed.Entrypoints (EpAddress(..), parseEpAddress) import Morley.Michelson.Untyped (InternalByteString(..), Value, Value'(..)) import Morley.Michelson.Untyped.Entrypoints (EpName(..), pattern DefEpName)@@ -64,39 +69,44 @@         Left _ -> []       _ -> [] --- | Simplified version of 'runContract' for convenience------ Sets transfer amount to 0 and sender and source are both unspecified.-runContractSimple-  :: forall cp st m. (HasTezosRpc m, T.ParameterScope cp, T.StorageScope st)-  => T.Contract cp st -- ^ Contract-  -> T.Value cp -- ^ Parameter passed to the contract-  -> T.Value st -- ^ Initial storage-  -> Mutez -- ^ Initial balance-  -> m (AsRPC (T.Value st))-runContractSimple rcpContract rcpParameter rcpStorage rcpBalance =-  let rcpSender = Nothing-      rcpSource = Nothing-      rcpAmount = zeroMutez-  in runContract RunContractParameters {..}- -- | A structure with all the parameters for 'runContract' data RunContractParameters cp st = RunContractParameters   { rcpContract :: T.Contract cp st-  , rcpParameter :: T.Value cp-  , rcpStorage :: T.Value st+  , rcpParameter :: MaybeRPC (T.Value cp)+  , rcpStorage :: MaybeRPC (T.Value st)   , rcpBalance :: Mutez   , rcpAmount :: Mutez   , rcpSender :: Maybe Address   , rcpSource :: Maybe Address   } +-- | Initializes the parameters for `runContract` with sensible defaults.+--+-- Use the @with*@ lenses to set any optional parameters.+runContractParameters+  :: T.Contract cp st -> MaybeRPC (T.Value cp) -> MaybeRPC (T.Value st)+  -> RunContractParameters cp st+runContractParameters contract cp st =+  RunContractParameters+    { rcpContract = contract+    , rcpParameter = cp+    , rcpStorage = st+    , rcpBalance = zeroMutez+    , rcpAmount = zeroMutez+    , rcpSender = Nothing+    , rcpSource = Nothing+    }++makeLensesFor+  [ ("rcpBalance", "withBalance")+  , ("rcpAmount", "withAmount")+  , ("rcpSender", "withSender")+  , ("rcpSource", "withSource")+  ]+  ''RunContractParameters+ -- | Run contract with given parameter and storage and get new storage without -- injecting anything to the chain.------ Storage type is limited to not have any bigmaps because their updates are treated differently--- in node RPC and its quite nontrivial to properly support storage update when storage type--- contains bigmaps. runContract   :: forall cp st m. (HasTezosRpc m, T.ParameterScope cp, T.StorageScope st)   => RunContractParameters cp st -> m (AsRPC (T.Value st))@@ -109,6 +119,10 @@         , rcAmount = TezosMutez rcpAmount         , rcBalance = TezosMutez rcpBalance         , rcChainId = bcChainId headConstants+        -- Note: assigning source=sender and payer=source may seem like a bug, but it's not.+        -- For some reason, the /run_code uses a different naming scheme.+        -- What this endpoint calls 'source' is actually the address that will be returned by the `SENDER` instruction.+        -- See details here: https://gitlab.com/tezos/tezos/-/issues/710         , rcSource = rcpSender         , rcPayer = rcpSource         }@@ -116,7 +130,6 @@   throwLeft @_ @FromExpressionError $ pure $     fromExpression @(AsRPC (T.Value st)) (rcrStorage res)       \\ rpcStorageScopeEvi @st-      \\ rpcHasNoBigMapEvi @st  -- | Function for relatively safe getting password from stdin. -- After reading bytes are converted to @ScrubbedBytes@, thus it's harder

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2021 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Morley.Util.Batching   ( BatchingM@@ -12,7 +11,7 @@   ) where  import Control.Monad.Except (Except, runExcept, throwError)-import Fmt (Buildable(..), pretty)+import Fmt (Buildable(..))  -- | Errors that can occur during batching, usually because the -- underlying function that performs batch operation returns output@@ -88,7 +87,7 @@   -> BatchingM i o e a   -> m (r, a) unsafeRunBatching =-  fmap (second $ either (error . pretty) id) ... runBatching+  fmap (second unsafe) ... runBatching  -- | This is the basic primitive for all actions in 'BatchingM'. --

@@ -1,658 +0,0 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ--{-# OPTIONS_GHC -Wno-star-is-type #-}--module Test.AsRPC-  ( unit_Renames_constructors_fields_and_generic_metadata-  , unit_Can_derive_many_instances_at_once-  , unit_Supports_higher_kinded_types-  , unit_Can_derive_instances_with_newtype-  , unit_Can_derive_many_instances_with_newtypes-  , unit_Can_derive_many_instances_with_type_aliases-  ) where--import Data.Typeable ((:~:)(Refl))-import GHC.Generics-import qualified Language.Haskell.TH.Syntax as TH-import Test.Tasty.HUnit (Assertion)--import Lorentz (BigMap, BigMapId, IsoValue(ToT), MText, customGeneric, leftBalanced, ligoLayout)-import Morley.Client.RPC.AsRPC--import Test.Util (shouldCompileIgnoringInstance, shouldCompileTo)--data ExampleStorage a b = ExampleStorage-  { _esField1 :: Integer-  , _esField2 :: [BigMap Integer MText]-  , _esField3 :: a-  }-  deriving stock Generic-  deriving anyclass IsoValue-deriveRPC "ExampleStorage"--unit_Renames_constructors_fields_and_generic_metadata :: Assertion-unit_Renames_constructors_fields_and_generic_metadata = do-  $(deriveRPC "ExampleStorage" >>= TH.lift) `shouldCompileTo`-    [d|-      data ExampleStorageRPC a (b :: k) = ExampleStorageRPC-        { _esField1RPC :: AsRPC Integer-        , _esField2RPC :: AsRPC [BigMap Integer MText]-        , _esField3RPC :: AsRPC a-        }--      type instance AsRPC (ExampleStorage a (b :: k)) = ExampleStorageRPC a (b :: k)-      deriving anyclass instance IsoValue (AsRPC a) => IsoValue (ExampleStorageRPC a (b :: k))--      instance Generic (ExampleStorageRPC a (b :: k))-          where type Rep (ExampleStorageRPC a-                                      (b :: k)) = D1 ('MetaData "ExampleStorageRPC" "Test.AsRPC" "main" 'False)-                                                      (C1 ('MetaCons "ExampleStorageRPC" 'PrefixI 'True)-                                                          ((:*:) (S1 ('MetaSel ('Just "_esField1RPC")-                                                                              'NoSourceUnpackedness-                                                                              'NoSourceStrictness-                                                                              'DecidedStrict)-                                                                    (Rec0 (AsRPC Integer)))-                                                                ((:*:) (S1 ('MetaSel ('Just "_esField2RPC")-                                                                                      'NoSourceUnpackedness-                                                                                      'NoSourceStrictness-                                                                                      'DecidedStrict)-                                                                            (Rec0 (AsRPC ([BigMap Integer-                                                                                                  MText]))))-                                                                        (S1 ('MetaSel ('Just "_esField3RPC")-                                                                                      'NoSourceUnpackedness-                                                                                      'NoSourceStrictness-                                                                                      'DecidedStrict)-                                                                            (Rec0 (AsRPC a))))))-                from (ExampleStorageRPC v0-                                  v1-                                  v2) = M1 (M1 ((:*:) (M1 (K1 v0)) ((:*:) (M1 (K1 v1)) (M1 (K1 v2)))))-                to (M1 (M1 ((:*:) (M1 (K1 v0))-                                  ((:*:) (M1 (K1 v1)) (M1 (K1 v2)))))) = ExampleStorageRPC v0 v1 v2-    |]--data Ex1 = Ex1 Integer Ex1Inner-  deriving stock Generic-  deriving anyclass IsoValue-data Ex1Inner = Ex1Inner Integer-  deriving stock Generic-  deriving anyclass IsoValue--data Ex2 = Ex2 Integer-  deriving stock Generic-  deriving anyclass IsoValue-deriveRPC "Ex2"--data Ex3 = Ex3 Integer-  deriving stock (Generic, Eq, Ord)-  deriving anyclass IsoValue--data Ex4 a = Ex4 a-  deriving stock Generic-  deriving anyclass IsoValue--data ExampleMany = ExampleMany-  { _emField1 :: Integer-  , _emField2 :: Ex1-  , _emField3 :: Ex2-  , _emField4 :: [BigMap Ex3 (Ex4 MText)]-  }-  deriving stock Generic-  deriving anyclass IsoValue---- Check that the declarations generated by `deriveManyRPC` actually compile.-deriveManyRPC "ExampleMany" []--unit_Can_derive_many_instances_at_once :: Assertion-unit_Can_derive_many_instances_at_once = do-  shouldCompileIgnoringInstance ''Generic-    $(deriveManyRPC "ExampleMany" ["Ex3"] >>= TH.lift)-    [d|-      data ExampleManyRPC = ExampleManyRPC-        {_emField1RPC :: AsRPC Integer-        , _emField2RPC :: AsRPC Ex1-        , _emField3RPC :: AsRPC Ex2-        , _emField4RPC :: AsRPC [BigMap Ex3 (Ex4 MText)]-        }-      type instance AsRPC ExampleMany = ExampleManyRPC-      deriving anyclass instance IsoValue ExampleManyRPC--      -- An instance is generated for Ex1-      data Ex1RPC = Ex1RPC (AsRPC Integer) (AsRPC Ex1Inner)-      type instance AsRPC Ex1 = Ex1RPC-      deriving anyclass instance IsoValue Ex1RPC--      -- An instance is generated for Ex1's fields' types-      data Ex1InnerRPC = Ex1InnerRPC (AsRPC Integer)-      type instance AsRPC Ex1Inner = Ex1InnerRPC-      deriving anyclass instance IsoValue Ex1InnerRPC--      -- No instance is generated for Ex2, because one already exists--      -- No instance is generated for Ex3, because we explicitly said we don't want one--      -- An instance is generated for BigMap's concrete type arguments-      data Ex4RPC a = Ex4RPC (AsRPC a)-      type instance AsRPC (Ex4 a) = Ex4RPC a-      deriving anyclass instance IsoValue (AsRPC a) => IsoValue (Ex4RPC a)-    |]--------------------------------------------------------------------------------- AsRPC type family-------------------------------------------------------------------------------checkLaws :: ToT (AsRPC t) :~: AsRPC (ToT t) -> ()-checkLaws Refl = ()--------------------------------------------------------------------------------- Examples data types:------ Simple data type-------------------------------------------------------------------------------data Simple = Simple Integer Integer [Integer]-  deriving stock Generic-  deriving anyclass IsoValue-deriveRPC "Simple"--data ExpectedSimpleRPC = ExpectedSimpleRPC Integer Integer [Integer]-  deriving stock Generic-  deriving anyclass IsoValue--_checkSimple :: ToT SimpleRPC :~: ToT ExpectedSimpleRPC-_checkSimple = Refl--_checkSimpleLaws :: ()-_checkSimpleLaws = checkLaws @Simple Refl--------------------------------------------------------------------------------- Simple record data type-------------------------------------------------------------------------------data SimpleRecord = SimpleRecord-  { _simpleRecordField1 :: Integer-  , _simpleRecordField2 :: Integer-  , _simpleRecordField3 :: [Integer]-  }-  deriving stock Generic-  deriving anyclass IsoValue-deriveRPC "SimpleRecord"--data ExpectedSimpleRecordRPC = ExpectedSimpleRecordRPC-  { eSimpleRecordField1 :: Integer-  , eSimpleRecordField2 :: Integer-  , eSimpleRecordField3 :: [Integer]-  }-  deriving stock Generic-  deriving anyclass IsoValue--_checkSimpleRecord :: ToT SimpleRecordRPC :~: ToT ExpectedSimpleRecordRPC-_checkSimpleRecord = Refl--_checkSimpleRecordLaws :: ()-_checkSimpleRecordLaws = checkLaws @SimpleRecord Refl--------------------------------------------------------------------------------- Data type with bigmap fields-------------------------------------------------------------------------------data WithBigMap = WithBigMap-  { _wbmField1 :: Integer-  , _wbmField2 :: BigMap Integer Integer-  , _wbmField3 :: [BigMap Integer Integer]-  }-  deriving stock Generic-  deriving anyclass IsoValue-deriveRPC "WithBigMap"--data ExpectedWithBigMapRPC = ExpectedWithBigMapRPC-  { expectedWbmField1 :: Integer-  , expectedWbmField2 :: BigMapId Integer Integer-  , expectedWbmField3 :: [BigMapId Integer Integer]-  }-  deriving stock Generic-  deriving anyclass IsoValue--_checkWithBigMap :: ToT WithBigMapRPC :~: ToT ExpectedWithBigMapRPC-_checkWithBigMap = Refl--_checkWithBigMapLaws :: ()-_checkWithBigMapLaws = checkLaws @WithBigMap Refl--------------------------------------------------------------------------------- Data type with custom generic strategy-------------------------------------------------------------------------------data WithGenericStrategy-  = WithGenericStrategy_1 Integer Integer Integer-  | WithGenericStrategy_2 Integer Integer Integer-  | WithGenericStrategy_3 Integer Integer Integer-  | WithGenericStrategy_4 Integer Integer Integer--deriving anyclass instance IsoValue WithGenericStrategy-customGeneric "WithGenericStrategy" leftBalanced-deriveRPCWithStrategy "WithGenericStrategy" leftBalanced--_checkWithGenericStrategy :: ToT WithGenericStrategyRPC :~: ToT WithGenericStrategy-_checkWithGenericStrategy = Refl--_checkWithGenericStrategyLaws :: ()-_checkWithGenericStrategyLaws = checkLaws @WithGenericStrategy Refl--------------------------------------------------------------------------------- Data type with reordered fields-------------------------------------------------------------------------------data WithReordered = WithRedordered-  { _wrField1 :: Integer-  , _wrField3 :: MText-  , _wrField2 :: [Integer]-  }--deriving anyclass instance IsoValue WithReordered-customGeneric "WithReordered" ligoLayout-deriveRPCWithStrategy "WithReordered" ligoLayout--_checkWithReordered :: ToT WithReorderedRPC :~: ToT WithReordered-_checkWithReordered = Refl--_checkWithReorderedLaws :: ()-_checkWithReorderedLaws = checkLaws @WithReordered Refl--------------------------------------------------------------------------------- Data type with type variables-------------------------------------------------------------------------------data WithTypeVariables a = WithTypeVariables-  { _wtvField1 :: a-  }-  deriving stock Generic-  deriving anyclass IsoValue-deriveRPC "WithTypeVariables"--data ExpectedWithTypeVariablesRPC = ExpectedWithTypeVariablesRPC-  { expectedWtvField1 :: BigMapId Integer MText-  }-  deriving stock Generic-  deriving anyclass IsoValue--_checkWithTypeVariables :: ToT (WithTypeVariablesRPC (BigMap Integer MText)) :~: ToT ExpectedWithTypeVariablesRPC-_checkWithTypeVariables = Refl--_checkWithTypeVariablesLaws :: ()-_checkWithTypeVariablesLaws = checkLaws @(WithTypeVariables (BigMap Integer MText)) Refl--------------------------------------------------------------------------------- Data type with nested data types and type variables-------------------------------------------------------------------------------data WithNested a = WithNested-  { _wnField1 :: WithNested2 a-  , _wnField2 :: [WithNested2 a]-  , _wnField3 :: WithNested2 [a]-  }-  deriving stock Generic-deriving anyclass instance IsoValue a => IsoValue (WithNested a)--data WithNested2 a = WithNested2-  { _wn2Field1 :: a-  , _wn2Field2 :: [a]-  }-  deriving stock Generic-  deriving anyclass IsoValue--deriveManyRPC "WithNested" []--data ExpectedWithNestedRPC = ExpectedWithNestedRPC-  { expectedWnField1 :: ExpectedWithNested2RPC-  , expectedWnField2 :: [ExpectedWithNested2RPC]-  , expectedWnField3 :: ExpectedWithNested2RPC'-  }-  deriving stock Generic-  deriving anyclass IsoValue--data ExpectedWithNested2RPC = ExpectedWithNested2RPC-  { expectedWn2Field1 :: BigMapId Integer MText-  , expectedWn2Field2 :: [BigMapId Integer MText]-  }-  deriving stock Generic-  deriving anyclass IsoValue--data ExpectedWithNested2RPC' = ExpectedWithNested2RPC'-  { expectedWn2Field1' :: [BigMapId Integer MText]-  , expectedWn2Field2' :: [[BigMapId Integer MText]]-  }-  deriving stock Generic-  deriving anyclass IsoValue--_checkWithNested2 :: ToT (WithNested2RPC (BigMap Integer MText)) :~: ToT ExpectedWithNested2RPC-_checkWithNested2 = Refl--_checkWithNested :: ToT (WithNestedRPC (BigMap Integer MText)) :~: ToT ExpectedWithNestedRPC-_checkWithNested = Refl--_checkWithNestedLaws :: ()-_checkWithNestedLaws = checkLaws @(WithNested (BigMap Integer MText)) Refl--_checkWithNested2Laws :: ()-_checkWithNested2Laws = checkLaws @(WithNested2 (BigMap Integer MText)) Refl--------------------------------------------------------------------------------- Data type with phantom type variables-------------------------------------------------------------------------------data WithPhantom a b c = WithPhantom-  { _wpField1 :: Integer-  , _wpField2 :: b-  }-  deriving stock Generic-  deriving anyclass IsoValue-deriveRPC "WithPhantom"--data ExpectedWithPhantomRPC = ExpectedWithPhantomRPC-  { expectedWpField1 :: Integer-  , expectedWpField2 :: MText-  }-  deriving stock Generic-  deriving anyclass IsoValue--_checkWithPhantom :: ToT (WithPhantomRPC Integer MText (BigMap Integer Integer)) :~: ToT ExpectedWithPhantomRPC-_checkWithPhantom = Refl--_checkWithPhantomLaws :: ()-_checkWithPhantomLaws = checkLaws @(WithPhantom Integer MText (BigMap Integer Integer)) Refl--------------------------------------------------------------------------------- Data type with higher-kinded type variables-------------------------------------------------------------------------------data WithHigherKind f = WithHigherKind-  { _whkField1 :: WithHigherKindNested f-  }-  deriving stock Generic-deriving anyclass instance (IsoValue (f Integer MText)) => IsoValue (WithHigherKind f)--data WithHigherKindNested f = WithHigherKindNested-  { _whknField1 :: f Integer MText-  }-  deriving stock Generic-deriving anyclass instance (IsoValue (f Integer MText)) => IsoValue (WithHigherKindNested f)--deriveManyRPC "WithHigherKind" []--unit_Supports_higher_kinded_types :: Assertion-unit_Supports_higher_kinded_types = do-  shouldCompileIgnoringInstance ''Generic-    $(deriveManyRPC "WithHigherKind" [] >>= TH.lift)-    [d|-      data WithHigherKindRPC (f :: * -> * -> *) = WithHigherKindRPC-        { _whkField1RPC :: AsRPC (WithHigherKindNested f)-        }-      type instance AsRPC (WithHigherKind (f :: * -> * -> *))-        = WithHigherKindRPC (f :: * -> * -> *)-      deriving anyclass instance IsoValue (AsRPC (WithHigherKindNested f))-        => IsoValue (WithHigherKindRPC (f :: * -> * -> *))--      data WithHigherKindNestedRPC (f :: * -> * -> *) = WithHigherKindNestedRPC-        { _whknField1RPC :: AsRPC (f Integer MText)-        }-      type instance AsRPC (WithHigherKindNested (f :: * -> * -> *))-        = WithHigherKindNestedRPC (f :: * -> * -> *)-      deriving anyclass instance IsoValue (AsRPC (f Integer MText))-        => IsoValue (WithHigherKindNestedRPC (f :: * -> * -> *))-    |]--data ExpectedWithHigherKindRPC = ExpectedWithHigherKindRPC-  { expectedWhkField1 :: ExpectedWithHigherKindNestedRPC-  }-  deriving stock Generic-  deriving anyclass IsoValue--data ExpectedWithHigherKindNestedRPC = ExpectedWithHigherKindNestedRPC-  { expectedWhknField1 :: Map Integer MText-  }-  deriving stock Generic-  deriving anyclass IsoValue--_checkWithHigherKindNested :: ToT (WithHigherKindNestedRPC Map) :~: ToT ExpectedWithHigherKindNestedRPC-_checkWithHigherKindNested = Refl--_checkWithHigherKind :: ToT (WithHigherKindRPC Map) :~: ToT ExpectedWithHigherKindRPC-_checkWithHigherKind = Refl--_checkWithHigherKindLaws :: ()-_checkWithHigherKindLaws = checkLaws @(WithHigherKind Map) Refl--_checkWithHigherKindNestedLaws :: ()-_checkWithHigherKindNestedLaws = checkLaws @(WithHigherKindNested Map) Refl--------------------------------------------------------------------------------- Newtypes allowed with deriveRPC and in deriveManyRPC-------------------------------------------------------------------------------data Data1 b = Data1 b-  deriving stock (Generic, Eq, Ord)-  deriving anyclass IsoValue--deriveRPC "Data1"--newtype Nt1 a b = Nt1 [Data1 a]-  deriving stock (Generic, Eq, Ord)-deriving anyclass instance IsoValue a => IsoValue (Nt1 a b)--deriveRPC "Nt1"--unit_Can_derive_instances_with_newtype :: Assertion-unit_Can_derive_instances_with_newtype = do-  shouldCompileIgnoringInstance ''Generic-    $(deriveRPC "Nt1" >>= TH.lift)-    [d|-      newtype Nt1RPC a (b :: k) = Nt1RPC (AsRPC ([Data1 a]))-      type instance AsRPC (Nt1 a (b :: k)) = Nt1RPC a (b :: k)-      deriving anyclass instance IsoValue (AsRPC ([Data1 a])) => IsoValue (Nt1RPC a (b :: k))-    |]--newtype Nt2 = Nt2 { _nt2field :: Integer }-  deriving stock Generic-  deriving anyclass IsoValue--newtype Nt3 a = Nt3 a-  deriving stock Generic-  deriving anyclass IsoValue--newtype Nt4 a b = Nt4 (BigMap Integer MText)-  deriving stock Generic-  deriving anyclass IsoValue--newtype Nt5 a = Nt5 a-  deriving stock Generic-  deriving anyclass IsoValue--newtype Nt6 a = Nt6 (Nt5 a)-  deriving stock Generic-deriving anyclass instance IsoValue a => IsoValue (Nt6 a)--data Data2 a = Data2 (Nt6 a)-  deriving stock Generic-deriving anyclass instance IsoValue a => IsoValue (Data2 a)--data ExampleWithNewtypes = ExampleWithNewtypes-  { _ewnField1 :: Nt3 Nt2-  , _ewnField2 :: Nt4 MText Integer-  , _ewnField3 :: Data2 Integer-  }-  deriving stock Generic-  deriving anyclass IsoValue--deriveManyRPC "ExampleWithNewtypes" []--unit_Can_derive_many_instances_with_newtypes :: Assertion-unit_Can_derive_many_instances_with_newtypes = do-  shouldCompileIgnoringInstance ''Generic-    $(deriveManyRPC "ExampleWithNewtypes" [] >>= TH.lift)-    [d|-      data ExampleWithNewtypesRPC = ExampleWithNewtypesRPC-        {_ewnField1RPC :: (AsRPC (Nt3 Nt2))-        , _ewnField2RPC :: (AsRPC (Nt4 MText Integer))-        , _ewnField3RPC :: (AsRPC (Data2 Integer))-        }--      type instance AsRPC ExampleWithNewtypes = ExampleWithNewtypesRPC-      deriving anyclass instance IsoValue ExampleWithNewtypesRPC--      newtype Nt3RPC a = Nt3RPC (AsRPC a)-      type instance AsRPC (Nt3 a) = Nt3RPC a-      deriving anyclass instance IsoValue (AsRPC a) => IsoValue (Nt3RPC a)--      newtype Nt2RPC = Nt2RPC {_nt2fieldRPC :: (AsRPC Integer)}-      type instance AsRPC Nt2 = Nt2RPC-      deriving anyclass instance IsoValue Nt2RPC--      newtype Nt4RPC (a :: k) (b :: k) = Nt4RPC (AsRPC (BigMap Integer MText))-      type instance AsRPC (Nt4 (a :: k) (b :: k)) = Nt4RPC (a :: k) (b :: k)-      deriving anyclass instance IsoValue (Nt4RPC (a :: k) (b :: k))--      data Data2RPC a = Data2RPC (AsRPC (Nt6 a))-      type instance AsRPC (Data2 a) = Data2RPC a-      deriving anyclass instance IsoValue (AsRPC (Nt6 a)) => IsoValue (Data2RPC a)--      newtype Nt6RPC a = Nt6RPC (AsRPC (Nt5 a))-      type instance AsRPC (Nt6 a) = Nt6RPC a-      deriving anyclass instance IsoValue (AsRPC (Nt5 a)) => IsoValue (Nt6RPC a)--      newtype Nt5RPC a = Nt5RPC (AsRPC a)-      type instance AsRPC (Nt5 a) = Nt5RPC a-      deriving anyclass instance IsoValue (AsRPC a) => IsoValue (Nt5RPC a)-    |]--------------------------------------------------------------------------------- Type aliases allowed with deriveManyRPC-------------------------------------------------------------------------------type Ty1 = Integer--type Ty2 k v = BigMap k v--type Ty3 phantom = Ty1--data Dt1 = Dt1 Integer-  deriving stock (Generic, Eq, Ord)-  deriving anyclass IsoValue--data Dt2 a = Dt2 a-  deriving stock Generic-  deriving anyclass IsoValue--type Ty4 = Dt1--type Ty5 a = Dt2 a--data Dt3 k v = Dt3 k v-  deriving stock (Generic, Eq, Ord)-  deriving anyclass IsoValue--type Ty6 v = Dt3 Integer v--data Dt4 v = Dt4 (Ty6 v)-  deriving stock (Generic, Eq, Ord)-deriving anyclass instance IsoValue v => IsoValue (Dt4 v)--data Dt5 a = Dt5 a-  deriving stock Generic-  deriving anyclass IsoValue--type Ty7 (f :: Type -> Type) = (f Integer)--data Dt6 = Dt6 Integer-  deriving stock (Generic, Eq, Ord)-  deriving anyclass IsoValue--data Dt7 a b = Dt7 a b-  deriving stock Generic-  deriving anyclass IsoValue--data Dt8 = Dt8 [BigMap Integer MText]-  deriving stock Generic-  deriving anyclass IsoValue--type Ty8 (f :: Type -> Type -> Type) a = f a Dt6-type Ty9 (f :: Type -> Type -> Type) a = Ty8 f a-type Ty10 (f :: Type -> Type -> Type) a = Ty9 f a--data ExampleTypeAliasMany = ExampleTypeAliasMany-  { _etamField1 :: Ty1-  , _etamField2 :: Ty2 Integer MText-  , _etamField3 :: Ty3 Integer-  , _etamField4 :: Ty4-  , _etamField5 :: Ty5 Integer-  , _etamField6 :: Ty6 MText-  , _etamField7 :: Ty7 Dt5-  , _etamField8 :: Ty10 Dt7 Dt8-  , _etamField9 :: Dt4 Integer-  }-  deriving stock Generic-  deriving anyclass IsoValue---- Check that the declarations generated by `deriveManyRPC` actually compile.-deriveManyRPC "ExampleTypeAliasMany" []--unit_Can_derive_many_instances_with_type_aliases :: Assertion-unit_Can_derive_many_instances_with_type_aliases = do-  shouldCompileIgnoringInstance ''Generic-    $(deriveManyRPC "ExampleTypeAliasMany" [] >>= TH.lift)-    [d|-      data ExampleTypeAliasManyRPC = ExampleTypeAliasManyRPC-        { _etamField1RPC :: AsRPC Ty1-        , _etamField2RPC :: AsRPC (Ty2 Integer MText)-        , _etamField3RPC :: AsRPC (Ty3 Integer)-        , _etamField4RPC :: AsRPC Ty4-        , _etamField5RPC :: AsRPC (Ty5 Integer)-        , _etamField6RPC :: AsRPC (Ty6 MText)-        , _etamField7RPC :: AsRPC (Ty7 Dt5)-        , _etamField8RPC :: AsRPC (Ty10 Dt7 Dt8)-        , _etamField9RPC :: AsRPC (Dt4 Integer)-        }-      type instance AsRPC ExampleTypeAliasMany = ExampleTypeAliasManyRPC-      deriving anyclass instance IsoValue ExampleTypeAliasManyRPC--      -- An instance is generated for Dt1-      data Dt1RPC = Dt1RPC (AsRPC Integer)-      type instance AsRPC Dt1 = Dt1RPC-      deriving anyclass instance IsoValue Dt1RPC--      -- An instance is generated for Dt2-      data Dt2RPC a = Dt2RPC (AsRPC a)-      type instance AsRPC (Dt2 a) = Dt2RPC a-      deriving anyclass instance IsoValue (AsRPC a) => IsoValue (Dt2RPC a)--      -- An instance is generated for Dt3-      data Dt3RPC k v = Dt3RPC (AsRPC k) (AsRPC v)-      type instance AsRPC (Dt3 k v) = Dt3RPC k v-      deriving anyclass instance (IsoValue (AsRPC k), IsoValue (AsRPC v)) => IsoValue (Dt3RPC k v)--      -- An instance is generated for Dt5-      data Dt5RPC a = Dt5RPC (AsRPC a)-      type instance AsRPC (Dt5 a) = Dt5RPC a-      deriving anyclass instance IsoValue (AsRPC a) => IsoValue (Dt5RPC a)--      -- An instance is generated for Dt6-      data Dt6RPC = Dt6RPC (AsRPC Integer)-      type instance AsRPC Dt6 = Dt6RPC-      deriving anyclass instance IsoValue Dt6RPC--      -- An instance is generated for Dt7-      data Dt7RPC a b = Dt7RPC (AsRPC a) (AsRPC b)-      type instance AsRPC (Dt7 a b) = Dt7RPC a b-      deriving anyclass instance (IsoValue (AsRPC a), IsoValue (AsRPC b)) => IsoValue (Dt7RPC a b)--      -- An instance is generated for Dt8-      data Dt8RPC = Dt8RPC (AsRPC ([BigMap Integer MText]))-      type instance AsRPC Dt8 = Dt8RPC-      deriving anyclass instance IsoValue Dt8RPC--      -- An instance is generated for Dt4-      data Dt4RPC v = Dt4RPC (AsRPC (Ty6 v))-      type instance AsRPC (Dt4 v) = Dt4RPC v-      deriving anyclass instance IsoValue (AsRPC (Ty6 v)) => IsoValue (Dt4RPC v)-    |]

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Test.BigMapGet   ( test_BigMapGetUnit@@ -12,7 +11,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) -import qualified Lorentz as L+import Lorentz qualified as L import Lorentz.Pack (expressionToScriptExpr) import Morley.Micheline (decodeExpression) import Morley.Tezos.Crypto (encodeBase58Check)

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Test.Fees   ( test_Fees_comp_iterations@@ -11,14 +10,14 @@ import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase) -import qualified Lorentz as L+import Lorentz qualified as L import Morley.Client.Action.Origination import Morley.Client.Action.Transaction import Morley.Client.RPC.Types import Morley.Client.TezosClient import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2) import Morley.Michelson.Untyped.Entrypoints-import Morley.Tezos.Core (toMutez)+import Morley.Tezos.Core (tz) import Test.Util import TestM @@ -85,7 +84,7 @@       let forgeCalls =             runForgesCountingTest $               lTransfer genesisAddress1 genesisAddress2-                (toMutez 10) DefEpName () Nothing+                [tz|10u|] DefEpName () Nothing       in forgeCalls @?= sum           [ 2  -- for fees adjustment           , 1  -- check on fees being on par@@ -96,7 +95,7 @@       let forgeCalls =             runForgesCountingTest $               lOriginateContract True "c"-                (AddressResolved genesisAddress1) (toMutez 10)+                (AddressResolved genesisAddress1) [tz|10u|]                 averageContract () Nothing       in forgeCalls @?= sum           [ 2  -- for fees adjustment

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2021 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Test.KeyRevealing   ( test_keyRevealing@@ -10,11 +9,11 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) -import qualified Lorentz as L+import Lorentz qualified as L import Morley.Client import Morley.Michelson.Runtime.GState (genesisAddress1) import Morley.Michelson.Typed-import Morley.Tezos.Core (toMutez)+import Morley.Tezos.Core (tz) import Test.Util import TestM @@ -81,10 +80,10 @@   ]   where     dummyTransfer from to =-      void $ transfer from to (toMutez 10) DefEpName (toVal ()) Nothing+      void $ transfer from to [tz|10u|] DefEpName (toVal ()) Nothing      originateDummy addr =-      lOriginateContract True "dummy" (AddressResolved addr) (toMutez 10)+      lOriginateContract True "dummy" (AddressResolved addr) [tz|10u|]       dumbLorentzContract () Nothing  -- | Handlers which don't allow to reveal key.

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Test.Origination   ( test_lRunTransactionsUnit@@ -12,7 +11,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) -import qualified Lorentz as L+import Lorentz qualified as L import Morley.Client import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2, genesisAddress3) import Morley.Tezos.Core@@ -36,11 +35,11 @@ test_lRunTransactionsUnit = testGroup "Mock test transaction sending"   [ testCase "Successful origination" $ handleSuccess $     runMockTest chainOperationHandlers mockState $-      lOriginateContract True "dummy" (AddressResolved genesisAddress1) (toMutez 100500)+      lOriginateContract True "dummy" (AddressResolved genesisAddress1) [tz|100500u|]       dumbLorentzContract () Nothing   , testCase "Originator doesn't exist" $ handleUnknownContract $     runMockTest chainOperationHandlers mockState $-      lOriginateContract True "dummy" (AddressResolved genesisAddress3) (toMutez 100500)+      lOriginateContract True "dummy" (AddressResolved genesisAddress3) [tz|100500u|]       dumbLorentzContract () Nothing   ]   where

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Test.ParameterTypeGet   ( test_parameterTypeGetUnit@@ -11,16 +10,16 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) -import qualified Lorentz as L+import Lorentz qualified as L  import Morley.Client import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Micheline import Morley.Michelson.Runtime.GState (genesisAddress1)-import Morley.Michelson.TypeCheck.TypeCheck (SomeParamType, unsafeMkSomeParamType)+import Morley.Michelson.TypeCheck.TypeCheck (SomeParamType, mkSomeParamType) import Morley.Michelson.Typed-import qualified Morley.Michelson.Untyped as U+import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address import Test.Util import TestM@@ -66,8 +65,8 @@       getContractsParameterTypes       [genesisAddress1, smartContractAddr1, smartContractAddr2]     ) $ fromList-    [ (contractHash1, unsafeMkSomeParamType $ U.ParameterType (U.Ty U.TNat U.noAnn) U.noAnn)-    , (contractHash2, unsafeMkSomeParamType $ U.ParameterType (U.Ty U.TBool U.noAnn) U.noAnn)+    [ (contractHash1, unsafe . mkSomeParamType $ U.ParameterType (U.Ty U.TNat U.noAnn) U.noAnn)+    , (contractHash2, unsafe . mkSomeParamType $ U.ParameterType (U.Ty U.TBool U.noAnn) U.noAnn)     ]   , testCase "Parameter type for nonexistent smart contract is not extracted" $     expectContractMap

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Test.Parser   ( test_bakerFeeParser@@ -15,18 +14,19 @@ import Morley.Client.TezosClient.Types (SecretKeyEncryption(..)) import Morley.Micheline import Morley.Tezos.Core+import Morley.Util.SizedList qualified as SL  test_bakerFeeParser :: TestTree test_bakerFeeParser = testGroup "tezos-client baker fee parser"   [ testCase "resulted fee is multiplied by 1e6" $-    parseBakerFeeFromOutput "Fee to the baker: ꜩ0.056008\n" 1 `shouldBe`-    Right [TezosMutez $ toMutez 56008]+      parseBakerFeeFromOutput @1 "Fee to the baker: ꜩ0.056008\n"+        `shouldBe` Right (one $ TezosMutez [tz|56008u|])   , testCase "multiples fees can be parsed" $-    parseBakerFeeFromOutput "Fee to the baker: ꜩ0.056008\n Fee to the baker: ꜩ0.056008\n" 2 `shouldBe`-    Right (replicate 2 $ TezosMutez $ toMutez 56008)+      parseBakerFeeFromOutput @2 "Fee to the baker: ꜩ0.056008\n Fee to the baker: ꜩ0.056008\n"+        `shouldBe`  Right (SL.replicateT @2 $ TezosMutez [tz|56008u|])   , testCase "no valid baker fee in the output" $-    parseBakerFeeFromOutput "Notfee to the baker: ꜩ0.056008\n" 1 `shouldSatisfy`-    isLeft+      parseBakerFeeFromOutput @1 "Notfee to the baker: ꜩ0.056008\n"+        `shouldSatisfy` isLeft   ]  test_secretKeyEncriptionParser :: TestTree

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Test.ReadBigMapValue   ( test_ReadBigMapValueUnit

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  module Test.Transaction   ( test_lRunTransactionsUnit@@ -15,7 +14,7 @@ import Morley.Client.Action.Transaction import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2, genesisAddress3) import Morley.Michelson.Untyped.Entrypoints-import Morley.Tezos.Core (toMutez)+import Morley.Tezos.Core (tz) import Test.Util import TestM @@ -33,15 +32,15 @@   [ testCase "Successful transaction" $ handleSuccess $     runMockTest chainOperationHandlers mockState $       lTransfer genesisAddress1 genesisAddress2-        (toMutez 10) DefEpName () Nothing+        [tz|10u|] DefEpName () Nothing   , testCase "Sender doesn't exist" $ handleUnknownContract $     runMockTest chainOperationHandlers mockState $       lTransfer genesisAddress3 genesisAddress2-        (toMutez 10) DefEpName () Nothing+        [tz|10u|] DefEpName () Nothing   , testCase "Destination doesn't exist" $ handleUnknownContract $     runMockTest chainOperationHandlers mockState $       lTransfer genesisAddress1 genesisAddress3-        (toMutez 10) DefEpName () Nothing+        [tz|10u|] DefEpName () Nothing   ]   where     handleSuccess :: Either SomeException a -> Assertion

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  -- | Module with various helpers that are used in morley-client mock tests. module Test.Util@@ -11,47 +10,37 @@   , mapToContractStateBigMap   , handleGetBigMapValue -    -- * TemplateHaskell test helpers-  , shouldCompileTo-  , shouldCompileIgnoringInstance     -- * Internals   , handleRunOperationInternal   , assertHeadBlockId   ) where -import Prelude hiding (Type)- import Control.Exception.Safe (throwString) import Control.Lens (at, (?~)) import Data.Aeson (encode) import Data.ByteArray (ScrubbedBytes)-import qualified Data.ByteString.Lazy as LBS (toStrict)-import qualified Data.Generics as SYB+import Data.ByteString.Lazy qualified as LBS (toStrict) import Data.Map as Map (elems, fromList, insert, lookup, toList) import Data.Singletons (demote) import Fmt ((+|), (|+))-import Language.Haskell.TH (pprint)-import Language.Haskell.TH.Syntax-  (Dec(..), Name, Q, TyVarBndr(..), Type(..), mkName, nameBase, runQ) import Network.HTTP.Types.Status (status404) import Network.HTTP.Types.Version (http20) import Servant.Client.Core   (BaseUrl(..), ClientError(..), RequestF(..), ResponseF(..), Scheme(..), defaultRequest)-import Test.Tasty.HUnit (Assertion, (@?=)) import Text.Hex (encodeHex)-import qualified Text.Show (show)  import Lorentz as L (compileLorentz, drop) import Lorentz.Constraints import Lorentz.Pack import Morley.Client.RPC.Types import Morley.Client.TezosClient.Types+import Morley.Client.Types import Morley.Micheline import Morley.Michelson.Typed import Morley.Tezos.Address import Morley.Tezos.Core import Morley.Tezos.Crypto-import qualified Morley.Tezos.Crypto.Ed25519 as Ed25519+import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519 import Morley.Util.ByteString import TestM @@ -98,9 +87,7 @@   , hGetProtocolParameters = handleGetProtocolParameters   , hRunOperation = handleRunOperation   , hPreApplyOperations = mapM . handlePreApplyOperation-  , hForgeOperation = \blkId arg -> do-      assertHeadBlockId blkId-      pure . HexJSONByteString . LBS.toStrict . encode $ arg+  , hForgeOperation = handleForgeOperation   , hInjectOperation = pure . OperationHash . (<> "_injected") . encodeHex . unHexJSONByteString   , hGetContractScript = handleGetContractScript   , hSignBytes =@@ -109,8 +96,8 @@   , hGetAlias = handleGetAlias   , hResolveAddressMaybe = handleResolveAddressMaybe   , hRememberContract = handleRememberContract-  , hCalcTransferFee = \_ _ _ _ -> pure $ [TezosMutez $ toMutez 100500]-  , hCalcOriginationFee = \_ -> pure $ TezosMutez $ toMutez 100500+  , hCalcTransferFee = \_ _ _ _ -> pure $ [TezosMutez [tz|100500u|]]+  , hCalcOriginationFee = \_ -> pure $ TezosMutez [tz|100500u|]   , hGetKeyPassword = \_ -> pure Nothing   , hGenKey = handleGenKey   , hGetManagerKey = handleGetManagerKey@@ -132,9 +119,11 @@  handleGetBlockHash :: Monad m => BlockId -> TestT m Text handleGetBlockHash blkId = do-  assertHeadBlockId blkId+  unless (blkId == FinalHeadId) do+    throwString "Expected `getBlockHash` to be called with `head~2`."+   MockState{..} <- get-  pure $ msHeadBlock+  pure msFinalHeadBlock  handleGetCounter   :: ( MonadState MockState m@@ -150,10 +139,10 @@  handleGetBlockConstants   :: MonadState MockState m-  => anything -> m BlockConstants-handleGetBlockConstants _ = do+  => BlockId -> m BlockConstants+handleGetBlockConstants blkId = do   MockState{..} <- get-  pure $ msBlockConstants+  pure $ msBlockConstants blkId  handleGetProtocolParameters   :: (MonadState MockState m, MonadThrow m)@@ -168,7 +157,11 @@   assertHeadBlockId blk   MockState{..} <- get   -- Ensure that passed chain id matches with one that mock state has-  unless (roChainId == bcChainId msBlockConstants) (throwM $ InvalidChainId)+  unless (roChainId == bcChainId (msBlockConstants blk)) (throwM $ InvalidChainId)+  -- As of release of the ithaca protocol, the "branch" field should be "head~2".+  -- https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html+  unless (roiBranch roOperation == msFinalHeadBlock) do+    throwM $ InvalidBranch $ roiBranch roOperation   originatedContracts <- handleRunOperationInternal roOperation   pure $ mkRunOperationResult originatedContracts @@ -177,21 +170,36 @@   assertHeadBlockId blk   MockState{..} <- get   -- Ensure that passed protocol matches with one that mock state has-  unless (paoProtocol == bcProtocol msBlockConstants) (throwM $ InvalidProtocol)+  unless (paoProtocol == bcProtocol (msBlockConstants blk)) $+    throwM InvalidProtocol+  -- As of release of the ithaca protocol, the "branch" field should be "head~2".+  -- https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html+  unless (paoBranch == msFinalHeadBlock) do+    throwM $ InvalidBranch paoBranch   originatedContracts <- concatMapM handleTransactionOrOrigination paoContents   pure $ mkRunOperationResult originatedContracts +handleForgeOperation :: Monad m => BlockId -> ForgeOperation -> TestT m HexJSONByteString+handleForgeOperation blkId op = do+  assertHeadBlockId blkId+  ms <- get+  -- As of release of the ithaca protocol, the "branch" field should be "head~2".+  -- https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html+  unless (foBranch op == msFinalHeadBlock ms) do+    throwM $ InvalidBranch $ foBranch op+  pure . HexJSONByteString . LBS.toStrict . encode $ op+ handleRunOperationInternal :: Monad m => RunOperationInternal -> TestT m [Address] handleRunOperationInternal RunOperationInternal{..} = do   concatMapM handleTransactionOrOrigination roiContents  handleTransactionOrOrigination-  :: Monad m => Either TransactionOperation OriginationOperation -> TestT m [Address]+  :: Monad m => OperationInput -> TestT m [Address] handleTransactionOrOrigination op = do   MockState{..} <- get-  case op of+  case oiCustom op of     -- Ensure that transaction sender exists-    Left TransactionOperation{..} -> case lookup codSource msContracts of+    OpTransfer TransactionOperation{..} -> case lookup codSource msContracts of       Nothing -> throwM $ UnknownContract $ AddressResolved codSource       Just ContractState{..} -> do         -- Ensure that sender counter matches@@ -199,22 +207,23 @@         case lookup toDestination msContracts of           Nothing -> throwM $ UnknownContract $ AddressResolved toDestination           Just _ -> pure []-      where-        CommonOperationData{..} = toCommonData     -- Ensure that originator exists-    Right OriginationOperation{..} -> case lookup codSource msContracts of+    OpOriginate _ -> case lookup codSource msContracts of       Nothing -> throwM $ UnknownContract $ AddressResolved codSource       Just ContractState{..} -> do         -- Ensure that originator counter matches         unless (csCounter + 1 == codCounter) (throwM CounterMismatch)         pure [dummyContractAddr]       where-        CommonOperationData{..} = ooCommonData-        dummyContractAddr = unsafeParseAddress "KT1LZwEZqbqtLYhwzaidBp6So9LgYDpkpEv7"+        dummyContractAddr = unsafe $ parseAddress "KT1LZwEZqbqtLYhwzaidBp6So9LgYDpkpEv7"+    OpReveal _ ->+      -- We do not care about reveals at the moment+      return []+  where+    CommonOperationData{..} = oiCommonData op --- We don't pass non-head block anywhere in @morley-client@, this feature--- exists only for external users.-assertHeadBlockId :: MonadThrow m => BlockId -> m ()+-- | In most places, @morley-client@ executes operations against the @head@ block.+assertHeadBlockId :: (HasCallStack, MonadThrow m) => BlockId -> m () assertHeadBlockId blockId = unless (blockId == HeadId) $   throwString "Accessing non-head block is not supported in tests" @@ -362,65 +371,3 @@ dumbManagerKey :: PublicKey dumbManagerKey = fromRight (error "impossible") $ parsePublicKey   "edpkuwTWKgQNnhR5v17H2DYHbfcxYepARyrPGbf1tbMoGQAj8Ljr3V"--------------------------------------------------------------------------------- TemplateHaskell test helpers-------------------------------------------------------------------------------shouldCompileTo :: HasCallStack => [Dec] -> Q [Dec] -> Assertion-shouldCompileTo actualDecs expectedQ = do-  expectedDecs <- runQ expectedQ-  PrettyDecs (normalizeDecs actualDecs) @?= PrettyDecs (normalizeDecs expectedDecs)---- | Same as 'shouldCompileTo', but ignores instance declarations of the given class.-shouldCompileIgnoringInstance :: HasCallStack => Name -> [Dec] -> Q [Dec] -> Assertion-shouldCompileIgnoringInstance className actualDecs expectedQ = do-  expectedDecs <- runQ expectedQ-  let actualDecs' = filter (not . isInstance) actualDecs-  PrettyDecs (normalizeDecs actualDecs') @?= PrettyDecs (normalizeDecs expectedDecs)--  where-    isInstance :: Dec -> Bool-    isInstance = \case-      InstanceD _ _ (ConT t `AppT` _) _ | t == className -> True-      _ -> False---- | Normalize ASTs to make them comparable.------ By default, quoted ASTs and ASTs with names created using 'newName' will have--- names with unique IDs.--- For example:------ > decs <- runQ [d|data D = D { f :: Int } |]--- > putStrLn $ pprint decs--- >--- > -- Will generate this AST:--- > data D_0 = D_1 { f_2 :: Int }------ To be able to check if two ASTs are equivalent, we have to scrub the unique IDs off all names.------ For convenience, to make the output easier to read, we also erase kind annotations when the kind is '*'.-normalizeDecs :: [Dec] -> [Dec]-normalizeDecs decs =-    SYB.everywhere-      (SYB.mkT fixName . SYB.mkT simplifyType . SYB.mkT simplifyTyVar)-      decs-  where-    fixName :: Name -> Name-    fixName = mkName . nameBase--    simplifyType :: Type -> Type-    simplifyType = \case-      SigT t StarT -> t-      t -> t--    simplifyTyVar :: TyVarBndr -> TyVarBndr-    simplifyTyVar = \case-     KindedTV name StarT -> PlainTV name-     tv -> tv--newtype PrettyDecs = PrettyDecs [Dec]-  deriving newtype Eq--instance Show PrettyDecs where-  show (PrettyDecs decs) = pprint decs

@@ -1,6 +1,5 @@--- SPDX-FileCopyrightText: 2020 Tocqueville Group------ SPDX-License-Identifier: LicenseRef-MIT-TQ+-- SPDX-FileCopyrightText: 2021 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA  {-# OPTIONS_GHC -Wno-orphans #-} @@ -33,6 +32,7 @@ import Data.ByteArray (ScrubbedBytes) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Fmt import Morley.Client import Morley.Client.Logging (ClientLogAction) import Morley.Client.RPC@@ -78,7 +78,7 @@   , hRevealKey :: Alias -> Maybe ScrubbedBytes -> m ()   , hWaitForOperation :: OperationHash -> m ()   , hRememberContract :: Bool -> Address -> AliasOrAliasHint -> m ()-  , hImportKey :: Bool -> AliasOrAliasHint -> SecretKey -> m ()+  , hImportKey :: Bool -> AliasOrAliasHint -> SecretKey -> m Alias   , hResolveAddressMaybe :: AddressOrAlias -> m (Maybe Address)   , hGetAlias :: AddressOrAlias -> m Alias   , hGetPublicKey :: AddressOrAlias -> m PublicKey@@ -163,7 +163,10 @@ data MockState = MockState   { msContracts :: Map Address ContractState   , msHeadBlock :: Text-  , msBlockConstants :: BlockConstants+  -- ^ Hash of the `head` block+  , msFinalHeadBlock :: Text+  -- ^ Hash of the `head~2` block+  , msBlockConstants :: BlockId -> BlockConstants   , msProtocolParameters :: ProtocolParameters   } @@ -171,7 +174,8 @@ defaultMockState = MockState   { msContracts = mempty   , msHeadBlock = "HEAD"-  , msBlockConstants = BlockConstants+  , msFinalHeadBlock = "HEAD~2"+  , msBlockConstants = \blkId -> BlockConstants     { bcProtocol = "PROTOCOL"     , bcChainId = "CHAIN_ID"     , bcHeader = BlockHeaderNoHash@@ -179,10 +183,10 @@       , bhnhLevel = 0       , bhnhPredecessor = BlockHash "PREV_HASH"       }-    , bcHash = BlockHash "HASH"+    , bcHash = BlockHash $ pretty blkId     }   , msProtocolParameters = ProtocolParameters 257 1040000 60000 15-                                              (TezosMutez $ unsafeMkMutez 250)+                                              (TezosMutez [tz|250u|])   }  type TestT m = StateT MockState (ReaderT (TestHandlers m) (CatchT m))@@ -217,6 +221,7 @@   | CantRevealContract Address   | InvalidChainId   | InvalidProtocol+  | InvalidBranch Text   | CounterMismatch   deriving stock Show