morley-client 0.3.1 → 0.3.2

raw patch · 34 files changed

+1732/−1520 lines, 34 filesdep +bimapdep −fmt

Dependencies added: bimap

Dependencies removed: fmt

Files

• CHANGES.md +25/−0
• app/Main.hs +39/−143
• morley-client.cabal +10/−9
• src/Morley/Client.hs +1/−0
• src/Morley/Client/Action/Batched.hs +1/−1
• src/Morley/Client/Action/Common.hs +19/−16
• src/Morley/Client/Action/Operation.hs +10/−10
• src/Morley/Client/Action/Reveal.hs +0/−45
• src/Morley/Client/Action/Transaction.hs +3/−3
• src/Morley/Client/App.hs +37/−9
• src/Morley/Client/Full.hs +1/−130
• src/Morley/Client/OnlyRPC.hs +6/−3
• src/Morley/Client/Parser.hs +292/−272
• src/Morley/Client/RPC/API.hs +7/−2
• src/Morley/Client/RPC/Aeson.hs +15/−3
• src/Morley/Client/RPC/Class.hs +3/−0
• src/Morley/Client/RPC/Error.hs +23/−1
• src/Morley/Client/RPC/Types.hs +227/−128
• src/Morley/Client/TezosClient/Class.hs +4/−22
• src/Morley/Client/TezosClient/Config.hs +39/−0
• src/Morley/Client/TezosClient/Helpers.hs +138/−0
• src/Morley/Client/TezosClient/Impl.hs +138/−680
• src/Morley/Client/TezosClient/Resolve.hs +246/−0
• src/Morley/Client/TezosClient/Types.hs +28/−15
• src/Morley/Client/TezosClient/Types/Errors.hs +158/−0
• src/Morley/Client/TezosClient/Types/MorleyClientM.hs +138/−0
• src/Morley/Client/Types.hs +10/−1
• src/Morley/Client/Types/AliasesAndAddresses.hs +54/−0
• src/Morley/Client/Util.hs +2/−2
• test/Test/Errors.hs +10/−9
• test/Test/Fees.hs +2/−2
• test/Test/Util.hs +35/−12
• test/TestM.hs +9/−1
• test/data/constants.json +2/−1

@@ -1,6 +1,31 @@ <!-- Unreleased: append new entries here -->  +0.3.2+=====+* [!1350](https://gitlab.com/morley-framework/morley/-/merge_requests/1350)+  Add caching of address/alias mappings to morley-client+* [!1357](https://gitlab.com/morley-framework/morley/-/merge_requests/1357)+  Better tests for `PACK`+  + Add `pack_data` RPC endpoint support+* [!1361](https://gitlab.com/morley-framework/morley/-/merge_requests/1361)+  Add an `Ord` instance for `AddressWithAlias`+* [!1345](https://gitlab.com/morley-framework/morley/-/merge_requests/1345)+  Add RPC error response logs+* [!1342](https://gitlab.com/morley-framework/morley/-/merge_requests/1342)+  Replace fmt with prettyprinter+  + Improve formatting for operations and errors+* [!1323](https://gitlab.com/morley-framework/morley/-/merge_requests/1323)+  Trace called contracts on error+  + Reduce duplication of RPC types and parse more responses+  + Trace internal operations in morley-client+* [!1335](https://gitlab.com/morley-framework/morley/-/merge_requests/1335)+  Include morley CLI commands with morley-client+* [!1340](https://gitlab.com/morley-framework/morley/-/merge_requests/1340)+  Remove deprecated types and functions+  + `revealKeyOp`+  + `revealKeyUnlessRevealedOp`+ 0.3.1 ===== * [!1331](https://gitlab.com/morley-framework/morley/-/merge_requests/1331)

@@ -5,152 +5,15 @@   ( main   ) where -import Control.Exception.Safe (throwString)-import Data.Aeson qualified as Aeson-import Data.Default (def)-import Data.Singletons (demote, fromSing)-import Data.Type.Equality (pattern Refl)-import Fmt (blockListF, build, nameF, pretty, (+|), (|+)) import GHC.IO.Encoding (setFileSystemEncoding) import Options.Applicative qualified as Opt+import Options.Applicative.Help.Pretty (Doc, linebreak) import System.IO (utf8) -import Morley.Client import Morley.Client.Parser-import Morley.Client.RPC-import Morley.Client.Util (extractAddressesFromValue)-import Morley.Micheline (fromExpression, toExpression, unStringEncode)-import Morley.Michelson.Runtime (prepareContract)-import Morley.Michelson.TypeCheck qualified as TC-import Morley.Michelson.Typed (Contract, Contract'(..), SomeContract(..))-import Morley.Michelson.Typed qualified as T-import Morley.Michelson.Typed.Value (Value'(..))-import Morley.Michelson.Untyped qualified as U-import Morley.Tezos.Address-import Morley.Tezos.Core (prettyTez)-import Morley.Util.Constrained-import Morley.Util.Exception (throwLeft)+import Morley.Client.Util import Morley.Util.Main (wrapMain)--mainImpl :: ClientArgsRaw -> MorleyClientM ()-mainImpl cmd =-  case cmd of-    Originate OriginateArgs{..} -> do-      contract <- liftIO $ prepareContract oaMbContractFile-      let originator = oaOriginateFrom-      originatorAA <- resolveAddressWithAlias originator-      (operationHash, contractAddr) <--        originateUntypedContract OverwriteDuplicateAlias oaContractName originatorAA oaInitialBalance-          contract oaInitialStorage oaMbFee oaDelegate--      putTextLn "Contract was successfully deployed."-      putTextLn $ "Operation hash: " <> pretty operationHash-      putTextLn $ "Contract address: " <> formatAddress contractAddr--    Transfer TransferArgs{..} -> do-      sendAddress <- resolveAddressWithAlias taSender-      destAddress <- resolveAddress taDestination-      (operationHash, contractEvents) :: (OperationHash, [IntOpEvent]) <--        withConstrained destAddress \case-          destContract@ContractAddress{} -> do-            contract <- getContract destContract-            SomeContract (Contract{} :: Contract cp st) <--              throwLeft $ pure $ TC.typeCheckingWith def $ TC.typeCheckContract contract-            let addrs = extractAddressesFromValue taParameter & mapMaybe \case-                  MkAddress x@ContractAddress{} -> Just x-                  _ -> Nothing-            tcOriginatedContracts <- getContractsParameterTypes addrs-            parameter <- throwLeft $ pure $ TC.typeCheckingWith def $-              TC.typeVerifyParameter @cp tcOriginatedContracts taParameter-            transfer sendAddress destContract taAmount U.DefEpName parameter taMbFee-          destImplicit@ImplicitAddress {} -> case taParameter of-            U.ValueUnit -> transfer sendAddress destImplicit taAmount U.DefEpName VUnit Nothing-            _ -> throwString ("The transaction parameter must be 'Unit' "-              <> "when transferring to an implicit account")--      putTextLn $ "Transaction was successfully sent.\nOperation hash " <> pretty operationHash <> "."-      unless (null contractEvents) do-        putTextLn $ "Additionally, the following contract events were emitted:"-        putTextLn $ pretty $ blockListF contractEvents--    TransferTicket TransferTicketArgs{..} -> T.withUType ttaTicketType \(_ :: T.Notes t) -> do-      T.Dict <- throwLeft $ pure $ first (TC.UnsupportedTypeForScope (demote @t))-        $ T.checkScope @(T.ParameterScope t, T.Comparable t)-      sendAddress <- resolveAddressWithAlias ttaSender-      destAddress <- resolveAddress ttaDestination-      ticketer <- resolveAddress ttaTicketTicketer-      (operationHash, contractEvents) :: (OperationHash, [IntOpEvent]) <--        withConstrained destAddress \case-          destContract@ContractAddress{} -> do-            contract <- getContract destContract-            SomeContract (Contract{} :: Contract cp st) <--              throwLeft $ pure $ TC.typeCheckingWith def $ TC.typeCheckContract contract-            Constrained (_ :: T.SingT t') :: Constrained T.SingI T.SingT <- case T.sing @cp of-              T.STTicket x -> pure $ Constrained @T.SingI x-              x -> throwM $ TC.TcContractError @U.ExpandedOp-                ("Expected contract to accept tickets, but it had type " <> pretty (fromSing x))-                $ Just $ TC.UnexpectedType (one $ one $ "ticket 'a")-            Refl <- T.requireEq @t @t' $ throwM . TC.TypeEqError-            parameter <- throwLeft $ pure $ TC.typeCheckingWith def $ do-              TC.typeCheckValue @t' ttaTicketContents-            transferTicket @_ @t' sendAddress destContract ticketer parameter ttaTicketAmount-              U.DefEpName ttaMbFee-          destImplicit@ImplicitAddress{} -> do-            parameter <- throwLeft $ pure $ TC.typeCheckingWith def $-                  TC.typeCheckValue @t ttaTicketContents-            transferTicket sendAddress destImplicit ticketer parameter ttaTicketAmount-                  U.DefEpName ttaMbFee--      putTextLn $ "Tickets successfully sent.\nOperation hash " <> pretty operationHash <> "."-      unless (null contractEvents) do-        putTextLn $ "Additionally, the following contract events were emitted:"-        putTextLn $ pretty $ blockListF contractEvents--    GetBalance addrOrAlias -> do-      balance <- getBalance =<< resolveAddress addrOrAlias-      putTextLn $ prettyTez balance--    GetBlockHeader blockId -> do-      blockHeader <- getBlockHeader blockId-      putStrLn $ Aeson.encode blockHeader--    GetScriptSize GetScriptSizeArgs{..} -> do-      contract <- liftIO $ prepareContract (Just ssScriptFile)-      void . throwLeft . pure . TC.typeCheckingWith def $-        TC.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_ (orwmResponse <$> boContents) \case-            TransactionOpResp to -> putStrLn $ Aeson.encode to-            OtherOpResp -> putTextLn "Non-transaction operation"-          putTextLn ""-      putTextLn "——————————————————————————————————————————————————\n"-    TicketBalance owner' TicketBalanceArgs{..} -> do-      owner <- resolveAddress owner'-      bal <- getTicketBalance owner GetTicketBalance-        { gtbContent = toExpression tbaContent-        , gtbContentType = toExpression tbaContentType-        , gtbTicketer = tbaTicketer-        }-      print bal-    AllTicketBalances owner' -> do-      owner <- resolveAddress owner'-      bals <- getAllTicketBalances owner-      forM_ bals \GetAllTicketBalancesResponse{..} -> do-        content <- either throwM pure $ fromExpression @U.Value gatbrContent-        ty <- either throwM pure $ fromExpression @U.Ty gatbrContentType-        putTextLn $ pretty @Text $-          nameF "Ticketer" (build gatbrTicketer) |+ ", "-          +| nameF "content" (build content) |+ ", "-          +| nameF "type" (build ty) |+ ", "-          +| nameF "amount" (build $ unStringEncode gatbrAmount)+import Morley.Util.Named  main :: IO () main = wrapMain $ do@@ -162,6 +25,39 @@   setFileSystemEncoding utf8    disableAlphanetWarning-  ClientArgs parsedConfig cmd <- Opt.execParser morleyClientInfo-  env <- mkMorleyClientEnv parsedConfig-  runMorleyClientM env (mainImpl cmd)+  join $ Opt.execParser $ parserInfo+    ! #usage usageDoc+    ! #description "Morley Client: RPC client for interaction with tezos node"+    ! #header "Morley Client"+    ! #parser clientParser++usageDoc :: Doc+usageDoc = mconcat+  [ "You can use help for specific COMMAND", linebreak+  , "EXAMPLE:", linebreak+  , "morley-client originate --help", linebreak+  , linebreak+  , "Documentation for morley tools can be found at the following links:", linebreak+  , "  https://gitlab.com/morley-framework/morley/blob/master/README.md", linebreak+  , "  https://gitlab.com/morley-framework/morley/tree/master/docs", linebreak+  , linebreak+  , "Sample contracts for running can be found at the following link:", linebreak+  , "  https://gitlab.com/morley-framework/morley/tree/master/contracts", linebreak+  , linebreak+  , "USAGE EXAMPLE:", linebreak+  , "morley-client -E florence.testnet.tezos.serokell.team:8732 originate \\", linebreak+  , "  --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak+  , "  --contract ../contracts/tezos_examples/attic/add1.tz --initial-balance 1 --initial-storage 0", linebreak+  , linebreak+  , "  This command will originate contract with code stored in add1.tz", linebreak+  , "  on real network with initial balance 1 and initial storage set to 0", linebreak+  , "  and return info about operation: operation hash and originated contract address", linebreak+  , linebreak+  , "morley-client -E florence.testnet.tezos.serokell.team:8732 transfer \\", linebreak+  , "  --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak+  , "  --to KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW --amount 1 --parameter 0", linebreak+  , linebreak+  , "  This command will perform tranfer to contract with address on real network", linebreak+  , "  KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW with amount 1 and parameter 0", linebreak+  , "  as a result it will return operation hash"+  ]

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morley-client-version:        0.3.1+version:        0.3.2 synopsis:       Client to interact with the Tezos blockchain description:    A client to interact with the Tezos blockchain, by use of the octez-node RPC and/or of the octez-client binary. category:       Blockchain@@ -56,10 +56,16 @@       Morley.Client.RPC.Types       Morley.Client.TezosClient       Morley.Client.TezosClient.Class+      Morley.Client.TezosClient.Config+      Morley.Client.TezosClient.Helpers       Morley.Client.TezosClient.Impl       Morley.Client.TezosClient.Parser+      Morley.Client.TezosClient.Resolve       Morley.Client.TezosClient.Types+      Morley.Client.TezosClient.Types.Errors+      Morley.Client.TezosClient.Types.MorleyClientM       Morley.Client.Types+      Morley.Client.Types.AliasesAndAddresses       Morley.Client.Util       Morley.Util.Batching   other-modules:@@ -126,6 +132,7 @@       aeson     , aeson-casing     , base-noprelude >=4.7 && <5+    , bimap     , binary     , bytestring     , co-log@@ -134,7 +141,6 @@     , constraints     , containers     , data-default-    , fmt     , hex-text     , http-client     , http-client-tls@@ -149,6 +155,7 @@     , optparse-applicative     , process     , random+    , safe-exceptions     , scientific     , servant     , servant-client@@ -219,16 +226,11 @@       ViewPatterns   ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode   build-depends:-      aeson-    , base-noprelude >=4.7 && <5-    , data-default-    , fmt+      base-noprelude >=4.7 && <5     , morley     , morley-client     , morley-prelude     , optparse-applicative-    , safe-exceptions-    , singletons   default-language: Haskell2010  test-suite morley-client-test@@ -316,7 +318,6 @@     , co-log     , co-log-core     , exceptions-    , fmt     , hex-text     , hspec-expectations     , http-types

@@ -58,6 +58,7 @@    -- ** Errors   , ClientRpcError (..)+  , ClientRpcErrorWithStack (..)   , UnexpectedErrors (..)   , IncorrectRpcResponse (..)   , RunError (..)

@@ -68,7 +68,7 @@     maybeToRight UnexpectedOperationResult . (^? unwrapOut)  -- | Perform transaction within a batch.-runTransactionM :: TransactionData -> OperationsBatch [IntOpEvent]+runTransactionM :: TransactionData -> OperationsBatch [WithSource EventOperation] runTransactionM = runOperationM OpTransfer _OpTransfer  -- | Perform origination within a batch.

@@ -32,7 +32,7 @@ import Control.Lens (Prism') import Data.ByteString (cons) import Data.Default (def)-import Fmt (Buildable(..), Builder, (+|), (|+))+import Fmt (Buildable(..), Doc, (+|), (|+))  import Morley.Client.RPC.Class import Morley.Client.RPC.Error@@ -83,16 +83,16 @@   build = buildTxDataWithAlias Nothing  -- | Builds 'TransactionData' with additional info about receiver's alias, if present.-buildTxDataWithAlias :: Maybe Text -> TransactionData -> Builder+buildTxDataWithAlias :: Maybe SomeAlias -> TransactionData -> Doc buildTxDataWithAlias mbAlias (TransactionData TD{..}) =   "To: " +| tdReceiver |+ buildMbAlias mbAlias |+ ". EP: " +| tdEpName |+   ". Parameter: " +| tdParam |+ ". Amount: " +| tdAmount |+ ""   where-    buildMbAlias :: Maybe Text -> Builder+    buildMbAlias :: Maybe SomeAlias -> Doc     buildMbAlias = maybe "" $ \a -> " (" +| a |+ ")"  -- | Builds 'TransactionData' with additional info about receiver's alias, if present.-buildTxTicketDataWithAlias :: Maybe Text -> TransferTicketData -> Builder+buildTxTicketDataWithAlias :: Maybe SomeAlias -> TransferTicketData -> Doc buildTxTicketDataWithAlias mbAlias   (TransferTicketData contents ticketer amount dest ep _mbFee) =   "To: " +| dest |+ buildMbAlias mbAlias |+ ". EP: " +| ep@@ -101,7 +101,7 @@   |+ " amount: " +| amount   |+ ""   where-    buildMbAlias :: Maybe Text -> Builder+    buildMbAlias :: Maybe SomeAlias -> Doc     buildMbAlias = maybe "" $ \a -> " (" +| a |+ ")"  -- | Data for a single origination in a batch@@ -192,7 +192,7 @@ -- will be thrown. getAppliedResults   :: (HasTezosRpc m)-  => Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult, [InternalOperationData])+  => Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult, [OperationResp WithSource]) getAppliedResults op = do   (runResult, expectedContentsSize) <- case op of     Left runOp ->@@ -209,33 +209,36 @@  -- | 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, [InternalOperationData])+handleOperationResult+  :: MonadThrow m+  => RunOperationResult -> Int -> m (NonEmpty AppliedResult, [OperationResp WithSource]) handleOperationResult RunOperationResult{..} expectedContentsSize = do   when (length rrOperationContents /= expectedContentsSize) $     throwM $ RpcUnexpectedSize expectedContentsSize (length rrOperationContents)    let (appliedResults, runErrors) =         sconcat $ first pure . collectResults <$> rrOperationContents-      ioDatas = concatMap (map ioData . rmInternalOperationResults . unOperationContent)+      ioDatas = concatMap (map ioData . rmInternalOperationResults . ocMetadata)         $ toList rrOperationContents+      ops = sconcat $ rrOperationContents <&> \op ->+        ocOperation op :| (fmap ioData $ rmInternalOperationResults $ ocMetadata op) -  whenJust runErrors handleErrors+  whenJust runErrors $ handleErrors ops    pure (appliedResults, ioDatas)    where     collectResults :: OperationContent -> (AppliedResult, Maybe [RunError])-    collectResults (OperationContent (RunMetadata res internalOps)) =+    collectResults (OperationContent _ (RunMetadata res internalOps)) =       res : map ioResult internalOps       & flip foldr (mempty, Nothing) \case         OperationApplied result -> first (result <>)         OperationFailed errors -> second (Just errors <>) -    handleErrors :: MonadThrow m => [RunError] -> m a-    handleErrors errs-      | Just err <- runErrorsToClientError errs = throwM err-      | otherwise = throwM $ UnexpectedRunErrors errs+    handleErrors :: MonadThrow m => NonEmpty (OperationResp WithSource) -> [RunError] -> m a+    handleErrors iops errs+      | Just err <- runErrorsToClientError errs = throwM $ ClientRpcErrorWithStack iops err+      | otherwise = throwM $ ClientRpcErrorWithStack iops $ UnexpectedRunErrors errs   -- | When an error happens, we will get a list of 'RunError' in response. This@@ -323,7 +326,7 @@ computeStorageLimit appliedResults pp = sum $ map (\ar -> sum   [ arPaidStorageDiff ar   , (arAllocatedDestinationContracts ar) * fromIntegral (ppOriginationSize pp)-  , fromIntegral (length $ arOriginatedContracts ar) * fromIntegral (ppOriginationSize pp)+  , length (arOriginatedContracts ar) * fromIntegral (ppOriginationSize pp)   ]) appliedResults  -- | Update common operation data based on preliminary run which estimates storage and

@@ -13,7 +13,6 @@ import Control.Lens (has, (%=), (&~)) import Data.List (zipWith4) import Data.List.NonEmpty qualified as NE-import Data.Map qualified as Map import Data.Ratio ((%)) import Data.Singletons (Sing, SingI, demote, sing) import Data.Text qualified as T@@ -27,6 +26,7 @@ import Morley.Client.RPC.Types import Morley.Client.TezosClient import Morley.Client.Types+import Morley.Client.Types.AliasesAndAddresses import Morley.Client.Util (epNameToTezosEp) import Morley.Micheline (StringEncode(..), TezosInt64, TezosMutez(..), toExpression) import Morley.Michelson.Typed (Value)@@ -41,8 +41,8 @@ -- | Designates output of an operation. data Result instance OperationInfoDescriptor Result where-  type TransferInfo Result = [IntOpEvent]-  type TransferTicketInfo Result = [IntOpEvent]+  type TransferInfo Result = [WithSource EventOperation]+  type TransferTicketInfo Result = [WithSource EventOperation]   type OriginationInfo Result = ContractAddress   type RevealInfo Result = ()   type DelegationInfo Result = ()@@ -83,11 +83,11 @@         OpDelegation{} -> True    anas <- if needsAliasStore-    then Map.fromList . fmap swap <$> getAliasesAndAddresses-    else pure mempty+    then getAliasesAndAddresses+    else pure emptyAliasesAndAddresses -  let mbAlias :: KindedAddress k -> Maybe Text-      mbAlias addr = Map.lookup (pretty addr) anas+  let mbAlias :: KindedAddress k -> Maybe SomeAlias+      mbAlias = fmap Constrained . flip lookupAlias anas    let aliases = ops <&> \case         OpTransfer (TransactionData tx) -> withConstrained (tdReceiver tx) mbAlias@@ -248,7 +248,7 @@           commonData = mkCommonOperationData pp             ! #sender senderAddress             ! #counter (ocCounter + i)-            ! #num_operations (fromIntegral (length operations))+            ! #num_operations (length @Int64 operations)    let opsToRun = NE.zipWith convertOps (1 :| [(2 :: TezosInt64)..]) operations       mbFees = operations <&> \case@@ -406,9 +406,9 @@           runOperationsNonEmptyHelper @runMode (retryCount - 1) sender operations         e -> throwM e   where-    iopsDataToEmitOp :: InternalOperationData -> Maybe IntOpEvent+    iopsDataToEmitOp :: OperationResp WithSource -> Maybe (WithSource EventOperation)     iopsDataToEmitOp = \case-      IODEvent evt -> Just evt+      EventOpResp evt -> Just evt       _ -> Nothing      mayNeedSenderRevealing :: [OperationInfo i] -> Bool

@@ -8,8 +8,6 @@   , revealKeyWithFee   , revealKeyUnlessRevealed   , revealKeyUnlessRevealedWithFee-  , revealKeyOp-  , revealKeyUnlessRevealedOp   ) where  import Fmt ((|+))@@ -22,10 +20,8 @@ import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Client.TezosClient.Class (HasTezosClient(getPublicKey))-import Morley.Client.TezosClient.Impl (getAlias) import Morley.Client.Types import Morley.Tezos.Address-import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (Mutez) import Morley.Tezos.Crypto (PublicKey) @@ -57,47 +53,6 @@ revealKeyUnlessRevealedWithFee sender mbFee = do   pk <- getPublicKey sender   handleAlreadyRevealed (flip (runRevealOperationRaw sender) mbFee) pk---- | Reveal given key.------ Note that sender is implicitly defined by the key being revealed, as you can--- only reveal your own key.------ This is a variation of key revealing method that tries to use solely RPC.-revealKeyOp--- TODO [#873] remove HasTezosClient dependency-  :: forall m env.-     ( HasTezosRpc m-     , HasTezosClient m-     , WithClientLog env m-     )-  => PublicKey-  -> Maybe Mutez-  -> m OperationHash-revealKeyOp pk mbFee = do-  senderAlias <- getAlias $ AddressResolved senderAddress-  runRevealOperationRaw (AddressWithAlias senderAddress senderAlias) pk mbFee-  where-    senderAddress = mkKeyAddress pk-{-# DEPRECATED revealKeyOp "Prefer using 'revealKeyWithFee', as it's a lot more efficient" #-}---- | Reveal given key.------ Note that sender is implicitly defined by the key being revealed, as you can--- only reveal your own key.-revealKeyUnlessRevealedOp--- TODO [#873] remove HasTezosClient dependency-  :: forall m env.-     ( HasTezosRpc m-     , HasTezosClient m-     , WithClientLog env m-     )-  => PublicKey-  -> Maybe Mutez-  -> m ()-revealKeyUnlessRevealedOp key mbFee = handleAlreadyRevealed (flip revealKeyOp mbFee) key-{-# DEPRECATED revealKeyUnlessRevealedOp-  "Prefer using 'revealKeyUnlessRevealedWithFee', as it's a lot more efficient" #-}  -- Internals 

@@ -96,7 +96,7 @@   -> EpName   -> T.Value t   -> Maybe Mutez-  -> m (OperationHash, [IntOpEvent])+  -> m (OperationHash, [WithSource EventOperation]) transfer from (Constrained -> tdReceiver) tdAmount tdEpName tdParam tdMbFee =   (fmap . second) (getEvents . toList) . runTransactionsNonEmpty from . one $ TransactionData TD{..}   where@@ -119,7 +119,7 @@   -> Natural -- ^ Ticket amount   -> EpName -- ^ Destination entrypoint   -> Maybe Mutez -- ^ Fee-  -> m (OperationHash, [IntOpEvent])+  -> m (OperationHash, [WithSource EventOperation]) transferTicket from (Constrained -> ttdDestination)   (Constrained -> ttdTicketTicketer) ttdTicketContents   ttdTicketAmount ttdEntrypoint ttdMbFee =@@ -144,5 +144,5 @@   -> EpName   -> t   -> Maybe Mutez-  -> m (OperationHash, [IntOpEvent])+  -> m (OperationHash, [WithSource EventOperation]) lTransfer from to amount epName = transfer from to amount epName . T.toVal

@@ -35,6 +35,7 @@   , waitForOperationImpl   , getTicketBalanceAtBlockImpl   , getAllTicketBalancesAtBlockImpl+  , packDataImpl    -- * Timeouts and retries   , retryOnTimeout@@ -50,7 +51,7 @@ import Data.Aeson qualified as Aeson import Data.Binary.Builder qualified as Binary import Data.Text (isInfixOf)-import Fmt (Buildable(..), Builder, build, pretty, (+|), (|+))+import Fmt (Buildable(..), Doc, build, pretty, (+|), (|+)) import Network.HTTP.Types (Status(..), renderQuery) import Servant.Client (ClientEnv, runClientM) import Servant.Client.Core@@ -66,7 +67,9 @@ import Morley.Client.Logging (WithClientLog, logDebug) import Morley.Client.RPC import Morley.Client.RPC.API qualified as API-import Morley.Micheline (Expression, TezosInt64, TezosNat, unStringEncode, unTezosMutez)+import Morley.Micheline+  (Expression, TezosInt64, TezosNat, toExpression, unStringEncode, unTezosMutez)+import Morley.Michelson.Typed qualified as T import Morley.Tezos.Address import Morley.Tezos.Core (ChainId, Mutez, parseChainId) import Morley.Tezos.Crypto (KeyHash, PublicKey)@@ -77,15 +80,29 @@ -- RunClient functions ---------------- -runRequestAcceptStatusImpl ::-  (WithClientLog env m, MonadIO m, MonadThrow m) =>-  ClientEnv -> Maybe [Status] -> Request -> m Response+runRequestAcceptStatusImpl+  :: forall env m. (WithClientLog env m, MonadIO m, MonadThrow m)+  => ClientEnv -> Maybe [Status] -> Request -> m Response runRequestAcceptStatusImpl env _ req = do   logRequest req-  response <- either throwClientErrorImpl pure =<<+  response <- either logResponseAndThrowError pure =<<     liftIO (runClientM (runRequest req) env)   response <$ logResponse response +  where+    getResponse :: ClientError -> Maybe Response+    getResponse = \case+      FailureResponse _ response -> Just response+      DecodeFailure _ response -> Just response+      UnsupportedContentType _ response -> Just response+      InvalidContentTypeHeader response -> Just response+      ConnectionError{} -> Nothing++    logResponseAndThrowError :: ClientError -> m Response+    logResponseAndThrowError err = do+      whenJust (getResponse err) logResponse+      throwClientErrorImpl err+ throwClientErrorImpl :: forall m a . MonadThrow m => ClientError -> m a throwClientErrorImpl err = case err of   FailureResponse _ resp@@ -221,6 +238,17 @@ getChainIdImpl :: (RunClient m, MonadCatch m) => m ChainId getChainIdImpl = throwLeft $ parseChainId <$> API.getChainId API.nodeMethods +packDataImpl+  :: (T.ForbidOp t, RunClient m, MonadCatch m, MonadUnliftIO m)+  => BlockId -> T.Value t -> T.Notes t -> m Text+packDataImpl blkId val notes = retryOnceOnTimeout do+  PackDataResult{..} <- API.packData API.nodeMethods blkId PackData+     { pdData = toExpression val+     , pdType = toExpression notes+     , pdGas = Nothing+     }+  pure pdrPacked+ waitForOperationImpl :: forall m                       . (MonadUnliftIO m, HasTezosRpc m)                      => m OperationHash@@ -294,7 +322,7 @@ fromBS :: ConvertUtf8 Text bs => bs -> Text fromBS = decodeUtf8 -ppRequestBody :: RequestBody -> Builder+ppRequestBody :: RequestBody -> Doc ppRequestBody = build .   \case     RequestBodyLBS lbs -> fromBS lbs@@ -306,7 +334,7 @@ -- path and query, request body. We don't print other things that are -- subjectively less interesting such as HTTP version or media type. -- But feel free to add them if you want.-ppRequest :: Request -> Builder+ppRequest :: Request -> Doc ppRequest Request {..} =   fromBS requestMethod |+ " " +| fromBS (Binary.toLazyByteString requestPath)   |+ fromBS (renderQuery True $ toList requestQueryString) |+@@ -321,7 +349,7 @@ -- -- If response is not human-readable text in UTF-8 encoding it will -- print some garbage.  Apparently we don't make such requests for now.-ppResponse :: Response -> Builder+ppResponse :: Response -> Doc ppResponse Response {..} =   statusCode responseStatusCode |+ " " +|   fromBS (statusMessage responseStatusCode) |+ "\n" +|

@@ -22,134 +22,5 @@   , mccSecretKeyL   ) where -import Colog (HasLog(..), Message)-import Network.HTTP.Types (Status(..))-import Servant.Client (ClientEnv)-import Servant.Client.Core (Request, Response, RunClient(..))-import System.Environment (lookupEnv)-import UnliftIO (MonadUnliftIO)--import Morley.Client.App import Morley.Client.Init-import Morley.Client.Logging (ClientLogAction)-import Morley.Client.RPC.Class-import Morley.Client.RPC.HttpClient-import Morley.Client.TezosClient.Class-import Morley.Client.TezosClient.Impl (getTezosClientConfig)-import Morley.Client.TezosClient.Impl qualified as TezosClient-import Morley.Client.TezosClient.Types-import Morley.Client.Types-import Morley.Tezos.Crypto (Signature(..))-import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519-import Morley.Util.Lens (makeLensesWith, postfixLFields)----- | Runtime environment for morley client.-data MorleyClientEnv = MorleyClientEnv-  { mceTezosClient :: TezosClientEnv-  -- ^ Environment for @octez-client@.-  , mceLogAction :: ClientLogAction MorleyClientM-  -- ^ Action used to log messages.-  , mceSecretKey :: Maybe Ed25519.SecretKey-  -- ^ Pass if you want to sign operations manually or leave it-  -- to @octez-client@.-  , mceClientEnv :: ClientEnv-  -- ^ Environment necessary to make HTTP calls.-  }--newtype MorleyClientM a = MorleyClientM-  { unMorleyClientM :: ReaderT MorleyClientEnv IO a }-  deriving newtype-    ( Functor, Applicative, Monad, MonadReader MorleyClientEnv-    , MonadIO, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO-    )---- | 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--makeLensesWith postfixLFields ''MorleyClientEnv--instance HasTezosClientEnv MorleyClientEnv where-  tezosClientEnvL = mceTezosClientL--instance HasLog MorleyClientEnv Message MorleyClientM where-  getLogAction = mceLogAction-  setLogAction action mce = mce { mceLogAction = action }--instance HasTezosClient MorleyClientM where-  signBytes (AddressWithAlias _ senderAlias) mbPassword opHash = retryOnceOnTimeout $ do-    env <- ask-    case mceSecretKey env of-      Just sk -> pure . SignatureEd25519 $ Ed25519.sign sk opHash-      Nothing -> TezosClient.signBytes senderAlias mbPassword opHash-  rememberContract = failOnTimeout ... TezosClient.rememberContract-  getAliasesAndAddresses = retryOnceOnTimeout ... TezosClient.getAliasesAndAddresses-  genKey alias = flip AddressWithAlias alias <$> TezosClient.genKey alias-  genFreshKey alias = flip AddressWithAlias alias <$> TezosClient.genFreshKey alias-  getKeyPassword (AddressWithAlias _ alias) = retryOnceOnTimeout $ TezosClient.getKeyPassword alias-  getPublicKey (AddressWithAlias _ alias) = TezosClient.getPublicKey alias--instance RunClient MorleyClientM where-  runRequestAcceptStatus :: Maybe [Status] -> Request -> MorleyClientM Response-  runRequestAcceptStatus statuses req = do-    env <- mceClientEnv <$> ask-    runRequestAcceptStatusImpl env statuses req-  throwClientError = throwClientErrorImpl--instance HasTezosRpc MorleyClientM where-  getBlockHash = getBlockHashImpl-  getCounterAtBlock = getCounterImpl-  getBlockHeader = getBlockHeaderImpl-  getBlockConstants = getBlockConstantsImpl-  getBlockOperations = getBlockOperationsImpl-  getScriptSizeAtBlock = getScriptSizeAtBlockImpl-  getBlockOperationHashes = getBlockOperationHashesImpl-  getProtocolParametersAtBlock = getProtocolParametersImpl-  runOperationAtBlock = runOperationImpl-  preApplyOperationsAtBlock = preApplyOperationsImpl-  forgeOperationAtBlock = forgeOperationImpl-  injectOperation = injectOperationImpl-  getContractScriptAtBlock = getContractScriptImpl-  getContractStorageAtBlock = getContractStorageAtBlockImpl-  getContractBigMapAtBlock = getContractBigMapImpl-  getBigMapValueAtBlock = getBigMapValueAtBlockImpl-  getBigMapValuesAtBlock = getBigMapValuesAtBlockImpl-  getBalanceAtBlock = getBalanceImpl-  getDelegateAtBlock = getDelegateImpl-  runCodeAtBlock = runCodeImpl-  getChainId = getChainIdImpl-  getManagerKeyAtBlock = getManagerKeyImpl-  waitForOperation = (asks mceClientEnv >>=) . waitForOperationImpl-  getTicketBalanceAtBlock = getTicketBalanceAtBlockImpl-  getAllTicketBalancesAtBlock = getAllTicketBalancesAtBlockImpl----- | Construct 'MorleyClientEnv'.------ * @octez-client@ path is taken from 'MorleyClientConfig', but can be--- overridden using @MORLEY_TEZOS_CLIENT@ environment variable.--- * Node data is taken from @octez-client@ config and can be overridden--- by 'MorleyClientConfig'.--- * The rest is taken from 'MorleyClientConfig' as is.-mkMorleyClientEnv :: MorleyClientConfig -> IO MorleyClientEnv-mkMorleyClientEnv MorleyClientConfig{..} = do-  envTezosClientPath <- lookupEnv "MORLEY_TEZOS_CLIENT"-  let tezosClientPath = fromMaybe mccTezosClientPath envTezosClientPath-  TezosClientConfig {..} <- getTezosClientConfig tezosClientPath mccMbTezosClientDataDir-  let-    endpointUrl = fromMaybe tcEndpointUrl mccEndpointUrl-    tezosClientEnv = TezosClientEnv-      { tceEndpointUrl = endpointUrl-      , tceTezosClientPath = tezosClientPath-      , tceMbTezosClientDataDir = mccMbTezosClientDataDir-      }--  clientEnv <- newClientEnv endpointUrl-  pure MorleyClientEnv-    { mceTezosClient = tezosClientEnv-    , mceLogAction = mkLogAction mccVerbosity-    , mceSecretKey = mccSecretKey-    , mceClientEnv = clientEnv-    }+import Morley.Client.TezosClient.Types.MorleyClientM

@@ -16,7 +16,7 @@ import Colog (HasLog(..), Message) import Control.Lens (at) import Data.Map.Strict qualified as Map-import Fmt (pretty, (+|), (|+))+import Fmt ((+|), (|+)) import Servant.Client (BaseUrl, ClientEnv) import Servant.Client.Core (RunClient(..)) import UnliftIO (MonadUnliftIO)@@ -28,7 +28,9 @@ import Morley.Client.RPC.HttpClient (newClientEnv) import Morley.Client.TezosClient.Class (HasTezosClient(..)) import Morley.Client.Types+import Morley.Client.Types.AliasesAndAddresses import Morley.Tezos.Address+import Morley.Tezos.Address.Alias import Morley.Tezos.Crypto (SecretKey, sign, toPublic)  ----------------@@ -127,8 +129,8 @@   -- TODO [#652] [#910]: consider using a `Map` instead   getAliasesAndAddresses = do     implicitAddrs <- asks moreSecretKeys-    pure $-      keys implicitAddrs <&> \implicitAddr -> ("MorleyOnlyRpc", pretty implicitAddr)+    pure $ mkAliasesAndAddresses $ keys implicitAddrs <&> \awaAddress ->+      let awaAlias = mkAlias "MorleyOnlyRpc" in Constrained AddressWithAlias{..}    -- Actions that are not supported and simply throw exceptions.   genKey _ = throwM $ UnsupportedByOnlyRPC "genKey"@@ -168,3 +170,4 @@   waitForOperation = (asks moreClientEnv >>=) . waitForOperationImpl   getTicketBalanceAtBlock = getTicketBalanceAtBlockImpl   getAllTicketBalancesAtBlock = getAllTicketBalancesAtBlockImpl+  packData = packDataImpl

@@ -2,37 +2,48 @@ -- SPDX-License-Identifier: LicenseRef-MIT-OA  module Morley.Client.Parser-  ( ClientArgs (..)-  , ClientArgsRaw (..)-  , OriginateArgs (..)-  , TransferArgs (..)-  , GetScriptSizeArgs (..)-  , TicketBalanceArgs (..)-  , TransferTicketArgs (..)-  , addressOrAliasOption+  ( clientParser   , clientConfigParser-  , morleyClientInfo-  , parserInfo+  , argsRawParser -  , originateArgsOption+    -- * Internals   , mbContractFileOption   , contractNameOption--    -- * Parser utilities+  , feeOption   , baseUrlReader+  , OriginateArgs(..)+  , originateArgsOption++    -- * Re-exports+  , parserInfo   ) where +import Control.Exception.Safe (throwString)+import Data.Aeson qualified as Aeson+import Data.Default (def)+import Data.Singletons (demote, fromSing)+import Data.Type.Equality (pattern Refl)+import Fmt (blockListF, build, nameF, pretty, (+|), (|+)) import Options.Applicative   (ReadM, eitherReader, help, long, metavar, option, short, strOption, subparser, value) import Options.Applicative qualified as Opt-import Options.Applicative.Help.Pretty (Doc, linebreak) import Servant.Client (BaseUrl(..), parseBaseUrl) +import Morley.App.CLI qualified as Morley import Morley.CLI   (addressOrAliasOption, keyHashOption, mutezOption, parserInfo, someAddressOrAliasOption,   valueOption)-import Morley.Client.Init-import Morley.Client.RPC.Types (BlockId(HeadId))+import Morley.Client.Action+import Morley.Client.Full+import Morley.Client.RPC+import Morley.Client.TezosClient+import Morley.Client.Util (extractAddressesFromValue)+import Morley.Micheline (fromExpression, toExpression, unStringEncode)+import Morley.Michelson.Runtime (prepareContract)+import Morley.Michelson.TypeCheck qualified as TC+import Morley.Michelson.Typed (Contract, Contract'(..), SomeContract(..))+import Morley.Michelson.Typed qualified as T+import Morley.Michelson.Typed.Value (Value'(..)) import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address import Morley.Tezos.Address.Alias@@ -40,67 +51,237 @@ import Morley.Tezos.Core import Morley.Tezos.Crypto import Morley.Util.CLI (mkCLOptionParser, mkCommandParser)+import Morley.Util.Constrained+import Morley.Util.Exception (throwLeft) import Morley.Util.Named -data ClientArgs-  = ClientArgs MorleyClientConfig ClientArgsRaw+mkCommandParser' :: String -> String -> Opt.Parser a -> Opt.Mod Opt.CommandFields a+mkCommandParser' = flip . mkCommandParser -data ClientArgsRaw where-  Originate :: OriginateArgs -> ClientArgsRaw-  GetScriptSize :: GetScriptSizeArgs -> ClientArgsRaw-  Transfer :: TransferArgs -> ClientArgsRaw-  TransferTicket :: TransferTicketArgs -> ClientArgsRaw-  GetBalance :: L1AddressKind kind => AddressOrAlias kind -> ClientArgsRaw-  GetBlockHeader :: BlockId -> ClientArgsRaw-  GetBlockOperations :: BlockId -> ClientArgsRaw-  TicketBalance :: SomeAddressOrAlias -> TicketBalanceArgs -> ClientArgsRaw-  AllTicketBalances :: ContractAddressOrAlias -> ClientArgsRaw+type ClientMCmd = Opt.Mod Opt.CommandFields (MorleyClientM ()) -data OriginateArgs = OriginateArgs-  { oaMbContractFile :: Maybe FilePath-  , oaContractName   :: ContractAlias-  , oaInitialBalance :: Mutez-  , oaInitialStorage :: U.Value-  , oaOriginateFrom  :: ImplicitAddressOrAlias-  , oaMbFee :: Maybe Mutez-  , oaDelegate :: Maybe KeyHash-  }+originateCmd :: ClientMCmd+originateCmd = mkCommandParser' "originate" "Originate passed contract on real network." do+  oas <- originateArgsOption+  pure let OriginateArgs{..} = oas in do+    contract <- liftIO $ prepareContract oaMbContractFile+    let originator = oaOriginateFrom+    originatorAA <- resolveAddressWithAlias originator+    (operationHash, contractAddr) <-+      originateUntypedContract OverwriteDuplicateAlias oaContractName originatorAA oaInitialBalance+        contract oaInitialStorage oaMbFee oaDelegate -data GetScriptSizeArgs = GetScriptSizeArgs-  { ssScriptFile :: FilePath-  , ssStorage    :: U.Value-  }+    putTextLn "Contract was successfully deployed."+    putTextLn $ "Operation hash: " <> pretty operationHash+    putTextLn $ "Contract address: " <> formatAddress contractAddr -data TransferArgs = TransferArgs-  { taSender      :: ImplicitAddressOrAlias-  , taDestination :: SomeAddressOrAlias-  , taAmount      :: Mutez-  , taParameter   :: U.Value-  , taMbFee :: Maybe Mutez-  }+transferCmd :: ClientMCmd+transferCmd = mkCommandParser' "transfer"+  "Perform a transfer to the given contract with given amount and parameter." do+  taSender <- addressOrAliasOption @'AddressKindImplicit Nothing+    ! #name "from"+    ! #help "Address or alias from which transfer is performed."+  taDestination <- someAddressOrAliasOption Nothing+    ! #name "to"+    ! #help "Address or alias of the transfer's destination."+  taAmount <- mutezOption (Just zeroMutez)+    ! #name "amount"+    ! #help "Transfer amount."+  taParameter <- valueOption Nothing+    ! #name "parameter"+    ! #help "Transfer parameter."+  taMbFee <- feeOption+  pure do+    sendAddress <- resolveAddressWithAlias taSender+    destAddress <- resolveAddress taDestination+    (operationHash, contractEvents) :: (OperationHash, [WithSource EventOperation]) <-+      withConstrained destAddress \case+        destContract@ContractAddress{} -> do+          contract <- getContract destContract+          SomeContract (Contract{} :: Contract cp st) <-+            throwLeft $ pure $ TC.typeCheckingWith def $ TC.typeCheckContract contract+          let addrs = extractAddressesFromValue taParameter & mapMaybe \case+                MkAddress x@ContractAddress{} -> Just x+                _ -> Nothing+          tcOriginatedContracts <- getContractsParameterTypes addrs+          parameter <- throwLeft $ pure $ TC.typeCheckingWith def $+            TC.typeVerifyParameter @cp tcOriginatedContracts taParameter+          transfer sendAddress destContract taAmount U.DefEpName parameter taMbFee+        destImplicit@ImplicitAddress {} -> case taParameter of+          U.ValueUnit -> transfer sendAddress destImplicit taAmount U.DefEpName VUnit Nothing+          _ -> throwString ("The transaction parameter must be 'Unit' "+            <> "when transferring to an implicit account") -data TransferTicketArgs = TransferTicketArgs-  { ttaSender         :: ImplicitAddressOrAlias-  , ttaTicketContents :: U.Value-  , ttaTicketType     :: U.Ty-  , ttaTicketTicketer :: ContractAddressOrAlias-  , ttaTicketAmount   :: Natural-  , ttaDestination    :: SomeAddressOrAlias-  , ttaMbFee          :: Maybe Mutez-  } -morleyClientInfo :: Opt.ParserInfo ClientArgs-morleyClientInfo =-  parserInfo-    (#usage :! usageDoc)-    (#description :! "Morley Client: RPC client for interaction with tezos node")-    (#header :! "Morley Client")-    (#parser :! clientParser)+    putTextLn $ "Transaction was successfully sent.\nOperation hash " <> pretty operationHash <> "."+    unless (null contractEvents) do+      putTextLn $ "Additionally, the following contract events were emitted:"+      putTextLn $ pretty $ blockListF contractEvents +getBalanceCmd :: ClientMCmd+getBalanceCmd = mkCommandParser' "get-balance" "Get balance for given address" do+  addrOrAlias <- someAddressOrAliasOption Nothing+    ! #name "addr"+    ! #help "Contract or implicit address or alias to get balance for."+  pure do+    Constrained addr <- resolveAddress addrOrAlias+    balance <- getBalance addr+    putTextLn $ prettyTez balance++getBlockHeaderCmd :: ClientMCmd+getBlockHeaderCmd = mkCommandParser' "get-block-header" "Get header of a block" do+  blockId <- blockIdOption+  pure do+    blockHeader <- getBlockHeader blockId+    putStrLn $ Aeson.encode blockHeader++getScriptSizeCmd :: ClientMCmd+getScriptSizeCmd = mkCommandParser' "compute-script-size" "Compute script size" do+  ssScriptFile <- scriptFileOption+  ssStorage <- valueOption Nothing+    ! #name "storage"+    ! #help "Contract storage value."+  pure do+    contract <- liftIO $ prepareContract (Just ssScriptFile)+    void . throwLeft . pure . TC.typeCheckingWith def $+      TC.typeCheckContractAndStorage contract ssStorage+    size <- computeUntypedContractSize contract ssStorage+    print size++getBlockOperationsCmd :: ClientMCmd+getBlockOperationsCmd = mkCommandParser' "get-block-operations"+  "Get operations contained in a block" do+  blockId <- blockIdOption+  pure do+    operationLists <- getBlockOperations blockId+    forM_ operationLists $ \operations -> do+      forM_ operations $ \BlockOperation {..} -> do+        putTextLn $ "Hash: " <> boHash+        putTextLn $ "Contents: "+        forM_ (orwmResponse <$> boContents) \case+          TransactionOpResp op -> putStrLn $ Aeson.encode op+          TransferTicketOpResp op -> putStrLn $ Aeson.encode op+          OriginationOpResp op -> putStrLn $ Aeson.encode op+          DelegationOpResp op  -> putStrLn $ Aeson.encode op+          RevealOpResp op      -> putStrLn $ Aeson.encode op+          EventOpResp op       -> putStrLn $ Aeson.encode op+          OtherOpResp kind     -> putTextLn $ "Unknown operation kind: " <> kind+        putTextLn ""+    putTextLn "——————————————————————————————————————————————————\n"++getTicketBalanceCmd :: ClientMCmd+getTicketBalanceCmd = mkCommandParser' "ticket-balance" "Get ticket balance for specific tickets" do+  owner' <- ownerOption someAddressOrAliasOption+  tbaTicketer <- mkCLOptionParser Nothing+    ! #name "ticketer"+    ! #help "The contract that issued the ticket."+  tbaContentType <- mkCLOptionParser @U.Ty Nothing+    ! #name "content-type"+    ! #help "Content type."+  tbaContent <- valueOption Nothing+    ! #name "content"+    ! #help "Ticket content."+  pure do+    owner <- resolveAddress owner'+    bal <- getTicketBalance owner GetTicketBalance+      { gtbContent = toExpression tbaContent+      , gtbContentType = toExpression tbaContentType+      , gtbTicketer = tbaTicketer+      }+    print bal++getAllTicketBalancesCmd :: ClientMCmd+getAllTicketBalancesCmd = mkCommandParser' "all-ticket-balances" "Get all ticket balances" do+  owner' <- ownerOption $ addressOrAliasOption @'AddressKindContract+  pure do+    owner <- resolveAddress owner'+    bals <- getAllTicketBalances owner+    forM_ bals \GetAllTicketBalancesResponse{..} -> do+      content <- either throwM pure $ fromExpression @U.Value gatbrContent+      ty <- either throwM pure $ fromExpression @U.Ty gatbrContentType+      putTextLn $+        nameF "Ticketer" (build gatbrTicketer) |+ ", "+        +| nameF "content" (build content) |+ ", "+        +| nameF "type" (build ty) |+ ", "+        +| nameF "amount" (build $ unStringEncode gatbrAmount)+++transferTicketCmd :: ClientMCmd+transferTicketCmd = mkCommandParser' "transfer-ticket"+  "Perform a ticket transfer to the given contract with given amount and parameter." do+  ttaSender <- addressOrAliasOption @'AddressKindImplicit Nothing+    ! #name "from"+    ! #help "Address or alias from which transfer is performed."+  ttaTicketAmount <- mkCLOptionParser @Natural Nothing+    ! #name "amount"+    ! #help "Ticket amount."+  ttaTicketContents <- mkCLOptionParser @U.Value Nothing+    ! #name "value"+    ! #help "Ticket value."+  ttaTicketType <- mkCLOptionParser @U.Ty Nothing+    ! #name "type"+    ! #help "Ticket type."+  ttaTicketTicketer <- mkCLOptionParser @ContractAddressOrAlias Nothing+    ! #name "ticketer"+    ! #help "Ticketer address or alias."+  ttaDestination <- someAddressOrAliasOption Nothing+    ! #name "to"+    ! #help "Address or alias of the transfer's destination."+  ttaMbFee <- feeOption+  pure $ T.withUType ttaTicketType \(_ :: T.Notes t) -> do+    T.Dict <- throwLeft $ pure $ first (TC.UnsupportedTypeForScope (demote @t))+      $ T.checkScope @(T.ParameterScope t, T.Comparable t)+    sendAddress <- resolveAddressWithAlias ttaSender+    destAddress <- resolveAddress ttaDestination+    ticketer <- resolveAddress ttaTicketTicketer+    (operationHash, contractEvents) :: (OperationHash, [WithSource EventOperation]) <-+      withConstrained destAddress \case+        destContract@ContractAddress{} -> do+          contract <- getContract destContract+          SomeContract (Contract{} :: Contract cp st) <-+            throwLeft $ pure $ TC.typeCheckingWith def $ TC.typeCheckContract contract+          Constrained (_ :: T.SingT t') :: Constrained T.SingI T.SingT <- case T.sing @cp of+            T.STTicket x -> pure $ Constrained @T.SingI x+            x -> throwM $ TC.TcContractError @U.ExpandedOp+              ("Expected contract to accept tickets, but it had type " <> pretty (fromSing x))+              $ Just $ TC.UnexpectedType (one $ one $ "ticket 'a")+          Refl <- T.requireEq @t @t' $ throwM . TC.TypeEqError+          parameter <- throwLeft $ pure $ TC.typeCheckingWith def $ do+            TC.typeCheckValue @t' ttaTicketContents+          transferTicket @_ @t' sendAddress destContract ticketer parameter ttaTicketAmount+            U.DefEpName ttaMbFee+        destImplicit@ImplicitAddress{} -> do+          parameter <- throwLeft $ pure $ TC.typeCheckingWith def $+                TC.typeCheckValue @t ttaTicketContents+          transferTicket sendAddress destImplicit ticketer parameter ttaTicketAmount+                U.DefEpName ttaMbFee++    putTextLn $ "Tickets successfully sent.\nOperation hash " <> pretty operationHash <> "."+    unless (null contractEvents) do+      putTextLn $ "Additionally, the following contract events were emitted:"+      putTextLn $ pretty $ blockListF contractEvents+ -- | Parser for the @morley-client@ executable.-clientParser :: Opt.Parser ClientArgs-clientParser = ClientArgs <$> clientConfigParser <*> argsRawParser+clientParser :: Opt.Parser (IO ())+clientParser = runMorleyClientM' <$> clientConfigParser <*> argsRawParser <|> Morley.argParser+  where+    runMorleyClientM' envConfig action = do+      env <- mkMorleyClientEnv envConfig+      runMorleyClientM env action +argsRawParser :: Opt.Parser (MorleyClientM ())+argsRawParser = subparser $ mconcat+  [ originateCmd+  , transferCmd+  , transferTicketCmd+  , getBalanceCmd+  , getScriptSizeCmd+  , getBlockHeaderCmd+  , getBlockOperationsCmd+  , getTicketBalanceCmd+  , getAllTicketBalancesCmd+  ]+ clientConfigParser :: Opt.Parser MorleyClientConfig clientConfigParser = do   let mccSecretKey = Nothing@@ -116,6 +297,41 @@       , help "Increase verbosity (pass several times to increase further)."       ] +data OriginateArgs = OriginateArgs+  { oaMbContractFile :: Maybe FilePath+  , oaContractName   :: ContractAlias+  , oaInitialBalance :: Mutez+  , oaInitialStorage :: U.Value+  , oaOriginateFrom  :: ImplicitAddressOrAlias+  , oaMbFee :: Maybe Mutez+  , oaDelegate :: Maybe KeyHash+  }++originateArgsOption :: Opt.Parser OriginateArgs+originateArgsOption = do+  oaMbContractFile <- mbContractFileOption+  oaContractName <- contractNameOption+  oaInitialBalance <- mutezOption (Just zeroMutez)+    ! #name "initial-balance"+    ! #help "Initial balance of the contract."+  oaInitialStorage <- valueOption Nothing+    ! #name "initial-storage"+    ! #help "Initial contract storage value."+  oaOriginateFrom <- addressOrAliasOption Nothing+    ! #name "from"+    ! #help "Address or alias of address from which origination is performed."+  oaMbFee <- feeOption+  oaDelegate <- optional $ keyHashOption Nothing+    ! #name "delegate"+    ! #help "Key hash of the contract's delegate"+  pure OriginateArgs{..}+++blockIdOption :: Opt.Parser BlockId+blockIdOption = mkCLOptionParser (Just HeadId)+  ! #name "block-id"+  ! #help "Id of the block whose header will be queried."+ -- | Parses URL of the Tezos node. endpointOption :: Opt.Parser (Maybe BaseUrl) endpointOption = optional . option baseUrlReader $@@ -139,142 +355,10 @@           ]  feeOption :: Opt.Parser (Maybe Mutez)-feeOption = optional $ mutezOption-            Nothing-            (#name :! "fee")-            (#help :! "Fee that is going to be used for the transaction. \-                      \By default fee will be computed automatically."-            )--data TicketBalanceArgs = TicketBalanceArgs-  { tbaTicketer :: ContractAddress-  , tbaContent :: U.Value-  , tbaContentType :: U.Ty-  }--getTicketBalanceOption :: Opt.Parser TicketBalanceArgs-getTicketBalanceOption = do-  tbaTicketer <- mkCLOptionParser Nothing-    (#name :! "ticketer")-    (#help :! "The contract that issued the ticket.")-  tbaContentType <- mkCLOptionParser Nothing-    (#name :! "content-type")-    (#help :! "Content type.")-  tbaContent <- valueOption Nothing-    (#name :! "content")-    (#help :! "Ticket content.")-  pure TicketBalanceArgs{..}---- | Generic parser to read an option of 'BlockId' type.-blockIdOption-  :: Maybe BlockId-  -> "name" :! String-  -> "help" :! String-  -> Opt.Parser BlockId-blockIdOption = mkCLOptionParser--argsRawParser :: Opt.Parser ClientArgsRaw-argsRawParser = subparser $ mconcat-  [ originateCmd-  , transferCmd-  , transferTicketCmd-  , getBalanceCmd-  , getScriptSizeCmd-  , getBlockHeaderCmd-  , getBlockOperationsCmd-  , getTicketBalanceCmd-  , getAllTicketBalancesCmd-  ]-  where-    ownerOption f = f-      Nothing-      (#name :! "owner")-      (#help :! "Ticket owner")-    getTicketBalanceCmd =-      mkCommandParser "ticket-balance"-      (TicketBalance <$> ownerOption someAddressOrAliasOption <*> getTicketBalanceOption)-      "Get ticket balance for specific tickets"-    getAllTicketBalancesCmd =-      mkCommandParser "all-ticket-balances"-      (AllTicketBalances <$> ownerOption addressOrAliasOption)-      "Get all ticket balances"-    originateCmd =-      mkCommandParser "originate"-      (Originate <$> originateArgsOption)-      "Originate passed contract on real network."-    transferCmd =-      mkCommandParser "transfer"-      (Transfer <$> transferArgsOption)-      "Perform a transfer to the given contract with given amount and parameter."-    transferTicketCmd =-      mkCommandParser "transfer-ticket"-      (TransferTicket <$> transferTicketArgsOption)-      "Perform a ticket transfer to the given contract with given amount and parameter."-    getBalanceCmd =-      mkCommandParser "get-balance"-      ((GetBalance <$>-        addressOrAliasOption @'AddressKindContract-          Nothing-          (#name :! "contract-addr")-          (#help :! "Contract address or alias to get balance for."))-      <|> (GetBalance <$> addressOrAliasOption @'AddressKindImplicit-          Nothing-          (#name :! "implicit-addr")-          (#help :! "Implicit address or alias to get balance for."))-      )-      "Get balance for given address"-    getBlockHeaderCmd =-      mkCommandParser "get-block-header"-      (GetBlockHeader <$> blockIdOption-        (Just HeadId)-        (#name :! "block-id")-        (#help :! "Id of the block whose header will be queried.")-      )-      "Get header of a block"-    getBlockOperationsCmd =-      mkCommandParser "get-block-operations"-      (GetBlockOperations <$> blockIdOption-        (Just HeadId)-        (#name :! "block-id")-        (#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-  oaMbContractFile <- mbContractFileOption-  oaContractName <- contractNameOption-  oaInitialBalance <--    mutezOption-      (Just zeroMutez)-      (#name :! "initial-balance")-      (#help :! "Inital balance of the contract.")-  oaInitialStorage <--    valueOption-      Nothing-      (#name :! "initial-storage")-      (#help :! "Initial contract storage value.")-  oaOriginateFrom <--    addressOrAliasOption-      Nothing-      (#name :! "from")-      (#help :! "Address or alias of address from which origination is performed.")-  oaMbFee <- feeOption-  oaDelegate <- optional $-    keyHashOption-      Nothing-      (#name :! "delegate")-      (#help :! "Key hash of the contract's delegate")-  pure $ OriginateArgs {..}--getScriptSizeArgsOption :: Opt.Parser GetScriptSizeArgs-getScriptSizeArgsOption = GetScriptSizeArgs <$> scriptFileOption-  <*> valueOption Nothing (#name :! "storage")-                          (#help :! "Contract storage value.")+feeOption = optional $ mutezOption Nothing+  ! #name "fee"+  ! #help "Fee that is going to be used for the transaction. \+          \By default fee will be computed automatically."  mbContractFileOption :: Opt.Parser (Maybe FilePath) mbContractFileOption = optional . strOption $ mconcat@@ -295,76 +379,12 @@   , help "Alias of originated contract."   ] -transferArgsOption :: Opt.Parser TransferArgs-transferArgsOption = do-  taSender <--    addressOrAliasOption-      Nothing-      (#name :! "from")-      (#help :! "Address or alias from which transfer is performed.")-  taDestination <--    someAddressOrAliasOption-      Nothing-      (#name :! "to")-      (#help :! "Address or alias of the transfer's destination.")-  taAmount <--    mutezOption-      (Just zeroMutez)-      (#name :! "amount")-      (#help :! "Transfer amount.")-  taParameter <--    valueOption-      Nothing-      (#name :! "parameter")-      (#help :! "Transfer parameter.")-  taMbFee <- feeOption-  pure $ TransferArgs {..}--transferTicketArgsOption :: Opt.Parser TransferTicketArgs-transferTicketArgsOption = do-  ttaSender <- addressOrAliasOption Nothing-    ! #name "from"-    ! #help "Address or alias from which transfer is performed."-  ttaTicketAmount <- mkCLOptionParser Nothing-    ! #name "amount"-    ! #help "Ticket amount."-  ttaTicketContents <- mkCLOptionParser Nothing-    ! #name "value"-    ! #help "Ticket value."-  ttaTicketType <- mkCLOptionParser Nothing-    ! #name "type"-    ! #help "Ticket type."-  ttaTicketTicketer <- mkCLOptionParser Nothing-    ! #name "ticketer"-    ! #help "Ticketer address or alias."-  ttaDestination <- someAddressOrAliasOption Nothing-    ! #name "to"-    ! #help "Address or alias of the transfer's destination."-  ttaMbFee <- feeOption-  pure $ TransferTicketArgs {..}--usageDoc :: Doc-usageDoc = mconcat-  [ "You can use help for specific COMMAND", linebreak-  , "EXAMPLE:", linebreak-  , "morley-client originate --help"-  , "USAGE EXAMPLE:", linebreak-  , "morley-client -E florence.testnet.tezos.serokell.team:8732 originate \\", linebreak-  , "  --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak-  , "  --contract ../contracts/tezos_examples/attic/add1.tz --initial-balance 1 --initial-storage 0", linebreak-  , linebreak-  , "  This command will originate contract with code stored in add1.tz", linebreak-  , "  on real network with initial balance 1 and initial storage set to 0", linebreak-  , "  and return info about operation: operation hash and originated contract address", linebreak-  , linebreak-  , "morley-client -E florence.testnet.tezos.serokell.team:8732 transfer \\", linebreak-  , "  --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak-  , "  --to KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW --amount 1 --parameter 0", linebreak-  , linebreak-  , "  This command will perform tranfer to contract with address on real network", linebreak-  , "  KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW with amount 1 and parameter 0", linebreak-  , "  as a result it will return operation hash"-  ]+ownerOption+  :: (Maybe a -> ("name" :! String) -> ("help" :! String) -> Opt.Parser r)+  -> Opt.Parser r+ownerOption f = f Nothing+  ! #name "owner"+  ! #help "Ticket owner"  -------------------------------------------------------------------------------- -- Parser utilities

@@ -112,8 +112,11 @@      -- Run contract with given parameter and storage.     Capture "block_id" BlockId :> "helpers" :> "scripts" :> "run_code"-      :> ReqBody '[JSON] RunCode :> Post '[JSON] RunCodeResult+      :> ReqBody '[JSON] RunCode :> Post '[JSON] RunCodeResult :<|> +    Capture "block_id" BlockId :> "helpers" :> "scripts" :> "pack_data"+      :> ReqBody '[JSON] PackData :> Post '[JSON] PackDataResult+     ) :<|>    "chains" :> "main" :> "chain_id" :> Get '[JSON] Text :<|>@@ -157,6 +160,7 @@   , getManagerKey :: BlockId -> ImplicitAddress -> m (Maybe PublicKey)   , getChainId :: m Text   , injectOperation :: HexJSONByteString -> m OperationHash+  , packData :: BlockId -> PackData -> m PackDataResult   }  @@ -196,7 +200,8 @@         :<|> forgeOperation         :<|> runOperation         :<|> preApplyOperations-        :<|> runCode)+        :<|> runCode+        :<|> packData)       :<|> getChainId       :<|> injectOperation       = nodeAPI `clientIn` (Proxy @m)

@@ -8,13 +8,25 @@  module Morley.Client.RPC.Aeson   ( morleyClientAesonOptions+  , ClientJSON(..)   ) where +import Data.Aeson qualified as JSON import Data.Aeson.Casing (aesonPrefix, snakeCase)-import Data.Aeson.TH (Options)+import GHC.Generics (Rep) --- | We use these 'Options' to produce JSON encoding in the format+-- | We use these @Options@ to produce JSON encoding in the format -- that RPC expects. We are not using defaults from @morley@ because -- we need a specific format.-morleyClientAesonOptions :: Options+morleyClientAesonOptions :: JSON.Options morleyClientAesonOptions = aesonPrefix snakeCase++newtype ClientJSON a = ClientJSON { unClientJSON :: a }++instance (Generic a, JSON.GToJSON JSON.Zero (Rep a), JSON.GToEncoding JSON.Zero (Rep a))+  => JSON.ToJSON (ClientJSON a) where+  toJSON = JSON.genericToJSON morleyClientAesonOptions . unClientJSON+  toEncoding = JSON.genericToEncoding morleyClientAesonOptions . unClientJSON++instance (Generic a, JSON.GFromJSON JSON.Zero (Rep a)) => JSON.FromJSON (ClientJSON a) where+  parseJSON = fmap ClientJSON . JSON.genericParseJSON morleyClientAesonOptions

@@ -16,6 +16,7 @@  import Morley.Client.RPC.Types import Morley.Micheline (Expression, TezosInt64)+import Morley.Michelson.Typed qualified as T  -- | Type class that provides interaction with tezos node via RPC class (Monad m, MonadCatch m) => HasTezosRpc m where@@ -92,3 +93,5 @@     -> m [GetAllTicketBalancesResponse]   -- ^ Access the complete list of tickets owned by the given contract by   -- scanning the contract's storage.+  packData :: T.ForbidOp t => BlockId -> T.Value t -> T.Notes t -> m Text+  -- ^ Pack typed value into hexadecimal text representation.

@@ -4,13 +4,15 @@ -- | Various errors that can happen in the RPC part of @morley-client@. module Morley.Client.RPC.Error   ( ClientRpcError (..)+  , ClientRpcErrorWithStack (..)   , RunCodeErrors (..)   , UnexpectedErrors (..)   , IncorrectRpcResponse (..)   , WaitForOperationError (..)   ) where -import Fmt (Buildable(..), blockListF, pretty, (+|), (|+))+import Data.Typeable (cast)+import Fmt (Buildable(..), blockListF, nameF, pretty, unlinesF, (+|), (|+))  import Morley.Micheline (Expression) import Morley.Tezos.Address@@ -21,6 +23,20 @@ -- Caused by invalid user action ---------------------------------------------------------------------------- +data ClientRpcErrorWithStack a = ClientRpcErrorWithStack+  { crewsStack :: NonEmpty (OperationResp WithSource)+  , crewsError :: a+  } deriving stock Show++instance Buildable a => Buildable (ClientRpcErrorWithStack a) where+  build ClientRpcErrorWithStack{..} = unlinesF+    [ build crewsError+    , nameF "Call stack" $ unlinesF $ build <$> toList crewsStack+    ]++instance (Show a, Typeable a, Buildable a) => Exception (ClientRpcErrorWithStack a) where+  displayException = pretty+ -- | Errors that can happen in the RPC part when a user tries to make -- failing actions. data ClientRpcError@@ -78,8 +94,11 @@     DelegateNotRegistered addr -> addr |+ " not registered as delegate"     ClientInternalError err -> build err +-- | To reduce friction between 'ClientRpcErrorWithStack' and 'ClientRpcError',+-- this instance will try to convert from both in 'fromException' instance Exception ClientRpcError where   displayException = pretty+  fromException (SomeException e) = cast e <|> fmap crewsError (cast e)  -- | Errors that can happen during @run_code@ endpoint call. -- These errors returned along with 500 code, so we have to handle@@ -115,8 +134,11 @@       "RPC failed with unexpected internal errors:\n" +|       mconcat (map ((<> "\n\n") . build) errs) |+ "" +-- | To reduce friction between 'ClientRpcErrorWithStack' and 'UnexpectedErrors',+-- this instance will try to convert from both in 'fromException' instance Exception UnexpectedErrors where   displayException = pretty+  fromException (SomeException e) = cast e <|> fmap crewsError (cast e)  -- | Errors that we can throw when we get a response from a node that -- doesn't match our expectations. It means that either the node we

@@ -29,8 +29,7 @@   , ScriptSize(..)   , GetBigMapResult (..)   , InternalOperation (..)-  , InternalOperationData (..)-  , IntOpEvent (..)+  , WithSource (..)   , OperationContent (..)   , OperationHash (..)   , OperationInput@@ -54,9 +53,12 @@   , TransactionOperation (..)   , TransferTicketOperation (..)   , WithCommonOperationData (..)+  , EventOperation (..)   , MonitorHeadsStep(..)   , GetTicketBalance (..)   , GetAllTicketBalancesResponse (..)+  , PackData(..)+  , PackDataResult(..)   , mkCommonOperationData    -- * Errors@@ -88,8 +90,8 @@  import Control.Lens (makePrisms) import Data.Aeson-  (FromJSON(..), Key, Object, ToJSON(..), Value(..), object, omitNothingFields, withObject, (.!=),-  (.:), (.:?), (.=))+  (FromJSON(..), Key, Object, ToJSON(..), Value(..), object, omitNothingFields, withObject,+  withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Key qualified as Key (toText) import Data.Aeson.TH (deriveFromJSON, deriveJSON, deriveToJSON) import Data.Default (Default(..))@@ -98,21 +100,24 @@ import Data.Ratio ((%)) import Data.Text qualified as T import Data.Time (UTCTime)-import Fmt (Buildable(..), pretty, unwordsF, (+|), (|+))+import Fmt+  (Buildable(..), blockListF, blockMapF, enumerateF', fillSepF', nameF, reflowF, unlinesF, (++|),+  (|++)) import Servant.API (ToHttpApiData(..))  import Data.Aeson.Types (Parser)-import Morley.Client.RPC.Aeson (morleyClientAesonOptions)+import Morley.Client.RPC.Aeson import Morley.Client.Types import Morley.Micheline-  (Expression, MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosInt64,-  TezosMutez(..), TezosNat, expressionPrim)+  (Expression, MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosBigNum,+  TezosInt64, TezosMutez(..), TezosNat, expressionPrim) import Morley.Michelson.Text (MText) import Morley.Tezos.Address import Morley.Tezos.Core (Mutez, tz, zeroMutez) import Morley.Tezos.Crypto   (KeyHash, PublicKey, Signature, decodeBase58CheckWithPrefix, formatSignature) import Morley.Util.CLI (HasCLReader(..), eitherReader)+import Morley.Util.MismatchError import Morley.Util.Named import Morley.Util.Text (dquotes) @@ -169,11 +174,14 @@   deriving stock (Eq, Show)   deriving newtype (FromJSON, Buildable) -newtype OperationContent = OperationContent { unOperationContent :: RunMetadata }+data OperationContent = OperationContent+  { ocOperation :: OperationResp WithSource+  , ocMetadata :: RunMetadata+  }  instance FromJSON OperationContent where-  parseJSON = withObject "operationCostContent" $ \o ->-    OperationContent <$> o .: "metadata"+  parseJSON json = json & withObject "operationCostContent" \o ->+    OperationContent <$> parseJSON json <*> o .: "metadata"  data RunMetadata = RunMetadata   { rmOperationResult :: OperationResult@@ -186,7 +194,7 @@     o .:? "internal_operation_results" .!= []  data InternalOperation = InternalOperation-  { ioData :: InternalOperationData+  { ioData :: OperationResp WithSource   , ioResult :: OperationResult   } @@ -194,33 +202,6 @@   parseJSON json = json & withObject "internal_operation" \o ->     InternalOperation <$> parseJSON json <*> o .: "result" -data InternalOperationData-  = IODEvent IntOpEvent-  | IODIgnored--instance FromJSON InternalOperationData where-  parseJSON json = json & withObject "internal_operation_data" \o -> do-    (kind :: Text) <- o .: "kind"-    case kind of-      "event" -> IODEvent <$> parseJSON json-      _ -> pure IODIgnored--data IntOpEvent = IntOpEvent-  { ioeSource :: ContractAddress-  , ioeType :: Expression-  , ioeTag :: Maybe MText-  , ioePayload :: Maybe Expression-  }--instance Buildable IntOpEvent where-  build IntOpEvent{..} =-    "Contract event with source: " +| ioeSource |+ ", tag: " +| ioeTag |+ ", type: " +| ioeType |+-    ", and payload: " +| ioePayload |+ ""--instance FromJSON IntOpEvent where-  parseJSON = withObject "internal_operation_data_event" \o -> do-    IntOpEvent <$> o .: "source" <*> o .: "type" <*> o .:? "tag" <*> o .:? "payload"- data BlockConstants = BlockConstants   { bcProtocol :: Text   , bcChainId :: Text@@ -361,8 +342,8 @@  instance Buildable BadStackInformation where   build (BadStackInformation loc stack_portion prim stack_type) =-    "Bad Stack in location " +| loc |+ " stack portion " +| stack_portion |+-    " on primitive " +| prim |+ " with (wrong) stack type " +| stack_type |+ ""+    "Bad Stack in location" ++| loc |++ "stack portion" ++| stack_portion |+++    "on primitive" ++| prim |++ "with (wrong) stack type" ++| stack_type |++ ""  -- | Errors that are sent as part of operation result in an OK -- response (status 200). They are semi-formally defined as errors@@ -460,73 +441,72 @@  instance Buildable RunError where   build = \case-    RuntimeError addr -> "Runtime error for contract: " +| addr |+ ""-    ScriptRejected expr -> "Script rejected with: " +| expr |+ ""-    BadContractParameter addr -> "Bad contract parameter for: " +| addr |+ ""-    InvalidConstant expectedType expr ->-      "Invalid type: " +| expectedType |+ "\n" +|-      "For: " +| expr |+ ""-    InvalidContract addr -> "Invalid contract: " +| addr |+ ""+    RuntimeError addr -> nameF "Runtime error for contract" addr+    ScriptRejected expr -> nameF "Script rejected with:" expr+    BadContractParameter addr -> nameF "Bad contract parameter for" addr+    InvalidConstant expectedType expr -> unlinesF+      [ nameF "Invalid type" expectedType+      , nameF "For" expr+      ]+    InvalidContract addr -> nameF "Invalid contract" addr     InconsistentTypes type1 type2 ->-      "Inconsistent types: " +| type1 |+ " and " +| type2 |+ ""-    InvalidPrimitive expectedPrimitives wrongPrimitive ->-      "Invalid primitive: " +| wrongPrimitive |+ "\n" +|-      "Expecting one of: " +|-      mconcat (intersperse (" " :: Text) $ map pretty expectedPrimitives) |+ ""+      nameF "Inconsistent types" $ MkMismatchError type1 type2+    InvalidPrimitive expectedPrimitives wrongPrimitive -> unlinesF+      [ nameF "Invalid primitive" wrongPrimitive+      , nameF "Expecting one of" $ fillSepF' "," expectedPrimitives+      ]     InvalidSyntacticConstantError expectedForm wrongExpression ->-      "Invalid syntatic constant error, expecting: " +| expectedForm |+ "\n" +|-      "But got: " +| wrongExpression |+ ""+      nameF "Invalid syntatic constant error" $ MkMismatchError+        { meExpected = expectedForm, meActual = wrongExpression }     InvalidExpressionKind expectedKinds wrongKind ->-      "Invalid expression kind, expecting expression of kind: " +| expectedKinds |+ "\n" +|-      "But got: " +| wrongKind |+ ""-    InvalidContractNotation notation ->-      "Invalid contract notation: " +| notation |+ ""-    UnexpectedContract ->+      nameF "Invalid expression kind" $ MkMismatchError+        { meExpected = fillSepF' "," expectedKinds, meActual = build wrongKind }+    InvalidContractNotation notation -> nameF "Invalid contract notation" notation+    UnexpectedContract -> reflowF       "When parsing script, a contract type was found in \       \the storage or parameter field."-    IllFormedType expr ->-      "Ill formed type: " +| expr |+ ""-    UnexpectedOperation ->+    IllFormedType expr -> nameF "Ill formed type" expr+    UnexpectedOperation -> reflowF       "When parsing script, an operation type was found in \       \the storage or parameter field"     REEmptyTransaction addr ->-      "It's forbidden to send 0ꜩ to " +| addr |+ " that has no code"-    ScriptOverflow ->+      "It's forbidden to send 0ꜩ to " ++| addr |++ " that has no code"+    ScriptOverflow -> reflowF       "A contract failed due to the detection of an overflow"-    GasExhaustedOperation ->+    GasExhaustedOperation -> reflowF       "Contract failed due to gas exhaustion"-    MutezAdditionOverflow amounts ->-      "A contract failed due to mutez addition overflow when adding following values:\n" +|-      unwordsF amounts |+ ""-    MutezSubtractionUnderflow amounts ->-      "A contract failed due to mutez subtraction underflow when subtracting following values:\n" +|-      unwordsF amounts |+ ""+    MutezAdditionOverflow amounts -> nameF+      (reflowF "A contract failed due to mutez addition overflow when adding following values")+      $ fillSepF' "," amounts+    MutezSubtractionUnderflow amounts -> nameF+      (reflowF "A contract failed due to mutez subtraction underflow when subtracting following values")+      $ fillSepF' "," amounts     MutezMultiplicationOverflow amount multiplicator ->-      "A contract failed due to mutez multiplication overflow when multiplying" +|-      amount |+ " by " +| multiplicator |+ ""-    CantPayStorageFee ->+      "A contract failed due to mutez multiplication overflow when multiplying" ++|+      amount |++ "by" ++| multiplicator |++ ""+    CantPayStorageFee -> reflowF       "Balance is too low to pay storage fee"     BalanceTooLow (arg #balance -> balance) (arg #required -> required) ->-      "Balance is too low, \-      \current balance: " +| balance |+ ", but required: " +| required |+ ""-    PreviouslyRevealedKey addr ->-      "Key for " +| addr |+ " has already been revealed"-    NonExistingContract addr ->-      "Contract is not registered: " +| addr |+ ""+      nameF "Balance is too low" $ blockMapF @Text+        [ ("current balance:", balance)+        , ("required balance:", required)+        ]+    PreviouslyRevealedKey addr -> "Key for " ++| addr |++ " has already been revealed"+    NonExistingContract addr -> nameF "Contract is not registered" addr     InvalidB58Check input ->-      "Failed to read a valid b58check_encoding data from \"" +| input |+ "\""+      "Failed to read a valid b58check_encoding data from" ++| dquotes input |++ ""     UnregisteredDelegate addr ->-      addr |+ " is not registered as delegate"+      "" ++| addr |++ " is not registered as delegate"     FailedUnDelegation addr ->-      "Failed to withdraw delegation for: " +| addr |+ ""-    DelegateAlreadyActive ->-      "Delegate already active"-    REEmptyImplicitContract addr ->-      "Empty implicit contract (" +| addr |+ ")"-    IllTypedContract expr ->-      "Ill typed contract: " +| expr |+ ""+      "Failed to withdraw delegation for" ++| addr |++ ""+    DelegateAlreadyActive -> reflowF "Delegate already active"+    REEmptyImplicitContract addr -> nameF "Empty implicit contract" addr+    IllTypedContract expr -> nameF "Ill typed contract" expr     IllTypedData expected ill_typed ->-      "Ill typed data: Expected type " +| expected |+ ", ill typed expression: " +| ill_typed |+ ""+      nameF "Ill typed data" $ blockMapF @Text+        [ ("Expected type", build expected)+        , ("Ill typed expression", build ill_typed)+        ]     BadStack info -> build info     ForbiddenZeroAmountTicket -> "Forbidden zero amount ticket" @@ -553,13 +533,11 @@ instance Buildable InternalError where   build = \case     CounterInThePast addr (arg #expected -> expected) (arg #found -> found) ->-      "Expected counter " +| expected |+ " for " +| addr |+ "but got: " +|-      found |+ ""+      "Expected counter" ++| expected |++ "for" ++| addr |++ "but got:" ++| found |++ ""     UnrevealedKey addr ->       "One tried to apply a manager operation without revealing " <>-      "the manager public key of " <> build addr-    Failure msg ->-      "Contract failed with the following message: " +| msg |+ ""+      "the manager public key of " ++| addr |++ ""+    Failure msg -> nameF (reflowF "Contract failed with the following message") msg  instance FromJSON InternalError where   parseJSON = withObject "internal error" $ \o ->@@ -633,8 +611,13 @@ data ParametersInternal = ParametersInternal   { piEntrypoint :: Text   , piValue :: Expression-  }+  } deriving stock (Generic, Show)+    deriving (FromJSON, ToJSON) via ClientJSON ParametersInternal +instance Buildable ParametersInternal where+  build ParametersInternal{..} =+    "entrypoint:" ++| (build piEntrypoint <> ",") |++ "value:" ++| piValue |++ ""+ -- | 'ParametersInternal' can be missing when default entrypoint is called with -- Unit value. Usually it happens when destination is an implicit account. -- In our structures 'ParametersInternal' is not optional because missing@@ -643,7 +626,7 @@ defaultParametersInternal = ParametersInternal   { piEntrypoint = "default"   , piValue = expressionPrim MichelinePrimAp-    { mpaPrim = MichelinePrimitive "Unit"+    { mpaPrim = Prim_Unit     , mpaArgs = []     , mpaAnnots = []     }@@ -737,6 +720,18 @@ instance FromJSON a => FromJSON (WithCommonOperationData a) where   parseJSON v = WithCommonOperationData <$> parseJSON v <*> parseJSON v +data WithSource a = WithSource+  { wsSource :: Address+  , wsOtherData :: a+  } deriving stock (Show, Functor)++instance FromJSON a => FromJSON (WithSource a) where+  parseJSON v = v & withObject "WithSource" \o ->+    WithSource <$> (o .: "source") <*> parseJSON v++instance Buildable a => Buildable (WithSource a) where+  build WithSource{..} = "" ++| (build wsOtherData <> ",") |++ "and source" ++| wsSource |++ ""+ -- | All the data needed to perform a transaction through -- Tezos RPC interface. -- For additional information, please refer to RPC documentation@@ -745,8 +740,15 @@   { toAmount :: TezosMutez   , toDestination :: Address   , toParameters :: ParametersInternal-  }+  } deriving stock Show +instance Buildable TransactionOperation where+  build TransactionOperation{..} = enumerateF' ","+    [ ("Transaction with amount:", build $ unTezosMutez toAmount)+    , ("destination:", build toDestination)+    , ("and parameter:", build toParameters)+    ]+ data TransferTicketOperation = TransferTicketOperation   { ttoTicketContents :: Expression   , ttoTicketTy :: Expression@@ -754,12 +756,24 @@   , ttoTicketAmount :: TezosNat   , ttoDestination :: Address   , ttoEntrypoint :: Text-  }+  } deriving stock (Show) +instance Buildable TransferTicketOperation where+  build TransferTicketOperation{..} =+    nameF "Transfer ticket with" $ blockListF+      [ nameF "Contents" $ build ttoTicketContents+      , nameF "Type" $ build ttoTicketTy+      , nameF "Ticketer" $ build ttoTicketTicketer+      , nameF "Amount" $ build ttoTicketAmount+      , nameF "Destination" $ build ttoDestination+      , nameF "Entrypoint" $ build ttoEntrypoint+      ]+ data OriginationScript = OriginationScript   { osCode :: Expression   , osStorage :: Expression-  }+  } deriving stock (Generic, Show)+    deriving (FromJSON, ToJSON) via ClientJSON OriginationScript  -- | All the data needed to perform contract origination -- through Tezos RPC interface@@ -767,33 +781,71 @@   { ooBalance :: TezosMutez   , ooDelegate :: Maybe KeyHash   , ooScript :: OriginationScript-  }+  } deriving stock (Generic, Show)+    deriving (FromJSON) via ClientJSON OriginationOperation+    deriving anyclass ToJSONObject +instance Buildable OriginationOperation where+  build OriginationOperation{..} =+    "Origination operation with balance " ++| (build (unTezosMutez ooBalance) <> ",")+      |++ "delegate" ++| ooDelegate |++ ""++instance ToJSON OriginationOperation where+  toJSON OriginationOperation{..} = object $+    [ "kind" .= String "origination"+    , "balance" .= ooBalance+    , "script" .= ooScript+    ] <> maybeToList (("delegate" .=) <$> ooDelegate)+ -- | All the data needed to perform key revealing -- through Tezos RPC interface data RevealOperation = RevealOperation   { roPublicKey :: PublicKey-  }+  } deriving stock (Generic, Show)+    deriving anyclass ToJSONObject+    deriving FromJSON via ClientJSON RevealOperation  instance ToJSON RevealOperation where   toJSON RevealOperation{..} = object $     [ "kind" .= String "reveal"     , "public_key" .= roPublicKey     ]-instance ToJSONObject RevealOperation +instance Buildable RevealOperation where+  build (RevealOperation pk) = "Reveal operation for public key" ++| pk |++ ""+ data DelegationOperation = DelegationOperation   { doDelegate :: Maybe KeyHash     -- ^ 'Nothing' removes delegate, 'Just' sets it-  }+  } deriving stock (Generic, Show)+    deriving FromJSON via ClientJSON DelegationOperation+    deriving anyclass ToJSONObject  instance ToJSON DelegationOperation where   toJSON DelegationOperation{..} = object $     [ "kind" .= String "delegation" ]     <> maybeToList (("delegate" .=) <$> doDelegate) -instance ToJSONObject DelegationOperation+instance Buildable DelegationOperation where+  build DelegationOperation{..} = case doDelegate of+    Nothing -> reflowF "Delegation operation removing delegate"+    Just kh -> "Delegation operation setting delegate to" ++| kh |++ "" +data EventOperation = EventOperation+  { eoType :: Expression+  , eoTag :: Maybe MText+  , eoPayload :: Maybe Expression+  } deriving stock (Generic, Show)+    deriving anyclass ToJSONObject+    deriving (ToJSON, FromJSON) via ClientJSON EventOperation++instance Buildable EventOperation where+  build EventOperation{..} = enumerateF' ","+    [ ("Contract event with tag:", build eoTag)+    , ("type:", build eoType)+    , ("and payload:", build eoPayload)+    ]+ -- | @$operation@ in Tezos docs. data BlockOperation = BlockOperation   { boHash :: Text@@ -801,14 +853,36 @@   }  -- | Contents of an operation that can appear in RPC responses.-data OperationResp-  = TransactionOpResp (WithCommonOperationData TransactionOperation)+data OperationResp f+  = TransactionOpResp (f TransactionOperation)   -- ^ Operation with kind @transaction@.-  | OtherOpResp-  -- ^ Operation with kind that we don't support yet (but need to parse to something).+  | TransferTicketOpResp (f TransferTicketOperation)+  -- ^ Operation with kind @transfer_ticket@.+  | OriginationOpResp (f OriginationOperation)+  -- ^ Operation with kind @origination@.+  | DelegationOpResp (f DelegationOperation)+  -- ^ Operation with kind @delegation@.+  | RevealOpResp (f RevealOperation)+  -- ^ Operation with kind @reveal@.+  | EventOpResp (f EventOperation)+  -- ^ Operation with kind @event@.+  | OtherOpResp Text+  -- ^ Response we don't handle yet. +deriving stock instance (forall a. Show a => Show (f a)) => Show (OperationResp f)++instance (forall a. Buildable a => Buildable (f a)) => Buildable (OperationResp f) where+  build = \case+    TransactionOpResp x -> build x+    TransferTicketOpResp x -> build x+    OriginationOpResp x -> build x+    DelegationOpResp x -> build x+    RevealOpResp x -> build x+    EventOpResp x -> build x+    OtherOpResp x -> "Unsupported operation kind: " <> build x+ data OperationRespWithMeta = OperationRespWithMeta-  { orwmResponse :: OperationResp+  { orwmResponse :: OperationResp WithCommonOperationData   , orwmMetadata :: Maybe OperationMetadata   } @@ -873,8 +947,6 @@  data MonitorHeadsStep a = MonitorHeadsStop a | MonitorHeadsContinue -deriveJSON morleyClientAesonOptions ''ParametersInternal- instance ToJSON TransactionOperation where   toJSON TransactionOperation{..} = object $     [ "kind" .= String "transaction"@@ -903,27 +975,20 @@     toParameters <- fromMaybe defaultParametersInternal <$> obj .:? "parameters"     pure TransactionOperation {..} -instance FromJSON OperationResp where-  parseJSON = withObject "OperationResp" $ \obj -> do+instance (forall a. FromJSON a => FromJSON (f a)) => FromJSON (OperationResp f) where+  parseJSON json = json & withObject "OperationResp" \obj -> do     kind :: Text <- obj .: "kind"     case kind of-      "transaction" -> TransactionOpResp <$> parseJSON (Object obj)-      _ -> pure OtherOpResp+      "transaction" -> TransactionOpResp <$> parseJSON json+      "origination" -> OriginationOpResp <$> parseJSON json+      "delegation"  -> DelegationOpResp <$> parseJSON json+      "event"  -> EventOpResp <$> parseJSON json+      x -> pure $ OtherOpResp x  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-    ] <> maybeToList (("delegate" .=) <$> ooDelegate)-instance ToJSONObject OriginationOperation- instance ToJSON ForgeOperation where   toJSON ForgeOperation{..} = object     [ "branch" .= unBlockHash foBranch@@ -945,6 +1010,39 @@     , "signature" .= formatSignature paoSignature     ] +data PackData = PackData+  { pdData :: Expression+  , pdType :: Expression+  , pdGas :: Maybe TezosBigNum+  }++instance Buildable PackData where+  build PackData{..} = enumerateF' "," $+    [ ("Pack data request with data:", build pdData)+    , ("type:", build pdType)+    ] <> maybeToList (("gas:",) . build . unStringEncode <$> pdGas)++data PackDataResult = PackDataResult+  { pdrPacked :: Text+  , pdrGas :: PackDataResultGas+  }++newtype PackDataResultGas = PackDataResultGas (Maybe TezosBigNum)++instance FromJSON PackDataResultGas where+  parseJSON o = o & withText "PackDataResultGas" \case+    "unaccounted" -> pure $ PackDataResultGas Nothing+    _ -> PackDataResultGas . Just <$> parseJSON o++instance Buildable PackDataResultGas where+  build (PackDataResultGas x) = maybe "unaccounted" (build . unStringEncode) x++instance Buildable PackDataResult where+  build PackDataResult{..} = enumerateF' ","+    [ ("Pack data response packed data:", build pdrPacked)+    , ("gas:", build pdrGas)+    ]+ deriveToJSON morleyClientAesonOptions ''RunOperation deriveToJSON morleyClientAesonOptions ''GetBigMap deriveToJSON morleyClientAesonOptions ''GetTicketBalance@@ -957,8 +1055,9 @@ deriveJSON morleyClientAesonOptions ''BlockHeader deriveFromJSON morleyClientAesonOptions ''ProtocolParameters deriveFromJSON morleyClientAesonOptions ''BlockOperation-deriveFromJSON morleyClientAesonOptions ''OriginationScript deriveFromJSON morleyClientAesonOptions ''RunCodeResult+deriveToJSON morleyClientAesonOptions{omitNothingFields = True} ''PackData+deriveFromJSON morleyClientAesonOptions ''PackDataResult  instance FromJSON GetBigMapResult where   parseJSON v = maybe GetBigMapNotFound GetBigMapResult <$> parseJSON v

@@ -11,26 +11,13 @@  import Data.ByteArray (ScrubbedBytes) +import Morley.Client.TezosClient.Types import Morley.Client.Types+import Morley.Client.Types.AliasesAndAddresses import Morley.Tezos.Address import Morley.Tezos.Address.Alias import Morley.Tezos.Crypto --- | How to save the originated contract address.-data AliasBehavior-  = DontSaveAlias-  -- ^ Don't save the newly originated contract address.-  | KeepDuplicateAlias-  -- ^ If an alias already exists, keep it, don't save the newly originated-  -- contract address.-  | OverwriteDuplicateAlias-  -- ^ If an alias already exists, replace it with the address of the newly-  -- originated contract.-  | ForbidDuplicateAlias-  -- ^ If an alias already exists, throw an exception without doing the-  -- origination-  deriving stock (Eq, Ord, Enum)- -- | Type class that provides interaction with @octez-client@ binary class (Monad m) => HasTezosClient m where   signBytes@@ -51,16 +38,11 @@   -- ^ Associate the given contract with alias.   -- The 'Bool' variable indicates whether or not we should replace already   -- existing contract alias or not.-  getAliasesAndAddresses :: m [(Text, Text)]+  getAliasesAndAddresses :: m AliasesAndAddresses   -- ^ Retrieves a list with all known aliases and respective addresses.   --   -- Note that an alias can be ambiguous: it can refer to BOTH a contract and an implicit account.-  -- When an alias "abc" is ambiguous, the list will contain two entries:-  ---  -- > ("abc", "KT1...")-  -- > ("key:abc", "tz1...")-  ---  -- TODO [#910]: Cache this and turn it into a 'Morley.Util.Bimap'.+  -- In that case, the map will contain entries for both.   getKeyPassword :: ImplicitAddressWithAlias -> m (Maybe ScrubbedBytes)   -- ^ Get password for secret key associated with given address   -- in case this key is password-protected. Obtained password is used

@@ -0,0 +1,39 @@+-- SPDX-FileCopyrightText: 2023 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++-- | @octez-client@ config.+module Morley.Client.TezosClient.Config+  ( TezosClientConfig (..)++  -- * @octez-client@ api+  , getTezosClientConfig+  ) where++import Data.Aeson (FromJSON(..), eitherDecodeStrict, withObject, (.:))+import Servant.Client (BaseUrl(..))+import System.Exit (ExitCode(..))++import Morley.Client.TezosClient.Helpers+import Morley.Client.TezosClient.Types.Errors++-- | Configuration maintained by @octez-client@, see its @config@ subcommands+-- (e. g. @octez-client config show@).+-- Only the field we are interested in is present here.+newtype TezosClientConfig = TezosClientConfig { tcEndpointUrl :: BaseUrl }+  deriving stock Show++-- | For reading @octez-client@ config.+instance FromJSON TezosClientConfig where+  parseJSON = withObject "node info" $ \o -> TezosClientConfig <$> o .: "endpoint"++-- | Read @octez-client@ configuration.+getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig+getTezosClientConfig client mbDataDir = do+  t <- readProcessWithExitCode' client+    (maybe [] (\dir -> ["-d", dir]) mbDataDir ++  ["config", "show"]) ""+  case t of+    (ExitSuccess, toText -> output, _) -> case eitherDecodeStrict . encodeUtf8 . toText $ output of+        Right config -> pure config+        Left err -> throwM $ ConfigParseError err+    (ExitFailure errCode, toText -> output, toText -> errOutput) ->+      throwM $ UnexpectedClientFailure errCode output errOutput

@@ -0,0 +1,138 @@+-- SPDX-FileCopyrightText: 2023 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++-- | Helpers used to call @octez-client@.+module Morley.Client.TezosClient.Helpers+  ( CallMode(..)+  , callTezosClient+  , callTezosClientStrict+  , readProcessWithExitCode'+  ) where++import Unsafe qualified ((!!))++import Colourista (formatWith, red)+import Control.Exception (IOException, throwIO)+import Data.ByteArray (ScrubbedBytes)+import Data.Text qualified as T+import System.Exit (ExitCode(..))+import System.Process (readProcessWithExitCode)++import Morley.Client.Logging+import Morley.Client.TezosClient.Types+import Morley.Client.TezosClient.Types.Errors+import Morley.Client.Util (scrubbedBytesToString)++-- | Datatype that represents modes for calling node from @octez-client@.+data CallMode+  = MockupMode+  -- ^ Mode in which @octez-client@ doesn't perform any actual RPC calls to the node+  -- and use mock instead.+  | ClientMode+  -- ^ Normal mode in which @octez-client@ performs all necessary RPC calls to the node.++-- | Call @octez-client@ with given arguments. Arguments defined by+-- config are added automatically. The second argument specifies what+-- should be done in failure case. It takes stdout and stderr+-- output. Possible handling:+--+-- 1. Parse a specific error and throw it.+-- 2. Parse an expected error that shouldn't cause a failure.+-- Return @True@ in this case.+-- 3. Detect an unexpected error, return @False@.+-- In this case 'UnexpectedClientFailure' will be throw.+callTezosClient+  :: forall env m. (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)+  => (Text -> Text -> IO Bool) -> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text+callTezosClient errHandler args mode mbInput = retryEConnreset mode $ do+  TezosClientEnv {..} <- view tezosClientEnvL+  let+    extraArgs :: [String]+    extraArgs = mconcat+      [ ["-E", toCmdArg tceEndpointUrl]+      , maybe [] (\dir -> ["-d", dir]) tceMbTezosClientDataDir+      , ["--mode", case mode of+            MockupMode -> "mockup"+            ClientMode -> "client"+        ]+      ]++    allArgs = extraArgs ++ args+  logDebug $ "Running: " <> unwords (toText <$> tceTezosClientPath:allArgs)+  let+    ifNotEmpty prefix output+      | null output = ""+      | otherwise = prefix <> ":\n" <> output+    logOutput :: Text -> Text -> m ()+    logOutput output errOutput = logDebug $+      ifNotEmpty "stdout" output <>+      ifNotEmpty "stderr" errOutput++  liftIO (readProcessWithExitCode' tceTezosClientPath allArgs+          (maybe "" scrubbedBytesToString mbInput)) >>= \case+    (ExitSuccess, toText -> output, toText -> errOutput) ->+      output <$ logOutput output errOutput+    (ExitFailure errCode, toText -> output, toText -> errOutput) -> do+      checkCounterError errOutput+      checkEConnreset errOutput+      liftIO $ unlessM (errHandler output errOutput) $+        throwM $ UnexpectedClientFailure errCode output errOutput++      output <$ logOutput output errOutput+  where+    checkCounterError+      :: Text -> m ()+    checkCounterError errOutput |+      "Counter" `T.isPrefixOf` errOutput && "already used for contract" `T.isInfixOf` errOutput = do+        let splittedErrOutput = words errOutput+        liftIO $ throwM $+          CounterIsAlreadyUsed (splittedErrOutput Unsafe.!! 1) (splittedErrOutput Unsafe.!! 5)+    checkCounterError _ = pass+    checkEConnreset :: Text -> m ()+    checkEConnreset errOutput+      | "Unix.ECONNRESET" `T.isInfixOf` errOutput = throwM EConnreset+    checkEConnreset _ = pass++    -- Helper function that retries @octez-client@ call action in case of @ECONNRESET@.+    -- Note that this error cannot appear in case of 'MockupMode' call.+    retryEConnreset :: CallMode -> m a -> m a+    retryEConnreset MockupMode action = action+    retryEConnreset ClientMode action = retryEConnresetImpl 0 action++    retryEConnresetImpl :: Integer -> m a -> m a+    retryEConnresetImpl attempt action = action `catch` \err -> do+      case err of+        EConnreset ->+          if attempt >= maxRetryAmount then throwM err+          else retryEConnresetImpl (attempt + 1) action+        anotherErr -> throwM anotherErr++    maxRetryAmount = 5++-- | Call @octez-client@ and expect success.+callTezosClientStrict+  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)+  => [String] -> CallMode -> Maybe ScrubbedBytes -> m Text+callTezosClientStrict = callTezosClient errHandler+  where+    errHandler _ _ = pure False++-- | Variant of @readProcessWithExitCode@ that prints a better error in case of+-- an exception in the inner @readProcessWithExitCode@ call.+readProcessWithExitCode'+  :: FilePath+  -> [String]+  -> String+  -> IO (ExitCode, String, String)+readProcessWithExitCode' fp args inp =+  catch+    (readProcessWithExitCode fp args inp) handler+  where+    handler :: IOException -> IO (ExitCode, String, String)+    handler e = do+      hPutStrLn @Text stderr $ formatWith [red] errorMsg+      throwIO e++    errorMsg =+      "ERROR!! There was an error in executing `" <> toText fp <> "` program. Is the \+      \ executable available in PATH ?"

@@ -1,8 +1,9 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA --- | Interface to the @octez-client@ executable expressed in Haskell types.+{-# OPTIONS_GHC -Wno-orphans #-} +-- | Interface to the @octez-client@ executable expressed in Haskell types. module Morley.Client.TezosClient.Impl   ( TezosClientError (..) @@ -32,173 +33,44 @@   , resolveAddressWithAlias   , resolveAddressWithAliasMaybe -  -- * Internals-  , findAddress-  , FindAddressResult(..)-  , CallMode(..)-  , callTezosClient-  , callTezosClientStrict+    -- * For tests+  , lookupAliasCache   ) where -import Unsafe qualified ((!!))--import Colourista (formatWith, red)-import Control.Exception (IOException, throwIO)-import Data.Aeson (eitherDecodeStrict, encode)+import Data.Aeson (encode) import Data.ByteArray (ScrubbedBytes) import Data.ByteString.Lazy.Char8 qualified as C (unpack)+import Data.Constraint ((\\)) import Data.Text qualified as T-import Fmt (Buildable(..), pretty, (+|), (|+))-import System.Exit (ExitCode(..))-import System.Process (readProcessWithExitCode)+import Fmt (pretty, (+|), (|+)) import Text.Printf (printf) import UnliftIO.IO (hGetEcho, hSetEcho) -import Data.Constraint ((\\))-import Data.Singletons (demote) import Lorentz.Value+import Morley.Client.App import Morley.Client.Logging-import Morley.Client.RPC.Class (HasTezosRpc) import Morley.Client.RPC.Getters (getManagerKey)-import Morley.Client.RPC.Types-import Morley.Client.TezosClient.Class (AliasBehavior(..))-import Morley.Client.TezosClient.Class qualified as Class (HasTezosClient(..))+import Morley.Client.TezosClient.Class qualified as Class+import Morley.Client.TezosClient.Config+import Morley.Client.TezosClient.Helpers import Morley.Client.TezosClient.Parser+import Morley.Client.TezosClient.Resolve import Morley.Client.TezosClient.Types+import Morley.Client.TezosClient.Types.Errors+import Morley.Client.TezosClient.Types.MorleyClientM import Morley.Client.Types-import Morley.Client.Util (readScrubbedBytes, scrubbedBytesToString)+import Morley.Client.Types.AliasesAndAddresses+import Morley.Client.Util (readScrubbedBytes) import Morley.Micheline import Morley.Michelson.Typed.Scope import Morley.Tezos.Address import Morley.Tezos.Address.Alias-import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto+import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519 import Morley.Util.Constrained-import Morley.Util.Interpolate (itu) import Morley.Util.Peano-import Morley.Util.Sing (castSing) import Morley.Util.SizedList.Types -------------------------------------------------------------------------------- Errors--------------------------------------------------------------------------------- | A data type for all /predicatable/ errors that can happen during--- @octez-client@ usage.-data TezosClientError =-    UnexpectedClientFailure-    -- ^ @octez-client@ call unexpectedly failed (returned non-zero exit code).-    -- The error contains the error code, stdout and stderr contents.-      Int -- ^ Exit code-      Text -- ^ stdout-      Text -- ^ stderr--  -- These errors represent specific known scenarios.-  | AlreadyRevealed-    -- ^ Public key of the given address is already revealed.-      ImplicitAlias -- ^ Address alias that has already revealed its key-  | InvalidOperationHash-    -- ^ Can't wait for inclusion of operation with given hash because-    -- the hash is invalid.-      OperationHash-  | CounterIsAlreadyUsed-    -- ^ Error that indicates when given counter is already used for-    -- given contract.-    Text -- ^ Raw counter-    Text -- ^ Raw address-  | EConnreset-    -- ^ Network error with which @octez-client@ fails from time to time.--  -- Note: the errors below most likely indicate that something is wrong in our code.-  -- Maybe we made a wrong assumption about @octez-client@ or just didn't consider some case.-  -- Another possible reason that a broken @octez-client@ is used.-  | ConfigParseError String-  -- ^ A parse error occurred during config parsing.-  | TezosClientCryptoParseError Text CryptoParseError-  -- ^ @octez-client@ produced a cryptographic primitive that we can't parse.-  | TezosClientParseAddressError Text ParseAddressError-  -- ^ @octez-client@ produced an address that we can't parse.-  | TezosClientParseFeeError Text Text-  -- ^ @octez-client@ produced invalid output for parsing baker fee-  | TezosClientUnexpectedOutputFormat Text-  -- ^ @octez-client@ printed a string that doesn't match the format we expect.-  | CantRevealContract-    -- ^ Given alias is a contract and cannot be revealed.-    ImplicitAlias -- ^ Address alias of implicit account-  | ContractSender ContractAddress Text-    -- ^ Given contract is a source of a transfer or origination operation.-  | EmptyImplicitContract-    -- ^ Given alias is an empty implicit contract.-    ImplicitAlias -- ^ Address alias of implicit contract-  | TezosClientUnexpectedSignatureOutput Text-  -- ^ @octez-client sign bytes@ produced unexpected output format-  | TezosClientParseEncryptionTypeError Text Text-  -- ^ @octez-client@ produced invalid output for parsing secret key encryption type.-  | DuplicateAlias Text-  -- ^ Tried to save alias, but such alias already exists.-  | AmbiguousAlias Text ContractAddress ImplicitAddress-  -- ^ Expected an alias to be associated with either an implicit address or a-  -- contract address, but it was associated with both.-  | ResolveError ResolveError--deriving stock instance Show TezosClientError--instance Exception TezosClientError where-  displayException = pretty--instance Buildable TezosClientError where-  build = \case-    UnexpectedClientFailure errCode output errOutput ->-      "`octez-client` unexpectedly failed with error code " +| errCode |+-      ". Stdout:\n" +| output |+ "\nStderr:\n" +| errOutput |+ ""-    AlreadyRevealed alias ->-      "The address alias " <> build alias <> " is already revealed"-    InvalidOperationHash hash ->-      "Can't wait for inclusion of operation " <> build hash <>-      " because this hash is invalid."-    CounterIsAlreadyUsed counter addr ->-      "Counter " +| counter |+ " already used for " +| addr |+ "."-    EConnreset -> "`octez-client` call failed with 'Unix.ECONNRESET' error."-    ConfigParseError err ->-      "A parse error occurred during config parsing: " <> build err-    TezosClientCryptoParseError txt err ->-      "`octez-client` produced a cryptographic primitive that we can't parse: " +|-      txt |+ ".\n The error is: " +| err |+ "."-    TezosClientParseAddressError txt err ->-      "`octez-client` produced an address that we can't parse: " +|-      txt |+ ".\n The error is: " +| err |+ "."-    TezosClientParseFeeError txt err ->-      "`octez-client` produced invalid output for parsing baker fee: " +|-      txt |+ ".\n Parsing error is: " +| err |+ ""-    TezosClientUnexpectedOutputFormat txt ->-      "`octez-client` printed a string that doesn't match the format we expect:\n" <>-      build txt-    CantRevealContract alias ->-      "Contracts (" <> build alias <> ") cannot be revealed"-    ContractSender addr opName ->-      "Contract (" <> build addr <> ") cannot be source of " +| opName |+ ""-    EmptyImplicitContract alias ->-      "Empty implicit contract (" <> build alias <> ")"-    TezosClientUnexpectedSignatureOutput txt ->-      "`octez-client sign bytes` call returned a signature in format we don't expect:\n" <>-      build txt-    TezosClientParseEncryptionTypeError txt err ->-      "`octez-client` produced invalid output for parsing secret key encryption type: " +|-      txt |+ ".\n Parsing error is: " +| err |+ ""-    DuplicateAlias alias -> "Attempted to save alias '" +| alias |+ "', but it already exists"-    AmbiguousAlias aliasText contractAddr implicitAddr ->-      [itu|-        The alias '#{aliasText}' is assigned to both:-          * a contract address: #{contractAddr}-          * and an implicit address: #{implicitAddr}-        Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate.-        |]-    ResolveError err -> build err--------------------------------------------------------------------------------- API------------------------------------------------------------------------------ -- Note: if we try to sign with an unknown alias, @octez-client@ will -- report a fatal error (assert failure) to stdout. It's bad. It's -- reported in two issues: https://gitlab.com/tezos/tezos/-/issues/653@@ -208,11 +80,10 @@ -- | Sign an arbtrary bytestring using @octez-client@. -- Secret key of the address corresponding to give 'AddressOrAlias' must be known. signBytes-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => ImplicitAlias+  :: ImplicitAlias   -> Maybe ScrubbedBytes   -> ByteString-  -> m Signature+  -> MorleyClientM Signature signBytes signerAlias mbPassword opHash = do   logDebug $ "Signing for " <> pretty signerAlias   output <- callTezosClientStrict@@ -232,32 +103,28 @@ -- | Generate a new secret key and save it with given alias. -- If an address with given alias already exists, it will be returned -- and no state will be changed.-genKey-  :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m-     , Class.HasTezosClient m)-  => ImplicitAlias-  -> m ImplicitAddress+genKey :: ImplicitAlias -> MorleyClientM ImplicitAddress genKey name = do-  let-    isAlreadyExistsError :: Text -> Bool-    -- We can do a bit better here using more complex parsing if necessary.-    isAlreadyExistsError = T.isInfixOf "already exists."+  lookupAliasCache name >>= \case+    Just addr -> pure addr+    Nothing -> do+      let+        isAlreadyExistsError :: Text -> Bool+        -- We can do a bit better here using more complex parsing if necessary.+        isAlreadyExistsError = T.isInfixOf "already exists." -    errHandler _ errOut = pure (isAlreadyExistsError errOut)+        errHandler _ errOut = pure (isAlreadyExistsError errOut) -  _ <--    callTezosClient errHandler-    ["gen", "keys", toCmdArg name] MockupMode Nothing-  resolveAddress (AddressAlias name)+      _ <-+        callTezosClient errHandler+        ["gen", "keys", toCmdArg name] MockupMode Nothing+      invalidateAliasCache+      resolveAddress (AddressAlias name)  -- | Generate a new secret key and save it with given alias. -- If an address with given alias already exists, it will be removed -- and replaced with a fresh one.-genFreshKey-  :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m-     , Class.HasTezosClient m)-  => ImplicitAlias-  -> m ImplicitAddress+genFreshKey :: ImplicitAlias -> MorleyClientM ImplicitAddress genFreshKey name = do   let     isNoAliasError :: Text -> Bool@@ -270,15 +137,12 @@     callTezosClient errHandler     ["forget", "address", toCmdArg name, "--force"] MockupMode Nothing   callTezosClientStrict ["gen", "keys", toCmdArg name] MockupMode Nothing+  invalidateAliasCache   resolveAddress (AddressAlias name)  -- | Reveal public key corresponding to the given alias. -- Fails if it's already revealed.-revealKey-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => ImplicitAlias-  -> Maybe ScrubbedBytes-  -> m ()+revealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> MorleyClientM () revealKey alias mbPassword = do   logDebug $ "Revealing key for " +| alias |+ ""   let@@ -298,11 +162,7 @@   logDebug $ "Successfully revealed key for " +| alias |+ ""  -- | Reveal key for implicit address if necessary.-revealKeyUnlessRevealed-  :: (WithClientLog env m, HasTezosRpc m, MonadIO m, HasTezosClientEnv env)-  => ImplicitAddressWithAlias-  -> Maybe ScrubbedBytes-  -> m ()+revealKeyUnlessRevealed :: ImplicitAddressWithAlias -> Maybe ScrubbedBytes -> MorleyClientM () revealKeyUnlessRevealed (AddressWithAlias addr alias) mbPassword = do   mbManagerKey <- getManagerKey addr   case mbManagerKey of@@ -310,11 +170,7 @@     Just _  -> logDebug $ alias |+ " alias has already revealed key"  -- | Register alias as delegate-registerDelegate-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => ImplicitAlias-  -> Maybe ScrubbedBytes-  -> m ()+registerDelegate :: ImplicitAlias -> Maybe ScrubbedBytes -> MorleyClientM () registerDelegate alias mbPassword = do   logDebug $ "Registering " +| alias |+ " as delegate"   let@@ -330,17 +186,14 @@   logDebug $ "Successfully registered " +| alias |+ " as delegate"  -- | Call @octez-client@ to list known addresses or contracts-callListKnown-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => String -> m Text+callListKnown :: String -> MorleyClientM Text callListKnown objects =   callTezosClientStrict ["list", "known", objects] MockupMode Nothing  -- | Return 'PublicKey' corresponding to given 'AddressOrAlias'. getPublicKey-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => ImplicitAlias-  -> m PublicKey+  :: ImplicitAlias+  -> MorleyClientM PublicKey getPublicKey alias = do   logDebug $ "Getting " +| alias |+ " public key"   output <- callTezosClientStrict ["show", "address", toCmdArg alias] MockupMode Nothing@@ -355,9 +208,8 @@  -- | Return 'SecretKey' corresponding to given 'AddressOrAlias'. getSecretKey-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => ImplicitAlias-  -> m SecretKey+  :: ImplicitAlias+  -> MorleyClientM SecretKey getSecretKey alias = do   logDebug $ "Getting " +| alias |+ " secret key"   output <- callTezosClientStrict ["show", "address", toCmdArg alias, "--show-secret"] MockupMode Nothing@@ -374,80 +226,69 @@ -- If @replaceExisting@ is @False@ and a contract with given alias -- already exists, this function does nothing. rememberContract-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => AliasBehavior+  :: AliasBehavior   -> ContractAddress   -> ContractAlias-  -> m ()-rememberContract aliasBehavior address alias = case aliasBehavior of-  DontSaveAlias ->-    logInfo $ "Not saving " +| address |+ " as " +| alias |+ " as requested"-  OverwriteDuplicateAlias ->-    void $ callTezosClient (\_ _ -> pure False) (args <> ["--force"]) MockupMode Nothing-  _ -> do-    let errHandler _ errOut-          | isAlreadyExistsError errOut = case aliasBehavior of-              KeepDuplicateAlias -> pure True-              ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias-          | otherwise = pure False-    void $ callTezosClient errHandler args MockupMode Nothing+  -> MorleyClientM ()+rememberContract aliasBehavior address alias = do+  case aliasBehavior of+    DontSaveAlias ->+      logInfo $ "Not saving " +| address |+ " as " +| alias |+ " as requested"+    OverwriteDuplicateAlias -> do+      void $ callTezosClientStrict (args <> ["--force"]) MockupMode Nothing+      tryUpdateAliasCache alias address+    _ -> do+      lookupAliasCache alias >>= \case+        Nothing -> do+          let errHandler _ errOut+                | isAlreadyExistsError errOut = case aliasBehavior of+                    KeepDuplicateAlias -> pure True+                    ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias+                | otherwise = pure False+          void $ callTezosClient errHandler args MockupMode Nothing+          tryUpdateAliasCache alias address+        Just{} -> case aliasBehavior of+          KeepDuplicateAlias -> pass+          ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias   where     args = ["remember", "contract", toCmdArg alias, pretty address]     isAlreadyExistsError = T.isInfixOf "already exists"  importKey-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => Bool+  :: Bool   -> ImplicitAlias   -> SecretKey-  -> m ImplicitAddressWithAlias+  -> MorleyClientM ImplicitAddressWithAlias importKey replaceExisting name key = do-  let-    isAlreadyExistsError = T.isInfixOf "already exists"-    errHandler _ errOut = pure (isAlreadyExistsError errOut)-    args = ["import", "secret", "key", toCmdArg name, toCmdArg key]-  _ <--    callTezosClient errHandler+  let isAlreadyExistsError = T.isInfixOf "already exists"+      errHandler _ errOut+        | isAlreadyExistsError errOut = throwM $ DuplicateAlias $ unAlias name+        | otherwise = pure False+      args = ["import", "secret", "key", toCmdArg name, toCmdArg key]+  void $ callTezosClient errHandler     (if replaceExisting then args <> ["--force"] else args)     MockupMode Nothing-  pure $ AddressWithAlias (mkKeyAddress (toPublic key)) name---- | Read @octez-client@ configuration.-getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig-getTezosClientConfig client mbDataDir = do-  t <- readProcessWithExitCode' client-    (maybe [] (\dir -> ["-d", dir]) mbDataDir ++  ["config", "show"]) ""-  case t of-    (ExitSuccess, toText -> output, _) -> case eitherDecodeStrict . encodeUtf8 . toText $ output of-        Right config -> pure config-        Left err -> throwM $ ConfigParseError err-    (ExitFailure errCode, toText -> output, toText -> errOutput) ->-      throwM $ UnexpectedClientFailure errCode output errOutput+  let addr = mkKeyAddress (toPublic key)+  tryUpdateAliasCache name addr+  pure $ AddressWithAlias addr name  -- | Calc baker fee for transfer using @octez-client@. calcTransferFee-  :: ( WithClientLog env m, HasTezosClientEnv env-     , MonadIO m, MonadCatch m-     )-  => AddressOrAlias kind+  :: AddressOrAlias kind   -> Maybe ScrubbedBytes   -> TezosInt64   -> [CalcTransferFeeData]-  -> m [TezosMutez]+  -> MorleyClientM [TezosMutez] calcTransferFee from mbPassword burnCap transferFeeDatas = do   output <- callTezosClientStrict     [ "multiple", "transfers", "from", pretty from, "using"     , C.unpack $ encode transferFeeDatas, "--burn-cap", showBurnCap burnCap, "--dry-run"     ] ClientMode mbPassword-  withSomePeano (fromIntegralOverflowing $ length transferFeeDatas) $+  withSomePeano (length transferFeeDatas) $     \(_ :: Proxy n) -> toList <$> feeOutputParser @n output  -- | Calc baker fee for origination using @octez-client@.-calcOriginationFee-  :: ( UntypedValScope st, WithClientLog env m, HasTezosClientEnv env-     , MonadIO m, MonadCatch m-     )-  => CalcOriginationFeeData cp st -> m TezosMutez+calcOriginationFee :: UntypedValScope st => CalcOriginationFeeData cp st -> MorleyClientM TezosMutez calcOriginationFee CalcOriginationFeeData{..} = do   output <- callTezosClientStrict     [ "originate", "contract", "-", "transferring"@@ -465,11 +306,7 @@ -- -- Note that @octez-client@ does not support passing an address here, -- at least at the moment of writing.-calcRevealFee-  :: ( WithClientLog env m, HasTezosClientEnv env-     , MonadIO m, MonadCatch m-     )-  => ImplicitAlias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez+calcRevealFee :: ImplicitAlias -> Maybe ScrubbedBytes -> TezosInt64 -> MorleyClientM TezosMutez calcRevealFee alias mbPassword burnCap = do   output <- callTezosClientStrict     [ "reveal", "key", "for", toCmdArg alias@@ -480,7 +317,7 @@   case fees of     singleFee :< Nil -> return singleFee -feeOutputParser :: forall n m. (SingIPeano n, MonadIO m, MonadThrow m) => Text -> m (SizedList n TezosMutez)+feeOutputParser :: forall n. (SingIPeano n) => Text -> MorleyClientM (SizedList n TezosMutez) feeOutputParser output =   case parseBakerFeeFromOutput @n output of     Right fee -> return fee@@ -494,9 +331,7 @@  -- | Get password for secret key associated with given address -- in case this key is password-protected-getKeyPassword-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadMask m)-  => ImplicitAlias -> m (Maybe ScrubbedBytes)+getKeyPassword :: ImplicitAlias -> MorleyClientM (Maybe ScrubbedBytes) getKeyPassword alias = do   output <- callTezosClientStrict [ "show", "address", pretty alias, "-S"] MockupMode Nothing   encryptionType <-@@ -516,428 +351,6 @@       old <- hGetEcho stdin       bracket_ (hSetEcho stdin False) (hSetEcho stdin old) action -------------------------------------------------------------------------------- Helpers--- All interesting @octez-client@ functionality is supposed to be--- exported as functions with types closely resembling inputs of--- respective @octez-client@ functions. If something is not--- available, consider adding it here. But if it is not feasible,--- you can use these two functions directly to constructor a custom--- @octez-client@ call.--------------------------------------------------------------------------------- | Datatype that represents modes for calling node from @octez-client@.-data CallMode-  = MockupMode-  -- ^ Mode in which @octez-client@ doesn't perform any actual RPC calls to the node-  -- and use mock instead.-  | ClientMode-  -- ^ Normal mode in which @octez-client@ performs all necessary RPC calls to the node.---- | Call @octez-client@ with given arguments. Arguments defined by--- config are added automatically. The second argument specifies what--- should be done in failure case. It takes stdout and stderr--- output. Possible handling:------ 1. Parse a specific error and throw it.--- 2. Parse an expected error that shouldn't cause a failure.--- Return @True@ in this case.--- 3. Detect an unexpected error, return @False@.--- In this case 'UnexpectedClientFailure' will be throw.-callTezosClient-  :: forall env m. (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => (Text -> Text -> IO Bool) -> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text-callTezosClient errHandler args mode mbInput = retryEConnreset mode $ do-  TezosClientEnv {..} <- view tezosClientEnvL-  let-    extraArgs :: [String]-    extraArgs = mconcat-      [ ["-E", toCmdArg tceEndpointUrl]-      , maybe [] (\dir -> ["-d", dir]) tceMbTezosClientDataDir-      , ["--mode", case mode of-            MockupMode -> "mockup"-            ClientMode -> "client"-        ]-      ]--    allArgs = extraArgs ++ args-  logDebug $ "Running: " <> unwords (toText <$> tceTezosClientPath:allArgs)-  let-    ifNotEmpty prefix output-      | null output = ""-      | otherwise = prefix <> ":\n" <> output-    logOutput :: Text -> Text -> m ()-    logOutput output errOutput = logDebug $-      ifNotEmpty "stdout" output <>-      ifNotEmpty "stderr" errOutput--  liftIO (readProcessWithExitCode' tceTezosClientPath allArgs-          (maybe "" scrubbedBytesToString mbInput)) >>= \case-    (ExitSuccess, toText -> output, toText -> errOutput) ->-      output <$ logOutput output errOutput-    (ExitFailure errCode, toText -> output, toText -> errOutput) -> do-      checkCounterError errOutput-      checkEConnreset errOutput-      liftIO $ unlessM (errHandler output errOutput) $-        throwM $ UnexpectedClientFailure errCode output errOutput--      output <$ logOutput output errOutput-  where-    checkCounterError-      :: Text -> m ()-    checkCounterError errOutput |-      "Counter" `T.isPrefixOf` errOutput && "already used for contract" `T.isInfixOf` errOutput = do-        let splittedErrOutput = words errOutput-        liftIO $ throwM $-          CounterIsAlreadyUsed (splittedErrOutput Unsafe.!! 1) (splittedErrOutput Unsafe.!! 5)-    checkCounterError _ = pass-    checkEConnreset :: Text -> m ()-    checkEConnreset errOutput-      | "Unix.ECONNRESET" `T.isInfixOf` errOutput = throwM EConnreset-    checkEConnreset _ = pass--    -- Helper function that retries @octez-client@ call action in case of @ECONNRESET@.-    -- Note that this error cannot appear in case of 'MockupMode' call.-    retryEConnreset :: CallMode -> m a -> m a-    retryEConnreset MockupMode action = action-    retryEConnreset ClientMode action = retryEConnresetImpl 0 action--    retryEConnresetImpl :: Integer -> m a -> m a-    retryEConnresetImpl attempt action = action `catch` \err -> do-      case err of-        EConnreset ->-          if attempt >= maxRetryAmount then throwM err-          else retryEConnresetImpl (attempt + 1) action-        anotherErr -> throwM anotherErr--    maxRetryAmount = 5---- | Call @octez-client@ and expect success.-callTezosClientStrict-  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => [String] -> CallMode -> Maybe ScrubbedBytes -> m Text-callTezosClientStrict args mode mbInput = callTezosClient errHandler args mode mbInput-  where-    errHandler _ _ = pure False---- | Variant of @readProcessWithExitCode@ that prints a better error in case of--- an exception in the inner @readProcessWithExitCode@ call.-readProcessWithExitCode'-  :: FilePath-  -> [String]-  -> String-  -> IO (ExitCode, String, String)-readProcessWithExitCode' fp args inp =-  catch-    (readProcessWithExitCode fp args inp) handler-  where-    handler :: IOException -> IO (ExitCode, String, String)-    handler e = do-      hPutStrLn @Text stderr $ formatWith [red] errorMsg-      throwIO e--    errorMsg =-      "ERROR!! There was an error in executing `" <> toText fp <> "` program. Is the \-      \ executable available in PATH ?"--data ResolveError where-  REAliasNotFound :: Text -> ResolveError-  -- ^ Could not find an address with given alias.-  REWrongKind :: Alias expectedKind -> Address -> ResolveError-  -- ^ Expected an alias to be associated with an implicit address, but it was-  -- associated with a contract address, or vice-versa.-  REAddressNotFound :: KindedAddress kind -> ResolveError-  -- ^ Could not find an alias with given address.--deriving stock instance Show ResolveError--instance Buildable ResolveError where-  build = \case-    REWrongKind (alias :: Alias expectedKind) (Constrained (addr :: KindedAddress actualKind)) ->-      [itu|-        Expected the alias '#{alias}' to be assigned to an address of kind '#{demotedExpectedKind}',-        but it's assigned to an address of kind '#{demotedActualKind}': #{addr}.-        |]-      where-        demotedExpectedKind = demote @expectedKind \\ aliasKindSanity alias :: AddressKind-        demotedActualKind = demote @actualKind \\ addressKindSanity addr :: AddressKind-    REAliasNotFound aliasText ->-      [itu|Could not find the alias '#{aliasText}'.|]-    REAddressNotFound addr ->-      [itu|Could not find an alias for the address '#{addr}'.|]--class Resolve addressOrAlias where-  type ResolvedAddress addressOrAlias :: Type-  type ResolvedAlias addressOrAlias :: Type-  type ResolvedAddressAndAlias addressOrAlias :: Type--  -- | Looks up the address associated with the given @addressOrAlias@.-  ---  -- When the alias is associated with __both__ an implicit and a contract address:-  ---  -- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',-  --   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.-  -- * The 'AddressOrAlias' instance will return the address with the requested kind.-  resolveAddressEither-    :: forall m env-     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)-    => addressOrAlias-    -> m (Either ResolveError (ResolvedAddress addressOrAlias))--  {- | Looks up the alias associated with the given @addressOrAlias@.--  When the alias is associated with __both__ an implicit and a contract address:--  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',-    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.-  * The 'AddressOrAlias' instance will return the alias of the address with the requested kind.--  The primary (and probably only) reason this function exists is that-  @octez-client sign@ command only works with aliases. It was-  reported upstream: <https://gitlab.com/tezos/tezos/-/issues/836>.-  -}-  getAliasEither-    :: forall m env-     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)-    => addressOrAlias-    -> m (Either ResolveError (ResolvedAlias addressOrAlias))--  -- | Resolve both address and alias at the same time-  resolveAddressWithAliasEither-    :: forall m env-     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)-    => addressOrAlias-    -> m (Either ResolveError (ResolvedAddressAndAlias addressOrAlias))--instance Resolve (AddressOrAlias kind) where-  type ResolvedAddress (AddressOrAlias kind) = KindedAddress kind-  type ResolvedAlias (AddressOrAlias kind) = Alias kind-  type ResolvedAddressAndAlias (AddressOrAlias kind) = AddressWithAlias kind--  resolveAddressEither-    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)-    => AddressOrAlias kind -> m (Either ResolveError (KindedAddress kind))-  resolveAddressEither = \case-    AddressResolved addr -> pure $ Right addr-    aoa@(AddressAlias alias) -> do-      findAddress (unAlias alias) >>= \case-        FARNone -> pure $ Left $ REAliasNotFound (pretty aoa)-        FARUnambiguous (Constrained addr) ->-          pure $ maybeToRight (REWrongKind alias (Constrained addr)) $-            castSing addr \\ addressKindSanity addr \\ aliasKindSanity alias-        FARAmbiguous contractAddr implicitAddr ->-          withDict (aliasKindSanity alias) $-            usingImplicitOrContractKind @kind-              case sing @kind of-                SAddressKindContract -> pure $ Right contractAddr-                SAddressKindImplicit -> pure $ Right implicitAddr--  getAliasEither-    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)-    => AddressOrAlias kind -> m (Either ResolveError (Alias kind))-  getAliasEither = \case-    aoa@(AddressAlias alias) ->-      -- Check if the alias exists-      ($> alias) <$> resolveAddressEither aoa-    AddressResolved addr -> do-      aliasesAndAddresses <- Class.getAliasesAndAddresses-      case fst <$> find (\(_, addr') -> addr' == pretty addr) aliasesAndAddresses of-        Nothing -> pure $ Left $ REAddressNotFound addr-        Just aliasText -> do-          -- This alias _might_ belong to both an implicit account and a contract,-          -- in which case it might be prefixed with "key".-          -- If so, we have to strip the prefix.-          let aliasTextWithoutPrefix = fromMaybe aliasText $ T.stripPrefix "key:" aliasText-          pure $ Right $ mkAlias @kind aliasTextWithoutPrefix \\ addressKindSanity addr--  resolveAddressWithAliasEither addr =-    (liftA2 . liftA2) AddressWithAlias (resolveAddressEither addr) (getAliasEither addr)--instance Resolve SomeAddressOrAlias where-  type ResolvedAddress SomeAddressOrAlias = L1Address-  type ResolvedAlias SomeAddressOrAlias = SomeAlias-  type ResolvedAddressAndAlias SomeAddressOrAlias = Constrained L1AddressKind AddressWithAlias--  resolveAddressEither-    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)-    => SomeAddressOrAlias -> m (Either ResolveError L1Address)-  resolveAddressEither = \case-    SAOAKindUnspecified aliasText -> do-      findAddress aliasText >>= \case-        FARNone -> pure $ Left $ REAliasNotFound aliasText-        FARUnambiguous addr -> pure $ Right addr-        FARAmbiguous contractAddr implicitAddr -> throwM $ AmbiguousAlias aliasText contractAddr implicitAddr-    SAOAKindSpecified aoa ->-      fmap Constrained <$> resolveAddressEither aoa \\ addressOrAliasKindSanity aoa--  getAliasEither-    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)-    => SomeAddressOrAlias -> m (Either ResolveError SomeAlias)-  getAliasEither = \case-    SAOAKindSpecified aoa -> do-      fmap SomeAlias-        <$> getAliasEither aoa \\ addressOrAliasKindSanity aoa-    aoa@SAOAKindUnspecified{} -> runExceptT do-      -- Find out whether this alias is associated with an implicit address or a contract,-      -- and return an @Alias kind@ of the correct kind.-      ExceptT (resolveAddressWithAliasEither aoa) <&> foldConstrained (SomeAlias . awaAlias)--  resolveAddressWithAliasEither addr = runExceptT case addr of-    SAOAKindSpecified aoa -> do-      kaddr <- ExceptT $ resolveAddressEither aoa-      kalias <- ExceptT $ getAliasEither aoa-      pure $ Constrained (AddressWithAlias kaddr kalias) \\ addressOrAliasKindSanity aoa-    aoa@(SAOAKindUnspecified aliasText) -> do-      ExceptT (resolveAddressEither aoa) <&> foldConstrained-        \kaddr -> Constrained $ AddressWithAlias kaddr $ mkAlias aliasText \\ addressKindSanity kaddr---- | Looks up the address and alias with the given @addressOrAlias@.-resolveAddressWithAlias-  :: forall addressOrAlias m env-   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)-  => addressOrAlias-  -> m (ResolvedAddressAndAlias addressOrAlias)-resolveAddressWithAlias = resolveAddressWithAliasEither >=> either (throwM . ResolveError) pure---- | Looks up the address and alias with the given @addressOrAlias@.-resolveAddressWithAliasMaybe-  :: forall addressOrAlias m env-   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)-  => addressOrAlias-  -> m (Maybe (ResolvedAddressAndAlias addressOrAlias))-resolveAddressWithAliasMaybe = fmap rightToMaybe . resolveAddressWithAliasEither---- | Looks up the address associated with the given @addressOrAlias@.------ Will throw a 'TezosClientError' if @addressOrAlias@ is an alias and:------ * the alias does not exist.--- * the alias exists but its address is of the wrong kind.------ When the alias is associated with __both__ an implicit and a contract address:------ * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',---   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.--- * The 'AddressOrAlias' instance will return the address with the requested kind.-resolveAddress-  :: forall addressOrAlias m env-   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)-  => addressOrAlias-  -> m (ResolvedAddress addressOrAlias)-resolveAddress = resolveAddressEither >=> either (throwM . ResolveError) pure---- | Looks up the address associated with the given @addressOrAlias@.------ Will return 'Nothing' if @addressOrAlias@ is an alias and:------ * the alias does not exist.--- * the alias exists but its address is of the wrong kind.------ When the alias is associated with __both__ an implicit and a contract address:------ * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',---   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.--- * The 'AddressOrAlias' instance will return the address with the requested kind.-resolveAddressMaybe-  :: forall addressOrAlias m env-   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)-  => addressOrAlias-  -> m (Maybe (ResolvedAddress addressOrAlias))-resolveAddressMaybe aoa =-  rightToMaybe <$> resolveAddressEither aoa--{- | Looks up the alias associated with the given @addressOrAlias@.--Will throw a 'TezosClientError' if @addressOrAlias@:--  * is an address that is not associated with any alias.-  * is an alias that does not exist.-  * is an alias that exists but its address is of the wrong kind.--When the alias is associated with __both__ an implicit and a contract address:--  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',-    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.-  * The 'AddressOrAlias' instance will return the alias.--}-getAlias-  :: forall addressOrAlias m env-   . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)-  => addressOrAlias-  -> m (ResolvedAlias addressOrAlias)-getAlias = getAliasEither >=> either (throwM . ResolveError) pure--{- | Looks up the alias associated with the given @addressOrAlias@.--Will return 'Nothing' if @addressOrAlias@:--  * is an address that is not associated with any alias.-  * is an alias that does not exist.-  * is an alias that exists but its address is of the wrong kind.--When the alias is associated with __both__ an implicit and a contract address:--  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',-    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.-  * The 'AddressOrAlias' instance will return the alias.--}-getAliasMaybe-  :: forall addressOrAlias m env-   . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)-  => addressOrAlias-  -> m (Maybe (ResolvedAlias addressOrAlias))-getAliasMaybe aoa =-  rightToMaybe <$> getAliasEither aoa--{- | Finds the implicit/contract addresses assigned to the given alias.--Note that an alias can be ambiguous: it can refer to __both__ a contract and an-implicit account. When an alias "abc" is ambiguous, @octez-client list known-contracts@ will return two entries with the following format:--> abc: KT1...-> key:abc: tz1...--So, in order to check whether the alias is ambiguous, we check whether both-"abc" and "key:abc" are present in the output.--If only "abc" is present, then we know it's not ambiguous (and it refers to-__either__ a contract or an implicit account).--}-findAddress-  :: forall m env-   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)-  => Text-  -> m FindAddressResult-findAddress aliasText = do-  logDebug $ "Resolving " +| aliasText |+ ""-  aliasesAndAddresses <- Class.getAliasesAndAddresses--  let find' alias = snd <$> find (\(alias', _) -> alias' == alias) aliasesAndAddresses--  case (find' aliasText, find' ("key:" <> aliasText)) of-    (Nothing, _) -> pure FARNone-    (Just firstMatch, Nothing) -> FARUnambiguous <$> parseL1Address firstMatch-    (Just contractAddrText, Just implicitAddrText) -> do-      contractAddr <--        either (throwM . TezosClientParseAddressError contractAddrText) pure $-          parseKindedAddress @'AddressKindContract contractAddrText-      implicitAddr <--        either (throwM . TezosClientParseAddressError implicitAddrText) pure $-          parseKindedAddress @'AddressKindImplicit implicitAddrText-      pure $ FARAmbiguous contractAddr implicitAddr-  where-    parseL1Address :: Text -> m L1Address-    parseL1Address addrText =-      either (throwM . TezosClientParseAddressError addrText) pure .-      parseConstrainedAddress $ addrText---- | Whether an alias is associated with an implicit address, a contract address, or both.-data FindAddressResult-  = FARUnambiguous L1Address-  | FARAmbiguous ContractAddress ImplicitAddress-  | FARNone- {- | Calls @octez-client list known contracts@ and returns a list of @(alias, address)@ pairs. @@ -947,16 +360,61 @@ > ("abc", "KT1...") > ("key:abc", "tz1...") -}-getAliasesAndAddresses-  :: forall m env-   . (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)-  => m [(Text, Text)]-getAliasesAndAddresses =-  parseOutput <$> callListKnown "contracts"+getAliasesAndAddresses :: MorleyClientM AliasesAndAddresses+getAliasesAndAddresses = do+  env <- ask+  let mv = env ^. mceTezosClientL . tceAliasMapL+  updateMVar' mv $ get >>= \case+    Nothing -> do+      res <- lift $ parseOutput =<< runMorleyClientM env (callListKnown "contracts")+      put $ Just res+      pure res+    Just a -> pure a   where-    parseOutput :: Text -> [(Text, Text)]-    parseOutput = fmap parseLine . lines+    parseOutput :: Text -> IO AliasesAndAddresses+    parseOutput out = mkAliasesAndAddresses <$> mapM parseLine (lines out)      -- Note: each line has the format "<alias>: <address>"-    parseLine :: Text -> (Text, Text)-    parseLine = first (T.dropEnd 2) . T.breakOnEnd ": "+    parseLine :: Text -> IO (Constrained NullConstraint AddressWithAlias)+    parseLine ln = do+      let (aliasText', addressText) = first (T.dropEnd 2) $ T.breakOnEnd ": " ln+          -- This alias _might_ belong to both an implicit account and a contract,+          -- in which case it might be prefixed with "key".+          -- If so, we have to strip the prefix.+          aliasText = fromMaybe aliasText' $ T.stripPrefix "key:" aliasText'+      Constrained awaAddress <- parseL1Address addressText+      let awaAlias = mkAlias aliasText \\ addressKindSanity awaAddress+      pure . Constrained $ AddressWithAlias{..}++    parseL1Address :: Text -> IO L1Address+    parseL1Address addrText+      = either (throwM . TezosClientParseAddressError addrText) pure+      . parseConstrainedAddress $ addrText++invalidateAliasCache :: MorleyClientM ()+invalidateAliasCache = do+  mv <- view $ tezosClientEnvL . tceAliasMapL+  updateMVar' mv $ put Nothing++tryUpdateAliasCache :: Alias kind -> KindedAddress kind -> MorleyClientM ()+tryUpdateAliasCache alias addr = do+  mv <- view $ tezosClientEnvL . tceAliasMapL+  updateMVar' mv $ modify' $ fmap $ insertAliasAndAddress alias addr++lookupAliasCache :: Alias kind -> MorleyClientM (Maybe (KindedAddress kind))+lookupAliasCache alias = do+  mv <- view $ tezosClientEnvL . tceAliasMapL+  (lookupAddr alias =<<) <$> readMVar mv++instance Class.HasTezosClient MorleyClientM where+  signBytes (AddressWithAlias _ senderAlias) mbPassword opHash = retryOnceOnTimeout $ do+    env <- ask+    case mceSecretKey env of+      Just sk -> pure . SignatureEd25519 $ Ed25519.sign sk opHash+      Nothing -> signBytes senderAlias mbPassword opHash+  rememberContract = failOnTimeout ... rememberContract+  getAliasesAndAddresses = retryOnceOnTimeout ... getAliasesAndAddresses+  genKey alias = flip AddressWithAlias alias <$> genKey alias+  genFreshKey alias = flip AddressWithAlias alias <$> genFreshKey alias+  getKeyPassword (AddressWithAlias _ alias) = retryOnceOnTimeout $ getKeyPassword alias+  getPublicKey (AddressWithAlias _ alias) = getPublicKey alias

@@ -0,0 +1,246 @@+-- SPDX-FileCopyrightText: 2023 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++-- | Utilities for resolving addresses and aliases.+module Morley.Client.TezosClient.Resolve+  ( ResolveError(..)+  , Resolve(..)+  , resolveAddress+  , resolveAddressMaybe+  , getAlias+  , getAliasMaybe+  , getTezosClientConfig+  , resolveAddressWithAlias+  , resolveAddressWithAliasMaybe+  ) where++import Data.Constraint ((\\))+import Fmt (pretty)++import Morley.Client.Logging+import Morley.Client.TezosClient.Class qualified as Class+import Morley.Client.TezosClient.Config+import Morley.Client.TezosClient.Types.Errors+import Morley.Client.Types+import Morley.Client.Types.AliasesAndAddresses+import Morley.Tezos.Address+import Morley.Tezos.Address.Alias+import Morley.Tezos.Address.Kinds+import Morley.Util.Constrained++class Resolve addressOrAlias where+  type ResolvedAddress addressOrAlias :: Type+  type ResolvedAlias addressOrAlias :: Type+  type ResolvedAddressAndAlias addressOrAlias :: Type++  -- | Looks up the address associated with the given @addressOrAlias@.+  --+  -- When the alias is associated with __both__ an implicit and a contract address:+  --+  -- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+  --   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+  -- * The 'AddressOrAlias' instance will return the address with the requested kind.+  resolveAddressEither+    :: forall m env+     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+    => addressOrAlias+    -> m (Either ResolveError (ResolvedAddress addressOrAlias))++  {- | Looks up the alias associated with the given @addressOrAlias@.++  When the alias is associated with __both__ an implicit and a contract address:++  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+  * The 'AddressOrAlias' instance will return the alias of the address with the requested kind.++  The primary (and probably only) reason this function exists is that+  @octez-client sign@ command only works with aliases. It was+  reported upstream: <https://gitlab.com/tezos/tezos/-/issues/836>.+  -}+  getAliasEither+    :: forall m env+     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+    => addressOrAlias+    -> m (Either ResolveError (ResolvedAlias addressOrAlias))++  -- | Resolve both address and alias at the same time+  resolveAddressWithAliasEither+    :: forall m env+     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+    => addressOrAlias+    -> m (Either ResolveError (ResolvedAddressAndAlias addressOrAlias))++instance Resolve (AddressOrAlias kind) where+  type ResolvedAddress (AddressOrAlias kind) = KindedAddress kind+  type ResolvedAlias (AddressOrAlias kind) = Alias kind+  type ResolvedAddressAndAlias (AddressOrAlias kind) = AddressWithAlias kind++  resolveAddressEither+    :: (Class.HasTezosClient m)+    => AddressOrAlias kind -> m (Either ResolveError (KindedAddress kind))+  resolveAddressEither = \case+    AddressResolved addr -> pure $ Right addr+    aoa@(AddressAlias alias) -> do+      aas <- Class.getAliasesAndAddresses+      pure $ lookupAddr alias aas+        & maybeToRight (handleMissing aas)+      where+        handleMissing :: AliasesAndAddresses -> ResolveError+        handleMissing aas+          = maybe (REAliasNotFound (pretty aoa)) (REWrongKind alias)+          $ case alias of+              -- notice kind is flipped+              ImplicitAlias aliasTxt -> Constrained <$> lookupAddr (ContractAlias aliasTxt) aas+              ContractAlias aliasTxt -> Constrained <$> lookupAddr (ImplicitAlias aliasTxt) aas++  getAliasEither+    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+    => AddressOrAlias kind -> m (Either ResolveError (Alias kind))+  getAliasEither = \case+    aoa@(AddressAlias alias) ->+      -- Check if the alias exists+      ($> alias) <$> resolveAddressEither aoa+    AddressResolved addr ->+      maybeToRight (REAddressNotFound addr) . lookupAlias addr <$> Class.getAliasesAndAddresses++  resolveAddressWithAliasEither addr =+    (liftA2 . liftA2) AddressWithAlias (resolveAddressEither addr) (getAliasEither addr)++instance Resolve SomeAddressOrAlias where+  type ResolvedAddress SomeAddressOrAlias = L1Address+  type ResolvedAlias SomeAddressOrAlias = SomeAlias+  type ResolvedAddressAndAlias SomeAddressOrAlias = Constrained L1AddressKind AddressWithAlias++  resolveAddressEither+    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+    => SomeAddressOrAlias -> m (Either ResolveError L1Address)+  resolveAddressEither = \case+    SAOAKindUnspecified aliasText -> do+      aas <- Class.getAliasesAndAddresses+      let contractAddress = lookupAddr (mkAlias @'AddressKindContract aliasText) aas+          implicitAddress = lookupAddr (mkAlias @'AddressKindImplicit aliasText) aas+      case (contractAddress, implicitAddress) of+        (Nothing, Nothing) -> pure $ Left $ REAliasNotFound aliasText+        (Just addr, Nothing) -> pure $ Right $ Constrained addr+        (Nothing, Just addr) -> pure $ Right $ Constrained addr+        (Just ca, Just ia) -> throwM $ AmbiguousAlias aliasText ca ia+    SAOAKindSpecified aoa ->+      fmap Constrained <$> resolveAddressEither aoa \\ addressOrAliasKindSanity aoa++  getAliasEither+    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)+    => SomeAddressOrAlias -> m (Either ResolveError SomeAlias)+  getAliasEither = \case+    SAOAKindSpecified aoa -> do+      fmap SomeAlias+        <$> getAliasEither aoa \\ addressOrAliasKindSanity aoa+    aoa@SAOAKindUnspecified{} -> runExceptT do+      -- Find out whether this alias is associated with an implicit address or a contract,+      -- and return an @Alias kind@ of the correct kind.+      ExceptT (resolveAddressWithAliasEither aoa) <&> foldConstrained (SomeAlias . awaAlias)++  resolveAddressWithAliasEither addr = runExceptT case addr of+    SAOAKindSpecified aoa -> do+      kaddr <- ExceptT $ resolveAddressEither aoa+      kalias <- ExceptT $ getAliasEither aoa+      pure $ Constrained (AddressWithAlias kaddr kalias) \\ addressOrAliasKindSanity aoa+    aoa@(SAOAKindUnspecified aliasText) -> do+      ExceptT (resolveAddressEither aoa) <&> foldConstrained+        \kaddr -> Constrained $ AddressWithAlias kaddr $ mkAlias aliasText \\ addressKindSanity kaddr++-- | Looks up the address and alias with the given @addressOrAlias@.+resolveAddressWithAlias+  :: forall addressOrAlias m env+   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)+  => addressOrAlias+  -> m (ResolvedAddressAndAlias addressOrAlias)+resolveAddressWithAlias = resolveAddressWithAliasEither >=> either (throwM . ResolveError) pure++-- | Looks up the address and alias with the given @addressOrAlias@.+resolveAddressWithAliasMaybe+  :: forall addressOrAlias m env+   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)+  => addressOrAlias+  -> m (Maybe (ResolvedAddressAndAlias addressOrAlias))+resolveAddressWithAliasMaybe = fmap rightToMaybe . resolveAddressWithAliasEither++-- | Looks up the address associated with the given @addressOrAlias@.+--+-- Will throw a 'TezosClientError' if @addressOrAlias@ is an alias and:+--+-- * the alias does not exist.+-- * the alias exists but its address is of the wrong kind.+--+-- When the alias is associated with __both__ an implicit and a contract address:+--+-- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+--   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+-- * The 'AddressOrAlias' instance will return the address with the requested kind.+resolveAddress+  :: forall addressOrAlias m env+   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)+  => addressOrAlias+  -> m (ResolvedAddress addressOrAlias)+resolveAddress = resolveAddressEither >=> either (throwM . ResolveError) pure++-- | Looks up the address associated with the given @addressOrAlias@.+--+-- Will return 'Nothing' if @addressOrAlias@ is an alias and:+--+-- * the alias does not exist.+-- * the alias exists but its address is of the wrong kind.+--+-- When the alias is associated with __both__ an implicit and a contract address:+--+-- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+--   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+-- * The 'AddressOrAlias' instance will return the address with the requested kind.+resolveAddressMaybe+  :: forall addressOrAlias m env+   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)+  => addressOrAlias+  -> m (Maybe (ResolvedAddress addressOrAlias))+resolveAddressMaybe aoa = rightToMaybe <$> resolveAddressEither aoa++{- | Looks up the alias associated with the given @addressOrAlias@.++Will throw a 'TezosClientError' if @addressOrAlias@:++  * is an address that is not associated with any alias.+  * is an alias that does not exist.+  * is an alias that exists but its address is of the wrong kind.++When the alias is associated with __both__ an implicit and a contract address:++  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+  * The 'AddressOrAlias' instance will return the alias.+-}+getAlias+  :: forall addressOrAlias m env+   . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)+  => addressOrAlias+  -> m (ResolvedAlias addressOrAlias)+getAlias = getAliasEither >=> either (throwM . ResolveError) pure++{- | Looks up the alias associated with the given @addressOrAlias@.++Will return 'Nothing' if @addressOrAlias@:++  * is an address that is not associated with any alias.+  * is an alias that does not exist.+  * is an alias that exists but its address is of the wrong kind.++When the alias is associated with __both__ an implicit and a contract address:++  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',+    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.+  * The 'AddressOrAlias' instance will return the alias.+-}+getAliasMaybe+  :: forall addressOrAlias m env+   . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)+  => addressOrAlias+  -> m (Maybe (ResolvedAlias addressOrAlias))+getAliasMaybe aoa = rightToMaybe <$> getAliasEither aoa

@@ -7,26 +7,28 @@   ( CmdArg (..)   , CalcOriginationFeeData (..)   , CalcTransferFeeData (..)-  , TezosClientConfig (..)   , TezosClientEnv (..)   , HasTezosClientEnv (..)   , SecretKeyEncryption (..)+  , AliasBehavior (..)    -- * Lens   , tceEndpointUrlL   , tceTezosClientPathL   , tceMbTezosClientDataDirL+  , tceAliasMapL   ) where -import Data.Aeson (FromJSON(..), KeyValue(..), ToJSON(..), object, withObject, (.:))+import Data.Aeson (KeyValue(..), ToJSON(..), object) import Data.ByteArray (ScrubbedBytes) import Data.Fixed (E6, Fixed(..))-import Fmt (Buildable(..), pretty)+import Fmt (Buildable(..), pretty, prettyText) import Morley.Util.Lens (makeLensesWith, postfixLFields) import Servant.Client (BaseUrl(..), showBaseUrl) import Text.Hex (encodeHex)  import Morley.Client.RPC.Types (OperationHash)+import Morley.Client.Types.AliasesAndAddresses import Morley.Client.Util import Morley.Micheline import Morley.Michelson.Printer@@ -66,7 +68,7 @@ instance CmdArg Mutez where   toCmdArg m = show . MkFixed @_ @E6 $ fromIntegral (unMutez m) -instance T.ProperUntypedValBetterErrors t => CmdArg (Value t) where+instance T.UntypedValScope t => CmdArg (Value t) where   toCmdArg = toCmdArg . printTypedValue True  instance CmdArg (Contract cp st) where@@ -88,16 +90,6 @@   | LedgerKey   deriving stock (Eq, Show) --- | Configuration maintained by @octez-client@, see its @config@ subcommands--- (e. g. @octez-client config show@).--- Only the field we are interested in is present here.-newtype TezosClientConfig = TezosClientConfig { tcEndpointUrl :: BaseUrl }-  deriving stock Show---- | For reading @octez-client@ config.-instance FromJSON TezosClientConfig where-  parseJSON = withObject "node info" $ \o -> TezosClientConfig <$> o .: "endpoint"- -- | Runtime environment for @octez-client@ bindings. data TezosClientEnv = TezosClientEnv   { tceEndpointUrl :: BaseUrl@@ -107,6 +99,12 @@   -- performed.   , tceMbTezosClientDataDir :: Maybe FilePath   -- ^ Path to tezos client data directory.+  , tceAliasMap :: MVar (Maybe AliasesAndAddresses)+  -- ^ Lazy cache for the mapping between addresses and aliases. The 'Nothing'+  -- value signifies the cache is either yet unpopulated or was recently+  -- invalidated. The 'Just' value is the cached result of @octez-client list+  -- known contracts@. 'MVar' itself being empty/full is used for thread+  -- synchronization, as is usual.   }  makeLensesWith postfixLFields ''TezosClientEnv@@ -126,7 +124,7 @@  instance ToJSON CalcTransferFeeData where   toJSON CalcTransferFeeData{..} = object-    [ "destination" .= pretty @_ @Text ctfdTo+    [ "destination" .= prettyText ctfdTo     , "amount" .= (fromString @Text $ toCmdArg $ unTezosMutez ctfdAmount)     , "arg" .= (fromString @Text $ toCmdArg ctfdParam)     , "entrypoint" .= (fromString @Text $ toCmdArg ctfdEp)@@ -141,3 +139,18 @@   , cofdStorage :: Value st   , cofdBurnCap :: TezosInt64   }++-- | How to save the originated contract address.+data AliasBehavior+  = DontSaveAlias+  -- ^ Don't save the newly originated contract address.+  | KeepDuplicateAlias+  -- ^ If an alias already exists, keep it, don't save the newly originated+  -- contract address.+  | OverwriteDuplicateAlias+  -- ^ If an alias already exists, replace it with the address of the newly+  -- originated contract.+  | ForbidDuplicateAlias+  -- ^ If an alias already exists, throw an exception without doing the+  -- origination+  deriving stock (Eq, Ord, Enum)

@@ -0,0 +1,158 @@+-- SPDX-FileCopyrightText: 2023 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++-- | Various error types.+module Morley.Client.TezosClient.Types.Errors+  ( TezosClientError (..)+  , ResolveError(..)+  ) where++import Fmt (Buildable(..), pretty, (+|), (|+))++import Data.Constraint ((\\))+import Data.Singletons (demote)+import Lorentz.Value+import Morley.Client.RPC.Types+import Morley.Tezos.Address+import Morley.Tezos.Address.Alias+import Morley.Tezos.Address.Kinds+import Morley.Tezos.Crypto+import Morley.Util.Interpolate (itu)++-- | A data type for all /predicatable/ errors that can happen during+-- @octez-client@ usage.+data TezosClientError =+    UnexpectedClientFailure+    -- ^ @octez-client@ call unexpectedly failed (returned non-zero exit code).+    -- The error contains the error code, stdout and stderr contents.+      Int -- ^ Exit code+      Text -- ^ stdout+      Text -- ^ stderr++  -- These errors represent specific known scenarios.+  | AlreadyRevealed+    -- ^ Public key of the given address is already revealed.+      ImplicitAlias -- ^ Address alias that has already revealed its key+  | InvalidOperationHash+    -- ^ Can't wait for inclusion of operation with given hash because+    -- the hash is invalid.+      OperationHash+  | CounterIsAlreadyUsed+    -- ^ Error that indicates when given counter is already used for+    -- given contract.+    Text -- ^ Raw counter+    Text -- ^ Raw address+  | EConnreset+    -- ^ Network error with which @octez-client@ fails from time to time.++  -- Note: the errors below most likely indicate that something is wrong in our code.+  -- Maybe we made a wrong assumption about @octez-client@ or just didn't consider some case.+  -- Another possible reason that a broken @octez-client@ is used.+  | ConfigParseError String+  -- ^ A parse error occurred during config parsing.+  | TezosClientCryptoParseError Text CryptoParseError+  -- ^ @octez-client@ produced a cryptographic primitive that we can't parse.+  | TezosClientParseAddressError Text ParseAddressError+  -- ^ @octez-client@ produced an address that we can't parse.+  | TezosClientParseFeeError Text Text+  -- ^ @octez-client@ produced invalid output for parsing baker fee+  | TezosClientUnexpectedOutputFormat Text+  -- ^ @octez-client@ printed a string that doesn't match the format we expect.+  | CantRevealContract+    -- ^ Given alias is a contract and cannot be revealed.+    ImplicitAlias -- ^ Address alias of implicit account+  | ContractSender ContractAddress Text+    -- ^ Given contract is a source of a transfer or origination operation.+  | EmptyImplicitContract+    -- ^ Given alias is an empty implicit contract.+    ImplicitAlias -- ^ Address alias of implicit contract+  | TezosClientUnexpectedSignatureOutput Text+  -- ^ @octez-client sign bytes@ produced unexpected output format+  | TezosClientParseEncryptionTypeError Text Text+  -- ^ @octez-client@ produced invalid output for parsing secret key encryption type.+  | DuplicateAlias Text+  -- ^ Tried to save alias, but such alias already exists.+  | AmbiguousAlias Text ContractAddress ImplicitAddress+  -- ^ Expected an alias to be associated with either an implicit address or a+  -- contract address, but it was associated with both.+  | ResolveError ResolveError++deriving stock instance Show TezosClientError++instance Exception TezosClientError where+  displayException = pretty++instance Buildable TezosClientError where+  build = \case+    UnexpectedClientFailure errCode output errOutput ->+      "`octez-client` unexpectedly failed with error code " +| errCode |++      ". Stdout:\n" +| output |+ "\nStderr:\n" +| errOutput |+ ""+    AlreadyRevealed alias ->+      "The address alias " <> build alias <> " is already revealed"+    InvalidOperationHash hash ->+      "Can't wait for inclusion of operation " <> build hash <>+      " because this hash is invalid."+    CounterIsAlreadyUsed counter addr ->+      "Counter " +| counter |+ " already used for " +| addr |+ "."+    EConnreset -> "`octez-client` call failed with 'Unix.ECONNRESET' error."+    ConfigParseError err ->+      "A parse error occurred during config parsing: " <> build err+    TezosClientCryptoParseError txt err ->+      "`octez-client` produced a cryptographic primitive that we can't parse: " +|+      txt |+ ".\n The error is: " +| err |+ "."+    TezosClientParseAddressError txt err ->+      "`octez-client` produced an address that we can't parse: " +|+      txt |+ ".\n The error is: " +| err |+ "."+    TezosClientParseFeeError txt err ->+      "`octez-client` produced invalid output for parsing baker fee: " +|+      txt |+ ".\n Parsing error is: " +| err |+ ""+    TezosClientUnexpectedOutputFormat txt ->+      "`octez-client` printed a string that doesn't match the format we expect:\n" <>+      build txt+    CantRevealContract alias ->+      "Contracts (" <> build alias <> ") cannot be revealed"+    ContractSender addr opName ->+      "Contract (" <> build addr <> ") cannot be source of " +| opName |+ ""+    EmptyImplicitContract alias ->+      "Empty implicit contract (" <> build alias <> ")"+    TezosClientUnexpectedSignatureOutput txt ->+      "`octez-client sign bytes` call returned a signature in format we don't expect:\n" <>+      build txt+    TezosClientParseEncryptionTypeError txt err ->+      "`octez-client` produced invalid output for parsing secret key encryption type: " +|+      txt |+ ".\n Parsing error is: " +| err |+ ""+    DuplicateAlias alias -> "Attempted to save alias '" +| alias |+ "', but it already exists"+    AmbiguousAlias aliasText contractAddr implicitAddr ->+      [itu|+        The alias '#{aliasText}' is assigned to both:+          * a contract address: #{contractAddr}+          * and an implicit address: #{implicitAddr}+        Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate.+        |]+    ResolveError err -> build err++data ResolveError where+  REAliasNotFound :: Text -> ResolveError+  -- ^ Could not find an address with given alias.+  REWrongKind :: Alias expectedKind -> Address -> ResolveError+  -- ^ Expected an alias to be associated with an implicit address, but it was+  -- associated with a contract address, or vice-versa.+  REAddressNotFound :: KindedAddress kind -> ResolveError+  -- ^ Could not find an alias with given address.++deriving stock instance Show ResolveError++instance Buildable ResolveError where+  build = \case+    REWrongKind (alias :: Alias expectedKind) (Constrained (addr :: KindedAddress actualKind)) ->+      [itu|+        Expected the alias '#{alias}' to be assigned to an address of kind '#{demotedExpectedKind}',+        but it's assigned to an address of kind '#{demotedActualKind}': #{addr}.+        |]+      where+        demotedExpectedKind = demote @expectedKind \\ aliasKindSanity alias :: AddressKind+        demotedActualKind = demote @actualKind \\ addressKindSanity addr :: AddressKind+    REAliasNotFound aliasText ->+      [itu|Could not find the alias '#{aliasText}'.|]+    REAddressNotFound addr ->+      [itu|Could not find an alias for the address '#{addr}'.|]

@@ -0,0 +1,138 @@+-- SPDX-FileCopyrightText: 2023 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++-- | Full-featured Morley client, backed by @octez-client@.+module Morley.Client.TezosClient.Types.MorleyClientM+  ( MorleyClientEnv(..)+  , MorleyClientConfig (..)+  , MorleyClientM+  , runMorleyClientM+  , mkMorleyClientEnv+  , mkLogAction+  -- * Lens+  , mceTezosClientL+  , mceLogActionL+  , mceSecretKeyL+  , mceClientEnvL+  , mccEndpointUrlL+  , mccTezosClientPathL+  , mccMbTezosClientDataDirL+  , mccVerbosityL+  , mccSecretKeyL+  ) where++import Colog (HasLog(..), Message)+import Network.HTTP.Types (Status(..))+import Servant.Client (ClientEnv)+import Servant.Client.Core (Request, Response, RunClient(..))+import System.Environment (lookupEnv)+import UnliftIO (MonadUnliftIO)++import Morley.Client.App+import Morley.Client.Init+import Morley.Client.Logging (ClientLogAction)+import Morley.Client.RPC.Class+import Morley.Client.RPC.HttpClient+import Morley.Client.TezosClient.Config+import Morley.Client.TezosClient.Types+import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519+import Morley.Util.Lens (makeLensesWith, postfixLFields)++-- | Runtime environment for morley client.+data MorleyClientEnv = MorleyClientEnv+  { mceTezosClient :: TezosClientEnv+  -- ^ Environment for @octez-client@.+  , mceLogAction :: ClientLogAction MorleyClientM+  -- ^ Action used to log messages.+  , mceSecretKey :: Maybe Ed25519.SecretKey+  -- ^ Pass if you want to sign operations manually or leave it+  -- to @octez-client@.+  , mceClientEnv :: ClientEnv+  -- ^ Environment necessary to make HTTP calls.+  }++newtype MorleyClientM a = MorleyClientM+  { unMorleyClientM :: ReaderT MorleyClientEnv IO a }+  deriving newtype+    ( Functor, Applicative, Monad, MonadReader MorleyClientEnv+    , MonadIO, MonadThrow, MonadCatch, MonadMask, MonadUnliftIO+    )++-- | 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++makeLensesWith postfixLFields ''MorleyClientEnv++instance HasTezosClientEnv MorleyClientEnv where+  tezosClientEnvL = mceTezosClientL++instance HasLog MorleyClientEnv Message MorleyClientM where+  getLogAction = mceLogAction+  setLogAction action mce = mce { mceLogAction = action }++instance RunClient MorleyClientM where+  runRequestAcceptStatus :: Maybe [Status] -> Request -> MorleyClientM Response+  runRequestAcceptStatus statuses req = do+    env <- mceClientEnv <$> ask+    runRequestAcceptStatusImpl env statuses req+  throwClientError = throwClientErrorImpl++instance HasTezosRpc MorleyClientM where+  getBlockHash = getBlockHashImpl+  getCounterAtBlock = getCounterImpl+  getBlockHeader = getBlockHeaderImpl+  getBlockConstants = getBlockConstantsImpl+  getBlockOperations = getBlockOperationsImpl+  getScriptSizeAtBlock = getScriptSizeAtBlockImpl+  getBlockOperationHashes = getBlockOperationHashesImpl+  getProtocolParametersAtBlock = getProtocolParametersImpl+  runOperationAtBlock = runOperationImpl+  preApplyOperationsAtBlock = preApplyOperationsImpl+  forgeOperationAtBlock = forgeOperationImpl+  injectOperation = injectOperationImpl+  getContractScriptAtBlock = getContractScriptImpl+  getContractStorageAtBlock = getContractStorageAtBlockImpl+  getContractBigMapAtBlock = getContractBigMapImpl+  getBigMapValueAtBlock = getBigMapValueAtBlockImpl+  getBigMapValuesAtBlock = getBigMapValuesAtBlockImpl+  getBalanceAtBlock = getBalanceImpl+  getDelegateAtBlock = getDelegateImpl+  runCodeAtBlock = runCodeImpl+  getChainId = getChainIdImpl+  getManagerKeyAtBlock = getManagerKeyImpl+  waitForOperation = (asks mceClientEnv >>=) . waitForOperationImpl+  getTicketBalanceAtBlock = getTicketBalanceAtBlockImpl+  getAllTicketBalancesAtBlock = getAllTicketBalancesAtBlockImpl+  packData = packDataImpl++-- | Construct 'MorleyClientEnv'.+--+-- * @octez-client@ path is taken from 'MorleyClientConfig', but can be+-- overridden using @MORLEY_TEZOS_CLIENT@ environment variable.+-- * Node data is taken from @octez-client@ config and can be overridden+-- by 'MorleyClientConfig'.+-- * The rest is taken from 'MorleyClientConfig' as is.+mkMorleyClientEnv :: MorleyClientConfig -> IO MorleyClientEnv+mkMorleyClientEnv MorleyClientConfig{..} = do+  envTezosClientPath <- lookupEnv "MORLEY_TEZOS_CLIENT"+  let tezosClientPath = fromMaybe mccTezosClientPath envTezosClientPath+  TezosClientConfig {..} <- getTezosClientConfig tezosClientPath mccMbTezosClientDataDir+  tceAliasMap <- newMVar Nothing+  let+    endpointUrl = fromMaybe tcEndpointUrl mccEndpointUrl+    tezosClientEnv = TezosClientEnv+      { tceEndpointUrl = endpointUrl+      , tceTezosClientPath = tezosClientPath+      , tceMbTezosClientDataDir = mccMbTezosClientDataDir+      , tceAliasMap+      }++  clientEnv <- newClientEnv endpointUrl+  pure MorleyClientEnv+    { mceTezosClient = tezosClientEnv+    , mceLogAction = mkLogAction mccVerbosity+    , mceSecretKey = mccSecretKey+    , mceClientEnv = clientEnv+    }

@@ -57,11 +57,20 @@  makePrisms ''OperationInfo +{- | A kinded address together with the corresponding alias. Due to the quirks+of @octez-client@ we usually need both in @morley-client@, hence the need for+this type. Historically, we asked @octez-client@ for the missing part, but that+resulted in a lot of inefficiencies.++Note that the 'Ord' instance is rather arbitrary, and doesn't necessarily+correspond to anything in Michelson. It's added for convenience, e.g. so that+'AddressWithAlias' is usable as a 'Map' key.+-} data AddressWithAlias kind = AddressWithAlias   { awaAddress :: KindedAddress kind   , awaAlias :: Alias kind   }-  deriving stock (Show, Eq)+  deriving stock (Show, Eq, Ord)  instance ToAddress (AddressWithAlias kind) where   toAddress = toAddress . awaAddress

@@ -0,0 +1,54 @@+-- SPDX-FileCopyrightText: 2023 Oxhead Alpha+-- SPDX-License-Identifier: LicenseRef-MIT-OA++-- | Container for address-to-alias and vice versa translation.+module Morley.Client.Types.AliasesAndAddresses+  ( AliasesAndAddresses+  , lookupAddr+  , lookupAlias+  , mkAliasesAndAddresses+  , insertAliasAndAddress+  , emptyAliasesAndAddresses+  ) where++import Data.Bimap (Bimap)+import Data.Bimap qualified as Bimap+import Data.Constraint ((\\))++import Morley.Client.Types+import Morley.Tezos.Address+import Morley.Tezos.Address.Alias+import Morley.Util.Constrained+import Morley.Util.Sing (castSing)++newtype AliasesAndAddresses = AliasesAndAddresses+  { unAliasesAndAddresses :: Bimap SomeAlias Address }+  -- Invariant: address kind matches between address and alias.++lookupAlias :: KindedAddress kind -> AliasesAndAddresses -> Maybe (Alias kind)+lookupAlias addr as = do+  Constrained alias <- Bimap.lookupR (Constrained addr) (unAliasesAndAddresses as)+  castSing alias \\ aliasKindSanity alias \\ addressKindSanity addr++lookupAddr :: Alias kind -> AliasesAndAddresses -> Maybe (KindedAddress kind)+lookupAddr alias as = do+  Constrained addr <- Bimap.lookup (Constrained alias) (unAliasesAndAddresses as)+  castSing addr \\ aliasKindSanity alias \\ addressKindSanity addr++mkAliasesAndAddresses :: [Constrained NullConstraint AddressWithAlias] -> AliasesAndAddresses+mkAliasesAndAddresses = AliasesAndAddresses+  . Bimap.fromList+  . map (\(Constrained AddressWithAlias{..}) -> (SomeAlias awaAlias, Constrained awaAddress))++insertAliasAndAddress+  :: Alias kind+  -> KindedAddress kind+  -> AliasesAndAddresses+  -> AliasesAndAddresses+insertAliasAndAddress alias addr+  = AliasesAndAddresses+  . Bimap.insert (Constrained alias) (Constrained addr)+  . unAliasesAndAddresses++emptyAliasesAndAddresses :: AliasesAndAddresses+emptyAliasesAndAddresses = AliasesAndAddresses Bimap.empty

@@ -34,7 +34,7 @@ import Morley.Client.RPC.Types import Morley.Micheline import Morley.Michelson.Text-import Morley.Michelson.Typed (HasNoOp, untypeValue)+import Morley.Michelson.Typed (untypeValue) import Morley.Michelson.Typed qualified as T import Morley.Michelson.Typed.Entrypoints (EpAddress(..), parseEpAddress) import Morley.Michelson.Untyped (InternalByteString(..), Value, Value'(..))@@ -101,7 +101,7 @@ -- -- Use the @with*@ lenses to set any optional parameters. runContractParameters-  :: (HasNoOp cp, HasNoOp st)+  :: (T.ForbidOp cp, T.ForbidOp st)   => T.Contract cp st -> T.Value cp -> T.Value st   -> RunContractParameters cp st runContractParameters contract cp st =

@@ -24,34 +24,35 @@ test_handleOperationResult = testCase "getAppliedResults #709 regression test" do   let res = RunOperationResult         { rrOperationContents =-            OperationContent+            OperationContent (OtherOpResp "fake")               (RunMetadata                 { rmOperationResult = OperationFailed []                 , rmInternalOperationResults =-                    [ InternalOperation {ioData = IODIgnored, ioResult = OperationFailed []}-                    , InternalOperation {ioData = IODIgnored, ioResult = OperationFailed []}+                    [ InternalOperation {ioData = OtherOpResp "fake", ioResult = OperationFailed []}+                    , InternalOperation {ioData = OtherOpResp "fake", ioResult = OperationFailed []}                     ]                 })               :|-              [ OperationContent+              [ OperationContent (OtherOpResp "fake")                 (RunMetadata                   { rmOperationResult = OperationFailed                       [ CantPayStorageFee                       , BalanceTooLow (#balance :! [tz|149.38m|]) (#required :! [tz|355m|])                       ]                   , rmInternalOperationResults =-                      [ InternalOperation {ioData = IODIgnored, ioResult = OperationFailed []}-                      , InternalOperation {ioData = IODIgnored, ioResult = OperationFailed []}+                      [ InternalOperation {ioData = OtherOpResp "fake", ioResult = OperationFailed []}+                      , InternalOperation {ioData = OtherOpResp "fake", ioResult = OperationFailed []}                       ]                   })-              , OperationContent (RunMetadata { rmOperationResult = OperationFailed []-                                              , rmInternalOperationResults = []})+              , OperationContent (OtherOpResp "fake")+                  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) ->+      Just (crewsError -> UnexpectedRunErrors e) ->         e @?=           [ CantPayStorageFee           , BalanceTooLow (#balance :! [tz|149.38m|]) (#required :! [tz|355m|])

@@ -40,14 +40,14 @@       originatedContracts <- handleRunOperationInternal roOperation       return RunOperationResult         { rrOperationContents =-          one $ OperationContent $ RunMetadata+          one $ OperationContent (OtherOpResp "fake") $ RunMetadata             { rmOperationResult = OperationApplied $               -- Real-life numbers               AppliedResult                 { arConsumedMilliGas = 10100000                 , arStorageSize = 250                 , arPaidStorageDiff = 250-                , arOriginatedContracts = concatMap arOriginatedContracts originatedContracts+                , arOriginatedContracts = concatMap (arOriginatedContracts . snd) originatedContracts                 , arAllocatedDestinationContracts = 0                 }             , rmInternalOperationResults = []

@@ -21,19 +21,21 @@ import Data.Aeson (encode) import Data.ByteString.Lazy qualified as LBS (toStrict) import Data.Singletons (demote)-import Fmt (pretty, (+|), (|+))+import Fmt ((+|), (|+)) import Network.HTTP.Types.Status (status404) import Network.HTTP.Types.Version (http20) import Servant.Client.Core   (BaseUrl(..), ClientError(..), RequestF(..), ResponseF(..), Scheme(..), defaultRequest) import Text.Hex (encodeHex) +import Lorentz (toAddress) import Lorentz as L (compileLorentz, drop) import Lorentz.Constraints import Lorentz.Pack import Morley.Client.RPC.Types import Morley.Client.TezosClient (AliasBehavior(..), TezosClientError(DuplicateAlias)) import Morley.Client.Types+import Morley.Client.Types.AliasesAndAddresses import Morley.Micheline import Morley.Michelson.Runtime.GState import Morley.Michelson.Typed@@ -43,6 +45,7 @@ import Morley.Tezos.Crypto import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519 import Morley.Util.ByteString+import Morley.Util.Constrained import Morley.Util.Peano import Morley.Util.SizedList qualified as Sized import TestM@@ -106,10 +109,10 @@     testSecretKey :: Ed25519.SecretKey     testSecretKey = Ed25519.detSecretKey "\001\002\003\004" -mkRunOperationResult :: NonEmpty AppliedResult -> RunOperationResult+mkRunOperationResult :: NonEmpty (OperationResp WithSource, AppliedResult) -> RunOperationResult mkRunOperationResult results = RunOperationResult-  { rrOperationContents = results <&> \ar ->-      OperationContent $ RunMetadata+  { rrOperationContents = results <&> \(op, ar) ->+      OperationContent op $ RunMetadata         { rmOperationResult = OperationApplied ar         , rmInternalOperationResults = []         }@@ -188,14 +191,32 @@     throwM $ InvalidBranch $ foBranch op   pure . HexJSONByteString . LBS.toStrict . encode $ op -handleRunOperationInternal :: Monad m => RunOperationInternal -> TestT m (NonEmpty AppliedResult)+handleRunOperationInternal+  :: Monad m+  => RunOperationInternal+  -> TestT m (NonEmpty (OperationResp WithSource, AppliedResult)) handleRunOperationInternal RunOperationInternal{roiContents} = handleOperationInput roiContents -handleOperationInput :: Monad m => NonEmpty OperationInput -> TestT m (NonEmpty AppliedResult)+handleOperationInput+  :: Monad m+  => NonEmpty OperationInput+  -> TestT m (NonEmpty (OperationResp WithSource, AppliedResult)) handleOperationInput (c :| cs) =   (:|) <$> go c 1 <*> zipWithM go cs [2, 3..]-  where go = fmap mkAppliedResult ... handleTransactionOrOrigination+  where go op = fmap ((toIntOpData op, ) . mkAppliedResult) . handleTransactionOrOrigination op +toIntOpData :: OperationInput -> OperationResp WithSource+toIntOpData (WithCommonOperationData CommonOperationData{..} op) = case op of+  OpTransfer op' -> ws TransactionOpResp op'+  OpTransferTicket op' -> ws TransferTicketOpResp op'+  OpOriginate op' -> ws OriginationOpResp op'+  OpReveal op' -> ws RevealOpResp op'+    -- reveal operation apparently can't be internal, but why not handle this anyway+  OpDelegation op' -> ws DelegationOpResp op'+  where+    ws :: (WithSource a -> r) -> a -> r+    ws f = f . WithSource (toAddress codSource)+ handleTransactionOrOrigination   :: forall m. (Monad m, HasCallStack) => OperationInput -> TezosInt64 -> TestT m [ContractAddress] handleTransactionOrOrigination op n = do@@ -295,14 +316,16 @@  handleGetAliasesAndAddresses   :: forall m. Monad m-  => TestT m [(Text, Text)]+  => TestT m AliasesAndAddresses handleGetAliasesAndAddresses = do   FakeState{fsContracts, fsImplicits} <- get-  pure $ convert fsContracts <> convert fsImplicits+  pure $ mkAliasesAndAddresses $ convert fsContracts <> convert fsImplicits   where-    convert :: Map (KindedAddress kind) (AccountState kind) -> [(Text, Text)]-    convert m =-      toPairs m <&> \(addr, AccountState{asAlias}) -> (pretty asAlias, pretty addr)+    convert+      :: Map (KindedAddress kind) (AccountState kind)+      -> [Constrained NullConstraint AddressWithAlias]+    convert m = toPairs m <&> \(awaAddress, AccountState{asAlias=awaAlias}) ->+      Constrained AddressWithAlias{..}  handleGetManagerKey :: (Monad m) => BlockId -> ImplicitAddress -> TestT m (Maybe PublicKey) handleGetManagerKey blk addr = do

@@ -40,7 +40,9 @@ import Morley.Client import Morley.Client.Logging (ClientLogAction) import Morley.Client.RPC+import Morley.Client.Types.AliasesAndAddresses import Morley.Micheline+import Morley.Michelson.Typed qualified as T import Morley.Tezos.Address import Morley.Tezos.Address.Alias import Morley.Tezos.Address.Kinds@@ -82,6 +84,7 @@   , hGetDelegateAtBlock :: BlockId -> L1Address -> m (Maybe KeyHash)   , hGetTicketBalanceAtBlock :: BlockId -> Address -> GetTicketBalance ->  m Natural   , hGetAllTicketBalancesAtBlock :: BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse]+  , hPackData :: forall t. T.ForbidOp t => BlockId -> T.Value t -> T.Notes t -> m Text    -- HasTezosClient   , hSignBytes :: ImplicitAddressWithAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature@@ -90,7 +93,7 @@   , hGetPublicKey :: ImplicitAddressWithAlias -> m PublicKey   , hWaitForOperation :: m OperationHash -> m OperationHash   , hRememberContract :: AliasBehavior -> ContractAddress -> ContractAlias -> m ()-  , hGetAliasesAndAddresses :: m [(Text, Text)]+  , hGetAliasesAndAddresses :: m AliasesAndAddresses   , hGetKeyPassword :: ImplicitAddressWithAlias -> m (Maybe ScrubbedBytes)    -- HasLog@@ -120,6 +123,7 @@   , hGetChainId = throwM $ UnexpectedRpcCall "getChainId"   , hGetManagerKey = \_ _ -> throwM $ UnexpectedRpcCall "getManagerKey"   , hGetDelegateAtBlock = \_ _ -> throwM $ UnexpectedRpcCall "getDelegateAtBlock"+  , hPackData = \_ _ _ -> throwM $ UnexpectedRpcCall "packData"    , hSignBytes = \_ _ _ -> throwM $ UnexpectedClientCall "signBytes"   , hGenKey = \_ -> throwM $ UnexpectedClientCall "genKey"@@ -344,6 +348,10 @@   getAllTicketBalancesAtBlock block addr = do     h <- getHandler hGetAllTicketBalancesAtBlock     h block addr+  packData block val ty = do+    Handlers{..} <- unTestHandlers <$> ask+    hPackData block val ty+  makeLensesFor [("fsImplicits", "fsImplicitsL"), ("fsContracts", "fsContractsL")] ''FakeState makeLensesFor [("asAccountData", "asAccountDataL")] ''AccountState

@@ -74,7 +74,8 @@     "feature_enable": false,     "number_of_slots": 256,     "attestation_lag": 1,-    "availability_threshold": 50,+    "attestation_threshold": 50,+    "blocks_per_epoch": 32,     "redundancy_factor": 16,     "page_size": 4096,     "slot_size": 1048576,