morley-client 0.1.2 → 0.2.0

raw patch · 40 files changed

+713/−438 lines, 40 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.md +30/−1
• app/Main.hs +18/−12
• morley-client.cabal +3/−1
• src/Morley/Client.hs +0/−6
• src/Morley/Client/Action.hs +2/−0
• src/Morley/Client/Action/Batched.hs +1/−0
• src/Morley/Client/Action/Common.hs +28/−16
• src/Morley/Client/Action/Operation.hs +37/−13
• src/Morley/Client/Action/Origination.hs +8/−7
• src/Morley/Client/Action/Origination/Large.hs +5/−4
• src/Morley/Client/Action/Reveal.hs +2/−1
• src/Morley/Client/Action/SizeCalculation.hs +40/−0
• src/Morley/Client/Action/Transaction.hs +1/−1
• src/Morley/Client/App.hs +81/−3
• src/Morley/Client/Full.hs +5/−3
• src/Morley/Client/Init.hs +2/−6
• src/Morley/Client/Logging.hs +1/−12
• src/Morley/Client/OnlyRPC.hs +7/−13
• src/Morley/Client/Parser.hs +32/−22
• src/Morley/Client/RPC/API.hs +48/−12
• src/Morley/Client/RPC/Class.hs +9/−1
• src/Morley/Client/RPC/Error.hs +15/−0
• src/Morley/Client/RPC/Getters.hs +8/−1
• src/Morley/Client/RPC/QueryFixedParam.hs +9/−2
• src/Morley/Client/RPC/Types.hs +133/−95
• src/Morley/Client/TezosClient/Class.hs +8/−8
• src/Morley/Client/TezosClient/Impl.hs +30/−48
• src/Morley/Client/TezosClient/Types.hs +4/−97
• src/Morley/Client/Types.hs +17/−1
• src/Morley/Client/Util.hs +11/−1
• test/Test/BigMapGet.hs +2/−2
• test/Test/Errors.hs +59/−0
• test/Test/Fees.hs +2/−3
• test/Test/KeyRevealing.hs +3/−2
• test/Test/Origination.hs +1/−1
• test/Test/ParameterTypeGet.hs +6/−5
• test/Test/ReadBigMapValue.hs +0/−1
• test/Test/Transaction.hs +0/−1
• test/Test/Util.hs +11/−18
• test/TestM.hs +34/−18

@@ -1,6 +1,35 @@ <!-- Unreleased: append new entries here -->  +0.2.0+=====+* [!1161](https://gitlab.com/morley-framework/morley/-/merge_requests/1161)+  Remove support for `AliasHint`+* [!1164](https://gitlab.com/morley-framework/morley/-/merge_requests/1164)+  Add `now` and `level` params to the `/run_code`+* [!1150](https://gitlab.com/morley-framework/morley/-/merge_requests/1150)+  Implement wait-for-operation via RPC+  + Block injection is now checked for errors and injection is retried.+* [!1159](https://gitlab.com/morley-framework/morley/-/merge_requests/1159)+  Add script size calculation to morley-client+* [!1088](https://gitlab.com/morley-framework/morley/-/merge_requests/1088)+  Move data types related to address aliases to `morley`.+* [!1155](https://gitlab.com/morley-framework/morley/-/merge_requests/1155)+  Update operations limits estimation to match the v13.0 `tezos-client` implementation.+* [!1147](https://gitlab.com/morley-framework/morley/-/merge_requests/1147)+  Fix error handling in morley-client+  + `handleOperationResult` is now exported from `Morley.Client.Action.Common`+* [!1114](https://gitlab.com/morley-framework/morley/-/merge_requests/1114)+  Update to ghc-9.0.2+* [!1108](https://gitlab.com/morley-framework/morley/-/merge_requests/1108)+  Remove support for the deprecated morley extensions+* [!1133](https://gitlab.com/morley-framework/morley/-/merge_requests/1133)+  Add missing fields to `TransactionOpResp` constructor.+* [!1127](https://gitlab.com/morley-framework/morley/-/merge_requests/1127)+  Add method to get secret key from tezos-client+* [!1140](https://gitlab.com/morley-framework/morley/-/merge_requests/1140)+  Derive `newtype` `Eq`, `Ord`, `Show`, `Buildable` instances for `BlockHash`+ 0.1.2 ===== * [!1017](https://gitlab.com/morley-framework/morley/-/merge_requests/1017)@@ -31,7 +60,7 @@   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.+  + Use `Buildable` and `pretty` preferentially.   + Add `Buildable` instances to that effect for `FeeParserException`, `SecretKeyEncryptionParserException`.   + Use `displayException` instead of `show` where appropriate. 

@@ -1,9 +1,6 @@ -- 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@@ -18,11 +15,12 @@  import Morley.Client import Morley.Client.Parser-import Morley.Client.RPC (BlockOperation(..), OperationResp(..))+import Morley.Client.RPC (BlockOperation(..), OperationResp(..), OperationRespWithMeta(..)) import Morley.Client.RPC.Getters import Morley.Client.Util (extractAddressesFromValue)-import Morley.Michelson.Runtime (prepareContract, prepareContractExt)-import Morley.Michelson.TypeCheck (typeCheckContract, typeCheckingWith, typeVerifyParameter)+import Morley.Michelson.Runtime (prepareContract)+import Morley.Michelson.TypeCheck+  (typeCheckContract, typeCheckContractAndStorage, typeCheckingWith, typeVerifyParameter) import Morley.Michelson.Typed (Contract, Contract'(..), SomeContract(..)) import Morley.Michelson.Typed.Value (Value'(..)) import Morley.Michelson.Untyped qualified as U@@ -31,11 +29,11 @@ import Morley.Util.Exception (throwLeft) import Morley.Util.Main (wrapMain) -mainImpl :: Bool -> ClientArgsRaw -> MorleyClientM ()-mainImpl exts cmd =+mainImpl :: ClientArgsRaw -> MorleyClientM ()+mainImpl cmd =   case cmd of     Originate OriginateArgs{..} -> do-      contract <- liftIO $ (if exts then prepareContractExt else prepareContract) oaMbContractFile+      contract <- liftIO $ prepareContract oaMbContractFile       let originator = oaOriginateFrom       (operationHash, contractAddr) <-         originateUntypedContract True oaContractName originator oaInitialBalance@@ -64,6 +62,7 @@           U.ValueUnit -> transfer sendAddress destAddress taAmount U.DefEpName VUnit Nothing           _ -> throwString ("The transaction parameter must be 'Unit' "             <> "when transferring to an implicit account")+        TransactionRollupAddress _ -> throwString "Only smart contracts can call txr1 addresses"        putTextLn $ "Transaction was successfully sent.\nOperation hash " <> pretty operationHash <> "." @@ -75,13 +74,20 @@       blockHeader <- getBlockHeader blockId       putStrLn $ Aeson.encode blockHeader +    GetScriptSize GetScriptSizeArgs{..} -> do+      contract <- liftIO $ prepareContract (Just ssScriptFile)+      void . throwLeft . pure . typeCheckingWith def $+        typeCheckContractAndStorage contract ssStorage+      size <- computeUntypedContractSize contract ssStorage+      print size+     GetBlockOperations blockId -> do       operationLists <- getBlockOperations blockId       forM_ operationLists $ \operations -> do         forM_ operations $ \BlockOperation {..} -> do           putTextLn $ "Hash: " <> boHash           putTextLn $ "Contents: "-          forM_ boContents $ \case+          forM_ (orwmResponse <$> boContents) \case             TransactionOpResp to -> putStrLn $ Aeson.encode to             OtherOpResp -> putTextLn "Non-transaction operation"           putTextLn ""@@ -97,6 +103,6 @@   setFileSystemEncoding utf8    disableAlphanetWarning-  ClientArgs parsedConfig exts cmd <- Opt.execParser morleyClientInfo+  ClientArgs parsedConfig cmd <- Opt.execParser morleyClientInfo   env <- mkMorleyClientEnv parsedConfig-  runMorleyClientM env (mainImpl exts cmd)+  runMorleyClientM env (mainImpl cmd)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morley-client-version:        0.1.2+version:        0.2.0 synopsis:       Client to interact with the Tezos blockchain description:    A client to interact with the Tezos blockchain, by use of the tezos-node RPC and/or of the tezos-client binary. category:       Blockchain@@ -35,6 +35,7 @@       Morley.Client.Action.Origination       Morley.Client.Action.Origination.Large       Morley.Client.Action.Reveal+      Morley.Client.Action.SizeCalculation       Morley.Client.Action.Transaction       Morley.Client.App       Morley.Client.Env@@ -235,6 +236,7 @@   other-modules:       Ingredients       Test.BigMapGet+      Test.Errors       Test.Fees       Test.KeyRevealing       Test.Origination

@@ -68,12 +68,6 @@   , readBigMapValue    -- * @tezos-client@-  , Alias-  , mkAlias-  , AliasHint-  , mkAliasHint-  , AliasOrAliasHint (..)-  , AddressOrAlias (..)   , addressResolved   , HasTezosClient (..)   , resolveAddress

@@ -8,6 +8,7 @@   ( module Morley.Client.Action.Operation   , module Morley.Client.Action.Origination   , module Morley.Client.Action.Transaction+  , module Morley.Client.Action.SizeCalculation   , ClientInput   , revealKeyUnlessRevealed   ) where@@ -15,4 +16,5 @@ import Morley.Client.Action.Common (ClientInput, revealKeyUnlessRevealed) import Morley.Client.Action.Operation import Morley.Client.Action.Origination+import Morley.Client.Action.SizeCalculation import Morley.Client.Action.Transaction

@@ -21,6 +21,7 @@ import Morley.Client.TezosClient import Morley.Client.Types import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (AddressOrAlias) import Morley.Util.Batching  {- | Where the batched operations occur.

@@ -23,6 +23,7 @@   , toParametersInternals   , mkOriginationScript   , revealKeyUnlessRevealed+  , handleOperationResult   ) where  import Control.Lens (Prism')@@ -40,18 +41,19 @@ import Morley.Client.Types import Morley.Client.Util import Morley.Micheline (TezosInt64, TezosMutez(..), toExpression)-import Morley.Micheline.Expression (Expression(ExpressionString))+import Morley.Micheline.Expression (expressionString) import Morley.Michelson.Typed qualified as T import Morley.Michelson.Typed.Scope import Morley.Michelson.Untyped.Entrypoints import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias) import Morley.Tezos.Core import Morley.Tezos.Crypto  -- | Datatype that contains various values required for -- chain operations. data OperationConstants = OperationConstants-  { ocLastBlockHash :: Text+  { ocLastBlockHash :: BlockHash   -- ^ Block in which operations is going to be injected   , ocBlockConstants :: BlockConstants   -- ^ Information about block: chain_id and protocol@@ -92,7 +94,7 @@ data OriginationData =   forall cp st. (ParameterScope cp, StorageScope st) => OriginationData   { odReplaceExisting :: Bool-  , odName :: AliasHint+  , odName :: Alias   , odBalance :: Mutez   , odContract :: T.Contract cp st   , odStorage :: T.Value st@@ -173,20 +175,30 @@         _ -> throwM $ RpcUnexpectedSize 1 (length results)    handleOperationResult runResult expectedContentsSize-  where-    handleOperationResult ::-      MonadThrow m => RunOperationResult -> Int -> m (NonEmpty AppliedResult)-    handleOperationResult RunOperationResult{..} expectedContentsSize = do-      when (length rrOperationContents /= expectedContentsSize) $-        throwM $ RpcUnexpectedSize expectedContentsSize (length rrOperationContents) -      mapM (\(OperationContent (RunMetadata res internalOps)) ->-              let internalResults = map unInternalOperation internalOps in-                case foldr combineResults res internalResults of-                  OperationApplied appliedRes -> pure appliedRes-                  OperationFailed errors -> handleErrors errors-           ) rrOperationContents+-- | Handle a result of an operation: throw errors if there was an error,+-- return a nonempty list of applied results if there weren't.+handleOperationResult ::+  MonadThrow m => RunOperationResult -> Int -> m (NonEmpty AppliedResult)+handleOperationResult RunOperationResult{..} expectedContentsSize = do+  when (length rrOperationContents /= expectedContentsSize) $+    throwM $ RpcUnexpectedSize expectedContentsSize (length rrOperationContents) +  let (appliedResults, runErrors) =+        sconcat $ first pure . collectResults <$> rrOperationContents++  whenJust runErrors handleErrors++  pure appliedResults++  where+    collectResults :: OperationContent -> (AppliedResult, Maybe [RunError])+    collectResults (OperationContent (RunMetadata res internalOps)) =+      res : map unInternalOperation internalOps+      & flip foldr (mempty, Nothing) \case+        OperationApplied result -> first (result <>)+        OperationFailed errors -> second (Just errors <>)+     -- When an error happens, we will get a list of 'RunError' in response.     -- This list often contains more than one item.     -- We tested which errors are returned in certain scenarios and added@@ -207,7 +219,7 @@         = throwM $ BadParameter address expr       | Just address <- findError _BadContractParameter       , Just notation <- findError _InvalidContractNotation-        = throwM $ BadParameter address (ExpressionString notation)+        = throwM $ BadParameter address (expressionString notation)       | Just address <- findError _REEmptyTransaction         = throwM $ EmptyTransaction address       | Just address <- findError _RuntimeError

@@ -15,7 +15,7 @@ import Data.List.NonEmpty qualified as NE import Data.Singletons (Sing, SingI, sing) import Data.Text qualified as T-import Fmt (blockListF', listF, pretty, (+|), (|+))+import Fmt (blockListF, blockListF', listF, nameF, pretty, (+|), (|+))  import Morley.Client.Action.Common import Morley.Client.Logging@@ -27,6 +27,8 @@ import Morley.Client.Types import Morley.Micheline (StringEncode(..), TezosInt64, TezosMutez(..)) import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (AddressOrAlias(..))+import Morley.Tezos.Core import Morley.Tezos.Crypto import Morley.Util.ByteString @@ -103,6 +105,10 @@     (opHash, res) <- runOperationsNonEmpty sender $ op :| ops     return $ (Just opHash, toList res) +-- | How many times to retry if an operation fails after injection+injectionRetryCount :: Natural+injectionRetryCount = 2+ -- | Perform non-empty sequence of operations. -- -- Returns operation hash and result of each operation@@ -117,7 +123,7 @@   -> NonEmpty (OperationInfo ClientInput)   -> m (OperationHash, NonEmpty (OperationInfo Result)) runOperationsNonEmpty sender operations =-  runOperationsNonEmptyHelper @'RealRun sender operations+  runOperationsNonEmptyHelper @'RealRun injectionRetryCount sender operations  -- | Flag that is used to determine @runOperationsNonEmptyHelper@ behaviour. data RunMode = DryRun | RealRun@@ -159,7 +165,7 @@   -> NonEmpty (OperationInfo ClientInput)   -> m (NonEmpty (AppliedResult, TezosMutez)) dryRunOperationsNonEmpty sender operations =-  runOperationsNonEmptyHelper @'DryRun sender operations+  runOperationsNonEmptyHelper @'DryRun 0 sender operations  -- | Perform non-empty sequence of operations and either dry-run -- and return estimated limits and fees or perform operation injection.@@ -171,10 +177,11 @@      , WithClientLog env m      , SingI runMode      )-  => AddressOrAlias+  => Natural+  -> AddressOrAlias   -> NonEmpty (OperationInfo ClientInput)   -> m (RunResult runMode)-runOperationsNonEmptyHelper sender operations = do+runOperationsNonEmptyHelper retryCount sender operations = do   logOperations @runMode sender operations   senderAddress <- resolveAddress sender   prohibitContractSender senderAddress $ head operations@@ -185,7 +192,7 @@   pp <- getProtocolParameters   OperationConstants{..} <- preProcessOperation senderAddress -  let convertOps i = OperationInput commonData . \case+  let convertOps i = WithCommonOperationData commonData . \case         OpTransfer (TransactionData TD {..}) ->           OpTransfer TransactionOperation           { toDestination = tdReceiver@@ -238,9 +245,20 @@    -- Fill in fees   let-    updateOp opToRun mbFee ar isFirst = do+    updateOp :: OperationInput -> Maybe Mutez -> AppliedResult -> Bool -> m (OperationInput, Maybe (Signature, ByteString))+    updateOp opToRun@(WithCommonOperationData _ internalOp) mbFee ar isFirst = do+      let gasSafetyGuard = 100+          -- @gasSafetyGuard@ is added to origination operations and transfers to non-implicit+          -- accounts, see https://gitlab.com/tezos/tezos/-/blob/v13.0/src/proto_013_PtJakart/lib_client/injection.ml#L750+          additionalGas = case internalOp of+            OpOriginate _ -> gasSafetyGuard+            OpTransfer (TransactionOperation {..}) -> case toDestination of+              KeyAddress _ -> 0+              ContractAddress _ -> gasSafetyGuard+              TransactionRollupAddress _ -> gasSafetyGuard+            OpReveal _ -> 0       let storageLimit = computeStorageLimit [ar] pp + 20 -- similarly to tezos-client, we add 20 for safety-      let gasLimit = arConsumedGas ar + 100  -- adding extra for safety+      let gasLimit = arConsumedGas ar + additionalGas           updateCommonDataForFee fee =             updateCommonData gasLimit storageLimit (TezosMutez fee) @@ -249,7 +267,7 @@         @(Maybe (Signature, ByteString))  -- ready operation and its signature         (\fee ->           return $ opToRun &~-            oiCommonDataL %= updateCommonDataForFee fee+            wcoCommonDataL %= updateCommonDataForFee fee           )         (\op -> do           forgedOp <- forgeOp $ one op@@ -304,11 +322,10 @@   ars2 <- getAppliedResults (Right preApplyOp)   case sing @runMode of     SDryRun -> do-      let fees = map (codFee . oiCommonData) updOps+      let fees = map (codFee . wcoCommon) updOps       return $ NE.zip ars2 fees     SRealRun -> do-      operationHash <- injectOperation (HexJSONByteString signedOp)-      waitForOperation operationHash+      operationHash <- waitForOperation $ injectOperation (HexJSONByteString signedOp)       let contractAddrs = arOriginatedContracts <$> ars2       opsRes <- forM (NE.zip operations contractAddrs) $ \case         (OpTransfer _, []) ->@@ -322,7 +339,7 @@           throwM RpcOriginatedNoContracts         (OpOriginate OriginationData{..}, [addr]) -> do           logDebug $ "Saving " +| addr |+ " for " +| odName |+ "\n"-          rememberContract odReplaceExisting addr (AnAliasHint odName)+          rememberContract odReplaceExisting addr odName           alias <- getAlias $ AddressResolved addr           logInfo $ "Originated contract: " <> pretty alias           return $ OpOriginate addr@@ -332,6 +349,12 @@           return $ OpReveal ()       forM_ ars2 logStatistics       return (operationHash, opsRes)+      `catch` \case+        (UnexpectedRunErrors errs) | retryCount > 0 -> do+          logError $ pretty $ nameF "When injecting operations, there were unexpected errors" $+            blockListF errs+          runOperationsNonEmptyHelper @runMode (retryCount - 1) sender operations+        e -> throwM e   where     mayNeedSenderRevealing :: [OperationInfo i] -> Bool     mayNeedSenderRevealing = any \case@@ -350,6 +373,7 @@     prohibitContractSender addr op = case (addr, op) of       (KeyAddress _, _) -> pass       (ContractAddress _, op') -> throwM $ ContractSender addr (opName op')+      (TransactionRollupAddress _, op') -> throwM $ ContractSender addr (opName op')      opName = \case       OpTransfer _ -> "transfer"

@@ -41,6 +41,7 @@ import Morley.Michelson.Typed.Scope import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (AddressOrAlias, Alias) import Morley.Tezos.Core import Morley.Util.Exception @@ -74,7 +75,7 @@      , ParameterScope cp      )   => Bool-  -> AliasHint+  -> Alias   -> AddressOrAlias   -> Mutez   -> Contract cp st@@ -93,7 +94,7 @@      , WithClientLog env m      )   => Bool-  -> AliasHint+  -> Alias   -> AddressOrAlias   -> Mutez   -> U.Contract@@ -129,7 +130,7 @@      , NiceParameterFull cp      )   => Bool-  -> AliasHint+  -> Alias   -> AddressOrAlias   -> Mutez   -> L.Contract cp st vd@@ -185,7 +186,7 @@      , ParameterScope cp      )   => Bool-  -> AliasHint+  -> Alias   -> AddressOrAlias   -> Mutez   -> Contract cp st@@ -204,7 +205,7 @@      , WithClientLog env m      )   => Bool-  -> AliasHint+  -> Alias   -> AddressOrAlias   -> Mutez   -> U.Contract@@ -240,7 +241,7 @@      , NiceParameterFull cp      )   => Bool-  -> AliasHint+  -> Alias   -> AddressOrAlias   -> Mutez   -> L.Contract cp st vd@@ -259,7 +260,7 @@ data LOriginationData = forall cp st vd. (NiceParameterFull cp, NiceStorage st)   => LOriginationData   { lodReplaceExisting :: Bool-  , lodName :: AliasHint+  , lodName :: Alias   , lodBalance :: Mutez   , lodContract :: L.Contract cp st vd   , lodStorage :: st

@@ -53,6 +53,7 @@ import Morley.Michelson.Typed.Util (PushableStorageSplit(..), splitPushableStorage) import Morley.Michelson.Typed.Value import Morley.Michelson.Untyped.Annotation (annQ, noAnn)+import Morley.Tezos.Address.Alias (Alias(..))  -- | Just a utility type to hold 'SomeLargeContractOriginator' and its large -- contract 'OriginationData'.@@ -135,7 +136,7 @@     cEntriesOrder = def      cViews = def-    cCode =+    cCode = T.mkContractCode $       UNPAIR `Seq`       -- make checks on the storage       DIP@@ -192,7 +193,7 @@   -> T.Contract param store -- ^ large contract   -> Mutez -- ^ balance to tranfer during contract creation   -> Value (ToT (Lambda (Value heavy) (Address, [Operation])))-mkOriginationLambda instr largeContract xtzs = VLam $ RfNormal $+mkOriginationLambda instr largeContract xtzs = mkVLam $ RfNormal $   instr `Seq` PUSH (VMutez xtzs) `Seq` NONE `Seq`   CREATE_CONTRACT largeContract `Seq`   NIL `Seq` SWAP `Seq` CONS `Seq` SWAP `Seq` PAIR@@ -220,7 +221,7 @@ mkLargeOriginatorData sender' LargeOriginationData{..} = case largeOriginator of   SomeLargeContractOriginator heavyVal origContract _origLambda -> OriginationData     { odReplaceExisting = odReplaceExisting $ largeContractData-    , odName = "largeOriginator." <> odName largeContractData+    , odName = Alias $ "largeOriginator." <> unAlias (odName largeContractData)     , odBalance = zeroMutez     -- Note ^ we don't transfer any balance here, we instead do it as part of the     -- last transaction (where it will be transferred to the large contract)@@ -272,6 +273,6 @@   case completedStore of     Right (VPair (_, VOr (Left largeVAddr))) -> do       let largeAddr = fromVal @Address largeVAddr-      rememberContract odReplaceExisting largeAddr (AnAliasHint odName)+      rememberContract odReplaceExisting largeAddr odName       pure largeAddr     _ -> throwM RpcOriginatedNoContracts

@@ -17,9 +17,10 @@ import Morley.Client.RPC.Error import Morley.Client.RPC.Getters import Morley.Client.RPC.Types-import Morley.Client.TezosClient (AddressOrAlias(..), HasTezosClient)+import Morley.Client.TezosClient (HasTezosClient) import Morley.Client.Types import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (AddressOrAlias(..))  -- | Reveal given key. --

@@ -0,0 +1,40 @@+-- SPDX-FileCopyrightText: 2022 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++module Morley.Client.Action.SizeCalculation+  ( computeUntypedContractSize+  , computeContractSize+  ) where++import Morley.Client.RPC+import Morley.Micheline.Class (ToExpression(..))+import Morley.Michelson.Typed (Contract, Value)+import Morley.Michelson.Typed.Scope+import Morley.Michelson.Untyped qualified as U++computeUntypedContractSize :: HasTezosRpc m => U.Contract -> U.Value -> m Natural+computeUntypedContractSize ct st = do+  pps <- getProtocolParameters+  let csProgram = toExpression ct+      csStorage = toExpression st+      csGas     = ppHardGasLimitPerOperation pps+      csLegacy  = False+  ScriptSize size <- getScriptSize CalcSize{..}+  return size++computeContractSize+  :: forall m cp st.+     ( HasTezosRpc m+     , StorageScope st+     )+  => Contract cp st+  -> Value st+  -> m Natural+computeContractSize ct st = do+  pps <- getProtocolParameters+  let csProgram = toExpression ct+      csStorage = toExpression st+      csGas     = ppHardGasLimitPerOperation pps+      csLegacy  = False+  ScriptSize size <- getScriptSize CalcSize{..}+  return size

@@ -24,12 +24,12 @@ import Morley.Client.RPC.Error import Morley.Client.RPC.Types import Morley.Client.TezosClient.Class-import Morley.Client.TezosClient.Types 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+import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (Mutez)  -- | Perform sequence of transactions to the contract, each transactions should be

@@ -14,7 +14,9 @@   , getCounterImpl   , getBlockHeaderImpl   , getBlockConstantsImpl+  , getScriptSizeAtBlockImpl   , getBlockOperationsImpl+  , getBlockOperationHashesImpl   , getProtocolParametersImpl   , runOperationImpl   , preApplyOperationsImpl@@ -30,6 +32,7 @@   , runCodeImpl   , getChainIdImpl   , getDelegateImpl+  , waitForOperationImpl    -- * Timeouts and retries   , retryOnTimeout@@ -51,8 +54,11 @@ import Servant.Client.Core   (ClientError(..), Request, RequestBody(..), RequestF(..), Response, ResponseF(..), RunClient) import Servant.Client.Core.RunClient (runRequest)+import Servant.Client.Streaming (withClientM)+import Servant.Types.SourceT (SourceT(unSourceT), StepT(..)) import System.Random (randomRIO)-import UnliftIO (MonadUnliftIO)+import UnliftIO (MonadUnliftIO, withRunInIO)+import UnliftIO.Async (wait, waitEither, withAsync) import UnliftIO.Timeout (timeout)  import Morley.Client.Logging (WithClientLog, logDebug)@@ -102,8 +108,8 @@ -- HasTezosRpc functions ---------------- -getBlockHashImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m Text-getBlockHashImpl = retryOnceOnTimeout ... API.getBlockHash API.nodeMethods+getBlockHashImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m BlockHash+getBlockHashImpl = retryOnceOnTimeout ... fmap BlockHash . API.getBlockHash API.nodeMethods  getCounterImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> m TezosInt64 getCounterImpl = retryOnceOnTimeout ... API.getCounter API.nodeMethods@@ -119,6 +125,10 @@ getBlockOperationsImpl =   retryOnceOnTimeout ... API.getBlockOperations API.nodeMethods +getBlockOperationHashesImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m [[OperationHash]]+getBlockOperationHashesImpl =+  retryOnceOnTimeout ... API.getBlockOperationHashes API.nodeMethods+ getProtocolParametersImpl ::   (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m ProtocolParameters getProtocolParametersImpl = retryOnceOnTimeout ... API.getProtocolParameters API.nodeMethods@@ -160,6 +170,10 @@   BlockId -> Address -> GetBigMap -> m GetBigMapResult getContractBigMapImpl = retryOnceOnTimeout ... API.getBigMap API.nodeMethods +getScriptSizeAtBlockImpl ::+  (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> CalcSize -> m ScriptSize+getScriptSizeAtBlockImpl = retryOnceOnTimeout ... API.getScriptSizeAtBlock API.nodeMethods+ getBigMapValueAtBlockImpl ::   (RunClient m, MonadUnliftIO m, MonadCatch m) =>   BlockId -> Natural -> Text -> m Expression@@ -193,6 +207,70 @@  getChainIdImpl :: (RunClient m, MonadCatch m) => m ChainId getChainIdImpl = throwLeft $ parseChainId <$> API.getChainId API.nodeMethods++waitForOperationImpl :: forall m+                      . (MonadUnliftIO m, HasTezosRpc m)+                     => m OperationHash+                     -> ClientEnv+                     -> m OperationHash+waitForOperationImpl opHash env = do+  finalHead <- getBlockHeader FinalHeadId+  hash <- opHash+  let limit = 10 -- blocks to wait for+      blockout = throwM $ WaitForOperationBlockout limit+      handle other = maybe (wait other >>= maybe blockout pure) pure+  -- NB: we can't really use race here because even on failure on one direction+  -- we still want to check the other.+  withAsync (searchForwards limit hash) \fwd ->+    withAsync (searchBackwards hash (bhLevel finalHead) HeadId) \bwd ->+      waitEither fwd bwd >>= \case+        Left res -> handle bwd res+        Right res -> handle fwd res+  where+    monitorHeads :: Word -> (BlockHeader -> m (MonitorHeadsStep OperationHash)) -> m (Maybe OperationHash)+    monitorHeads limit test = withRunInIO $ \runInIO ->+      withClientM (client runInIO) env (either throwM pure)+      where+        client runInIO = do+          src <- API.monitorHeads+          liftIO $ unSourceT src $ go limit runInIO+        go 0 _ = const $ pure Nothing+        go n runInIO = \case+          Stop -> pure Nothing+          Error str -> throwM $ WaitForOperationStreamingError (fromString str)+          Skip next -> go n runInIO next+          Yield a next -> runInIO (test a) >>= \case+            MonitorHeadsContinue -> go (n - 1) runInIO next+            MonitorHeadsStop res -> pure $ Just res+          Effect eff -> eff >>= go n runInIO+    searchBackwards :: OperationHash -> Int64 -> BlockId -> m (Maybe OperationHash)+    searchBackwards hash stopAtLevel blkHead = do+      checkBlock hash blkHead >>= \case+        MonitorHeadsContinue -> do+          header <- getBlockHeader blkHead+          if bhLevel header == stopAtLevel+          then pure Nothing+          else searchBackwards hash stopAtLevel $ BlockHashId $ bhPredecessor header+        MonitorHeadsStop res -> pure $ Just res+    searchForwards :: Word -> OperationHash -> m (Maybe OperationHash)+    searchForwards limit hash = monitorHeads limit (checkBlock hash . BlockHashId . bhHash)+    checkBlock :: OperationHash -> BlockId -> m (MonitorHeadsStep OperationHash)+    checkBlock hash blkId = do+      opHashes <- concat <$> getBlockOperationHashes blkId+      if hash `notElem` opHashes+      then pure MonitorHeadsContinue+      else do+        ops <- concat <$> getBlockOperations blkId+        case find (\op -> boHash op == unOperationHash hash) ops of+          Just op -> do+            for_ (boContents op)+              \(OperationRespWithMeta{..}) -> case unOperationMetadata =<< orwmMetadata of+                Just res -> case res of+                  OperationApplied{} -> pass+                  OperationFailed errs -> throwM $ UnexpectedRunErrors errs+                Nothing -> pass+            pure $ MonitorHeadsStop hash+          Nothing -> error "impossible"  ---------------- -- Logging of requests and responses

@@ -37,8 +37,7 @@ -- | Run 'MorleyClientM' action within given t'MorleyClientEnv'. Retry action -- in case of invalid counter error. runMorleyClientM :: MorleyClientEnv -> MorleyClientM a -> IO a-runMorleyClientM env client =-  runReaderT (unMorleyClientM client) env+runMorleyClientM env client = runReaderT (unMorleyClientM client) env  instance HasLog MorleyClientEnv Message MorleyClientM where   getLogAction = mceLogAction@@ -50,12 +49,12 @@     case mceSecretKey env of       Just sk -> pure . SignatureEd25519 $ Ed25519.sign sk opHash       Nothing -> TezosClient.signBytes senderAlias mbPassword opHash-  waitForOperation = retryOnceOnTimeout ... TezosClient.waitForOperationInclusion   rememberContract = failOnTimeout ... TezosClient.rememberContract   importKey = failOnTimeout ... TezosClient.importKey   resolveAddressMaybe = retryOnceOnTimeout ... TezosClient.resolveAddressMaybe   getAlias = retryOnceOnTimeout ... TezosClient.getAlias   getPublicKey = retryOnceOnTimeout ... TezosClient.getPublicKey+  getSecretKey = retryOnceOnTimeout ... TezosClient.getSecretKey   -- This function doesn't perform any chain related operations with tezos-client,   -- so @ECONNRESET@ cannot appear here   getTezosClientConfig = do@@ -85,6 +84,8 @@   getBlockHeader = getBlockHeaderImpl   getBlockConstants = getBlockConstantsImpl   getBlockOperations = getBlockOperationsImpl+  getScriptSizeAtBlock = getScriptSizeAtBlockImpl+  getBlockOperationHashes = getBlockOperationHashesImpl   getProtocolParametersAtBlock = getProtocolParametersImpl   runOperationAtBlock = runOperationImpl   preApplyOperationsAtBlock = preApplyOperationsImpl@@ -100,3 +101,4 @@   runCodeAtBlock = runCodeImpl   getChainId = getChainIdImpl   getManagerKeyAtBlock = getManagerKeyImpl+  waitForOperation = (asks mceClientEnv >>=) . waitForOperationImpl

@@ -8,7 +8,6 @@   , mkLogAction      -- * Lens-  , mccAliasPrefixL   , mccEndpointUrlL   , mccTezosClientPathL   , mccMbTezosClientDataDirL@@ -31,9 +30,7 @@  -- | Data necessary for morley client initialization. data MorleyClientConfig = MorleyClientConfig-  { mccAliasPrefix :: Maybe Text-  -- ^ Optional prefix for aliases that will be passed to @tezos-client@.-  , mccEndpointUrl :: Maybe BaseUrl+  { mccEndpointUrl :: Maybe BaseUrl   -- ^ URL of tezos endpoint on which operations are performed   , mccTezosClientPath :: FilePath   -- ^ Path to @tezos-client@ binary through which operations are@@ -66,8 +63,7 @@   let     endpointUrl = fromMaybe tcEndpointUrl mccEndpointUrl     tezosClientEnv = TezosClientEnv-      { tceAliasPrefix = mccAliasPrefix-      , tceEndpointUrl = endpointUrl+      { tceEndpointUrl = endpointUrl       , tceTezosClientPath = tezosClientPath       , tceMbTezosClientDataDir = mccMbTezosClientDataDir       }

@@ -16,13 +16,11 @@   , logWarning   , logError   , logException-   , logFlush   ) where  import Colog-  (LogAction(..), Message, WithLog, logDebug, logError, logException, logInfo, logWarning)-import System.IO (hFlush)+  (LogAction(..), Message, WithLog, logDebug, logError, logException, logFlush, logInfo, logWarning)  -- | 'LogAction' with fixed message parameter. type ClientLogAction m = LogAction m Message@@ -31,12 +29,3 @@ -- If we want to use another message type we can change this constraint -- and exported functions, presumably without breaking other code significantly. type WithClientLog env m = WithLog env Message m---- See <https://github.com/kowainik/co-log/pull/194>, hopefully we won't need it one day.-{- | This action can be used in combination with other actions to flush-   a handle every time you log anything.--}-logFlush :: MonadIO m => Handle -> LogAction m a-logFlush handle = LogAction $ const $ liftIO $ hFlush handle-{-# INLINE logFlush #-}-{-# SPECIALIZE logFlush :: Handle -> LogAction IO () #-}

@@ -27,8 +27,8 @@ import Morley.Client.RPC.Class (HasTezosRpc(..)) import Morley.Client.RPC.HttpClient (newClientEnv) import Morley.Client.TezosClient.Class (HasTezosClient(..))-import Morley.Client.TezosClient.Types (AddressOrAlias(..), mkAlias) import Morley.Tezos.Address (Address, mkKeyAddress)+import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias(..)) import Morley.Tezos.Crypto (SecretKey, sign, toPublic)  ----------------@@ -77,12 +77,7 @@ -- | Run 'MorleyOnlyRpcM' action within given 'MorleyOnlyRpcEnv'. Retry action -- in case of invalid counter error. runMorleyOnlyRpcM :: MorleyOnlyRpcEnv -> MorleyOnlyRpcM a -> IO a-runMorleyOnlyRpcM env action =-  runReaderT (unMorleyOnlyRpcM (retryInvalidCounter action)) env-  where-    retryInvalidCounter a = a `catch` handleInvalidCounterRpc retryAction-      where-        retryAction = waitBeforeRetry >> retryInvalidCounter action+runMorleyOnlyRpcM env action = runReaderT (unMorleyOnlyRpcM action) env  ---------------- -- Exceptions@@ -125,11 +120,6 @@   -- In RPC-only mode we only use unencrypted in-memory passwords.   getKeyPassword _ = pure Nothing -  -- This method can be implemented if necessary by manually checking whether-  -- the operation is confirmed. For now we simply don't wait for confirmation-  -- in RPC-only mode.-  waitForOperation = \_ -> pass-   -- Stateful actions that simply do nothing because there is no persistent state.   rememberContract = \_ _ _ -> pass @@ -137,7 +127,7 @@   -- places and with an exception here it's not possible to send transactions.   -- So be aware of this and do not rely on this value!   -- TODO [#652]: consider using a `Map` instead-  getAlias _ = pure (mkAlias "MorleyOnlyRpc")+  getAlias _ = pure (Alias "MorleyOnlyRpc")    -- Actions that are not supported and simply throw exceptions.   genKey _ = throwM $ UnsupportedByOnlyRPC "genKey"@@ -146,6 +136,7 @@   revealKey _ _ = throwM $ UnsupportedByOnlyRPC "revealKey"   resolveAddressMaybe _ = throwM $ UnsupportedByOnlyRPC "resolveAddressMaybe"   getPublicKey _ = throwM $ UnsupportedByOnlyRPC "getPublicKey"+  getSecretKey _ = throwM $ UnsupportedByOnlyRPC "getSecretKey"   registerDelegate _ _ = throwM $ UnsupportedByOnlyRPC "registerDelegate"   getTezosClientConfig = throwM $ UnsupportedByOnlyRPC "getTezosClientConfig"   calcTransferFee _ _ _ _ = throwM $ UnsupportedByOnlyRPC "calcTransferFee"@@ -163,10 +154,12 @@   getBlockHeader = getBlockHeaderImpl   getBlockConstants = getBlockConstantsImpl   getBlockOperations = getBlockOperationsImpl+  getBlockOperationHashes = getBlockOperationHashesImpl   getProtocolParametersAtBlock = getProtocolParametersImpl   runOperationAtBlock = runOperationImpl   preApplyOperationsAtBlock = preApplyOperationsImpl   forgeOperationAtBlock = forgeOperationImpl+  getScriptSizeAtBlock = getScriptSizeAtBlockImpl   injectOperation = injectOperationImpl   getContractScriptAtBlock = getContractScriptImpl   getContractStorageAtBlock = getContractStorageAtBlockImpl@@ -178,3 +171,4 @@   runCodeAtBlock = runCodeImpl   getChainId = getChainIdImpl   getManagerKeyAtBlock = getManagerKeyImpl+  waitForOperation = (asks moreClientEnv >>=) . waitForOperationImpl

@@ -6,6 +6,7 @@   , ClientArgsRaw (..)   , OriginateArgs (..)   , TransferArgs (..)+  , GetScriptSizeArgs (..)   , addressOrAliasOption   , clientConfigParser   , morleyClientInfo@@ -25,20 +26,21 @@ import Options.Applicative.Help.Pretty (Doc, linebreak) import Servant.Client (BaseUrl(..), parseBaseUrl) -import Morley.CLI+import Morley.CLI (addressOrAliasOption, mutezOption, parserInfo, valueOption) import Morley.Client.Init import Morley.Client.RPC.Types (BlockId(HeadId))-import Morley.Client.TezosClient.Types (AddressOrAlias, AliasHint) import Morley.Michelson.Untyped qualified as U+import Morley.Tezos.Address.Alias (AddressOrAlias, Alias(..)) import Morley.Tezos.Core import Morley.Util.CLI (mkCLOptionParser, mkCommandParser) import Morley.Util.Named  data ClientArgs-  = ClientArgs MorleyClientConfig Bool ClientArgsRaw+  = ClientArgs MorleyClientConfig ClientArgsRaw  data ClientArgsRaw   = Originate OriginateArgs+  | GetScriptSize GetScriptSizeArgs   | Transfer TransferArgs   | GetBalance AddressOrAlias   | GetBlockHeader BlockId@@ -46,13 +48,18 @@  data OriginateArgs = OriginateArgs   { oaMbContractFile :: Maybe FilePath-  , oaContractName   :: AliasHint+  , oaContractName   :: Alias   , oaInitialBalance :: Mutez   , oaInitialStorage :: U.Value   , oaOriginateFrom  :: AddressOrAlias   , oaMbFee :: Maybe Mutez   } +data GetScriptSizeArgs = GetScriptSizeArgs+  { ssScriptFile :: FilePath+  , ssStorage    :: U.Value+  }+ data TransferArgs = TransferArgs   { taSender      :: AddressOrAlias   , taDestination :: AddressOrAlias@@ -71,16 +78,11 @@  -- | Parser for the @morley-client@ executable. clientParser :: Opt.Parser ClientArgs-clientParser = ClientArgs <$> clientConfigParser (pure Nothing) <*> enableExtsOption <*> argsRawParser-  where-    enableExtsOption = Opt.switch $-      long "deprecated-morley-extensions" <>-      help "Enable parsing deprecated Morley extensions"+clientParser = ClientArgs <$> clientConfigParser <*> argsRawParser -clientConfigParser :: Opt.Parser (Maybe Text) -> Opt.Parser MorleyClientConfig-clientConfigParser prefixParser = do+clientConfigParser :: Opt.Parser MorleyClientConfig+clientConfigParser = do   let mccSecretKey = Nothing-  mccAliasPrefix <- prefixParser   mccEndpointUrl <- endpointOption   mccTezosClientPath <- pathOption   mccMbTezosClientDataDir <- dataDirOption@@ -123,14 +125,6 @@                       \By default fee will be computed automatically."             ) --- | Generic parser to read an option of 'AddressOrAlias' type.-addressOrAliasOption-  :: Maybe AddressOrAlias-  -> "name" :! String-  -> "help" :! String-  -> Opt.Parser AddressOrAlias-addressOrAliasOption = mkCLOptionParser- -- | Generic parser to read an option of 'BlockId' type. blockIdOption   :: Maybe BlockId@@ -144,6 +138,7 @@   [ originateCmd   , transferCmd   , getBalanceCmd+  , getScriptSizeCmd   , getBlockHeaderCmd   , getBlockOperationsCmd   ]@@ -180,6 +175,10 @@         (#help :! "Id of the block whose operations will be queried.")       )       "Get operations contained in a block"+    getScriptSizeCmd =+      mkCommandParser "compute-script-size"+      (GetScriptSize <$> getScriptSizeArgsOption)+      "Compute script size"  originateArgsOption :: Opt.Parser OriginateArgs originateArgsOption = do@@ -203,14 +202,25 @@   oaMbFee <- feeOption   pure $ OriginateArgs {..} +getScriptSizeArgsOption :: Opt.Parser GetScriptSizeArgs+getScriptSizeArgsOption = GetScriptSizeArgs <$> scriptFileOption+  <*> valueOption Nothing (#name :! "storage")+                          (#help :! "Contract storage value")+ mbContractFileOption :: Opt.Parser (Maybe FilePath) mbContractFileOption = optional . strOption $ mconcat   [ long "contract", metavar "FILEPATH"   , help "Path to contract file"   ] -contractNameOption :: Opt.Parser AliasHint-contractNameOption = strOption $ mconcat+scriptFileOption :: Opt.Parser FilePath+scriptFileOption = strOption $ mconcat+  [ long "script", metavar "FILEPATH"+  , help "Path to script file"+  ]++contractNameOption :: Opt.Parser Alias+contractNameOption = fmap Alias . strOption $ mconcat   [ long "contract-name"   , value "stdin"   , help "Alias of originated contract"

@@ -6,12 +6,15 @@ module Morley.Client.RPC.API   ( NodeMethods (..)   , nodeMethods+  , monitorHeads   ) where  import Network.HTTP.Types.Status (Status(..)) import Servant.API-  (Capture, Get, JSON, Post, QueryParam, ReqBody, ToHttpApiData(..), (:<|>)(..), (:>))-import Servant.Client.Core (ResponseF(..), RunClient, clientIn, pattern FailureResponse)+  (Capture, Get, JSON, NewlineFraming, Post, QueryParam, ReqBody, SourceIO, StreamGet,+  ToHttpApiData(..), (:<|>)(..), (:>))+import Servant.Client.Core+  (ResponseF(..), RunClient, RunStreamingClient, clientIn, pattern FailureResponse)  import Morley.Client.RPC.QueryFixedParam import Morley.Client.RPC.Types@@ -44,6 +47,8 @@      Capture "block_id" BlockId :> "operations" :> Get '[JSON] [[BlockOperation]] :<|> +    Capture "block_id" BlockId :> "operation_hashes" :> Get '[JSON] [[OperationHash]] :<|>+     -- Despite this RPC is deprecated, it is said to be implemented quite sanely,     -- and also we were said that it is not going to be removed soon.     -- In babylonnet this entrypoint finds big_map with relevant key type and@@ -76,8 +81,15 @@     Capture "block_id" BlockId :> "context" :> "contracts"       :> Capture "contract" Address' :> "delegate" :> Get '[JSON] KeyHash :<|> +    Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "address" Address' :> "manager_key"+      :> Get '[JSON] (Maybe PublicKey) :<|>+     -- POST +    -- Calculate script size with given storage.+    Capture "block_id" BlockId :> "helpers" :> "scripts" :> "script_size"+        :> ReqBody '[JSON] CalcSize :> Post '[JSON] ScriptSize :<|>+     -- Turn a structured representation of an operation into a     -- bytestring that can be submitted to the blockchain.     Capture "block_id" BlockId :> "helpers" :> "forge" :> "operations"@@ -93,10 +105,7 @@      -- Run contract with given parameter and storage.     Capture "block_id" BlockId :> "helpers" :> "scripts" :> "run_code"-      :> ReqBody '[JSON] RunCode :> Post '[JSON] RunCodeResult :<|>--    Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "address" Address' :> "manager_key"-      :> Get '[JSON] (Maybe PublicKey)+      :> ReqBody '[JSON] RunCode :> Post '[JSON] RunCodeResult      ) :<|> @@ -109,6 +118,10 @@     :> ReqBody '[JSON] HexJSONByteString     :> Post '[JSON] OperationHash +type StreamingAPI =+  "monitor" :> "heads" :> "main"+    :> StreamGet NewlineFraming JSON (SourceIO BlockHeader)+ nodeAPI :: Proxy NodeAPI nodeAPI = Proxy @@ -121,11 +134,13 @@   , getBlockHeader :: BlockId -> m BlockHeader   , getProtocolParameters :: BlockId -> m ProtocolParameters   , getBlockOperations :: BlockId -> m [[BlockOperation]]+  , getBlockOperationHashes :: BlockId -> m [[OperationHash]]   , getBigMap :: BlockId -> Address -> GetBigMap -> m GetBigMapResult   , getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression   , getBigMapValuesAtBlock :: BlockId -> Natural -> Maybe Natural -> Maybe Natural -> m Expression   , getBalance :: BlockId -> Address -> m TezosMutez   , getDelegate :: BlockId -> Address -> m (Maybe KeyHash)+  , getScriptSizeAtBlock :: BlockId -> CalcSize -> m ScriptSize   , forgeOperation :: BlockId -> ForgeOperation -> m HexJSONByteString   , runOperation :: BlockId -> RunOperation -> m RunOperationResult   , preApplyOperations :: BlockId -> [PreApplyOperation] -> m [RunOperationResult]@@ -135,6 +150,10 @@   , injectOperation :: HexJSONByteString -> m OperationHash   } ++monitorHeads :: forall m. (RunStreamingClient m) => m (SourceIO BlockHeader)+monitorHeads = Proxy @StreamingAPI `clientIn` Proxy @m+ nodeMethods :: forall m. (MonadCatch m, RunClient m) => NodeMethods m nodeMethods = NodeMethods   { getCounter        = withAddress' getCounter'@@ -155,12 +174,29 @@   where     withAddress' f blockId = f blockId . Address'     getDelegate' :: BlockId -> Address' -> m KeyHash-    (getBlockHash :<|> getCounter' :<|> getScript' :<|> getStorageAtBlock' :<|> getBlockConstants :<|>-      getBlockHeader :<|> getProtocolParameters :<|> getBlockOperations :<|> getBigMap' :<|>-      getBigMapValueAtBlock :<|> getBigMapValuesAtBlock :<|> getBalance' :<|> getDelegate' :<|>-      forgeOperation :<|> runOperation :<|> preApplyOperations :<|> runCode :<|> getManagerKey') :<|>-      getChainId :<|> injectOperation =-      nodeAPI `clientIn` (Proxy @m)+    (getBlockHash+        :<|> getCounter'+        :<|> getScript'+        :<|> getStorageAtBlock'+        :<|> getBlockConstants+        :<|> getBlockHeader+        :<|> getProtocolParameters+        :<|> getBlockOperations+        :<|> getBlockOperationHashes+        :<|> getBigMap'+        :<|> getBigMapValueAtBlock+        :<|> getBigMapValuesAtBlock+        :<|> getBalance'+        :<|> getDelegate'+        :<|> getManagerKey'+        :<|> getScriptSizeAtBlock+        :<|> forgeOperation+        :<|> runOperation+        :<|> preApplyOperations+        :<|> runCode)+      :<|> getChainId+      :<|> injectOperation+      = nodeAPI `clientIn` (Proxy @m)  ---------------------------------------------------------------------------- -- Instances and helpers

@@ -19,7 +19,7 @@  -- | Type class that provides interaction with tezos node via RPC class (Monad m, MonadCatch m) => HasTezosRpc m where-  getBlockHash :: BlockId -> m Text+  getBlockHash :: BlockId -> m BlockHash   -- ^ Get hash of the given 'BlockId', mostly used to get hash of   -- 'HeadId'   getCounterAtBlock :: BlockId -> Address -> m TezosInt64@@ -27,10 +27,14 @@   -- and contract origination.   getBlockHeader :: BlockId -> m BlockHeader   -- ^ Get the whole header of a block.+  getScriptSizeAtBlock :: BlockId -> CalcSize -> m ScriptSize+  -- ^ Get the script size at block.   getBlockConstants :: BlockId -> m BlockConstants   -- ^ Get block constants that are required by other RPC calls.   getBlockOperations :: BlockId -> m [[BlockOperation]]   -- ^ Get all operations from the block with specified ID.+  getBlockOperationHashes :: BlockId -> m [[OperationHash]]+  -- ^ Get all operation hashes from the block with specified ID.   getProtocolParametersAtBlock :: BlockId -> m ProtocolParameters   -- ^ Get protocol parameters that are for limits calculations.   runOperationAtBlock :: BlockId -> RunOperation -> m RunOperationResult@@ -75,3 +79,7 @@   getManagerKeyAtBlock :: BlockId -> Address -> m (Maybe PublicKey)   -- ^ Get manager key for given address.   -- Returns @Nothing@ if this key wasn't revealed.+  waitForOperation :: m OperationHash -> m OperationHash+  -- ^ Blocks until an operation with the given hash is included into the chain.+  -- The first argument is the action that puts the operation on the chain.+  -- Returns the hash of the included operation.

@@ -7,6 +7,7 @@   , RunCodeErrors (..)   , UnexpectedErrors (..)   , IncorrectRpcResponse (..)+  , WaitForOperationError (..)   ) where  import Fmt (Buildable(..), blockListF, pretty, (+|), (|+))@@ -136,4 +137,18 @@       "No operations was run"  instance Exception IncorrectRpcResponse where+  displayException = pretty++data WaitForOperationError+  = WaitForOperationBlockout Word+  | WaitForOperationStreamingError Text+  deriving stock Show++instance Buildable WaitForOperationError where+  build = \case+    WaitForOperationBlockout n -> "Operation not included after " +| n |+ " blocks"+    WaitForOperationStreamingError s ->+      "Streaming error received waiting for operation: " +| s |+ ""++instance Exception WaitForOperationError where   displayException = pretty

@@ -16,6 +16,7 @@   , getImplicitContractCounter   , getContractsParameterTypes   , getContractStorage+  , getScriptSize   , getBigMapValue   , getBigMapValues   , getHeadBlock@@ -175,6 +176,7 @@ getImplicitContractCounter addr = case addr of   KeyAddress _      -> getCounter addr   ContractAddress _ -> throwM $ ContractGetCounterAttempt addr+  TransactionRollupAddress _ -> throwM $ ContractGetCounterAttempt addr  handleStatusCode :: MonadCatch m => Int -> m a -> m a -> m a handleStatusCode code onError action = action `catch`@@ -194,6 +196,7 @@       -> m (Maybe (ContractHash, SomeParamType))     extractParameterType addr = case addr of       KeyAddress _ -> return Nothing+      TransactionRollupAddress _ -> return Nothing       ContractAddress ch ->         handleStatusCode 404 (return Nothing) $ do           params <- fmap (U.contractParameter) . throwLeft $@@ -215,7 +218,7 @@  -- | Get hash of the current head block, this head hash is used in other -- RPC calls.-getHeadBlock :: HasTezosRpc m => m Text+getHeadBlock :: HasTezosRpc m => m BlockHash getHeadBlock = getBlockHash HeadId  -- | 'getCounterAtBlock' applied to the head block.@@ -249,6 +252,10 @@ -- | 'getBalanceAtBlock' applied to the head block. getBalance :: HasTezosRpc m => Address -> m Mutez getBalance = getBalanceAtBlock HeadId++-- | 'getScriptSizeAtBlock' applied to the head block.+getScriptSize :: HasTezosRpc m => CalcSize -> m ScriptSize+getScriptSize = getScriptSizeAtBlock HeadId  -- | 'getDelegateAtBlock' applied to the head block. getDelegate :: HasTezosRpc m => Address -> m (Maybe KeyHash)

@@ -5,7 +5,9 @@   ( QueryFixedParam   ) where -import Servant.API (ToHttpApiData(toQueryParam), type (:>))+import Data.ByteString.Builder qualified as Builder+import Data.ByteString.Lazy qualified as LBS+import Servant.API (ToHttpApiData(..), type (:>)) import Servant.Client.Core (HasClient(..), appendToQueryString)  import Morley.Util.TypeLits (KnownSymbol, Symbol, symbolValT')@@ -16,11 +18,16 @@  instance (KnownSymbol sym, KnownSymbol val, HasClient m api)       => HasClient m (QueryFixedParam sym val :> api) where+   type Client m (QueryFixedParam sym val :> api) = Client m api+   clientWithRoute pm Proxy req =     clientWithRoute pm (Proxy :: Proxy api)-      $ appendToQueryString pname (Just $ toQueryParam pval) req+      $ appendToQueryString pname (Just $ encodeQueryParamValue pval) req     where       pname = symbolValT' @sym       pval  = symbolValT' @val+      -- Lifted from the unreleased https://github.com/haskell-servant/servant/pull/1549+      encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString . toEncodedUrlPiece+   hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl

@@ -25,12 +25,16 @@   , CommonOperationData (..)   , ForgeOperation (..)   , GetBigMap (..)+  , CalcSize(..)+  , ScriptSize(..)   , GetBigMapResult (..)   , InternalOperation (..)   , OperationContent (..)   , OperationHash (..)-  , OperationInput (..)+  , OperationInput   , OperationResp (..)+  , OperationRespWithMeta (..)+  , OperationMetadata (..)   , OperationResult (..)   , OriginationOperation (..)   , OriginationScript (..)@@ -46,7 +50,8 @@   , RunOperationResult (..)   , RPCInput   , TransactionOperation (..)-  , combineResults+  , WithCommonOperationData (..)+  , MonitorHeadsStep(..)   , mkCommonOperationData    -- * Errors@@ -72,13 +77,14 @@   , _GasExhaustedOperation    -- * Lenses-  , oiCommonDataL+  , wcoCommonDataL   ) where -import Control.Lens (makeLensesFor, makePrisms)+import Control.Lens (makePrisms) import Data.Aeson-  (FromJSON(..), Object, ToJSON(..), Value(..), object, omitNothingFields, withObject, (.!=), (.:),-  (.:?), (.=))+  (FromJSON(..), Key, Object, ToJSON(..), Value(..), object, omitNothingFields, withObject, (.!=),+  (.:), (.:?), (.=))+import Data.Aeson.Key qualified as Key (toText) import Data.Aeson.TH (deriveFromJSON, deriveJSON, deriveToJSON) import Data.Default (Default(..)) import Data.Fixed (Milli)@@ -92,8 +98,8 @@ import Morley.Client.RPC.Aeson (morleyClientAesonOptions) import Morley.Client.Types import Morley.Micheline-  (Expression(..), MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosInt64,-  TezosMutez(..), TezosNat)+  (Expression, MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosInt64,+  TezosMutez(..), TezosNat, expressionPrim) import Morley.Tezos.Address (Address) import Morley.Tezos.Core (Mutez, tz, zeroMutez) import Morley.Tezos.Crypto (PublicKey, Signature, decodeBase58CheckWithPrefix, formatSignature)@@ -113,45 +119,19 @@   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+type OperationInput = WithCommonOperationData (OperationInfo RPCInput)  data ForgeOperation = ForgeOperation-  { foBranch :: Text+  { foBranch :: BlockHash   , foContents :: NonEmpty OperationInput   } -instance ToJSON ForgeOperation where-  toJSON ForgeOperation{..} = object-    [ "branch" .= toString foBranch-    , "contents" .= foContents-    ]- data RunOperationInternal = RunOperationInternal-  { roiBranch :: Text+  { roiBranch :: BlockHash   , roiContents :: NonEmpty OperationInput   , roiSignature :: Signature   } -instance ToJSON RunOperationInternal where-  toJSON RunOperationInternal{..} = object-    [ "branch" .= toString roiBranch-    , "contents" .= roiContents-    , "signature" .= roiSignature-    ]- data RunOperation = RunOperation   { roOperation :: RunOperationInternal   , roChainId :: Text@@ -159,19 +139,11 @@  data PreApplyOperation = PreApplyOperation   { paoProtocol :: Text-  , paoBranch :: Text+  , paoBranch :: BlockHash   , paoContents :: NonEmpty OperationInput   , paoSignature :: Signature   } -instance ToJSON PreApplyOperation where-  toJSON PreApplyOperation{..} = object-    [ "branch" .= toString paoBranch-    , "contents" .= paoContents-    , "protocol" .= toString paoProtocol-    , "signature" .= formatSignature paoSignature-    ]- data RunOperationResult = RunOperationResult   { rrOperationContents :: NonEmpty OperationContent   }@@ -233,7 +205,7 @@   }  newtype BlockHash = BlockHash { unBlockHash :: Text }-  deriving newtype (ToJSON, FromJSON)+  deriving newtype (Eq, Ord, Show, Buildable, ToJSON, FromJSON, ToHttpApiData)  data FeeConstants = FeeConstants   { fcBase :: Mutez@@ -262,7 +234,7 @@   -- ^ Identifier referring to the genesis block.   | LevelId Natural   -- ^ Identifier referring to a block by its level.-  | BlockHashId Text+  | BlockHashId BlockHash   -- ^ Idenfitier referring to a block by its hash in Base58Check notation.   | AtDepthId Natural   -- ^ Identifier of a block at specific depth relative to @head@.@@ -296,7 +268,7 @@   | Right lvl <- readEither t = Just (LevelId lvl)   | Just depthTxt <- "head~" `T.stripPrefix` t   , Right depth <- readEither depthTxt = Just (AtDepthId depth)-  | Right _ <- decodeBase58CheckWithPrefix blockPrefix t = Just (BlockHashId t)+  | Right _ <- decodeBase58CheckWithPrefix blockPrefix t = Just (BlockHashId (BlockHash t))   | otherwise = Nothing  -- A magic prefix used by Tezos for block hashes@@ -363,6 +335,7 @@   | BalanceTooLow ("balance" :! Mutez) ("required" :! Mutez)   | PreviouslyRevealedKey Address   | NonExistingContract Address+  | InvalidB58Check Text   deriving stock Show  instance FromJSON RunError where@@ -417,6 +390,8 @@           PreviouslyRevealedKey <$> o .: "contract"       x | "non_existing_contract" `isSuffixOf` x ->           NonExistingContract <$> o .: "contract"+      x | "invalid_b58check" `isSuffixOf` x ->+          InvalidB58Check <$> o .: "input"       _ -> fail ("unknown id: " <> id')  instance Buildable RunError where@@ -474,6 +449,8 @@       "Key for " +| addr |+ " has already been revealed"     NonExistingContract addr ->       "Contract is not registered: " +| addr |+ ""+    InvalidB58Check input ->+      "Failed to read a valid b58check_encoding data from \"" +| input |+ "\""  -- | Errors that are sent as part of an "Internal Server Error" -- response (HTTP code 500).@@ -518,11 +495,11 @@       "failure" -> Failure <$> o .: "msg"       x -> fail ("unknown id: " <> x)     where-      parseCounter :: Object -> Text -> Parser Word+      parseCounter :: Object -> Key -> Parser Word       parseCounter o fieldName = do         fieldValue <- o .: fieldName         let mCounter = fromIntegralMaybe fieldValue-        maybe (fail $ mkErrorMsg fieldName fieldValue) pure mCounter+        maybe (fail $ mkErrorMsg (Key.toText fieldName) fieldValue) pure mCounter        mkErrorMsg :: Text -> TezosInt64 -> String       mkErrorMsg fieldName fieldValue = toString $ unwords@@ -556,17 +533,6 @@ instance Monoid AppliedResult where   mempty = AppliedResult 0 0 0 [] 0 -combineResults :: OperationResult -> OperationResult -> OperationResult-combineResults-  (OperationApplied res1) (OperationApplied res2) =-  OperationApplied $ res1 <> res2-combineResults (OperationApplied _) (OperationFailed e) =-  OperationFailed e-combineResults (OperationFailed e) (OperationApplied _) =-  OperationFailed e-combineResults (OperationFailed e1) (OperationFailed e2) =-  OperationFailed $ e1 <> e2- instance FromJSON OperationResult where   parseJSON = withObject "operation_costs" $ \o -> do     status <- o .: "status"@@ -598,7 +564,7 @@ defaultParametersInternal :: ParametersInternal defaultParametersInternal = ParametersInternal   { piEntrypoint = "default"-  , piValue = ExpressionPrim MichelinePrimAp+  , piValue = expressionPrim MichelinePrimAp     { mpaPrim = MichelinePrimitive "Unit"     , mpaArgs = []     , mpaAnnots = []@@ -649,6 +615,19 @@     codStorageLimit <- o .: "storage_limit"     pure CommonOperationData {..} +-- | Some operation data accompanied with common data.+data WithCommonOperationData a = WithCommonOperationData+  { wcoCommon :: CommonOperationData+  , wcoCustom :: a+  }++instance ToJSONObject a => ToJSON (WithCommonOperationData a) where+  toJSON (WithCommonOperationData common custom) =+    toJSON common `mergeObjects` toJSON custom++instance FromJSON a => FromJSON (WithCommonOperationData a) where+  parseJSON v = WithCommonOperationData <$> parseJSON v <*> parseJSON v+ -- | All the data needed to perform a transaction through -- Tezos RPC interface. -- For additional information, please refer to RPC documentation@@ -659,21 +638,6 @@   , toParameters :: ParametersInternal   } -instance ToJSON TransactionOperation where-  toJSON TransactionOperation{..} = object $-    [ "kind" .= String "transaction"-    , "amount" .= toAmount-    , "destination" .= toDestination-    , "parameters" .= toParameters-    ]--instance FromJSON TransactionOperation where-  parseJSON = withObject "TransactionOperation" $ \obj -> do-    toAmount <- obj .: "amount"-    toDestination <- obj .: "destination"-    toParameters <- fromMaybe defaultParametersInternal <$> obj .:? "parameters"-    pure TransactionOperation {..}- data OriginationScript = OriginationScript   { osCode :: Expression   , osStorage :: Expression@@ -686,13 +650,6 @@   , ooScript :: OriginationScript   } -instance ToJSON OriginationOperation where-  toJSON OriginationOperation{..} = object $-    [ "kind" .= String "origination"-    , "balance" .= ooBalance-    , "script" .= ooScript-    ]- -- | All the data needed to perform key revealing -- through Tezos RPC interface data RevealOperation = RevealOperation@@ -704,27 +661,32 @@     [ "kind" .= String "reveal"     , "public_key" .= roPublicKey     ]+instance ToJSONObject RevealOperation  -- | @$operation@ in Tezos docs. data BlockOperation = BlockOperation   { boHash :: Text-  , boContents :: [OperationResp]+  , boContents :: [OperationRespWithMeta]   }  -- | Contents of an operation that can appear in RPC responses. data OperationResp-  = TransactionOpResp TransactionOperation+  = TransactionOpResp (WithCommonOperationData TransactionOperation)   -- ^ Operation with kind @transaction@.   | OtherOpResp   -- ^ Operation with kind that we don't support yet (but need to parse to something). -instance FromJSON OperationResp where-  parseJSON = withObject "OperationResp" $ \obj -> do-    kind :: Text <- obj .: "kind"-    case kind of-      "transaction" -> TransactionOpResp <$> parseJSON (Object obj)-      _ -> pure OtherOpResp+data OperationRespWithMeta = OperationRespWithMeta+  { orwmResponse :: OperationResp+  , orwmMetadata :: Maybe OperationMetadata+  } +newtype OperationMetadata = OperationMetadata { unOperationMetadata :: Maybe OperationResult }++instance FromJSON OperationMetadata where+  parseJSON = withObject "operationMetadata" $ \o ->+    OperationMetadata <$> o .:? "operation_result"+ data GetBigMap = GetBigMap   { bmKey :: Expression   , bmType :: Expression@@ -742,6 +704,8 @@   , rcAmount :: TezosMutez   , rcBalance :: TezosMutez   , rcChainId :: Text+  , rcNow :: Maybe TezosNat+  , rcLevel :: Maybe TezosNat   , rcSource :: Maybe Address   , rcPayer :: Maybe Address   }@@ -754,13 +718,84 @@   { rcrStorage :: Expression   } +newtype ScriptSize = ScriptSize { ssScriptSize :: Natural }++data CalcSize = CalcSize+  { csProgram :: Expression+  , csStorage :: Expression+  , csGas     :: TezosInt64+  , csLegacy  :: Bool+  }++data MonitorHeadsStep a = MonitorHeadsStop a | MonitorHeadsContinue+ deriveJSON morleyClientAesonOptions ''ParametersInternal++instance ToJSON TransactionOperation where+  toJSON TransactionOperation{..} = object $+    [ "kind" .= String "transaction"+    , "amount" .= toAmount+    , "destination" .= toDestination+    , "parameters" .= toParameters+    ]+instance ToJSONObject TransactionOperation++instance FromJSON TransactionOperation where+  parseJSON = withObject "TransactionOperation" $ \obj -> do+    toAmount <- obj .: "amount"+    toDestination <- obj .: "destination"+    toParameters <- fromMaybe defaultParametersInternal <$> obj .:? "parameters"+    pure TransactionOperation {..}++instance FromJSON OperationResp where+  parseJSON = withObject "OperationResp" $ \obj -> do+    kind :: Text <- obj .: "kind"+    case kind of+      "transaction" -> TransactionOpResp <$> parseJSON (Object obj)+      _ -> pure OtherOpResp++instance FromJSON OperationRespWithMeta where+  parseJSON = withObject "OperationRespWithMeta" $ \obj -> do+    OperationRespWithMeta <$> parseJSON (Object obj) <*> obj .:? "metadata"+ deriveToJSON morleyClientAesonOptions ''OriginationScript++instance ToJSON OriginationOperation where+  toJSON OriginationOperation{..} = object $+    [ "kind" .= String "origination"+    , "balance" .= ooBalance+    , "script" .= ooScript+    ]+instance ToJSONObject OriginationOperation++instance ToJSON ForgeOperation where+  toJSON ForgeOperation{..} = object+    [ "branch" .= unBlockHash foBranch+    , "contents" .= foContents+    ]++instance ToJSON RunOperationInternal where+  toJSON RunOperationInternal{..} = object+    [ "branch" .= unBlockHash roiBranch+    , "contents" .= roiContents+    , "signature" .= roiSignature+    ]++instance ToJSON PreApplyOperation where+  toJSON PreApplyOperation{..} = object+    [ "branch" .= unBlockHash paoBranch+    , "contents" .= paoContents+    , "protocol" .= paoProtocol+    , "signature" .= formatSignature paoSignature+    ]+ deriveToJSON morleyClientAesonOptions ''RunOperation deriveToJSON morleyClientAesonOptions ''GetBigMap+deriveToJSON morleyClientAesonOptions ''CalcSize deriveToJSON morleyClientAesonOptions{omitNothingFields = True} ''RunCode-deriveFromJSON morleyClientAesonOptions ''BlockConstants deriveFromJSON morleyClientAesonOptions ''BlockHeaderNoHash+deriveFromJSON morleyClientAesonOptions ''ScriptSize+deriveFromJSON morleyClientAesonOptions ''BlockConstants deriveJSON morleyClientAesonOptions ''BlockHeader deriveFromJSON morleyClientAesonOptions ''ProtocolParameters deriveFromJSON morleyClientAesonOptions ''BlockOperation@@ -771,4 +806,7 @@   parseJSON v = maybe GetBigMapNotFound GetBigMapResult <$> parseJSON v  makePrisms ''RunError-makeLensesFor [("oiCommonData", "oiCommonDataL")] ''OperationInput++wcoCommonDataL :: Lens' (WithCommonOperationData a) CommonOperationData+wcoCommonDataL = \f (WithCommonOperationData com cust) ->+  (`WithCommonOperationData` cust) <$> f com

@@ -10,34 +10,32 @@  import Data.ByteArray (ScrubbedBytes) -import Morley.Client.RPC.Types import Morley.Client.TezosClient.Types import Morley.Micheline import Morley.Michelson.Typed.Scope import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (AddressOrAlias, Alias) import Morley.Tezos.Crypto  -- | Type class that provides interaction with @tezos-client@ binary class (Monad m) => HasTezosClient m where   signBytes :: AddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature   -- ^ Sign an operation with @tezos-client@.-  genKey :: AliasOrAliasHint -> m Address+  genKey :: Alias -> m Address   -- ^ Generate a secret key and store it with given alias.   -- If a key with this alias already exists, the corresponding address   -- will be returned and no state will be changed.-  genFreshKey :: AliasOrAliasHint -> m Address+  genFreshKey :: Alias -> m Address   -- ^ Generate a secret key and store it with given alias.   -- Unlike 'genKey' this function overwrites   -- the existing key when given alias is already stored.   revealKey :: Alias -> Maybe ScrubbedBytes -> m ()   -- ^ Reveal public key associated with given implicit account.-  waitForOperation :: OperationHash -> m ()-  -- ^ Wait until operation known by some hash is included into the chain.-  rememberContract :: Bool -> Address -> AliasOrAliasHint -> m ()+  rememberContract :: Bool -> Address -> Alias -> m ()   -- ^ 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 Alias+  importKey :: Bool -> Alias -> 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.@@ -53,7 +51,9 @@   getPublicKey :: AddressOrAlias -> m PublicKey   -- ^ Get public key for given address. Public keys are often used when interacting   -- with the multising contracts-  registerDelegate :: AliasOrAliasHint -> Maybe ScrubbedBytes -> m ()+  getSecretKey :: AddressOrAlias -> m SecretKey+  -- ^ Get secret key for given address.+  registerDelegate :: Alias -> Maybe ScrubbedBytes -> m ()   -- ^ Register a given address as delegate   getTezosClientConfig :: m TezosClientConfig   -- ^ Retrieve the current @tezos-client@ config.

@@ -8,7 +8,6 @@    -- * @tezos-client@ api   , signBytes-  , waitForOperationInclusion   , rememberContract   , importKey   , genKey@@ -18,6 +17,7 @@   , resolveAddress   , getAlias   , getPublicKey+  , getSecretKey   , getTezosClientConfig   , calcTransferFee   , calcOriginationFee@@ -28,8 +28,6 @@   -- * Internals   , callTezosClient   , callTezosClientStrict-  , prefixName-  , prefixNameM   ) where  import Unsafe qualified ((!!))@@ -56,6 +54,7 @@ import Morley.Micheline import Morley.Michelson.Typed.Scope import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias(..)) import Morley.Tezos.Crypto import Morley.Util.Peano import Morley.Util.SizedList.Types@@ -212,10 +211,9 @@ genKey   :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m      , Class.HasTezosClient m)-  => AliasOrAliasHint+  => Alias   -> m Address-genKey originatorAlias = do-  name <- prefixNameM originatorAlias+genKey name = do   let     isAlreadyExistsError :: Text -> Bool     -- We can do a bit better here using more complex parsing if necessary.@@ -234,10 +232,9 @@ genFreshKey   :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m      , Class.HasTezosClient m)-  => AliasOrAliasHint+  => Alias   -> m Address-genFreshKey originatorAlias = do-  name <- prefixNameM originatorAlias+genFreshKey name = do   let     isNoAliasError :: Text -> Bool     -- We can do a bit better here using more complex parsing if necessary.@@ -279,11 +276,10 @@ -- | Register alias as delegate registerDelegate   :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => AliasOrAliasHint+  => Alias   -> Maybe ScrubbedBytes   -> m ()-registerDelegate addressOrAliasHint mbPassword = do-  alias <- prefixNameM addressOrAliasHint+registerDelegate alias mbPassword = do   logDebug $ "Registering " +| alias |+ " as delegate"   let     emptyImplicitContract = T.isInfixOf "Empty implicit contract"@@ -308,7 +304,7 @@   AddressAlias originatorName -> do     logDebug $ "Resolving " +| originatorName |+ ""     output <- callTezosClientStrict ["list", "known", "contracts"] MockupMode Nothing-    let parse = T.stripPrefix (unsafeGetAliasText originatorName <> ": ")+    let parse = T.stripPrefix (unAlias originatorName <> ": ")     liftIO case safeHead . mapMaybe parse . lines $ output of       Nothing -> pure Nothing       Just addrText ->@@ -328,7 +324,7 @@     let parse = T.stripSuffix (": " <> pretty senderAddress)     liftIO case safeHead . mapMaybe parse . lines $ output of       Nothing -> throwM $ UnknownAddress senderAddress-      Just alias -> pure (mkAlias alias)+      Just alias -> pure (Alias alias)  -- | Return 'PublicKey' corresponding to given 'AddressOrAlias'. getPublicKey@@ -348,19 +344,23 @@         parsePublicKey pkText     _ -> throwM $ TezosClientUnexpectedOutputFormat output --- | This function blocks until operation with given hash is included into blockchain.-waitForOperationInclusion+-- | Return 'SecretKey' corresponding to given 'AddressOrAlias'.+getSecretKey   :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => OperationHash-  -> m ()-waitForOperationInclusion op = void do-  logDebug $ "Waiting for operation " +| op |+ " to be included..."-  callTezosClient errHandler-    ["wait", "for", toCmdArg op, "to", "be", "included"] ClientMode Nothing-  where-    errHandler _ errOutput =-      False <$ when ("Invalid operation hash:" `T.isInfixOf` errOutput)-      (throwM $ InvalidOperationHash op)+  => AddressOrAlias+  -> m SecretKey+getSecretKey addrOrAlias = do+  alias <- getAlias addrOrAlias+  logDebug $ "Getting " +| alias |+ " secret key"+  output <- callTezosClientStrict ["show", "address", toCmdArg alias, "--show-secret"] MockupMode Nothing+  liftIO case lines output of+    _ : _ : [rawSK] -> do+      skText <- maybe+        (throwM $ TezosClientUnexpectedOutputFormat rawSK) pure+        (T.stripPrefix "Secret Key: " rawSK)+      either (throwM . TezosClientCryptoParseError skText) pure $+        parseSecretKey skText+    _ -> throwM $ TezosClientUnexpectedOutputFormat output  -- | Save a contract with given address and alias. -- If @replaceExisting@ is @False@ and a contract with given alias@@ -369,10 +369,9 @@   :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)   => Bool   -> Address-  -> AliasOrAliasHint+  -> Alias   -> m ()-rememberContract replaceExisting contractAddress newAlias = do-  name <- prefixNameM newAlias+rememberContract replaceExisting contractAddress name = do   let     isAlreadyExistsError = T.isInfixOf "already exists"     errHandler _ errOut = pure (isAlreadyExistsError errOut)@@ -386,11 +385,10 @@ importKey   :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)   => Bool-  -> AliasOrAliasHint+  -> Alias   -> SecretKey   -> m Alias-importKey replaceExisting alias key = do-  name <- prefixNameM alias+importKey replaceExisting name key = do   let     isAlreadyExistsError = T.isInfixOf "already exists"     errHandler _ errOut = pure (isAlreadyExistsError errOut)@@ -630,22 +628,6 @@     errorMsg =       "ERROR!! There was an error in executing `" <> toText fp <> "` program. Is the \       \ executable available in PATH ?"--prefixName :: Maybe Text -> AliasOrAliasHint -> Alias-prefixName _ (AnAlias x) = x-prefixName mPrefix (AnAliasHint (unsafeGetAliasHintText -> hint)) =-  mkAlias $ case mPrefix of-    Just prefix -> prefix <> "." <> hint-    Nothing -> hint---- | Prefix an alias with the value available in any 'HasTezosClientEnv'.-prefixNameM-  :: (HasTezosClientEnv env, MonadReader env m)-  => AliasOrAliasHint-  -> m Alias-prefixNameM alias = do-  prefix <- tceAliasPrefix <$> view tezosClientEnvL-  pure $ prefixName prefix alias  -- | Return 'Address' corresponding to given 'AddressOrAlias'. resolveAddress

@@ -5,10 +5,6 @@  module Morley.Client.TezosClient.Types   ( CmdArg (..)-  , Alias-  , AliasHint-  , AliasOrAliasHint (..)-  , AddressOrAlias (..)   , addressResolved   , CalcOriginationFeeData (..)   , CalcTransferFeeData (..)@@ -17,16 +13,7 @@   , HasTezosClientEnv (..)   , SecretKeyEncryption (..) -  -- * Unsafe coercions-  , unsafeCoerceAliasHintToAlias-  , unsafeCoerceAliasToAliasHint-  , unsafeGetAliasText-  , unsafeGetAliasHintText-  , mkAlias-  , mkAliasHint-   -- * Lens-  , tceAliasPrefixL   , tceEndpointUrlL   , tceTezosClientPathL   , tceMbTezosClientDataDirL@@ -34,11 +21,9 @@  import Data.Aeson (FromJSON(..), KeyValue(..), ToJSON(..), object, withObject, (.:)) import Data.ByteArray (ScrubbedBytes)-import Data.Coerce (coerce) import Data.Fixed (E6, Fixed(..)) import Fmt (Buildable(..), pretty) import Morley.Util.Lens (makeLensesWith, postfixLFields)-import Options.Applicative qualified as Opt import Servant.Client (BaseUrl(..), showBaseUrl) import Text.Hex (encodeHex) @@ -49,10 +34,10 @@ import Morley.Michelson.Printer import Morley.Michelson.Typed (Contract, EpName, Value) import Morley.Michelson.Typed qualified as T-import Morley.Tezos.Address (Address, parseAddress)+import Morley.Tezos.Address (Address)+import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias) import Morley.Tezos.Core import Morley.Tezos.Crypto-import Morley.Util.CLI (HasCLReader(..))  -- | An object that can be put as argument to a tezos-client command-line call. class CmdArg a where@@ -92,84 +77,14 @@  instance CmdArg OperationHash --- | @tezos-client@ can associate addresses with textual aliases.--- This type denotes such an alias.-newtype Alias = Alias-  { unsafeGetAliasText :: Text-    -- ^ Unsafely extract 'Text' from 'Alias'. Do NOT use the result with-    -- 'mkAliasHint'.-  }-  deriving stock (Show, Eq, Ord)-  deriving newtype (Buildable, CmdArg)---- | A hint for constructing an alias when generating an address or--- remembering a contract.------ Resulting 'Alias' most likely will differ from this as we tend to prefix--- aliases, but a user should be able to recognize your alias visually.--- For instance, passing @"alice"@ as a hint may result into @"myTest.alice"@--- alias being created.-newtype AliasHint = AliasHint-  { unsafeGetAliasHintText :: Text-    -- ^ Unsafely extract 'Text' from 'AliasHint'. Do NOT use the result with-    -- 'mkAlias'.-  }-  deriving stock (Show)-  deriving newtype (IsString, Buildable, Semigroup, Monoid)---- | Coerce 'Alias' to 'AliasHint'. Unless you know for a fact that prefix is empty,--- this is unsafe.-unsafeCoerceAliasToAliasHint :: Alias -> AliasHint-unsafeCoerceAliasToAliasHint = coerce---- | Coerce 'AliasHint' to 'Alias'. Unless you know for a fact that prefix is empty,--- this is unsafe.-unsafeCoerceAliasHintToAlias :: AliasHint -> Alias-unsafeCoerceAliasHintToAlias = coerce---- | Make 'Alias' from 'Text'-mkAlias :: Text -> Alias-mkAlias = Alias---- | Make 'AliasHint' from 'Text'-mkAliasHint :: Text -> AliasHint-mkAliasHint = AliasHint---- | Either an 'Alias', or an 'AliasHint'. The difference is that 'AliasHint' needs to be--- prefixed (if alias prefix is non-empty), while 'Alias' doesn't.-data AliasOrAliasHint-  = AnAlias Alias-  | AnAliasHint AliasHint-  deriving stock (Show)---- | Representation of an address that @tezos-client@ uses. It can be--- an address itself or a textual alias.-data AddressOrAlias-  = AddressResolved Address-  -- ^ Address itself, can be used as is.-  | AddressAlias Alias-  -- ^ Address alias, should be resolved by @tezos-client@.-  deriving stock (Show, Eq, Ord)+instance CmdArg Alias where  instance CmdArg AddressOrAlias where -instance HasCLReader AddressOrAlias where-  getReader =-    Opt.str <&> \addrOrAlias ->-      case parseAddress addrOrAlias of-        Right addr -> AddressResolved addr-        Left _ -> AddressAlias (Alias addrOrAlias)-  getMetavar = "ADDRESS OR ALIAS"- -- | Creates an 'AddressOrAlias' with the given address. addressResolved :: ToAddress addr => addr -> AddressOrAlias addressResolved = AddressResolved . toAddress -instance Buildable AddressOrAlias where-  build = \case-    AddressResolved addr -> build addr-    AddressAlias alias -> build alias- -- | Representation of address secret key encryption type data SecretKeyEncryption   = UnencryptedKey@@ -189,15 +104,7 @@  -- | Runtime environment for @tezos-client@ bindings. data TezosClientEnv = TezosClientEnv-  { tceAliasPrefix :: Maybe Text-  -- ^ Optional prefix for aliases that will be passed to @tezos-client@.-  -- If you call some function and pass @foo@ 'Alias' to it when the prefix-  -- is provided, it will be prepened to @foo@. So @prefix.foo@ will be passed-  -- to @tezos-client@. Note that the prefix will be only applied in functions-  -- such as 'Morley.Client.TezosClient.Class.genKey' and-  -- 'Morley.Client.TezosClient.Class.rememberContract' that work directly-  -- with @tezos-client@ contract cache and add addresses to it.-  , tceEndpointUrl :: BaseUrl+  { tceEndpointUrl :: BaseUrl   -- ^ URL of tezos node on which operations are performed.   , tceTezosClientPath :: FilePath   -- ^ Path to tezos client binary through which operations are

@@ -2,7 +2,8 @@ -- SPDX-License-Identifier: LicenseRef-MIT-OA  module Morley.Client.Types-  ( OperationInfoDescriptor (..)+  ( ToJSONObject+  , OperationInfoDescriptor (..)   , OperationInfo (..)   , _OpTransfer   , _OpOriginate@@ -10,7 +11,11 @@   ) where  import Control.Lens (makePrisms)+import Data.Aeson (ToJSON(..)) +-- | Designates types whose 'ToJSON' instance produces only 'Data.Aeson.Object's.+class ToJSON a => ToJSONObject a+ class OperationInfoDescriptor (i :: Type) where   type family TransferInfo i :: Type   type family OriginationInfo i :: Type@@ -20,5 +25,16 @@   = OpTransfer (TransferInfo i)   | OpOriginate (OriginationInfo i)   | OpReveal (RevealInfo i)++-- Requiring 'ToJSONObject' in superclass as those different types of operation+-- must be distinguishable and that is usually done by a special field+instance+  Each '[ToJSONObject] [TransferInfo i, OriginationInfo i, RevealInfo i] =>+  ToJSON (OperationInfo i) where+  toJSON = \case+    OpTransfer op -> toJSON op+    OpOriginate op -> toJSON op+    OpReveal op -> toJSON op+instance ToJSON (OperationInfo i) => ToJSONObject (OperationInfo i)  makePrisms ''OperationInfo

@@ -13,6 +13,8 @@   , withAmount   , withSender   , withSource+  , withLevel+  , withNow    -- * @tezos-client@ password-related helpers   , scrubbedBytesToString@@ -37,7 +39,7 @@ import Morley.Michelson.Untyped (InternalByteString(..), Value, Value'(..)) import Morley.Michelson.Untyped.Entrypoints (EpName(..), pattern DefEpName) import Morley.Tezos.Address-import Morley.Tezos.Core (Mutez, zeroMutez)+import Morley.Tezos.Core (Mutez, Timestamp(..), zeroMutez) import Morley.Util.Exception as E (throwLeft)  -- | Sets the environment variable for disabling tezos-client@@ -75,6 +77,8 @@   , rcpParameter :: MaybeRPC (T.Value cp)   , rcpStorage :: MaybeRPC (T.Value st)   , rcpBalance :: Mutez+  , rcpNow :: Maybe Timestamp+  , rcpLevel :: Maybe Natural   , rcpAmount :: Mutez   , rcpSender :: Maybe Address   , rcpSource :: Maybe Address@@ -93,6 +97,8 @@     , rcpStorage = st     , rcpBalance = zeroMutez     , rcpAmount = zeroMutez+    , rcpNow = Nothing+    , rcpLevel = Nothing     , rcpSender = Nothing     , rcpSource = Nothing     }@@ -102,6 +108,8 @@   , ("rcpAmount", "withAmount")   , ("rcpSender", "withSender")   , ("rcpSource", "withSource")+  , ("rcpLevel", "withLevel")+  , ("rcpNow", "withNow")   ]   ''RunContractParameters @@ -119,6 +127,8 @@         , rcAmount = TezosMutez rcpAmount         , rcBalance = TezosMutez rcpBalance         , rcChainId = bcChainId headConstants+        , rcNow = rcpNow <&> StringEncode . round . unTimestamp+        , rcLevel = StringEncode <$> rcpLevel         -- 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.

@@ -5,7 +5,7 @@   ( test_BigMapGetUnit   ) where -import Data.Map (fromList, lookup)+import Data.Map (lookup) import Test.HUnit (Assertion, assertFailure) import Test.Hspec.Expectations (shouldThrow) import Test.Tasty (TestTree, testGroup)@@ -18,9 +18,9 @@  import Morley.Client.RPC.Getters import Morley.Client.RPC.Types-import Morley.Client.TezosClient.Types (AddressOrAlias(..)) import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2, genesisAddress3) import Morley.Michelson.Typed+import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Test.Util import TestM 

@@ -0,0 +1,59 @@+-- SPDX-FileCopyrightText: 2022 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++{-# OPTIONS_GHC -Wno-orphans #-}++module Test.Errors+  ( test_handleOperationResult+  ) where++import Debug qualified++import Test.Tasty (TestTree)+import Test.Tasty.HUnit (assertFailure, testCase, (@?=))++import Morley.Client.Action.Common+import Morley.Client.RPC.Error+import Morley.Client.RPC.Types+import Morley.Tezos.Core+import Morley.Util.Named++deriving stock instance Eq RunError++test_handleOperationResult :: TestTree+test_handleOperationResult = testCase "getAppliedResults #709 regression test" do+  let res = RunOperationResult+        { rrOperationContents =+            OperationContent+              (RunMetadata+                { rmOperationResult = OperationFailed []+                , rmInternalOperationResults =+                    [ InternalOperation {unInternalOperation = OperationFailed []}+                    , InternalOperation {unInternalOperation = OperationFailed []}+                    ]+                })+              :|+              [ OperationContent+                (RunMetadata+                  { rmOperationResult = OperationFailed+                      [ CantPayStorageFee+                      , BalanceTooLow (#balance :! [tz|149.38m|]) (#required :! [tz|355m|])+                      ]+                  , rmInternalOperationResults =+                      [ InternalOperation {unInternalOperation = OperationFailed []}+                      , InternalOperation {unInternalOperation = OperationFailed []}+                      ]+                  })+              , OperationContent (RunMetadata { rmOperationResult = OperationFailed []+                                              , rmInternalOperationResults = []})+              ]+        }+  handleOperationResult @(Either SomeException) res 3 & \case+    Right _ -> assertFailure "Expected result to fail, but it succeeded."+    Left err -> case fromException err of+      Just (UnexpectedRunErrors e) ->+        e @?=+          [ CantPayStorageFee+          , BalanceTooLow (#balance :! [tz|149.38m|]) (#required :! [tz|355m|])+          ]+      _ -> assertFailure $ "Expected failure to be UnexpectedRunErrors, but it was " <> Debug.show err

@@ -5,7 +5,6 @@   ( test_Fees_comp_iterations   ) where -import Data.Map (fromList) import Test.HUnit ((@?=)) import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase)@@ -14,9 +13,9 @@ 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.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (tz) import Test.Util import TestM@@ -66,7 +65,7 @@     Right _ -> count  averageContract :: L.Contract () () ()-averageContract = L.mkContractWith L.intactCompilationOptions $+averageContract = L.mkContractWith L.intactCompilationOptions $ L.mkContractCode $   L.unpair L.# L.drop L.#   foldl' (L.#) L.nop (replicate 100 (L.push () L.# L.drop)) L.#   L.nil L.# L.pair

@@ -13,6 +13,7 @@ import Morley.Client import Morley.Michelson.Runtime.GState (genesisAddress1) import Morley.Michelson.Typed+import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (tz) import Test.Util import TestM@@ -29,7 +30,7 @@ test_keyRevealing = testGroup "Fake test key revealing"   [ testCase "Manager key for new address is revealed only once for transfer" $ handleSuccess $     runFakeTest chainOperationHandlers fakeState $ do-      senderAddress <- genKey $ AnAlias "sender"+      senderAddress <- genKey "sender"       dummyTransfer genesisAddress1 senderAddress       mbManagerKey <- getManagerKey senderAddress @@ -48,7 +49,7 @@    , testCase "Manager key for new address is revealed only once for origination" $ handleSuccess $     runFakeTest chainOperationHandlers fakeState $ do-      originatorAddress <- genKey $ AnAlias "originator"+      originatorAddress <- genKey "originator"       dummyTransfer genesisAddress1 originatorAddress        mbManagerKey <- getManagerKey originatorAddress

@@ -5,7 +5,6 @@   ( test_lRunTransactionsUnit   ) where -import Data.Map (fromList) import Test.HUnit (Assertion, assertFailure) import Test.Hspec.Expectations (shouldThrow) import Test.Tasty (TestTree, testGroup)@@ -14,6 +13,7 @@ import Lorentz qualified as L import Morley.Client import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2, genesisAddress3)+import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core import Test.Util import TestM

@@ -5,14 +5,13 @@   ( test_parameterTypeGetUnit   ) where -import Data.Map as Map (empty, fromList)+import Data.Map as Map (empty) import Test.HUnit (Assertion, assertEqual, assertFailure) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase)  import Lorentz qualified as L -import Morley.Client import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Micheline@@ -21,6 +20,8 @@ import Morley.Michelson.Typed import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (Alias)+import Morley.Tezos.Crypto import Test.Util import TestM @@ -39,9 +40,9 @@   }  contractHash1, contractHash2, contractHash3 :: ContractHash-contractHash1 = ContractHash "lol"-contractHash2 = ContractHash "kek"-contractHash3 = ContractHash "mda"+contractHash1 = Hash HashContract "lol"+contractHash2 = Hash HashContract "kek"+contractHash3 = Hash HashContract "mda"  smartContractAddr1, smartContractAddr2, smartContractAddr3 :: Address smartContractAddr1 = ContractAddress contractHash1

@@ -6,7 +6,6 @@   , test_ReadBigMapValueMaybeUnit   ) where -import Data.Map (fromList) import Test.HUnit (Assertion, assertFailure) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=))

@@ -5,7 +5,6 @@   ( test_lRunTransactionsUnit   ) where -import Data.Map (fromList) import Test.HUnit (Assertion, assertFailure) import Test.Hspec.Expectations (shouldThrow) import Test.Tasty (TestTree, testGroup)

@@ -20,7 +20,7 @@ import Data.Aeson (encode) import Data.ByteArray (ScrubbedBytes) import Data.ByteString.Lazy qualified as LBS (toStrict)-import Data.Map as Map (elems, fromList, insert, lookup, toList)+import Data.Map as Map (elems, insert, lookup, toList) import Data.Singletons (demote) import Fmt ((+|), (|+)) import Network.HTTP.Types.Status (status404)@@ -33,11 +33,11 @@ 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.Address.Alias (AddressOrAlias(..), Alias(..)) import Morley.Tezos.Core import Morley.Tezos.Crypto import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519@@ -92,7 +92,7 @@   , hGetContractScript = handleGetContractScript   , hSignBytes =     \_ _ -> pure . SignatureEd25519 . Ed25519.sign testSecretKey-  , hWaitForOperation = const pass+  , hWaitForOperation = id   , hGetAlias = handleGetAlias   , hResolveAddressMaybe = handleResolveAddressMaybe   , hRememberContract = handleRememberContract@@ -117,7 +117,7 @@       }   } -handleGetBlockHash :: Monad m => BlockId -> TestT m Text+handleGetBlockHash :: Monad m => BlockId -> TestT m BlockHash handleGetBlockHash blkId = do   unless (blkId == FinalHeadId) do     throwString "Expected `getBlockHash` to be called with `head~2`."@@ -197,7 +197,7 @@   :: Monad m => OperationInput -> TestT m [Address] handleTransactionOrOrigination op = do   FakeState{..} <- get-  case oiCustom op of+  case wcoCustom op of     -- Ensure that transaction sender exists     OpTransfer TransactionOperation{..} -> case lookup codSource fsContracts of       Nothing -> throwM $ UnknownContract $ AddressResolved codSource@@ -220,7 +220,7 @@       -- We do not care about reveals at the moment       return []   where-    CommonOperationData{..} = oiCommonData op+    CommonOperationData{..} = wcoCommon op  -- | In most places, @morley-client@ executes operations against the @head@ block. assertHeadBlockId :: (HasCallStack, MonadThrow m) => BlockId -> m ()@@ -267,15 +267,8 @@   where     path = "/chains/main/blocks/head/context/big_maps/" <> show bigMapId <> "/" <> scriptExpr --- Here we have an alias with the prefix already added,--- so we can use 'Alias' instead 'AliasHint'.-getAlias :: AliasOrAliasHint -> Alias-getAlias = \case-  AnAlias x -> x-  AnAliasHint hint -> unsafeCoerceAliasHintToAlias hint--handleRememberContract :: Monad m => Bool -> Address -> AliasOrAliasHint -> TestT m ()-handleRememberContract replaceExisting addr (getAlias -> alias) = do+handleRememberContract :: Monad m => Bool -> Address -> Alias -> TestT m ()+handleRememberContract replaceExisting addr alias = do   let     cs = dumbContractState { csAlias = alias }     remember addr' cs' FakeState{..} =@@ -286,10 +279,10 @@     Nothing -> remember addr cs st     _       -> bool pass (remember addr cs st) replaceExisting -handleGenKey :: Monad m => AliasOrAliasHint -> TestT m Address-handleGenKey (getAlias -> alias) = do+handleGenKey :: Monad m => Alias -> TestT m Address+handleGenKey alias = do   let-    addr = detGenKeyAddress (encodeUtf8 $ unsafeGetAliasText alias)+    addr = detGenKeyAddress (encodeUtf8 $ unAlias alias)     newContractState = dumbImplicitContractState { csAlias =  alias }   modify $ \s ->     s & fsContractsL . at addr ?~ newContractState

@@ -31,8 +31,8 @@ import Control.Monad.Catch.Pure (CatchT(..)) import Data.ByteArray (ScrubbedBytes) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Fmt (pretty) -import Fmt import Morley.Client import Morley.Client.Logging (ClientLogAction) import Morley.Client.RPC@@ -40,22 +40,25 @@ import Morley.Micheline import Morley.Michelson.Typed.Scope (UntypedValScope) import Morley.Tezos.Address+import Morley.Tezos.Address.Alias (AddressOrAlias, Alias(..)) import Morley.Tezos.Core import Morley.Tezos.Crypto (KeyHash, PublicKey, SecretKey, Signature) import Morley.Util.ByteString  -- | A test-specific orphan. instance IsString Alias where-  fromString = mkAlias . fromString+  fromString = Alias . fromString  -- | Reader environment to interact with the fake state. data Handlers m = Handlers   { -- HasTezosRpc-    hGetBlockHash :: BlockId -> m Text+    hGetBlockHash :: BlockId -> m BlockHash   , hGetCounter :: BlockId -> Address -> m TezosInt64   , hGetBlockHeader :: BlockId -> m BlockHeader   , hGetBlockConstants :: BlockId -> m BlockConstants   , hGetBlockOperations :: BlockId -> m [[BlockOperation]]+  , hGetScriptSizeAtBlock :: BlockId -> CalcSize -> m ScriptSize+  , hGetBlockOperationHashes :: BlockId -> m [[OperationHash]]   , hGetProtocolParameters :: BlockId -> m ProtocolParameters   , hRunOperation :: BlockId -> RunOperation -> m RunOperationResult   , hPreApplyOperations :: BlockId -> [PreApplyOperation] -> m [RunOperationResult]@@ -73,22 +76,23 @@    -- HasTezosClient   , hSignBytes :: AddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature-  , hGenKey :: AliasOrAliasHint -> m Address-  , hGenFreshKey :: AliasOrAliasHint -> m Address+  , hGenKey :: Alias -> m Address+  , hGenFreshKey :: Alias -> m Address   , hRevealKey :: Alias -> Maybe ScrubbedBytes -> m ()-  , hWaitForOperation :: OperationHash -> m ()-  , hRememberContract :: Bool -> Address -> AliasOrAliasHint -> m ()-  , hImportKey :: Bool -> AliasOrAliasHint -> SecretKey -> m Alias+  , hWaitForOperation :: m OperationHash -> m OperationHash+  , hRememberContract :: Bool -> Address -> Alias -> m ()+  , hImportKey :: Bool -> Alias -> SecretKey -> m Alias   , hResolveAddressMaybe :: AddressOrAlias -> m (Maybe Address)   , hGetAlias :: AddressOrAlias -> m Alias   , hGetPublicKey :: AddressOrAlias -> m PublicKey+  , hGetSecretKey :: AddressOrAlias -> m SecretKey   , hGetTezosClientConfig :: m TezosClientConfig   , hCalcTransferFee     :: AddressOrAlias -> Maybe ScrubbedBytes -> TezosInt64 -> [CalcTransferFeeData] -> m [TezosMutez]   , hCalcOriginationFee     :: forall cp st. UntypedValScope st => CalcOriginationFeeData cp st -> m TezosMutez   , hGetKeyPassword :: Address -> m (Maybe ScrubbedBytes)-  , hRegisterDelegate :: AliasOrAliasHint -> Maybe ScrubbedBytes -> m ()+  , hRegisterDelegate :: Alias -> Maybe ScrubbedBytes -> m ()    -- HasLog   , hLogAction :: ClientLogAction m@@ -100,7 +104,9 @@   , hGetCounter = \_ _ -> throwM $ UnexpectedRpcCall "getCounter"   , hGetBlockHeader = \_ -> throwM $ UnexpectedRpcCall "getBlockHeader"   , hGetBlockConstants = \_ -> throwM $ UnexpectedRpcCall "getBlockConstants"+  , hGetScriptSizeAtBlock = \_ _ -> throwM $ UnexpectedRpcCall "getScriptSizeAtBlock"   , hGetBlockOperations = \_ -> throwM $ UnexpectedRpcCall "getBlockOperations"+  , hGetBlockOperationHashes = \_ -> throwM $ UnexpectedRpcCall "hGetBlockOperationHashes"   , hGetProtocolParameters = \_ -> throwM $ UnexpectedRpcCall "getProtocolParameters"   , hRunOperation = \_ _ -> throwM $ UnexpectedRpcCall "runOperation"   , hPreApplyOperations = \_ _ -> throwM $ UnexpectedRpcCall "preApplyOperations"@@ -126,6 +132,7 @@   , hResolveAddressMaybe = \_ -> throwM $ UnexpectedRpcCall "resolveAddressMaybe"   , hGetAlias = \_ -> throwM $ UnexpectedRpcCall "getAlias"   , hGetPublicKey = \_ -> throwM $ UnexpectedRpcCall "getPublicKey"+  , hGetSecretKey = \_ -> throwM $ UnexpectedRpcCall "getSecretKey"   , hGetTezosClientConfig = throwM $ UnexpectedClientCall "getTezosClientConfig"   , hCalcTransferFee = \_ _ _ _ -> throwM $ UnexpectedClientCall "calcTransferFee"   , hCalcOriginationFee = \_ -> throwM $ UnexpectedClientCall "calcOriginationFee"@@ -162,9 +169,9 @@ -- | Type to represent chain state in mock tests. data FakeState = FakeState   { fsContracts :: Map Address ContractState-  , fsHeadBlock :: Text+  , fsHeadBlock :: BlockHash   -- ^ Hash of the `head` block-  , fsFinalHeadBlock :: Text+  , fsFinalHeadBlock :: BlockHash   -- ^ Hash of the `head~2` block   , fsBlockConstants :: BlockId -> BlockConstants   , fsProtocolParameters :: ProtocolParameters@@ -173,8 +180,8 @@ defaultFakeState :: FakeState defaultFakeState = FakeState   { fsContracts = mempty-  , fsHeadBlock = "HEAD"-  , fsFinalHeadBlock = "HEAD~2"+  , fsHeadBlock = BlockHash "HEAD"+  , fsFinalHeadBlock = BlockHash "HEAD~2"   , fsBlockConstants = \blkId -> BlockConstants     { bcProtocol = "PROTOCOL"     , bcChainId = "CHAIN_ID"@@ -221,7 +228,7 @@   | CantRevealContract Address   | InvalidChainId   | InvalidProtocol-  | InvalidBranch Text+  | InvalidBranch BlockHash   | CounterMismatch   deriving stock Show @@ -245,9 +252,6 @@   revealKey alias mbPassword = do     h <- getHandler hRevealKey     h alias mbPassword-  waitForOperation op = do-    h <- getHandler hWaitForOperation-    h op   rememberContract replaceExisting addr alias = do     h <- getHandler hRememberContract     h replaceExisting addr alias@@ -263,13 +267,16 @@   getPublicKey alias = do     h <- getHandler hGetPublicKey     h alias+  getSecretKey alias = do+    h <- getHandler hGetSecretKey+    h alias   getTezosClientConfig =     join $ getHandler hGetTezosClientConfig   calcTransferFee from mbPassword burnCap transferDatas = do     h <- getHandler hCalcTransferFee     h from mbPassword burnCap transferDatas   calcOriginationFee origData = do-    h <- getHandler hCalcOriginationFee+    h <- getHandler (\hs -> hCalcOriginationFee hs)     h origData   getKeyPassword addr = do     h <- getHandler hGetKeyPassword@@ -303,6 +310,9 @@   preApplyOperationsAtBlock block ops = do     h <- getHandler hPreApplyOperations     h block ops+  getScriptSizeAtBlock block script = do+    h <- getHandler hGetScriptSizeAtBlock+    h block script   forgeOperationAtBlock block op = do     h <- getHandler hForgeOperation     h block op@@ -337,5 +347,11 @@   getDelegateAtBlock block addr = do     h <- getHandler hGetDelegateAtBlock     h block addr+  getBlockOperationHashes block = do+    h <- getHandler hGetBlockOperationHashes+    h block+  waitForOperation opHash = do+    h <- getHandler hWaitForOperation+    h opHash  makeLensesFor [("fsContracts", "fsContractsL")] ''FakeState