diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,48 @@ + +0.3.1 +===== +* [!1331](https://gitlab.com/morley-framework/morley/-/merge_requests/1331) + Support implicit account tickets + + New `transfer-ticket` CLI command; + + New operation type, `OpTransferTicket`; + + Add `ToTAddress` instance for `AddressWithAlias`; +* [!1330](https://gitlab.com/morley-framework/morley/-/merge_requests/1330) + Support ticket balance queries +* [!1328](https://gitlab.com/morley-framework/morley/-/merge_requests/1328) + Kill support for TORUs, minimal sr1 address support, tz4 address support +* [!1329](https://gitlab.com/morley-framework/morley/-/merge_requests/1329) + Fix gas limit computation + + Fixes a bug where in some cases batched transfer could exceed hard gas + limit. +* [!1313](https://gitlab.com/morley-framework/morley/-/merge_requests/1313) + Add `contractStateResolver` getter to build Morley interpreter's + `ContractState` from chain. +* [!1315](https://gitlab.com/morley-framework/morley/-/merge_requests/1315) + Avoid redundant calls to octez-client address store + + Introduce `AddressWithAlias` and ways to resolve it (i.e. + `resolveAddressWithAlias`/`-Either`/`-Maybe`) + + Make RPC revelation and delegation more efficient, deprecate less efficient + `revealKeyOp` and `revealKeyUnlessRevealedOp` + + Use `AddressWithAlias` in critical code paths and key generators + + Add batched delegation +* [!1304](https://gitlab.com/morley-framework/morley/-/merge_requests/1304) + Relax lOriginateLargeContract constraints + + Now requires `NiceParameter` like other origination functions instead of + `NiceParameterFull` +* [!1286](https://gitlab.com/morley-framework/morley/-/merge_requests/1286) + Use RPC revealing in `runOperationsNonEmptyHelper` + + Replace `revealKey` with `getPublicKey` in `HasTezosClient`. + + Move `Morley.Client.Action.Common.revealKeyUnlessRevealed` to + `TezosClient.Impl`. + + Implement key revealing in `runOperationsNonEmptyHelper` via prepending the + reveal operation to the batch. + + Rename `Morley.Client.Action.Reveal.revealKey*` to `*Op`, since those inject + raw revelation **op**erations. + + Introduce utility versions of `Morley.Client.Action.Reveal.revealKey*` that + get the key using `getPublicKey`. + 0.3.0 ===== * [!1281](https://gitlab.com/morley-framework/morley/-/merge_requests/1281) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,5 +1,5 @@ MIT License -Copyright (c) 2021-2022 Oxhead Alpha +Copyright (c) 2021-2023 Oxhead Alpha Copyright (c) 2019-2021 Tocqueville Group Permission is hereby granted, free of charge, to any person obtaining a copy diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,3 +1,7 @@ +> :warning: **Note: this project is being deprecated.** +> +> It will no longer be maintained after the activation of protocol "N" on the Tezos mainnet. + # Morley-client This package implements a client to interact with the Tezos blockchain. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -8,7 +8,9 @@ import Control.Exception.Safe (throwString) import Data.Aeson qualified as Aeson import Data.Default (def) -import Fmt (blockListF, pretty) +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 System.IO (utf8) @@ -17,14 +19,16 @@ 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 - (typeCheckContract, typeCheckContractAndStorage, typeCheckingWith, typeVerifyParameter) +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.Util.Main (wrapMain) @@ -34,8 +38,9 @@ Originate OriginateArgs{..} -> do contract <- liftIO $ prepareContract oaMbContractFile let originator = oaOriginateFrom + originatorAA <- resolveAddressWithAlias originator (operationHash, contractAddr) <- - originateUntypedContract OverwriteDuplicateAlias oaContractName originator oaInitialBalance + originateUntypedContract OverwriteDuplicateAlias oaContractName originatorAA oaInitialBalance contract oaInitialStorage oaMbFee oaDelegate putTextLn "Contract was successfully deployed." @@ -43,32 +48,64 @@ putTextLn $ "Contract address: " <> formatAddress contractAddr Transfer TransferArgs{..} -> do - sendAddress <- resolveAddress taSender + sendAddress <- resolveAddressWithAlias taSender destAddress <- resolveAddress taDestination - (operationHash :: OperationHash, contractEvents :: [IntOpEvent]) <- case destAddress of - Constrained destContract@ContractAddress{} -> do - contract <- getContract destContract - SomeContract fullContract <- - throwLeft $ pure $ typeCheckingWith def $ typeCheckContract contract - case fullContract of - (Contract{} :: Contract cp st) -> do - let addrs = extractAddressesFromValue taParameter & mapMaybe \case - MkAddress x@ContractAddress{} -> Just x - _ -> Nothing - tcOriginatedContracts <- getContractsParameterTypes addrs - parameter <- throwLeft $ pure $ typeCheckingWith def $ - typeVerifyParameter @cp tcOriginatedContracts taParameter - transfer sendAddress destContract taAmount U.DefEpName parameter taMbFee - Constrained destImplicit@ImplicitAddress {} -> case taParameter of - U.ValueUnit -> transfer sendAddress destImplicit taAmount U.DefEpName VUnit Nothing - _ -> throwString ("The transaction parameter must be 'Unit' " - <> "when transferring to an implicit account") + (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 @@ -79,8 +116,8 @@ GetScriptSize GetScriptSizeArgs{..} -> do contract <- liftIO $ prepareContract (Just ssScriptFile) - void . throwLeft . pure . typeCheckingWith def $ - typeCheckContractAndStorage contract ssStorage + void . throwLeft . pure . TC.typeCheckingWith def $ + TC.typeCheckContractAndStorage contract ssStorage size <- computeUntypedContractSize contract ssStorage print size @@ -95,6 +132,25 @@ 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) main :: IO () main = wrapMain $ do diff --git a/morley-client.cabal b/morley-client.cabal --- a/morley-client.cabal +++ b/morley-client.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: morley-client -version: 0.3.0 +version: 0.3.1 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 @@ -13,7 +13,7 @@ bug-reports: https://gitlab.com/morley-framework/morley/-/issues author: Serokell, Tocqueville Group maintainer: Serokell -copyright: 2019-2021 Tocqueville Group, 2021-2022 Oxhead Alpha +copyright: 2019-2021 Tocqueville Group, 2021-2023 Oxhead Alpha license: MIT license-file: LICENSE build-type: Simple @@ -228,6 +228,7 @@ , morley-prelude , optparse-applicative , safe-exceptions + , singletons default-language: Haskell2010 test-suite morley-client-test @@ -245,6 +246,7 @@ Test.ParameterTypeGet Test.Parser Test.ReadBigMapValue + Test.Resolve Test.Transaction Test.Util TestM @@ -313,7 +315,6 @@ , bytestring , co-log , co-log-core - , containers , exceptions , fmt , hex-text diff --git a/src/Morley/Client.hs b/src/Morley/Client.hs --- a/src/Morley/Client.hs +++ b/src/Morley/Client.hs @@ -51,6 +51,10 @@ , getDelegate , runCode , getManagerKey + , getTicketBalance + , getAllTicketBalances + , GetTicketBalance (..) + , GetAllTicketBalancesResponse (..) -- ** Errors , ClientRpcError (..) @@ -74,11 +78,16 @@ , getAliasMaybe , resolveAddress , resolveAddressMaybe + , resolveAddressWithAlias + , resolveAddressWithAliasMaybe , TezosClientError (..) , AliasBehavior (..) -- * Util , disableAlphanetWarning + , AddressWithAlias(..) + , ImplicitAddressWithAlias + , ContractAddressWithAlias -- * Reexports , Opt.ParserInfo -- Needed for tests diff --git a/src/Morley/Client/Action.hs b/src/Morley/Client/Action.hs --- a/src/Morley/Client/Action.hs +++ b/src/Morley/Client/Action.hs @@ -10,13 +10,14 @@ , module Morley.Client.Action.Origination , module Morley.Client.Action.Transaction , module Morley.Client.Action.SizeCalculation + , module Morley.Client.Action.Reveal , ClientInput - , revealKeyUnlessRevealed ) where -import Morley.Client.Action.Common (ClientInput, revealKeyUnlessRevealed) +import Morley.Client.Action.Common (ClientInput) import Morley.Client.Action.Delegation import Morley.Client.Action.Operation import Morley.Client.Action.Origination +import Morley.Client.Action.Reveal import Morley.Client.Action.SizeCalculation import Morley.Client.Action.Transaction diff --git a/src/Morley/Client/Action/Batched.hs b/src/Morley/Client/Action/Batched.hs --- a/src/Morley/Client/Action/Batched.hs +++ b/src/Morley/Client/Action/Batched.hs @@ -7,6 +7,7 @@ , originateContractM , runTransactionM , revealKeyM + , delegateM , runOperationsBatch ) where @@ -21,7 +22,6 @@ import Morley.Client.TezosClient import Morley.Client.Types import Morley.Tezos.Address -import Morley.Tezos.Address.Alias import Morley.Util.Batching {- | Where the batched operations occur. @@ -79,13 +79,17 @@ revealKeyM :: RevealData -> OperationsBatch () revealKeyM = runOperationM OpReveal _OpReveal +-- | Perform delegation within a batch. +delegateM :: DelegationData -> OperationsBatch () +delegateM = runOperationM OpDelegation _OpDelegation + -- | Execute a batch. runOperationsBatch :: ( HasTezosRpc m , HasTezosClient m , WithClientLog env m ) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> OperationsBatch a -> m (Maybe OperationHash, a) runOperationsBatch sender (OperationsBatch batch) = diff --git a/src/Morley/Client/Action/Common.hs b/src/Morley/Client/Action/Common.hs --- a/src/Morley/Client/Action/Common.hs +++ b/src/Morley/Client/Action/Common.hs @@ -8,11 +8,13 @@ , TD (..) , TransactionData(..) , OriginationData(..) + , TransferTicketData(..) , RevealData(..) , DelegationData(..) , ClientInput , addOperationPrefix , buildTxDataWithAlias + , buildTxTicketDataWithAlias , getAppliedResults , computeFee , computeStorageLimit @@ -23,18 +25,15 @@ , updateCommonData , toParametersInternals , mkOriginationScript - , revealKeyUnlessRevealed , handleOperationResult , runErrorsToClientError ) where import Control.Lens (Prism') -import Data.ByteArray (ScrubbedBytes) import Data.ByteString (cons) import Data.Default (def) import Fmt (Buildable(..), Builder, (+|), (|+)) -import Morley.Client.Logging (WithClientLog, logDebug) import Morley.Client.RPC.Class import Morley.Client.RPC.Error import Morley.Client.RPC.Getters @@ -92,6 +91,19 @@ buildMbAlias :: Maybe Text -> Builder buildMbAlias = maybe "" $ \a -> " (" +| a |+ ")" +-- | Builds 'TransactionData' with additional info about receiver's alias, if present. +buildTxTicketDataWithAlias :: Maybe Text -> TransferTicketData -> Builder +buildTxTicketDataWithAlias mbAlias + (TransferTicketData contents ticketer amount dest ep _mbFee) = + "To: " +| dest |+ buildMbAlias mbAlias |+ ". EP: " +| ep + |+ ". Ticketer: " +| ticketer + |+ " contents: " +| contents + |+ " amount: " +| amount + |+ "" + where + buildMbAlias :: Maybe Text -> Builder + buildMbAlias = maybe "" $ \a -> " (" +| a |+ ")" + -- | Data for a single origination in a batch data OriginationData = forall cp st. (ParameterScope cp, StorageScope st) => OriginationData @@ -116,10 +128,20 @@ , rdMbFee :: Maybe Mutez } +data TransferTicketData = forall t. (ParameterScope t, Comparable t) => TransferTicketData + { ttdTicketContents :: T.Value t + , ttdTicketTicketer :: Address + , ttdTicketAmount :: Natural + , ttdDestination :: Address + , ttdEntrypoint :: EpName + , ttdMbFee :: Maybe Mutez + } + -- | Standard operation input in morley-client interface. data ClientInput instance OperationInfoDescriptor ClientInput where type TransferInfo ClientInput = TransactionData + type TransferTicketInfo ClientInput = TransferTicketData type OriginationInfo ClientInput = OriginationData type RevealInfo ClientInput = RevealData type DelegationInfo ClientInput = DelegationData @@ -253,21 +275,6 @@ findError :: Prism' RunError a -> Maybe a findError prism = fmap head . nonEmpty . mapMaybe (preview prism) $ errs --- | Reveal key for implicit address if necessary. --- --- Throws an error if given address is a contract address. -revealKeyUnlessRevealed - :: (WithClientLog env m, HasTezosRpc m, HasTezosClient m) - => ImplicitAddress - -> Maybe ScrubbedBytes - -> m () -revealKeyUnlessRevealed addr mbPassword = do - alias <- getAlias $ AddressResolved addr - mbManagerKey <- getManagerKey addr - case mbManagerKey of - Nothing -> revealKey alias mbPassword - Just _ -> logDebug $ alias |+ " alias has already revealed key" - -- | Compute fee for operation. computeFee :: FeeConstants -> Int -> TezosInt64 -> Mutez computeFee FeeConstants{..} opSize gasLimit = @@ -342,4 +349,11 @@ prepareOpForInjection :: ByteString -> Signature -> ByteString prepareOpForInjection operationHex signature' = - operationHex <> signatureToBytes signature' + operationHex <> prefix <> signatureToBytes signature' + where + prefix + -- Apparently, because BLS signature is longer than other ones, this hacky + -- workaround is employed. This may or may not come up elsewhere. + -- see https://gitlab.com/tezos/tezos/-/merge_requests/5444 + | SignatureBLS{} <- signature' = "\xff\x03" + | otherwise = mempty diff --git a/src/Morley/Client/Action/Delegation.hs b/src/Morley/Client/Action/Delegation.hs --- a/src/Morley/Client/Action/Delegation.hs +++ b/src/Morley/Client/Action/Delegation.hs @@ -16,7 +16,6 @@ import Morley.Client.TezosClient.Class import Morley.Client.Types import Morley.Tezos.Address -import Morley.Tezos.Address.Alias import Morley.Tezos.Crypto -- | Set or revoke a delegate for the sender. @@ -47,7 +46,7 @@ , HasTezosClient m , MonadReader env m , HasLog env Message m) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> Maybe KeyHash -> m OperationHash setDelegateOp sender delegate = @@ -60,6 +59,8 @@ , HasTezosClient m , MonadReader env m , HasLog env Message m) - => KeyHash + => ImplicitAddressWithAlias -> m OperationHash -registerDelegateOp sender = setDelegateOp (AddressResolved . ImplicitAddress $ sender) (Just sender) +registerDelegateOp sender = do + let senderKh = unImplicitAddress $ awaAddress sender + setDelegateOp sender (Just senderKh) diff --git a/src/Morley/Client/Action/Operation.hs b/src/Morley/Client/Action/Operation.hs --- a/src/Morley/Client/Action/Operation.hs +++ b/src/Morley/Client/Action/Operation.hs @@ -13,8 +13,9 @@ 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, sing) +import Data.Singletons (Sing, SingI, demote, sing) import Data.Text qualified as T import Fmt (blockListF, blockListF', listF, nameF, pretty, (+|), (|+)) @@ -26,7 +27,9 @@ import Morley.Client.RPC.Types import Morley.Client.TezosClient import Morley.Client.Types -import Morley.Micheline (StringEncode(..), TezosInt64, TezosMutez(..)) +import Morley.Client.Util (epNameToTezosEp) +import Morley.Micheline (StringEncode(..), TezosInt64, TezosMutez(..), toExpression) +import Morley.Michelson.Typed (Value) import Morley.Tezos.Address import Morley.Tezos.Address.Alias import Morley.Tezos.Core @@ -39,33 +42,32 @@ data Result instance OperationInfoDescriptor Result where type TransferInfo Result = [IntOpEvent] + type TransferTicketInfo Result = [IntOpEvent] type OriginationInfo Result = ContractAddress type RevealInfo Result = () type DelegationInfo Result = () logOperations - :: forall (runMode :: RunMode) env m kind. + :: forall env m kind. ( WithClientLog env m , HasTezosClient m - , MonadThrow m - , SingI runMode -- We don't ask aliases with @octez-client@ in 'DryRun' mode - , L1AddressKind kind ) - => AddressOrAlias kind + => AddressWithAlias kind -> NonEmpty (OperationInfo ClientInput) -> m () logOperations sender ops = do - let runMode = sing @runMode - - opName = + let opName = if | all (has _OpTransfer) ops -> "transactions" | all (has _OpOriginate) ops -> "originations" | all (has _OpReveal) ops -> "reveals" + | all (has _OpTransferTicket) ops -> "ticket transfers" | otherwise -> "operations" buildOp = \case (OpTransfer tx, mbAlias) -> buildTxDataWithAlias mbAlias tx + (OpTransferTicket tx, mbAlias) -> + buildTxTicketDataWithAlias mbAlias tx (OpOriginate orig, _) -> odName orig |+ " (temporary alias)" (OpReveal rv, mbAlias) -> @@ -73,28 +75,29 @@ (OpDelegation delegate, mbAlias) -> "Key Hash " +| ddDelegate delegate |+ maybe "" (\a -> " (" +| a |+ ")") mbAlias - sender' <- case sender of - addr@AddressResolved{} -> case runMode of - SRealRun -> AddressAlias <$> getAlias sender - SDryRun -> pure addr - alias -> pure alias + let needsAliasStore = (`any` ops) \case + OpTransfer{} -> True + OpTransferTicket{} -> True + OpOriginate{} -> False + OpReveal{} -> True + OpDelegation{} -> True - aliases <- case runMode of - SRealRun -> - forM ops $ \case - OpTransfer (TransactionData tx) -> withConstrained (tdReceiver tx) $ - fmap (Just . pretty) . getAlias . AddressResolved - OpOriginate _ -> - pure Nothing - OpReveal r -> - Just . pretty <$> (getAlias . AddressResolved . mkKeyAddress $ rdPublicKey r) - OpDelegation d -> - maybe (pure Nothing) - (fmap (Just . pretty) . getAlias . AddressResolved . ImplicitAddress) $ ddDelegate d - SDryRun -> pure $ ops $> Nothing + anas <- if needsAliasStore + then Map.fromList . fmap swap <$> getAliasesAndAddresses + else pure mempty + let mbAlias :: KindedAddress k -> Maybe Text + mbAlias addr = Map.lookup (pretty addr) anas + + let aliases = ops <&> \case + OpTransfer (TransactionData tx) -> withConstrained (tdReceiver tx) mbAlias + OpTransferTicket TransferTicketData{..} -> withConstrained ttdDestination mbAlias + OpOriginate _ -> Nothing + OpReveal r -> mbAlias . mkKeyAddress $ rdPublicKey r + OpDelegation d -> mbAlias . ImplicitAddress =<< ddDelegate d + logInfo $ T.strip $ -- strip trailing newline - "Running " +| opName +| " by " +| sender' |+ ":\n" +| + "Running " +| opName +| " by " +| sender |+ ":\n" +| blockListF' "-" buildOp (ops `NE.zip` aliases) -- | Perform sequence of operations. @@ -107,7 +110,7 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> [OperationInfo ClientInput] -> m (Maybe OperationHash, [OperationInfo Result]) runOperations sender operations = case operations of @@ -130,7 +133,7 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> NonEmpty (OperationInfo ClientInput) -> m (OperationHash, NonEmpty (OperationInfo Result)) runOperationsNonEmpty sender operations = @@ -172,7 +175,7 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> NonEmpty (OperationInfo ClientInput) -> m (NonEmpty (AppliedResult, TezosMutez)) dryRunOperationsNonEmpty sender operations = @@ -189,11 +192,16 @@ , SingI runMode ) => Natural - -> ImplicitAddressOrAlias + -> ImplicitAddressWithAlias -> NonEmpty (OperationInfo ClientInput) -> m (RunResult runMode) -runOperationsNonEmptyHelper retryCount sender operations = do - logOperations @runMode sender operations +runOperationsNonEmptyHelper retryCount sender@(AddressWithAlias senderAddress _) operations' = do + operations <- fromMaybe operations' <$> runMaybeT do + guard $ isRealRun @runMode && mayNeedSenderRevealing (toList operations') + Nothing <- lift $ getManagerKey senderAddress + pk <- lift $ getPublicKey sender + pure $ OpReveal (RevealData pk Nothing) :| toList operations' + logOperations sender operations -- If we intend to fail on duplicate aliases, we want to fail now, rather than -- after contract origination. forM_ operations $ \case @@ -201,11 +209,7 @@ resolved <- resolveAddressMaybe (AddressAlias odName) whenJust resolved $ const $ throwM $ DuplicateAlias (unAlias odName) _ -> pass - senderAddress <- resolveAddress sender - mbPassword <- getKeyPassword senderAddress - when (isRealRun @runMode && mayNeedSenderRevealing (toList operations)) $ - revealKeyUnlessRevealed senderAddress mbPassword - + mbPassword <- getKeyPassword sender pp <- getProtocolParameters OperationConstants{..} <- preProcessOperation senderAddress @@ -216,6 +220,16 @@ , toAmount = TezosMutez tdAmount , toParameters = toParametersInternals tdEpName tdParam } + OpTransferTicket (TransferTicketData {..}) + | _ :: Value t <- ttdTicketContents -> + OpTransferTicket TransferTicketOperation + { ttoTicketContents = toExpression ttdTicketContents + , ttoTicketTy = toExpression (demote @t) + , ttoTicketTicketer = ttdTicketTicketer + , ttoTicketAmount = StringEncode ttdTicketAmount + , ttoDestination = ttdDestination + , ttoEntrypoint = epNameToTezosEp ttdEntrypoint + } OpOriginate OriginationData{..} -> OpOriginate OriginationOperation { ooBalance = TezosMutez odBalance @@ -239,6 +253,7 @@ let opsToRun = NE.zipWith convertOps (1 :| [(2 :: TezosInt64)..]) operations mbFees = operations <&> \case OpTransfer (TransactionData TD {..}) -> tdMbFee + OpTransferTicket TransferTicketData{..} -> ttdMbFee OpOriginate OriginationData{..} -> odMbFee OpReveal RevealData{..} -> rdMbFee OpDelegation DelegationData {..} -> ddMbFee @@ -277,11 +292,12 @@ -- @gasSafetyGuard@ is added to origination operations and transfers to non-implicit -- accounts, see https://gitlab.com/tezos/tezos/-/blob/v13.0/src/proto_013_PtJakart/lib_client/injection.ml#L750 additionalGas = case internalOp of + OpTransferTicket{} -> gasSafetyGuard OpOriginate _ -> gasSafetyGuard OpTransfer (TransactionOperation {..}) -> case toDestination of MkAddress ImplicitAddress{} -> 0 MkAddress ContractAddress{} -> gasSafetyGuard - MkAddress TxRollupAddress{} -> gasSafetyGuard + MkAddress SmartRollupAddress{} -> gasSafetyGuard OpReveal _ -> 0 OpDelegation _ -> 0 let storageLimit = computeStorageLimit [ar] pp + 20 @@ -356,13 +372,18 @@ operationHash <- waitForOperation $ injectOperation (HexJSONByteString signedOp) let contractAddrs = arOriginatedContracts <$> ars2 opsRes <- forM (NE.zip operations contractAddrs) $ \case - (OpTransfer _, []) -> - return $ OpTransfer $ mapMaybe iopsDataToEmitOp iopsData (OpTransfer _, addrs) -> do - logInfo . T.strip $ - "The following contracts were originated during transactions: " +| - listF addrs |+ "" + unless (null addrs) $ + logInfo . T.strip $ + "The following contracts were originated during transactions: " +| + listF addrs |+ "" return $ OpTransfer $ mapMaybe iopsDataToEmitOp iopsData + (OpTransferTicket _, addrs) -> do + unless (null addrs) $ + logInfo . T.strip $ + "The following contracts were originated during transactions: " +| + listF addrs |+ "" + return $ OpTransferTicket $ mapMaybe iopsDataToEmitOp iopsData (OpOriginate _, []) -> throwM RpcOriginatedNoContracts (OpOriginate OriginationData{..}, [addr]) -> do @@ -393,6 +414,7 @@ mayNeedSenderRevealing :: [OperationInfo i] -> Bool mayNeedSenderRevealing = any \case OpTransfer{} -> True + OpTransferTicket{} -> True OpOriginate{} -> True OpReveal{} -> False OpDelegation{} -> True diff --git a/src/Morley/Client/Action/Origination.hs b/src/Morley/Client/Action/Origination.hs --- a/src/Morley/Client/Action/Origination.hs +++ b/src/Morley/Client/Action/Origination.hs @@ -54,15 +54,16 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> [OriginationData] -> m (Maybe OperationHash, [ContractAddress]) originateContracts sender originations = do (opHash, res) <- runOperations sender (OpOriginate <$> originations) - return (opHash, fromOrigination <$> res) + return (opHash, getOriginations res) where - fromOrigination = \case - OpOriginate r -> r + getOriginations = mapMaybe \case + OpOriginate r -> Just r + OpReveal{} -> Nothing _ -> error "Unexpectedly not origination" -- | Originate single contract @@ -76,7 +77,7 @@ ) => AliasBehavior -> ContractAlias - -> ImplicitAddressOrAlias + -> ImplicitAddressWithAlias -> Mutez -> Contract cp st -> Value st @@ -96,7 +97,7 @@ ) => AliasBehavior -> ContractAlias - -> ImplicitAddressOrAlias + -> ImplicitAddressWithAlias -> Mutez -> U.Contract -> U.Value @@ -116,7 +117,7 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> [LOriginationData] -> m (Maybe OperationHash, [ContractAddress]) lOriginateContracts sender' originations = @@ -133,7 +134,7 @@ ) => AliasBehavior -> ContractAlias - -> ImplicitAddressOrAlias + -> ImplicitAddressWithAlias -> Mutez -> L.Contract cp st vd -> st @@ -156,11 +157,10 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> [OriginationData] -> m (Maybe OperationHash, [ContractAddress]) -originateLargeContracts sender' largeOriginations = do - senderAddress <- resolveAddress sender' +originateLargeContracts sender'@(AddressWithAlias senderAddress _) largeOriginations = do -- calculate large contract originators let originators = map mkLargeOriginationData largeOriginations -- originate them. Note: we use the operation hash from here even tho the @@ -172,7 +172,7 @@ -- Note: it is not possible to run these all at once, because the node won't -- accept a transaction batch where the sum of the storage cost is over 16k, -- so here we need to run them one by one. - mapM_ (runTransactions senderAddress . (: [])) . concat $ + mapM_ (runTransactions sender' . (: [])) . concat $ zipWith mkLargeOriginatorTransactions originatorsAddr originators -- get the addresses of the originated large contracts back from the originators -- and remember their addresses with their aliases @@ -190,7 +190,7 @@ ) => AliasBehavior -> ContractAlias - -> ImplicitAddressOrAlias + -> ImplicitAddressWithAlias -> Mutez -> Contract cp st -> Value st @@ -210,7 +210,7 @@ ) => AliasBehavior -> ContractAlias - -> ImplicitAddressOrAlias + -> ImplicitAddressWithAlias -> Mutez -> U.Contract -> U.Value @@ -230,7 +230,7 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddressOrAlias + => ImplicitAddressWithAlias -> [LOriginationData] -> m (Maybe OperationHash, [ContractAddress]) lOriginateLargeContracts sender' originations = @@ -243,11 +243,11 @@ , HasTezosClient m , WithClientLog env m , NiceStorage st - , NiceParameterFull cp + , NiceParameter cp ) => AliasBehavior -> ContractAlias - -> ImplicitAddressOrAlias + -> ImplicitAddressWithAlias -> Mutez -> L.Contract cp st vd -> st @@ -263,7 +263,7 @@ -------------------------------------------------------------------------------- -- | Lorentz version of 'OriginationData' -data LOriginationData = forall cp st vd. (NiceParameterFull cp, NiceStorage st) +data LOriginationData = forall cp st vd. (NiceParameter cp, NiceStorage st) => LOriginationData { lodAliasBehavior :: AliasBehavior , lodName :: ContractAlias diff --git a/src/Morley/Client/Action/Origination/Large.hs b/src/Morley/Client/Action/Origination/Large.hs --- a/src/Morley/Client/Action/Origination/Large.hs +++ b/src/Morley/Client/Action/Origination/Large.hs @@ -38,7 +38,7 @@ import Data.ByteString.Lazy qualified as LBS -import Lorentz +import Lorentz hiding (bytes) import Morley.Client.Action.Common import Morley.Client.RPC.Class import Morley.Client.RPC.Error diff --git a/src/Morley/Client/Action/Reveal.hs b/src/Morley/Client/Action/Reveal.hs --- a/src/Morley/Client/Action/Reveal.hs +++ b/src/Morley/Client/Action/Reveal.hs @@ -5,32 +5,66 @@ module Morley.Client.Action.Reveal ( RevealData (..) , revealKey + , revealKeyWithFee , revealKeyUnlessRevealed + , revealKeyUnlessRevealedWithFee + , revealKeyOp + , revealKeyUnlessRevealedOp ) where import Fmt ((|+)) -import Morley.Client.Action.Common hiding (revealKeyUnlessRevealed) +import Morley.Client.Action.Common import Morley.Client.Action.Operation import Morley.Client.Logging import Morley.Client.RPC.Class import Morley.Client.RPC.Error import Morley.Client.RPC.Getters import Morley.Client.RPC.Types -import Morley.Client.TezosClient (HasTezosClient) +import Morley.Client.TezosClient.Class (HasTezosClient(getPublicKey)) +import Morley.Client.TezosClient.Impl (getAlias) import Morley.Client.Types -import Morley.Tezos.Address (mkKeyAddress) +import Morley.Tezos.Address import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (Mutez) import Morley.Tezos.Crypto (PublicKey) +-- | Resolve the public key of an implicit address and reveal it. +revealKey + :: (HasTezosRpc m, HasTezosClient m, WithClientLog env m) + => ImplicitAddressWithAlias -> m OperationHash +revealKey = (`revealKeyWithFee` Nothing) + +-- | Version of 'revealKey' with explicit fee. +revealKeyWithFee + :: (HasTezosRpc m, HasTezosClient m, WithClientLog env m) + => ImplicitAddressWithAlias -> Maybe Mutez -> m OperationHash +revealKeyWithFee sender mbFee = do + pk <- getPublicKey sender + runRevealOperationRaw sender pk mbFee + +-- | Resolve the public key of an implicit address and reveal it, unless already +-- revealed. +revealKeyUnlessRevealed + :: (HasTezosRpc m, HasTezosClient m, WithClientLog env m) + => ImplicitAddressWithAlias -> m () +revealKeyUnlessRevealed = (`revealKeyUnlessRevealedWithFee` Nothing) + +-- | Version of 'revealKeyUnlessRevealed' with explicit fee. +revealKeyUnlessRevealedWithFee + :: (HasTezosRpc m, HasTezosClient m, WithClientLog env m) + => ImplicitAddressWithAlias -> Maybe Mutez -> m () +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. -revealKey +revealKeyOp -- TODO [#873] remove HasTezosClient dependency :: forall m env. ( HasTezosRpc m @@ -40,16 +74,18 @@ => PublicKey -> Maybe Mutez -> m OperationHash -revealKey rdPublicKey rdMbFee = - fmap fst . runOperationsNonEmpty (AddressResolved sender) . one $ OpReveal RevealData{..} +revealKeyOp pk mbFee = do + senderAlias <- getAlias $ AddressResolved senderAddress + runRevealOperationRaw (AddressWithAlias senderAddress senderAlias) pk mbFee where - sender = mkKeyAddress rdPublicKey + 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. -revealKeyUnlessRevealed +revealKeyUnlessRevealedOp -- TODO [#873] remove HasTezosClient dependency :: forall m env. ( HasTezosRpc m @@ -59,14 +95,31 @@ => PublicKey -> Maybe Mutez -> m () -revealKeyUnlessRevealed key mbFee = do +revealKeyUnlessRevealedOp key mbFee = handleAlreadyRevealed (flip revealKeyOp mbFee) key +{-# DEPRECATED revealKeyUnlessRevealedOp + "Prefer using 'revealKeyUnlessRevealedWithFee', as it's a lot more efficient" #-} + +-- Internals + +handleAlreadyRevealed + :: (HasTezosRpc m, WithClientLog env m) + => (PublicKey -> m a) -> PublicKey -> m () +handleAlreadyRevealed doReveal key = do + let sender = mkKeyAddress key -- An optimization for the average case, but we can't rely on it in -- distributed environment - let sender = mkKeyAddress key getManagerKey sender >>= \case Just _ -> logDebug $ sender |+ " address has already revealed key" - Nothing -> ignoreAlreadyRevealedError . void $ revealKey key mbFee + Nothing -> ignoreAlreadyRevealedError . void $ doReveal key where ignoreAlreadyRevealedError = flip catch \case RunCodeErrors [PreviouslyRevealedKey _] -> pass e -> throwM e + +-- | Note that sender and rdPublicKey must be consistent, otherwise network will +-- reject the operation +runRevealOperationRaw + :: (HasTezosRpc m, HasTezosClient m, WithClientLog env m) + => ImplicitAddressWithAlias -> PublicKey -> Maybe Mutez -> m OperationHash +runRevealOperationRaw sender rdPublicKey rdMbFee = + fmap fst . runOperationsNonEmpty sender . one $ OpReveal RevealData{..} diff --git a/src/Morley/Client/Action/Transaction.hs b/src/Morley/Client/Action/Transaction.hs --- a/src/Morley/Client/Action/Transaction.hs +++ b/src/Morley/Client/Action/Transaction.hs @@ -9,11 +9,13 @@ -- * Transfer , transfer , lTransfer + , transferTicket -- Datatypes for batch transactions , TD (..) , LTransactionData (..) , TransactionData (..) + , TransferTicketData (..) ) where import Lorentz.Constraints @@ -28,7 +30,6 @@ import Morley.Michelson.Typed.Scope import Morley.Michelson.Untyped.Entrypoints import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (Mutez) -- | Perform sequence of transactions to the contract. Returns operation hash @@ -39,7 +40,7 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddress -> [TransactionData] + => ImplicitAddressWithAlias -> [TransactionData] -> m (Maybe (OperationHash, [OperationInfo Result])) runTransactions sender transactions = runMaybeT do ts <- hoistMaybe $ nonEmpty transactions @@ -53,10 +54,10 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddress -> NonEmpty TransactionData + => ImplicitAddressWithAlias -> NonEmpty TransactionData -> m (OperationHash, NonEmpty (OperationInfo Result)) runTransactionsNonEmpty sender = - runOperationsNonEmpty (AddressResolved sender) . map OpTransfer + runOperationsNonEmpty sender . map OpTransfer -- | Lorentz version of 'TransactionData'. data LTransactionData where @@ -71,7 +72,7 @@ , HasTezosClient m , WithClientLog env m ) - => ImplicitAddress + => ImplicitAddressWithAlias -> [LTransactionData] -> m (Maybe (OperationHash, [OperationInfo Result])) lRunTransactions sender transactions = @@ -89,7 +90,7 @@ , ParameterScope t , L1AddressKind kind ) - => ImplicitAddress + => ImplicitAddressWithAlias -> KindedAddress kind -> Mutez -> EpName @@ -103,6 +104,32 @@ OpTransfer i -> i _ -> [] +transferTicket + :: forall m t env kind. + ( HasTezosRpc m + , HasTezosClient m + , WithClientLog env m + , ParameterScope t + , Comparable t + ) + => ImplicitAddressWithAlias -- ^ Sender + -> KindedAddress kind -- ^ Destination + -> ContractAddress -- ^ Ticketer + -> T.Value t -- ^ Ticket value + -> Natural -- ^ Ticket amount + -> EpName -- ^ Destination entrypoint + -> Maybe Mutez -- ^ Fee + -> m (OperationHash, [IntOpEvent]) +transferTicket from (Constrained -> ttdDestination) + (Constrained -> ttdTicketTicketer) ttdTicketContents + ttdTicketAmount ttdEntrypoint ttdMbFee = + (fmap . second) (getEvents . toList) . runOperationsNonEmpty from . one . OpTransferTicket $ + TransferTicketData{..} + where + getEvents = concatMap \case + OpTransferTicket i -> i + _ -> [] + lTransfer :: forall m t env kind. ( HasTezosRpc m @@ -111,7 +138,7 @@ , NiceParameter t , L1AddressKind kind ) - => ImplicitAddress + => ImplicitAddressWithAlias -> KindedAddress kind -> Mutez -> EpName diff --git a/src/Morley/Client/App.hs b/src/Morley/Client/App.hs --- a/src/Morley/Client/App.hs +++ b/src/Morley/Client/App.hs @@ -33,6 +33,8 @@ , getChainIdImpl , getDelegateImpl , waitForOperationImpl + , getTicketBalanceAtBlockImpl + , getAllTicketBalancesAtBlockImpl -- * Timeouts and retries , retryOnTimeout @@ -64,7 +66,7 @@ import Morley.Client.Logging (WithClientLog, logDebug) import Morley.Client.RPC import Morley.Client.RPC.API qualified as API -import Morley.Micheline (Expression, TezosInt64, TezosNat, unTezosMutez) +import Morley.Micheline (Expression, TezosInt64, TezosNat, unStringEncode, unTezosMutez) import Morley.Tezos.Address import Morley.Tezos.Core (ChainId, Mutez, parseChainId) import Morley.Tezos.Crypto (KeyHash, PublicKey) @@ -190,6 +192,17 @@ (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> m Mutez getBalanceImpl = retryOnceOnTimeout ... fmap unTezosMutez ... API.getBalance API.nodeMethods + +getTicketBalanceAtBlockImpl :: + (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> GetTicketBalance -> m Natural +getTicketBalanceAtBlockImpl = + retryOnceOnTimeout ... fmap unStringEncode ... API.getTicketBalanceAtBlock API.nodeMethods + +getAllTicketBalancesAtBlockImpl + :: (RunClient m, MonadUnliftIO m, MonadCatch m) + => BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse] +getAllTicketBalancesAtBlockImpl = + retryOnceOnTimeout ... API.getAllTicketBalancesAtBlock API.nodeMethods getDelegateImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> L1Address -> m (Maybe KeyHash) diff --git a/src/Morley/Client/Full.hs b/src/Morley/Client/Full.hs --- a/src/Morley/Client/Full.hs +++ b/src/Morley/Client/Full.hs @@ -38,6 +38,7 @@ 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) @@ -78,19 +79,17 @@ setLogAction action mce = mce { mceLogAction = action } instance HasTezosClient MorleyClientM where - signBytes senderAlias mbPassword opHash = retryOnceOnTimeout $ do + 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 - genFreshKey = retryOnceOnTimeout ... TezosClient.genFreshKey - genKey = failOnTimeout ... TezosClient.genKey - -- Key revealing cannot be safely retried, so we're not trying to recover it - -- from @ECONNRESET@. - revealKey = failOnTimeout ... TezosClient.revealKey - getKeyPassword = retryOnceOnTimeout . TezosClient.getKeyPassword + 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 @@ -123,6 +122,8 @@ getChainId = getChainIdImpl getManagerKeyAtBlock = getManagerKeyImpl waitForOperation = (asks mceClientEnv >>=) . waitForOperationImpl + getTicketBalanceAtBlock = getTicketBalanceAtBlockImpl + getAllTicketBalancesAtBlock = getAllTicketBalancesAtBlockImpl -- | Construct 'MorleyClientEnv'. diff --git a/src/Morley/Client/OnlyRPC.hs b/src/Morley/Client/OnlyRPC.hs --- a/src/Morley/Client/OnlyRPC.hs +++ b/src/Morley/Client/OnlyRPC.hs @@ -27,8 +27,8 @@ import Morley.Client.RPC.Class (HasTezosRpc(..)) import Morley.Client.RPC.HttpClient (newClientEnv) import Morley.Client.TezosClient.Class (HasTezosClient(..)) +import Morley.Client.Types import Morley.Tezos.Address -import Morley.Tezos.Address.Alias import Morley.Tezos.Crypto (SecretKey, sign, toPublic) ---------------- @@ -109,13 +109,11 @@ -- [#652] We may implement more methods here if the need arises. instance HasTezosClient MorleyOnlyRpcM where - signBytes sender _password opHash = case sender of - AddressAlias {} -> throwM $ UnsupportedByOnlyRPC "signBytes (AddressAlias _)" - AddressResolved address -> do - env <- ask - case moreSecretKeys env ^. at address of - Nothing -> throwM $ UnknownSecretKeyFor address - Just secretKey -> liftIO $ sign secretKey opHash + signBytes (AddressWithAlias sender _) _password opHash = do + env <- ask + case moreSecretKeys env ^. at sender of + Nothing -> throwM $ UnknownSecretKeyFor sender + Just secretKey -> liftIO $ sign secretKey opHash -- In RPC-only mode we only use unencrypted in-memory passwords. getKeyPassword _ = pure Nothing @@ -135,7 +133,8 @@ -- Actions that are not supported and simply throw exceptions. genKey _ = throwM $ UnsupportedByOnlyRPC "genKey" genFreshKey _ = throwM $ UnsupportedByOnlyRPC "genFreshKey" - revealKey _ _ = throwM $ UnsupportedByOnlyRPC "revealKey" + getPublicKey (AddressWithAlias addr _) = asks moreSecretKeys >>= + maybe (throwM $ UnknownSecretKeyFor addr) (pure . toPublic) . view (at addr) instance RunClient MorleyOnlyRpcM where runRequestAcceptStatus statuses req = do @@ -167,3 +166,5 @@ getChainId = getChainIdImpl getManagerKeyAtBlock = getManagerKeyImpl waitForOperation = (asks moreClientEnv >>=) . waitForOperationImpl + getTicketBalanceAtBlock = getTicketBalanceAtBlockImpl + getAllTicketBalancesAtBlock = getAllTicketBalancesAtBlockImpl diff --git a/src/Morley/Client/Parser.hs b/src/Morley/Client/Parser.hs --- a/src/Morley/Client/Parser.hs +++ b/src/Morley/Client/Parser.hs @@ -7,6 +7,8 @@ , OriginateArgs (..) , TransferArgs (..) , GetScriptSizeArgs (..) + , TicketBalanceArgs (..) + , TransferTicketArgs (..) , addressOrAliasOption , clientConfigParser , morleyClientInfo @@ -47,9 +49,12 @@ 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 data OriginateArgs = OriginateArgs { oaMbContractFile :: Maybe FilePath @@ -74,6 +79,16 @@ , taMbFee :: Maybe Mutez } +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 @@ -131,6 +146,25 @@ \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 @@ -143,12 +177,27 @@ 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) @@ -157,6 +206,10 @@ 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 <$> @@ -266,6 +319,29 @@ (#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 diff --git a/src/Morley/Client/RPC/API.hs b/src/Morley/Client/RPC/API.hs --- a/src/Morley/Client/RPC/API.hs +++ b/src/Morley/Client/RPC/API.hs @@ -8,6 +8,7 @@ , monitorHeads ) where +import Data.Coerce (coerce) import Network.HTTP.Types.Status (Status(..)) import Servant.API (Capture, Get, JSON, NewlineFraming, Post, QueryParam, ReqBody, SourceIO, StreamGet, @@ -17,7 +18,7 @@ import Morley.Client.RPC.QueryFixedParam import Morley.Client.RPC.Types -import Morley.Micheline (Expression, TezosInt64, TezosMutez) +import Morley.Micheline (Expression, TezosInt64, TezosMutez, TezosNat) import Morley.Tezos.Address import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto (KeyHash, PublicKey) @@ -39,6 +40,12 @@ Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' :> "storage" :> Get '[JSON] Expression :<|> + Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address' + :> "ticket_balance" :> ReqBody '[JSON] GetTicketBalance :> Post '[JSON] TezosNat :<|> + + Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' + :> "all_ticket_balances" :> Get '[JSON] [GetAllTicketBalancesResponse] :<|> + Capture "block_id" BlockId :> Get '[JSON] BlockConstants :<|> Capture "block_id" BlockId :> "header" :> Get '[JSON] BlockHeader :<|> @@ -130,6 +137,8 @@ , getCounter :: BlockId -> ImplicitAddress -> m TezosInt64 , getScript :: BlockId -> ContractAddress -> m OriginationScript , getStorageAtBlock :: BlockId -> ContractAddress -> m Expression + , getTicketBalanceAtBlock :: BlockId -> Address -> GetTicketBalance -> m TezosNat + , getAllTicketBalancesAtBlock :: BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse] , getBlockConstants :: BlockId -> m BlockConstants , getBlockHeader :: BlockId -> m BlockHeader , getProtocolParameters :: BlockId -> m ProtocolParameters @@ -156,39 +165,33 @@ nodeMethods :: forall m. (MonadCatch m, RunClient m) => NodeMethods m nodeMethods = NodeMethods - { getCounter = withKindedAddress' getCounter' - , getScript = withKindedAddress' getScript' - , getStorageAtBlock = withKindedAddress' getStorageAtBlock' - , getBigMap = withKindedAddress' getBigMap' - , getBalance = withAddress' getBalance' - , getDelegate = \block (Constrained addr) -> do + { getDelegate = \block (Constrained addr) -> do result <- try $ getDelegate' block (Address' $ MkAddress addr) case result of Left (FailureResponse _ Response{responseStatusCode=Status{statusCode = 404}}) -> pure Nothing Left err -> throwM err Right res -> pure $ Just res - , getManagerKey = withKindedAddress' getManagerKey' , .. } where - withKindedAddress' f blockId = f blockId . KindedAddress' - withAddress' f blockId = f blockId . Address' (getBlockHash - :<|> getCounter' - :<|> getScript' - :<|> getStorageAtBlock' + :<|> (coerce -> getCounter) + :<|> (coerce -> getScript) + :<|> (coerce -> getStorageAtBlock) + :<|> (coerce -> getTicketBalanceAtBlock) + :<|> (coerce -> getAllTicketBalancesAtBlock) :<|> getBlockConstants :<|> getBlockHeader :<|> getProtocolParameters :<|> getBlockOperations :<|> getBlockOperationHashes - :<|> getBigMap' + :<|> (coerce -> getBigMap) :<|> getBigMapValueAtBlock :<|> getBigMapValuesAtBlock - :<|> getBalance' + :<|> (coerce -> getBalance) :<|> getDelegate' - :<|> getManagerKey' + :<|> (coerce -> getManagerKey) :<|> getScriptSizeAtBlock :<|> forgeOperation :<|> runOperation diff --git a/src/Morley/Client/RPC/Class.hs b/src/Morley/Client/RPC/Class.hs --- a/src/Morley/Client/RPC/Class.hs +++ b/src/Morley/Client/RPC/Class.hs @@ -83,3 +83,12 @@ -- ^ Blocks until an operation with the given hash is included into the chain. -- The first argument is the action that puts the operation on the chain. -- Returns the hash of the included operation. + getTicketBalanceAtBlock :: BlockId -> Address -> GetTicketBalance -> m Natural + -- ^ Access the contract's or implicit account's balance of ticket with + -- specified ticketer, content type, and content. + getAllTicketBalancesAtBlock + :: BlockId + -> ContractAddress + -> m [GetAllTicketBalancesResponse] + -- ^ Access the complete list of tickets owned by the given contract by + -- scanning the contract's storage. diff --git a/src/Morley/Client/RPC/Getters.hs b/src/Morley/Client/RPC/Getters.hs --- a/src/Morley/Client/RPC/Getters.hs +++ b/src/Morley/Client/RPC/Getters.hs @@ -31,6 +31,9 @@ , getDelegate , runCode , getManagerKey + , contractStateResolver + , getTicketBalance + , getAllTicketBalances ) where import Data.Map as Map (fromList) @@ -42,6 +45,8 @@ import Lorentz (NicePackedValue, NiceUnpackedValue, valueToScriptExpr) import Lorentz.Value import Morley.Micheline +import Morley.Michelson.Runtime.GState (ContractState(..)) +import Morley.Michelson.TypeCheck (typeCheckContract, typeCheckingWith) import Morley.Michelson.TypeCheck.TypeCheck (SomeParamType(..), TcOriginatedContracts, mkSomeParamType) import Morley.Michelson.Typed @@ -260,3 +265,29 @@ getManagerKey :: HasTezosRpc m => ImplicitAddress -> m (Maybe PublicKey) getManagerKey = getManagerKeyAtBlock HeadId + +-- | Get 'ContractState' for a given t'ContractAddress' at a given 'BlockId'. +-- Can be used with the morley interpreter to add some network interoperability. +contractStateResolver :: HasTezosRpc m => BlockId -> ContractAddress -> m (Maybe ContractState) +contractStateResolver blkId addr = handleStatusCode 404 (pure Nothing) $ Just <$> do + block <- BlockHashId <$> getBlockHash blkId + uContract <- throwLeft $ fromExpression . osCode <$> getContractScriptAtBlock block addr + csBalance <- getBalanceAtBlock block $ Constrained addr + csDelegate <- getDelegateAtBlock block $ Constrained addr + SomeContract csContract@Contract{} <- + either throwM pure . typeCheckingWith def $ typeCheckContract uContract + csStorage <- throwLeft $ fromExpression <$> getContractStorageAtBlock block addr + pure ContractState{..} + +getTicketBalance + :: HasTezosRpc m + => L1Address -- ^ Ticket owner + -> GetTicketBalance -- ^ Ticket description + -> m Natural +getTicketBalance = getTicketBalanceAtBlock HeadId . toAddress + +getAllTicketBalances + :: HasTezosRpc m + => ContractAddress -- ^ Ticket owner + -> m [GetAllTicketBalancesResponse] +getAllTicketBalances = getAllTicketBalancesAtBlock HeadId diff --git a/src/Morley/Client/RPC/Types.hs b/src/Morley/Client/RPC/Types.hs --- a/src/Morley/Client/RPC/Types.hs +++ b/src/Morley/Client/RPC/Types.hs @@ -52,8 +52,11 @@ , RunOperationResult (..) , RPCInput , TransactionOperation (..) + , TransferTicketOperation (..) , WithCommonOperationData (..) , MonitorHeadsStep(..) + , GetTicketBalance (..) + , GetAllTicketBalancesResponse (..) , mkCommonOperationData -- * Errors @@ -122,6 +125,7 @@ data RPCInput instance OperationInfoDescriptor RPCInput where type TransferInfo RPCInput = TransactionOperation + type TransferTicketInfo RPCInput = TransferTicketOperation type OriginationInfo RPCInput = OriginationOperation type RevealInfo RPCInput = RevealOperation type DelegationInfo RPCInput = DelegationOperation @@ -401,6 +405,7 @@ | IllTypedData Expression Expression | BadStack BadStackInformation | ForbiddenZeroAmountTicket + | REEmptyImplicitContract ImplicitAddress deriving stock Show instance FromJSON RunError where @@ -441,6 +446,7 @@ , "unregistered_delegate" ~> UnregisteredDelegate <$> o .: "hash" , "no_deletion" ~> FailedUnDelegation <$> o .: "delegate" , "delegate.already_active" ~> pure DelegateAlreadyActive + , "empty_implicit_contract" ~> REEmptyImplicitContract <$> o .: "implicit" , "ill_typed_contract" ~> IllTypedContract <$> o .: "ill_typed_code" , "ill_typed_data" ~> IllTypedData <$> o .: "expected_type" <*> o .: "ill_typed_expression" , "bad_stack" ~> BadStack <$> parseJSON (Object o) @@ -515,6 +521,8 @@ "Failed to withdraw delegation for: " +| addr |+ "" DelegateAlreadyActive -> "Delegate already active" + REEmptyImplicitContract addr -> + "Empty implicit contract (" +| addr |+ ")" IllTypedContract expr -> "Ill typed contract: " +| expr |+ "" IllTypedData expected ill_typed -> @@ -661,8 +669,8 @@ -- -- \[ -- \mathrm{min}\left(\mathbf{hard\_gas\_limit\_per\_operation}, --- \left\lceil \frac{\mathbf{hard\_gas\_limit\_per\_block}} --- {num\_operations}\right\rceil\right) +-- \left\lfloor \frac{\mathbf{hard\_gas\_limit\_per\_block}} +-- {num\_operations}\right\rfloor\right) -- \] -- -- This works well enough for the case of many small operations, but will break @@ -694,7 +702,7 @@ | Just numOp <- argF #num_operations mNumOp , numOp > 0 = StringEncode $ - min (unStringEncode ppHardGasLimitPerOperation) $ ceiling $ + min (unStringEncode ppHardGasLimitPerOperation) $ floor $ unStringEncode ppHardGasLimitPerBlock % numOp | otherwise = ppHardGasLimitPerOperation @@ -739,6 +747,15 @@ , toParameters :: ParametersInternal } +data TransferTicketOperation = TransferTicketOperation + { ttoTicketContents :: Expression + , ttoTicketTy :: Expression + , ttoTicketTicketer :: Address + , ttoTicketAmount :: TezosNat + , ttoDestination :: Address + , ttoEntrypoint :: Text + } + data OriginationScript = OriginationScript { osCode :: Expression , osStorage :: Expression @@ -824,6 +841,19 @@ , rcPayer :: Maybe ImplicitAddress } +data GetTicketBalance = GetTicketBalance + { gtbTicketer :: ContractAddress + , gtbContentType :: Expression + , gtbContent :: Expression + } + +data GetAllTicketBalancesResponse = GetAllTicketBalancesResponse + { gatbrTicketer :: ContractAddress + , gatbrContentType :: Expression + , gatbrContent :: Expression + , gatbrAmount :: TezosNat + } + -- | Result storage of @run_code@ RPC endpoint call. -- -- Actual resulting JSON has more contents, but currently we're interested @@ -854,6 +884,18 @@ ] instance ToJSONObject TransactionOperation +instance ToJSON TransferTicketOperation where + toJSON TransferTicketOperation{..} = object $ + [ "kind" .= String "transfer_ticket" + , "ticket_contents" .= ttoTicketContents + , "ticket_ty" .= ttoTicketTy + , "ticket_ticketer" .= ttoTicketTicketer + , "ticket_amount" .= ttoTicketAmount + , "destination" .= ttoDestination + , "entrypoint" .= ttoEntrypoint + ] +instance ToJSONObject TransferTicketOperation + instance FromJSON TransactionOperation where parseJSON = withObject "TransactionOperation" $ \obj -> do toAmount <- obj .: "amount" @@ -905,8 +947,10 @@ deriveToJSON morleyClientAesonOptions ''RunOperation deriveToJSON morleyClientAesonOptions ''GetBigMap +deriveToJSON morleyClientAesonOptions ''GetTicketBalance deriveToJSON morleyClientAesonOptions ''CalcSize deriveToJSON morleyClientAesonOptions{omitNothingFields = True} ''RunCode +deriveFromJSON morleyClientAesonOptions ''GetAllTicketBalancesResponse deriveFromJSON morleyClientAesonOptions ''BlockHeaderNoHash deriveFromJSON morleyClientAesonOptions ''ScriptSize deriveFromJSON morleyClientAesonOptions ''BlockConstants diff --git a/src/Morley/Client/TezosClient.hs b/src/Morley/Client/TezosClient.hs --- a/src/Morley/Client/TezosClient.hs +++ b/src/Morley/Client/TezosClient.hs @@ -13,6 +13,8 @@ , ResolveError(..) , resolveAddress , resolveAddressMaybe + , resolveAddressWithAlias + , resolveAddressWithAliasMaybe , getAlias , getAliasMaybe ) where diff --git a/src/Morley/Client/TezosClient/Class.hs b/src/Morley/Client/TezosClient/Class.hs --- a/src/Morley/Client/TezosClient/Class.hs +++ b/src/Morley/Client/TezosClient/Class.hs @@ -11,6 +11,7 @@ import Data.ByteArray (ScrubbedBytes) +import Morley.Client.Types import Morley.Tezos.Address import Morley.Tezos.Address.Alias import Morley.Tezos.Crypto @@ -32,18 +33,20 @@ -- | Type class that provides interaction with @octez-client@ binary class (Monad m) => HasTezosClient m where - signBytes :: ImplicitAddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature + signBytes + :: ImplicitAddressWithAlias + -> Maybe ScrubbedBytes + -> ByteString + -> m Signature -- ^ Sign an operation with @octez-client@. - genKey :: ImplicitAlias -> m ImplicitAddress + genKey :: ImplicitAlias -> m ImplicitAddressWithAlias -- ^ Generate a secret key and store it with given alias. -- If a key with this alias already exists, the corresponding address -- will be returned and no state will be changed. - genFreshKey :: ImplicitAlias -> m ImplicitAddress + genFreshKey :: ImplicitAlias -> m ImplicitAddressWithAlias -- ^ Generate a secret key and store it with given alias. -- Unlike 'genKey' this function overwrites -- the existing key when given alias is already stored. - revealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> m () - -- ^ Reveal public key associated with given implicit account. rememberContract :: AliasBehavior -> ContractAddress -> ContractAlias -> m () -- ^ Associate the given contract with alias. -- The 'Bool' variable indicates whether or not we should replace already @@ -58,9 +61,11 @@ -- > ("key:abc", "tz1...") -- -- TODO [#910]: Cache this and turn it into a 'Morley.Util.Bimap'. - getKeyPassword :: ImplicitAddress -> m (Maybe ScrubbedBytes) + 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 -- in two places: -- * 1) In @signBytes@ call. -- * 2) in @revealKey@ call. + getPublicKey :: ImplicitAddressWithAlias -> m PublicKey + -- ^ Get a public key for an implicit address or alias. diff --git a/src/Morley/Client/TezosClient/Impl.hs b/src/Morley/Client/TezosClient/Impl.hs --- a/src/Morley/Client/TezosClient/Impl.hs +++ b/src/Morley/Client/TezosClient/Impl.hs @@ -13,6 +13,7 @@ , genKey , genFreshKey , revealKey + , revealKeyUnlessRevealed , ResolveError(..) , Resolve(..) , resolveAddress @@ -28,6 +29,8 @@ , getKeyPassword , registerDelegate , getAliasesAndAddresses + , resolveAddressWithAlias + , resolveAddressWithAliasMaybe -- * Internals , findAddress @@ -55,11 +58,14 @@ import Data.Singletons (demote) import Lorentz.Value 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.Parser import Morley.Client.TezosClient.Types +import Morley.Client.Types import Morley.Client.Util (readScrubbedBytes, scrubbedBytesToString) import Morley.Micheline import Morley.Michelson.Typed.Scope @@ -67,6 +73,7 @@ import Morley.Tezos.Address.Alias import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto +import Morley.Util.Constrained import Morley.Util.Interpolate (itu) import Morley.Util.Peano import Morley.Util.Sing (castSing) @@ -132,10 +139,6 @@ | AmbiguousAlias Text ContractAddress ImplicitAddress -- ^ Expected an alias to be associated with either an implicit address or a -- contract address, but it was associated with both. - | AliasTxRollup Text (KindedAddress 'AddressKindTxRollup) - -- ^ Expected an alias to be associated with either - -- an implicit address or a contract address, - -- but it was associated with a transaction rollup address. | ResolveError ResolveError deriving stock instance Show TezosClientError @@ -190,11 +193,6 @@ * and an implicit address: #{implicitAddr} Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate. |] - AliasTxRollup aliasText txRollupAddr -> - [itu| - Expected the alias '#{aliasText}' to be assigned to either a contract or an implicit account, - but it's assigned to a transaction rollup address: #{txRollupAddr}. - |] ResolveError err -> build err ---------------------------------------------------------------------------- @@ -210,14 +208,13 @@ -- | 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, Class.HasTezosClient m) - => ImplicitAddressOrAlias + :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) + => ImplicitAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature -signBytes signer mbPassword opHash = do - signerAlias <- getAlias signer - logDebug $ "Signing for " <> pretty signer +signBytes signerAlias mbPassword opHash = do + logDebug $ "Signing for " <> pretty signerAlias output <- callTezosClientStrict ["sign", "bytes", toCmdArg opHash, "for", toCmdArg signerAlias] MockupMode mbPassword liftIO case T.stripPrefix "Signature: " output of @@ -300,6 +297,18 @@ 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 (AddressWithAlias addr alias) mbPassword = do + mbManagerKey <- getManagerKey addr + case mbManagerKey of + Nothing -> revealKey alias mbPassword + Just _ -> logDebug $ alias |+ " alias has already revealed key" + -- | Register alias as delegate registerDelegate :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) @@ -329,11 +338,10 @@ -- | Return 'PublicKey' corresponding to given 'AddressOrAlias'. getPublicKey - :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m) - => ImplicitAddressOrAlias + :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) + => ImplicitAlias -> m PublicKey -getPublicKey addrOrAlias = do - alias <- getAlias addrOrAlias +getPublicKey alias = do logDebug $ "Getting " +| alias |+ " public key" output <- callTezosClientStrict ["show", "address", toCmdArg alias] MockupMode Nothing liftIO case lines output of @@ -347,11 +355,10 @@ -- | Return 'SecretKey' corresponding to given 'AddressOrAlias'. getSecretKey - :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m) - => ImplicitAddressOrAlias + :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) + => ImplicitAlias -> m SecretKey -getSecretKey addrOrAlias = do - alias <- getAlias addrOrAlias +getSecretKey alias = do logDebug $ "Getting " +| alias |+ " secret key" output <- callTezosClientStrict ["show", "address", toCmdArg alias, "--show-secret"] MockupMode Nothing liftIO case lines output of @@ -393,7 +400,7 @@ => Bool -> ImplicitAlias -> SecretKey - -> m ImplicitAlias + -> m ImplicitAddressWithAlias importKey replaceExisting name key = do let isAlreadyExistsError = T.isInfixOf "already exists" @@ -403,7 +410,7 @@ callTezosClient errHandler (if replaceExisting then args <> ["--force"] else args) MockupMode Nothing - pure name + pure $ AddressWithAlias (mkKeyAddress (toPublic key)) name -- | Read @octez-client@ configuration. getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig @@ -488,25 +495,21 @@ -- | 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, Class.HasTezosClient m) - => ImplicitAddress -> m (Maybe ScrubbedBytes) -getKeyPassword key = (getAlias $ AddressResolved key) >>= getKeyPassword' - where - getKeyPassword' - :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, MonadMask m) - => ImplicitAlias -> m (Maybe ScrubbedBytes) - getKeyPassword' alias = do - output <- callTezosClientStrict [ "show", "address", pretty alias, "-S"] MockupMode Nothing - encryptionType <- - case parseSecretKeyEncryption output of - Right t -> return t - Left err -> throwM $ TezosClientParseEncryptionTypeError output $ pretty err - case encryptionType of - EncryptedKey -> do - putTextLn $ "Please enter password for '" <> pretty alias <> "':" - Just <$> withoutEcho readScrubbedBytes - _ -> pure Nothing + :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadMask m) + => ImplicitAlias -> m (Maybe ScrubbedBytes) +getKeyPassword alias = do + output <- callTezosClientStrict [ "show", "address", pretty alias, "-S"] MockupMode Nothing + encryptionType <- + case parseSecretKeyEncryption output of + Right t -> return t + Left err -> throwM $ TezosClientParseEncryptionTypeError output $ pretty err + case encryptionType of + EncryptedKey -> do + putTextLn $ "Please enter password for '" <> pretty alias <> "':" + Just <$> withoutEcho readScrubbedBytes + _ -> pure Nothing + where -- Hide entered password withoutEcho :: (MonadIO m, MonadMask m) => m a -> m a withoutEcho action = do @@ -666,6 +669,7 @@ 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@. -- @@ -698,9 +702,17 @@ => 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) @@ -738,9 +750,13 @@ 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) @@ -761,12 +777,35 @@ SAOAKindSpecified aoa -> do fmap SomeAlias <$> getAliasEither aoa \\ addressOrAliasKindSanity aoa - aoa@(SAOAKindUnspecified aliasText) -> do + 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. - resolveAddressEither aoa <&> fmap - \(Constrained (addr :: KindedAddress kind)) -> - SomeAlias $ mkAlias @kind aliasText \\ addressKindSanity addr + 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@. -- diff --git a/src/Morley/Client/TezosClient/Types.hs b/src/Morley/Client/TezosClient/Types.hs --- a/src/Morley/Client/TezosClient/Types.hs +++ b/src/Morley/Client/TezosClient/Types.hs @@ -5,7 +5,6 @@ module Morley.Client.TezosClient.Types ( CmdArg (..) - -- , addressResolved , CalcOriginationFeeData (..) , CalcTransferFeeData (..) , TezosClientConfig (..) @@ -27,7 +26,6 @@ import Servant.Client (BaseUrl(..), showBaseUrl) import Text.Hex (encodeHex) --- import Lorentz (ToAddress, toAddress) import Morley.Client.RPC.Types (OperationHash) import Morley.Client.Util import Morley.Micheline diff --git a/src/Morley/Client/Types.hs b/src/Morley/Client/Types.hs --- a/src/Morley/Client/Types.hs +++ b/src/Morley/Client/Types.hs @@ -5,26 +5,38 @@ ( ToJSONObject , OperationInfoDescriptor (..) , OperationInfo (..) + , AddressWithAlias(..) + , ImplicitAddressWithAlias + , ContractAddressWithAlias , _OpTransfer , _OpOriginate , _OpReveal , _OpDelegation + , _OpTransferTicket ) where import Control.Lens (makePrisms) import Data.Aeson (ToJSON(..)) +import Fmt (Buildable(..), (+|), (|+)) +import Lorentz (ToAddress(..), ToTAddress(..)) +import Morley.Tezos.Address +import Morley.Tezos.Address.Alias +import Morley.Tezos.Address.Kinds + -- | Designates types whose 'ToJSON' instance produces only 'Data.Aeson.Object's. class ToJSON a => ToJSONObject a class OperationInfoDescriptor (i :: Type) where type family TransferInfo i :: Type + type family TransferTicketInfo i :: Type type family OriginationInfo i :: Type type family RevealInfo i :: Type type family DelegationInfo i :: Type data OperationInfo i = OpTransfer (TransferInfo i) + | OpTransferTicket (TransferTicketInfo i) | OpOriginate (OriginationInfo i) | OpReveal (RevealInfo i) | OpDelegation (DelegationInfo i) @@ -32,13 +44,33 @@ -- Requiring 'ToJSONObject' in superclass as those different types of operation -- must be distinguishable and that is usually done by a special field instance - Each '[ToJSONObject] [TransferInfo i, OriginationInfo i, RevealInfo i, DelegationInfo i] => + Each '[ToJSONObject] + [TransferInfo i, TransferTicketInfo i, OriginationInfo i, RevealInfo i, DelegationInfo i] => ToJSON (OperationInfo i) where toJSON = \case OpTransfer op -> toJSON op + OpTransferTicket op -> toJSON op OpOriginate op -> toJSON op OpReveal op -> toJSON op OpDelegation op -> toJSON op instance ToJSON (OperationInfo i) => ToJSONObject (OperationInfo i) makePrisms ''OperationInfo + +data AddressWithAlias kind = AddressWithAlias + { awaAddress :: KindedAddress kind + , awaAlias :: Alias kind + } + deriving stock (Show, Eq) + +instance ToAddress (AddressWithAlias kind) where + toAddress = toAddress . awaAddress + +instance ToTAddress cp vd (KindedAddress kind) => ToTAddress cp vd (AddressWithAlias kind) where + toTAddress = toTAddress . awaAddress + +instance Buildable (AddressWithAlias kind) where + build (AddressWithAlias addr alias) = addr |+ " (" +| alias |+ ")" + +type ImplicitAddressWithAlias = AddressWithAlias 'AddressKindImplicit +type ContractAddressWithAlias = AddressWithAlias 'AddressKindContract diff --git a/test/Test/BigMapGet.hs b/test/Test/BigMapGet.hs --- a/test/Test/BigMapGet.hs +++ b/test/Test/BigMapGet.hs @@ -5,7 +5,7 @@ ( test_BigMapGetUnit ) where -import Data.Map (lookup) +import Control.Lens (at) import Test.HUnit (Assertion, assertFailure) import Test.Hspec.Expectations (shouldThrow) import Test.Tasty (TestTree, testGroup) @@ -28,15 +28,15 @@ bigMapGetHandlers = defaultHandlers { hGetContractBigMap = \blkId addr GetBigMap{..} -> do assertHeadBlockId blkId - st <- get - case lookup addr (fsContracts st) of + use (fsContractsL . at addr) >>= \case Nothing -> throwM $ UnknownAccount $ Constrained addr Just AccountState{..} -> case asAccountData of ContractData _ mbBigMap -> case mbBigMap of Nothing -> throwM $ ContractDoesntHaveBigMap $ MkAddress addr - Just ContractStateBigMap{..} -> case lookup (encodeBase58Check $ expressionToScriptExpr bmKey) csbmMap of - Nothing -> pure GetBigMapNotFound - Just serializedValue -> pure $ GetBigMapResult $ decodeExpression serializedValue + Just ContractStateBigMap{..} -> + case csbmMap ^. at (encodeBase58Check $ expressionToScriptExpr bmKey) of + Nothing -> pure GetBigMapNotFound + Just serializedValue -> pure $ GetBigMapResult $ decodeExpression serializedValue } fakeStateWithBigMapContract diff --git a/test/Test/Fees.hs b/test/Test/Fees.hs --- a/test/Test/Fees.hs +++ b/test/Test/Fees.hs @@ -14,9 +14,8 @@ import Morley.Client.Action.Origination import Morley.Client.Action.Transaction import Morley.Client.RPC.Types -import Morley.Michelson.Runtime.GState (genesisAddress1) +import Morley.Client.Types import Morley.Michelson.Untyped.Entrypoints -import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (tz) import Test.Addresses import Test.Util @@ -26,7 +25,7 @@ :: FakeState fakeState = defaultFakeState { fsContracts = fromList $ one $ (contractAddress2, dumbContractState) - , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitState) + , fsImplicits = fromList $ one $ second revealKeyState $ genesisState @1 } countForgesHandlers :: Handlers $ TestT (State Word) @@ -48,7 +47,7 @@ { arConsumedMilliGas = 10100000 , arStorageSize = 250 , arPaidStorageDiff = 250 - , arOriginatedContracts = originatedContracts + , arOriginatedContracts = concatMap arOriginatedContracts originatedContracts , arAllocatedDestinationContracts = 0 } , rmInternalOperationResults = [] @@ -82,7 +81,7 @@ [ testCase "One transaction" $ let forgeCalls = runForgesCountingTest $ - lTransfer genesisAddress1 contractAddress2 + lTransfer addr1 contractAddress2 [tz|10u|] DefEpName () Nothing in forgeCalls @?= sum [ 2 -- for fees adjustment @@ -94,7 +93,7 @@ let forgeCalls = runForgesCountingTest $ lOriginateContract OverwriteDuplicateAlias "c" - (AddressResolved genesisAddress1) [tz|10u|] + addr1 [tz|10u|] averageContract () Nothing Nothing in forgeCalls @?= sum [ 2 -- for fees adjustment @@ -103,3 +102,6 @@ ] ] + +addr1 :: ImplicitAddressWithAlias +addr1 = addrAndAliasFromGenesisState @1 diff --git a/test/Test/KeyRevealing.hs b/test/Test/KeyRevealing.hs --- a/test/Test/KeyRevealing.hs +++ b/test/Test/KeyRevealing.hs @@ -13,17 +13,13 @@ import Morley.Client import Morley.Michelson.Runtime.GState (genesisAddress1) import Morley.Michelson.Typed -import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (tz) import Test.Util import TestM fakeState :: FakeState fakeState = defaultFakeState - { fsImplicits = one ( genesisAddress1 - , dumbImplicitState - { asAccountData = ImplicitData $ Just dumbManagerKey } - ) + { fsImplicits = one $ second revealKeyState $ genesisState @1 } test_keyRevealing :: TestTree @@ -31,14 +27,14 @@ [ testCase "Manager key for new address is revealed only once for transfer" $ handleSuccess $ runFakeTest chainOperationHandlers fakeState $ do senderAddress <- genKey "sender" - dummyTransfer genesisAddress1 senderAddress - mbManagerKey <- getManagerKey senderAddress + dummyTransfer addr1 $ awaAddress senderAddress + mbManagerKey <- getManagerKey $ awaAddress senderAddress when (isJust mbManagerKey) $ fail "Manager key was expected not to be revealed, but it's revealed." dummyTransfer senderAddress genesisAddress1 - mbManagerKey' <- getManagerKey senderAddress + mbManagerKey' <- getManagerKey $ awaAddress senderAddress when (isNothing mbManagerKey') $ fail "Manager key was expected to be revealed, but it's not revealed." @@ -50,16 +46,16 @@ , testCase "Manager key for new address is revealed only once for origination" $ handleSuccess $ runFakeTest chainOperationHandlers fakeState $ do originatorAddress <- genKey "originator" - dummyTransfer genesisAddress1 originatorAddress + dummyTransfer addr1 $ awaAddress originatorAddress - mbManagerKey <- getManagerKey originatorAddress + mbManagerKey <- getManagerKey $ awaAddress originatorAddress when (isJust mbManagerKey) $ fail "Manager key was expected not to be revealed, but it's revealed." originateDummy originatorAddress - mbManagerKey' <- getManagerKey originatorAddress + mbManagerKey' <- getManagerKey $ awaAddress originatorAddress when (isNothing mbManagerKey') $ fail "Manager key was expected to be revealed, but it's not revealed." @@ -68,17 +64,18 @@ (originateDummy originatorAddress) ] where + addr1 = addrAndAliasFromGenesisState @1 dummyTransfer from to = void $ transfer from to [tz|10u|] DefEpName (toVal ()) Nothing originateDummy addr = - lOriginateContract OverwriteDuplicateAlias "dummy" (AddressResolved addr) [tz|10u|] + lOriginateContract OverwriteDuplicateAlias "dummy" addr [tz|10u|] dumbLorentzContract () Nothing Nothing -- | Handlers which don't allow to reveal key. noRevealHandlers :: (Monad m) => TestHandlers m noRevealHandlers = TestHandlers $ chainOperationHandlers - { hRevealKey = \_ _ -> throwM $ UnexpectedClientCall "revealKey" } + { hGetPublicKey = \_ -> throwM $ UnexpectedClientCall "getPublicKey" } dumbLorentzContract :: L.Contract Integer () () dumbLorentzContract = L.defaultContract $ diff --git a/test/Test/Origination.hs b/test/Test/Origination.hs --- a/test/Test/Origination.hs +++ b/test/Test/Origination.hs @@ -5,15 +5,13 @@ ( test_lRunTransactionsUnit ) where -import Test.HUnit (Assertion, assertFailure) import Test.Hspec.Expectations (shouldThrow) +import Test.HUnit (Assertion, assertFailure) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import Lorentz qualified as L import Morley.Client -import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress3) -import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core import Test.Addresses import Test.Util @@ -23,7 +21,7 @@ :: FakeState fakeState = defaultFakeState { fsContracts = fromList $ one $ (contractAddress2, dumbContractState) - , fsImplicits = fromList $ one $ (genesisAddress1, dumbImplicitState) + , fsImplicits = fromList $ one $ genesisState @1 } dumbLorentzContract :: L.Contract Integer () () @@ -34,14 +32,17 @@ test_lRunTransactionsUnit = testGroup "Mock test transaction sending" [ testCase "Successful origination" $ handleSuccess $ runFakeTest chainOperationHandlers fakeState $ - lOriginateContract OverwriteDuplicateAlias "dummy" (AddressResolved genesisAddress1) [tz|100500u|] + lOriginateContract OverwriteDuplicateAlias "dummy" addr1 [tz|100500u|] dumbLorentzContract () Nothing Nothing , testCase "Originator doesn't exist" $ handleUnknownContract $ runFakeTest chainOperationHandlers fakeState $ - lOriginateContract OverwriteDuplicateAlias "dummy" (AddressResolved genesisAddress3) [tz|100500u|] + lOriginateContract OverwriteDuplicateAlias "dummy" addr3 [tz|100500u|] dumbLorentzContract () Nothing Nothing ] where + addr1 = addrAndAliasFromGenesisState @1 + addr3 = addrAndAliasFromGenesisState @3 + handleSuccess :: Either SomeException a -> Assertion handleSuccess (Right _) = pass handleSuccess (Left e) = assertFailure $ displayException e @@ -51,5 +52,5 @@ assertFailure "Origination unexpectedly didn't fail." handleUnknownContract (Left e) = shouldThrow (throwM e) $ \case - ResolveError REAddressNotFound{} -> True + UnknownAccount{} -> True _ -> False diff --git a/test/Test/ParameterTypeGet.hs b/test/Test/ParameterTypeGet.hs --- a/test/Test/ParameterTypeGet.hs +++ b/test/Test/ParameterTypeGet.hs @@ -5,7 +5,6 @@ ( test_parameterTypeGetUnit ) where -import Data.Map as Map (empty) import Test.HUnit (Assertion, assertEqual, assertFailure) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) @@ -15,7 +14,6 @@ import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Micheline -import Morley.Michelson.Runtime.GState (genesisAddress1) import Morley.Michelson.TypeCheck.TypeCheck (SomeParamType, mkSomeParamType) import Morley.Michelson.Typed import Morley.Michelson.Untyped qualified as U @@ -56,7 +54,7 @@ [ (smartContractAddr1, buildSmartContractState "lol" (testContract @Natural)) , (smartContractAddr2, buildSmartContractState "kek" (testContract @Bool)) ] - , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitState) + , fsImplicits = fromList $ one $ genesisState @1 } test_parameterTypeGetUnit :: TestTree @@ -74,7 +72,7 @@ (runFakeTest chainOperationHandlers fakeStateWithSmartContracts $ getContractsParameterTypes [smartContractAddr3] - ) $ Map.empty + ) mempty ] where expectContractMap diff --git a/test/Test/Resolve.hs b/test/Test/Resolve.hs new file mode 100644 --- /dev/null +++ b/test/Test/Resolve.hs @@ -0,0 +1,117 @@ +-- SPDX-FileCopyrightText: 2023 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA + +module Test.Resolve + ( test_Resolve_calls + ) where + +import Test.HUnit ((@?=)) +import Test.Tasty (TestTree) +import Test.Tasty.HUnit (testCase) + +import Lorentz qualified as L +import Morley.Client (AliasBehavior(..)) +import Morley.Client.Action.Batched +import Morley.Client.Action.Common +import Morley.Client.Action.Delegation +import Morley.Client.Action.Origination +import Morley.Client.Action.Reveal +import Morley.Client.Action.Transaction +import Morley.Client.Types +import Morley.Michelson.Untyped.Entrypoints +import Morley.Tezos.Address +import Morley.Tezos.Core (tz) +import Test.Addresses +import Test.Util +import TestM + +fakeState :: Bool -> FakeState +fakeState initRevealed = defaultFakeState + { fsContracts = fromList $ one $ (contractAddress2, dumbContractState) + , fsImplicits = fromList $ one $ second revelation $ genesisState @1 + } + where + revelation | initRevealed = revealKeyState + | otherwise = id + +countAliasStoreCalls :: Handlers (TestT (State Word)) +countAliasStoreCalls = chainOperationHandlers + { hGetAliasesAndAddresses = do + liftToFakeTest $ modify (+1) + hGetAliasesAndAddresses chainOperationHandlers + } + +runAliasStoreCounterTest :: HasCallStack => Bool -> TestT (State Word) a -> Word +runAliasStoreCounterTest initRevealed action = do + let (res, count) = + usingState 0 $ runFakeTestT countAliasStoreCalls (fakeState initRevealed) action + case res of + Left e -> error . toText $ "Test action failed: " <> displayException e + Right _ -> count + +averageContract :: L.Contract () () () +averageContract = L.defaultContract $ L.car L.# L.nil L.# L.pair + +test_Resolve_calls :: [TestTree] +test_Resolve_calls = + [ testCase "One transaction" $ + let storeCalls = + runAliasStoreCounterTest True $ + lTransfer addr1 contractAddress2 + [tz|10u|] DefEpName () Nothing + in storeCalls @?= 1 -- one call in operations log. + + , testCase "One origination" + let storeCalls = + runAliasStoreCounterTest True $ + lOriginateContract OverwriteDuplicateAlias "c" + addr1 [tz|10u|] + averageContract () Nothing Nothing + in storeCalls @?= 0 + + , testCase "One revelation" + let storeCalls = + runAliasStoreCounterTest False $ revealKey addr1 + in storeCalls @?= 1 -- one call in operations log. + + , testCase "One delegation" + let storeCalls = + runAliasStoreCounterTest True $ registerDelegateOp addr1 + in storeCalls @?= 1 -- one call in operations log. + + , testCase "Mix" + let storeCalls = runAliasStoreCounterTest False do + revealKeyUnlessRevealed addr1 + registerDelegateOp addr1 + lOriginateContract OverwriteDuplicateAlias "c" addr1 [tz|10u|] averageContract () + Nothing Nothing + lTransfer addr1 contractAddress2 [tz|10u|] DefEpName () Nothing + in storeCalls @?= 3 -- one per injection except origination + + , testCase "Batch" + let storeCalls = runAliasStoreCounterTest False do + void $ runOperationsBatch addr1 $ do + delegateM $ DelegationData (Just $ unImplicitAddress $ awaAddress addr1) Nothing + originateContractM OriginationData + { odAliasBehavior = OverwriteDuplicateAlias + , odName = "c" + , odContract = L.toMichelsonContract averageContract + , odStorage = L.toVal () + , odDelegate = Nothing + , odMbFee = Nothing + , odBalance = [tz|10u|] } + runTransactionM $ TransactionData TD + { tdParam = L.toVal () + , tdReceiver = Constrained contractAddress2 + , tdAmount = [tz|10u|] + , tdEpName = DefEpName + , tdMbFee = Nothing + } + pure () + in storeCalls @?= 1 -- one per batch + + + ] + +addr1 :: ImplicitAddressWithAlias +addr1 = addrAndAliasFromGenesisState @1 diff --git a/test/Test/Transaction.hs b/test/Test/Transaction.hs --- a/test/Test/Transaction.hs +++ b/test/Test/Transaction.hs @@ -5,14 +5,13 @@ ( test_lRunTransactionsUnit ) where -import Test.HUnit (Assertion, assertFailure) import Test.Hspec.Expectations (shouldThrow) +import Test.HUnit (Assertion, assertFailure) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) -import Morley.Client (ResolveError(..), TezosClientError(..)) import Morley.Client.Action.Transaction -import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress3) +import Morley.Michelson.Runtime.GState (genesisAddress3) import Morley.Michelson.Untyped.Entrypoints import Morley.Tezos.Core (tz) import Test.Addresses @@ -23,25 +22,27 @@ :: FakeState fakeState = defaultFakeState { fsContracts = fromList $ one (contractAddress2, dumbContractState) - , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitState) + , fsImplicits = fromList $ one $ genesisState @1 } test_lRunTransactionsUnit :: TestTree test_lRunTransactionsUnit = testGroup "Fake test transaction sending" [ testCase "Successful transaction" $ handleSuccess $ runFakeTest chainOperationHandlers fakeState $ - lTransfer genesisAddress1 contractAddress2 + lTransfer addr1 contractAddress2 [tz|10u|] DefEpName () Nothing , testCase "Sender doesn't exist" $ handleUnknownContract $ runFakeTest chainOperationHandlers fakeState $ - lTransfer genesisAddress3 contractAddress2 + lTransfer addr3 contractAddress2 [tz|10u|] DefEpName () Nothing , testCase "Destination doesn't exist" $ handleUnknownContract $ runFakeTest chainOperationHandlers fakeState $ - lTransfer genesisAddress1 genesisAddress3 + lTransfer addr1 genesisAddress3 [tz|10u|] DefEpName () Nothing ] where + addr1 = addrAndAliasFromGenesisState @1 + addr3 = addrAndAliasFromGenesisState @3 handleSuccess :: Either SomeException a -> Assertion handleSuccess (Right _) = pass handleSuccess (Left e) = assertFailure $ displayException e @@ -51,5 +52,5 @@ assertFailure "Transaction sending unexpectedly didn't fail." handleUnknownContract (Left e) = shouldThrow (throwM e) $ \case - ResolveError REAddressNotFound{} -> True + UnknownAccount{} -> True _ -> False diff --git a/test/Test/Util.hs b/test/Test/Util.hs --- a/test/Test/Util.hs +++ b/test/Test/Util.hs @@ -5,10 +5,11 @@ module Test.Util ( chainOperationHandlers , dumbContractState - , dumbImplicitState - , dumbManagerKey , mapToContractStateBigMap , handleGetBigMapValue + , genesisState + , revealKeyState + , addrAndAliasFromGenesisState -- * Internals , handleRunOperationInternal @@ -16,11 +17,9 @@ ) where import Control.Exception.Safe (throwString) -import Control.Lens (at, (?~)) +import Control.Lens (at, (?=), (?~)) import Data.Aeson (encode) -import Data.ByteArray (ScrubbedBytes) import Data.ByteString.Lazy qualified as LBS (toStrict) -import Data.Map as Map (elems, insert, lookup, toList) import Data.Singletons (demote) import Fmt (pretty, (+|), (|+)) import Network.HTTP.Types.Status (status404) @@ -36,6 +35,7 @@ import Morley.Client.TezosClient (AliasBehavior(..), TezosClientError(DuplicateAlias)) import Morley.Client.Types import Morley.Micheline +import Morley.Michelson.Runtime.GState import Morley.Michelson.Typed import Morley.Tezos.Address import Morley.Tezos.Address.Alias @@ -43,6 +43,8 @@ import Morley.Tezos.Crypto import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519 import Morley.Util.ByteString +import Morley.Util.Peano +import Morley.Util.SizedList qualified as Sized import TestM -- | Function to convert given map to big map representation @@ -54,8 +56,7 @@ { csbmKeyType = toExpression $ demote @(ToT k) , csbmValueType = toExpression $ demote @(ToT v) , csbmMap = fromList $ - map (bimap (encodeBase58Check . valueToScriptExpr) lEncodeValue) $ - Map.toList map' + map (bimap (encodeBase58Check . valueToScriptExpr) lEncodeValue) $ toPairs map' , csbmId = bigMapId } @@ -72,12 +73,12 @@ Nothing } -dumbImplicitState :: AccountState 'AddressKindImplicit -dumbImplicitState = AccountState +dumbImplicitState :: PublicKey -> (ImplicitAddress, AccountState 'AddressKindImplicit) +dumbImplicitState pk = (mkKeyAddress pk, AccountState { asCounter = 100500 , asAlias = "genesis1" - , asAccountData = ImplicitData Nothing - } + , asAccountData = ImplicitData pk Nothing + }) -- | Fake handlers used for transaction sending and contract origination. chainOperationHandlers :: Monad m => Handlers (TestT m) @@ -99,22 +100,24 @@ , hGetKeyPassword = \_ -> pure Nothing , hGenKey = handleGenKey , hGetManagerKey = handleGetManagerKey - , hRevealKey = handleRevealKey + , hGetPublicKey = handleGetPublicKey } where testSecretKey :: Ed25519.SecretKey testSecretKey = Ed25519.detSecretKey "\001\002\003\004" -mkRunOperationResult :: [ContractAddress] -> RunOperationResult -mkRunOperationResult originatedContracts = RunOperationResult - { rrOperationContents = - one $ OperationContent $ RunMetadata - { rmOperationResult = OperationApplied $ - AppliedResult 100500 100500 100500 originatedContracts 0 - , rmInternalOperationResults = [] - } +mkRunOperationResult :: NonEmpty AppliedResult -> RunOperationResult +mkRunOperationResult results = RunOperationResult + { rrOperationContents = results <&> \ar -> + OperationContent $ RunMetadata + { rmOperationResult = OperationApplied ar + , rmInternalOperationResults = [] + } } +mkAppliedResult :: [ContractAddress] -> AppliedResult +mkAppliedResult originatedContracts = AppliedResult 100500 100500 100500 originatedContracts 0 + handleGetBlockHash :: Monad m => BlockId -> TestT m BlockHash handleGetBlockHash blkId = do unless (blkId == FinalHeadId) do @@ -130,8 +133,7 @@ => BlockId -> ImplicitAddress -> m TezosInt64 handleGetCounter blk addr = do assertHeadBlockId blk - FakeState{..} <- get - case lookup addr fsImplicits of + use (fsImplicitsL . at addr) >>= \case Nothing -> throwM $ UnknownAccount $ Constrained addr Just AccountState{..} -> pure $ asCounter @@ -160,8 +162,7 @@ -- https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html unless (roiBranch roOperation == fsFinalHeadBlock) do throwM $ InvalidBranch $ roiBranch roOperation - originatedContracts <- handleRunOperationInternal roOperation - pure $ mkRunOperationResult originatedContracts + mkRunOperationResult <$> handleRunOperationInternal roOperation handlePreApplyOperation :: Monad m => BlockId -> PreApplyOperation -> TestT m RunOperationResult handlePreApplyOperation blk PreApplyOperation{..} = do @@ -174,8 +175,8 @@ -- https://web.archive.org/web/20220305165609/https://tezos.gitlab.io/protocols/tenderbake.html unless (paoBranch == fsFinalHeadBlock) do throwM $ InvalidBranch paoBranch - originatedContracts <- concatMapM handleTransactionOrOrigination paoContents - pure $ mkRunOperationResult originatedContracts + results <- handleOperationInput paoContents + pure $ mkRunOperationResult results handleForgeOperation :: Monad m => BlockId -> ForgeOperation -> TestT m HexJSONByteString handleForgeOperation blkId op = do @@ -187,42 +188,40 @@ throwM $ InvalidBranch $ foBranch op pure . HexJSONByteString . LBS.toStrict . encode $ op -handleRunOperationInternal :: Monad m => RunOperationInternal -> TestT m [ContractAddress] -handleRunOperationInternal RunOperationInternal{..} = do - concatMapM handleTransactionOrOrigination roiContents +handleRunOperationInternal :: Monad m => RunOperationInternal -> TestT m (NonEmpty AppliedResult) +handleRunOperationInternal RunOperationInternal{roiContents} = handleOperationInput roiContents +handleOperationInput :: Monad m => NonEmpty OperationInput -> TestT m (NonEmpty AppliedResult) +handleOperationInput (c :| cs) = + (:|) <$> go c 1 <*> zipWithM go cs [2, 3..] + where go = fmap mkAppliedResult ... handleTransactionOrOrigination + handleTransactionOrOrigination - :: (Monad m, HasCallStack) => OperationInput -> TestT m [ContractAddress] -handleTransactionOrOrigination op = do + :: forall m. (Monad m, HasCallStack) => OperationInput -> TezosInt64 -> TestT m [ContractAddress] +handleTransactionOrOrigination op n = do FakeState{..} <- get + AccountState{..} <- + maybe (throwM $ UnknownAccount $ Constrained codSource) pure $ fsImplicits ^. at codSource + unless ((asCounter + n) == codCounter) $ throwM CounterMismatch + let checkContractExists :: Address -> TestT m () + checkContractExists dest'@(MkAddress dest) = case dest of + ContractAddress{} -> when (isNothing $ fsContracts ^. at dest) $ + throwM $ UnknownAccount dest' + ImplicitAddress{} -> when (isNothing $ fsImplicits ^. at dest) $ + throwM $ UnknownAccount dest' + SmartRollupAddress{} -> error "smart rollup unsupported" case wcoCustom op of - -- Ensure that transaction sender exists - OpTransfer TransactionOperation{..} -> case lookup codSource fsImplicits of - Nothing -> throwM $ UnknownAccount $ Constrained codSource - Just AccountState{..} -> do - -- Ensure that sender counter matches - unless (asCounter + 1 == codCounter) (throwM CounterMismatch) - case toDestination of - MkAddress dest@ContractAddress{} -> - case lookup dest fsContracts of - Nothing -> throwM $ UnknownAccount $ Constrained dest - Just _ -> pure [] - MkAddress dest@ImplicitAddress{} -> - case lookup dest fsImplicits of - Nothing -> throwM $ UnknownAccount $ Constrained dest - Just _ -> pure [] - MkAddress TxRollupAddress{} -> error "tx rollup unsupported" - -- Ensure that originator exists - OpOriginate _ -> case lookup codSource fsImplicits of - Nothing -> throwM $ UnknownAccount $ Constrained codSource - Just AccountState{..} -> do - -- Ensure that originator counter matches - unless (asCounter + 1 == codCounter) (throwM CounterMismatch) - pure [dummyContractAddr] - where - dummyContractAddr = [ta|KT1LZwEZqbqtLYhwzaidBp6So9LgYDpkpEv7|] - OpReveal _ -> - -- We do not care about reveals at the moment + OpTransfer TransactionOperation{toDestination} -> do + checkContractExists toDestination + pure [] + OpTransferTicket TransferTicketOperation{ttoDestination} -> do + checkContractExists ttoDestination + pure [] + OpOriginate{} -> + pure [[ta|KT1LZwEZqbqtLYhwzaidBp6So9LgYDpkpEv7|]] + OpReveal RevealOperation{..} -> do + let addr = mkKeyAddress roPublicKey + modify $ fsImplicitsL . at addr %~ fmap revealKeyState return [] OpDelegation _ -> -- We do not care about delegations at the moment @@ -244,8 +243,7 @@ -> m OriginationScript handleGetContractScript blockId addr = do assertHeadBlockId blockId - FakeState{..} <- get - case lookup addr fsContracts of + use (fsContractsL . at addr) >>= \case Nothing -> throwM $ err404 path Just AccountState{..} -> case asAccountData of ContractData script _ -> pure script @@ -259,7 +257,7 @@ let allBigMaps :: [ContractStateBigMap] = catMaybes $ - Map.elems (fsContracts st) <&> \cs -> case (asAccountData cs) of + toList (fsContracts st) <&> \cs -> case (asAccountData cs) of ContractData _ bigMapMaybe -> bigMapMaybe -- Check if a big_map with the given ID exists and, if so, check @@ -267,7 +265,7 @@ case find (\bigMap -> csbmId bigMap == bigMapId) allBigMaps of Nothing -> throwM $ err404 path Just bigMap -> - case lookup scriptExpr (csbmMap bigMap ) of + case csbmMap bigMap ^. at scriptExpr of Nothing -> throwM $ err404 path Just serializedValue -> pure $ decodeExpression serializedValue where @@ -278,25 +276,22 @@ handleRememberContract replaceExisting addr alias = do let cs = dumbContractState { asAlias = alias } - remember addr' cs' FakeState{..} = - modify $ \s -> s { fsContracts = insert addr' cs' fsContracts } + remember addr' cs' = fsContractsL . at addr' ?= cs' - st@FakeState{..} <- get - case lookup addr fsContracts of - Nothing -> remember addr cs st + use (fsContractsL . at addr) >>= \case + Nothing -> remember addr cs _ -> case replaceExisting of KeepDuplicateAlias -> pass - OverwriteDuplicateAlias -> remember addr cs st + OverwriteDuplicateAlias -> remember addr cs ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias -handleGenKey :: Monad m => ImplicitAlias -> TestT m ImplicitAddress +handleGenKey :: Monad m => ImplicitAlias -> TestT m ImplicitAddressWithAlias handleGenKey alias = do let - addr = detGenKeyAddress (encodeUtf8 $ unAlias alias) - newAccountState = dumbImplicitState { asAlias = alias } - modify $ \s -> - s & fsImplicitsL . at addr ?~ newAccountState - pure addr + pk = toPublic . detSecretKey . encodeUtf8 $ unAlias alias + (addr, newAccountState) = dumbImplicitState pk + modify $ fsImplicitsL . at addr ?~ newAccountState{ asAlias = alias } + pure $ AddressWithAlias addr alias handleGetAliasesAndAddresses :: forall m. Monad m @@ -307,7 +302,7 @@ where convert :: Map (KindedAddress kind) (AccountState kind) -> [(Text, Text)] convert m = - Map.toList m <&> \(addr, AccountState{asAlias}) -> (pretty asAlias, pretty addr) + toPairs m <&> \(addr, AccountState{asAlias}) -> (pretty asAlias, pretty addr) handleGetManagerKey :: (Monad m) => BlockId -> ImplicitAddress -> TestT m (Maybe PublicKey) handleGetManagerKey blk addr = do @@ -315,8 +310,7 @@ s <- get let mbCs = s ^. fsImplicitsL . at addr case mbCs of - Just AccountState{..} -> case asAccountData of - ImplicitData mbManagerKey -> pure mbManagerKey + Just AccountState{..} -> pure $ idManagerKey asAccountData Nothing -> throwM $ UnknownAccount $ Constrained addr -- In scenarios where the system under test checks for 404 errors, we @@ -339,25 +333,32 @@ , responseBody = "Contract with given address not found" } -handleRevealKey :: Monad m => ImplicitAlias -> Maybe ScrubbedBytes -> TestT m () -handleRevealKey alias _ = do - accounts <- gets (Map.toList . fsImplicits) - let accounts' = filter (\(_, AccountState{..}) -> asAlias == alias) accounts +handleGetPublicKey :: Monad m => ImplicitAddressWithAlias -> TestT m PublicKey +handleGetPublicKey aaa@(AddressWithAlias addr alias) = do + accounts <- gets (toPairs . fsImplicits) + let accounts' = filter check accounts + check (addr', AccountState{..}) = addr' == addr && asAlias == alias case accounts' of - [] -> throwM $ UnknownAlias alias - [(addr, cs@AccountState{..})] -> - case asAccountData of - ImplicitData (Just _) -> - throwM $ AlreadyRevealed $ MkAddress addr - ImplicitData Nothing -> - -- We don't care about the public key itself, but only its presence. - let newAccountState = cs { asAccountData = ImplicitData $ Just dumbManagerKey } - in modify $ \s -> s & fsImplicitsL . at addr ?~ newAccountState + [] -> throwM $ UnknownAccount $ Constrained addr + [(_, AccountState{..})] -> pure $ idPublicKey asAccountData _ -> - error $ "Multiple accounts have alias '" +| alias |+ + error $ "Multiple accounts found for '" +| aaa |+ "'. This is most likely a bug in tests." --- | Dummy public key used in fake tests. -dumbManagerKey :: PublicKey -dumbManagerKey = fromRight (error "impossible") $ parsePublicKey - "edpkuwTWKgQNnhR5v17H2DYHbfcxYepARyrPGbf1tbMoGQAj8Ljr3V" +genesisPk :: forall n. (SingIPeano n, ToPeano 10 > ToPeano n ~ 'True) => PublicKey +genesisPk = toPublic $ Sized.index @n genesisSecrets + +genesisState + :: forall n. (SingIPeano n, ToPeano 10 > ToPeano n ~ 'True) + => (ImplicitAddress, AccountState 'AddressKindImplicit) +genesisState = dumbImplicitState $ genesisPk @n + +addrAndAliasFromGenesisState + :: forall n. (SingIPeano n, ToPeano 10 > ToPeano n ~ 'True) + => ImplicitAddressWithAlias +addrAndAliasFromGenesisState = + let (addr, AccountState{asAlias}) = genesisState @n + in AddressWithAlias addr asAlias + +revealKeyState :: AccountState 'AddressKindImplicit -> AccountState 'AddressKindImplicit +revealKeyState = asAccountDataL %~ \x@ImplicitData{..} -> x{ idManagerKey = Just idPublicKey } diff --git a/test/TestM.hs b/test/TestM.hs --- a/test/TestM.hs +++ b/test/TestM.hs @@ -23,6 +23,8 @@ -- * Lens , fsImplicitsL + , fsContractsL + , asAccountDataL ) where import Colog.Core.Class (HasLog(..)) @@ -78,16 +80,18 @@ , hGetChainId :: m ChainId , hGetManagerKey :: BlockId -> ImplicitAddress -> m (Maybe PublicKey) , hGetDelegateAtBlock :: BlockId -> L1Address -> m (Maybe KeyHash) + , hGetTicketBalanceAtBlock :: BlockId -> Address -> GetTicketBalance -> m Natural + , hGetAllTicketBalancesAtBlock :: BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse] -- HasTezosClient - , hSignBytes :: ImplicitAddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature - , hGenKey :: ImplicitAlias -> m ImplicitAddress - , hGenFreshKey :: ImplicitAlias -> m ImplicitAddress - , hRevealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> m () + , hSignBytes :: ImplicitAddressWithAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature + , hGenKey :: ImplicitAlias -> m ImplicitAddressWithAlias + , hGenFreshKey :: ImplicitAlias -> m ImplicitAddressWithAlias + , hGetPublicKey :: ImplicitAddressWithAlias -> m PublicKey , hWaitForOperation :: m OperationHash -> m OperationHash , hRememberContract :: AliasBehavior -> ContractAddress -> ContractAlias -> m () , hGetAliasesAndAddresses :: m [(Text, Text)] - , hGetKeyPassword :: ImplicitAddress -> m (Maybe ScrubbedBytes) + , hGetKeyPassword :: ImplicitAddressWithAlias -> m (Maybe ScrubbedBytes) -- HasLog , hLogAction :: ClientLogAction m @@ -120,12 +124,15 @@ , hSignBytes = \_ _ _ -> throwM $ UnexpectedClientCall "signBytes" , hGenKey = \_ -> throwM $ UnexpectedClientCall "genKey" , hGenFreshKey = \_ -> throwM $ UnexpectedRpcCall "genFreshKey" - , hRevealKey = \_ _ -> throwM $ UnexpectedClientCall "revealKey" + , hGetPublicKey = \_ -> throwM $ UnexpectedClientCall "getPublicKey" , hWaitForOperation = \_ -> throwM $ UnexpectedRpcCall "waitForOperation" - , hRememberContract = \_ _ _ -> throwM $ UnexpectedClientCall "hRememberContract" + , hRememberContract = \_ _ _ -> throwM $ UnexpectedClientCall "rememberContract" , hGetAliasesAndAddresses = throwM $ UnexpectedRpcCall "getAliasesAndAddresses" , hGetKeyPassword = \_ -> throwM $ UnexpectedClientCall "getKeyPassword" + , hGetTicketBalanceAtBlock = \_ _ _ -> throwM $ UnexpectedClientCall "getTicketBalanceAtBlock" + , hGetAllTicketBalancesAtBlock = \_ _ -> throwM $ UnexpectedClientCall "getAllTicketBalancesAtBlock" + , hLogAction = mempty } @@ -138,8 +145,14 @@ } data AccountData k where - ContractData :: OriginationScript -> Maybe ContractStateBigMap -> AccountData 'AddressKindContract - ImplicitData :: Maybe PublicKey -> AccountData 'AddressKindImplicit + ContractData :: + { cdScript :: OriginationScript + , cdBigMap :: Maybe ContractStateBigMap + } -> AccountData 'AddressKindContract + ImplicitData :: + { idPublicKey :: PublicKey + , idManagerKey :: Maybe PublicKey + } -> AccountData 'AddressKindImplicit -- | Type to represent big_map in @AccountState@. data ContractStateBigMap = ContractStateBigMap @@ -218,11 +231,9 @@ -- | Various fake test errors. data TestError - = AlreadyRevealed Address - | UnexpectedRpcCall Text + = UnexpectedRpcCall Text | UnexpectedClientCall Text | UnknownAccount Address - | UnknownAlias ImplicitAlias | ContractDoesntHaveBigMap Address | InvalidChainId | InvalidProtocol @@ -247,9 +258,6 @@ genFreshKey alias = do h <- getHandler hGenFreshKey h alias - revealKey alias mbPassword = do - h <- getHandler hRevealKey - h alias mbPassword rememberContract replaceExisting addr alias = do h <- getHandler hRememberContract h replaceExisting addr alias @@ -258,6 +266,9 @@ getKeyPassword addr = do h <- getHandler hGetKeyPassword h addr + getPublicKey addrOrAlias = do + h <- getHandler hGetPublicKey + h addrOrAlias instance Monad m => HasTezosRpc (TestT m) where getBlockHash block = do @@ -327,5 +338,12 @@ waitForOperation opHash = do h <- getHandler hWaitForOperation h opHash + getTicketBalanceAtBlock block addr args = do + h <- getHandler hGetTicketBalanceAtBlock + h block addr args + getAllTicketBalancesAtBlock block addr = do + h <- getHandler hGetAllTicketBalancesAtBlock + h block addr -makeLensesFor [("fsImplicits", "fsImplicitsL")] ''FakeState +makeLensesFor [("fsImplicits", "fsImplicitsL"), ("fsContracts", "fsContractsL")] ''FakeState +makeLensesFor [("asAccountData", "asAccountDataL")] ''AccountState diff --git a/test/data/constants.json b/test/data/constants.json --- a/test/data/constants.json +++ b/test/data/constants.json @@ -9,34 +9,35 @@ "max_allowed_global_constants_depth": 10000, "cache_layout_size": 3, "michelson_maximum_type_size": 2001, - "sc_max_wrapped_proof_binary_size": 30000, - "sc_rollup_message_size_limit": 4096, + "smart_rollup_max_wrapped_proof_binary_size": 30000, + "smart_rollup_message_size_limit": 4096, + "smart_rollup_max_number_of_messages_per_level": "1000000", "preserved_cycles": 3, - "blocks_per_cycle": 4096, - "blocks_per_commitment": 32, - "nonce_revelation_threshold": 256, - "blocks_per_stake_snapshot": 256, + "blocks_per_cycle": 8192, + "blocks_per_commitment": 64, + "nonce_revelation_threshold": 512, + "blocks_per_stake_snapshot": 512, "cycles_per_voting_period": 1, "hard_gas_limit_per_operation": "1040000", - "hard_gas_limit_per_block": "5200000", + "hard_gas_limit_per_block": "2600000", "proof_of_work_threshold": "-1", "minimal_stake": "6000000000", - "vdf_difficulty": "2000000000", + "vdf_difficulty": "10000000000", "seed_nonce_revelation_tip": "125000", "origination_size": 257, - "baking_reward_fixed_portion": "10000000", - "baking_reward_bonus_per_slot": "4286", - "endorsing_reward_per_slot": "2857", + "baking_reward_fixed_portion": "2666666", + "baking_reward_bonus_per_slot": "1143", + "endorsing_reward_per_slot": "761", "cost_per_byte": "250", "hard_storage_limit_per_operation": "60000", "quorum_min": 2000, "quorum_max": 7000, "min_proposal_quorum": 500, - "liquidity_baking_subsidy": "2500000", + "liquidity_baking_subsidy": "666666", "liquidity_baking_toggle_ema_threshold": 1000000000, - "max_operations_time_to_live": 120, - "minimal_block_delay": "15", - "delay_increment_per_round": "5", + "max_operations_time_to_live": 240, + "minimal_block_delay": "8", + "delay_increment_per_round": "3", "consensus_committee_size": 7000, "consensus_threshold": 4667, "minimal_participation_ratio": { @@ -54,7 +55,7 @@ "cache_script_size": 100000000, "cache_stake_distribution_cycles": 8, "cache_sampler_state_cycles": 8, - "tx_rollup_enable": true, + "tx_rollup_enable": false, "tx_rollup_origination_size": 4000, "tx_rollup_hard_size_limit_per_inbox": 500000, "tx_rollup_hard_size_limit_per_message": 5000, @@ -72,25 +73,26 @@ "dal_parametric": { "feature_enable": false, "number_of_slots": 256, - "number_of_shards": 2048, - "endorsement_lag": 1, + "attestation_lag": 1, "availability_threshold": 50, - "slot_size": 1048576, "redundancy_factor": 16, - "page_size": 4096 + "page_size": 4096, + "slot_size": 1048576, + "number_of_shards": 2048 }, - "sc_rollup_enable": false, - "sc_rollup_origination_size": 6314, - "sc_rollup_challenge_window_in_blocks": 20160, - "sc_rollup_max_number_of_messages_per_commitment_period": 300000000, - "sc_rollup_stake_amount": "10000000000", - "sc_rollup_commitment_period_in_blocks": 30, - "sc_rollup_max_lookahead_in_blocks": 30000, - "sc_rollup_max_active_outbox_levels": 20160, - "sc_rollup_max_outbox_messages_per_level": 100, - "sc_rollup_number_of_sections_in_dissection": 32, - "sc_rollup_timeout_period_in_blocks": 20160, - "sc_rollup_max_number_of_cemented_commitments": 5, + "smart_rollup_enable": true, + "smart_rollup_arith_pvm_enable": false, + "smart_rollup_origination_size": 6314, + "smart_rollup_challenge_window_in_blocks": 40, + "smart_rollup_stake_amount": "10000000000", + "smart_rollup_commitment_period_in_blocks": 20, + "smart_rollup_max_lookahead_in_blocks": 30000, + "smart_rollup_max_active_outbox_levels": 20160, + "smart_rollup_max_outbox_messages_per_level": 100, + "smart_rollup_number_of_sections_in_dissection": 32, + "smart_rollup_timeout_period_in_blocks": 500, + "smart_rollup_max_number_of_cemented_commitments": 5, + "smart_rollup_max_number_of_parallel_games": 32, "zk_rollup_enable": false, "zk_rollup_origination_size": 4000, "zk_rollup_min_pending_to_process": 10