diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,25 @@ +0.2.1 +===== +* [!1199](https://gitlab.com/morley-framework/morley/-/merge_requests/1199) + Remove HasTezosClient getTezosClientConfig, importKey, get[Public/Secret]Key +* [!1212](https://gitlab.com/morley-framework/morley/-/merge_requests/1212) + Get contract events + + Operation result handlers now also return internal operation data. + + Injecting the operation fetches contract events from internal operation + data (received from preapply). + + `OpTransfer` now has a list of contract events as the result. +* [!1210](https://gitlab.com/morley-framework/morley/-/merge_requests/1210) + Use `consumed_milligas` instead of `consumed_gas`, as the latter is removed in Kathmandu protocol. +* [!1201](https://gitlab.com/morley-framework/morley/-/merge_requests/1201) + Enforce reveal operation to use key aliases when doing `tezos-client reveal` +* [!1177](https://gitlab.com/morley-framework/morley/-/merge_requests/1177) + Distinguish implicit/contract aliases and addresses on the type level +* [!1183](https://gitlab.com/morley-framework/morley/-/merge_requests/1183) + Avoid origination when an alias already exists + 0.2.0 ===== * [!1161](https://gitlab.com/morley-framework/morley/-/merge_requests/1161) diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -15,8 +15,7 @@ import Morley.Client import Morley.Client.Parser -import Morley.Client.RPC (BlockOperation(..), OperationResp(..), OperationRespWithMeta(..)) -import Morley.Client.RPC.Getters +import Morley.Client.RPC import Morley.Client.Util (extractAddressesFromValue) import Morley.Michelson.Runtime (prepareContract) import Morley.Michelson.TypeCheck @@ -24,7 +23,8 @@ import Morley.Michelson.Typed (Contract, Contract'(..), SomeContract(..)) import Morley.Michelson.Typed.Value (Value'(..)) import Morley.Michelson.Untyped qualified as U -import Morley.Tezos.Address (Address(..), formatAddress) +import Morley.Tezos.Address +import Morley.Tezos.Address.Alias import Morley.Tezos.Core (prettyTez) import Morley.Util.Exception (throwLeft) import Morley.Util.Main (wrapMain) @@ -43,26 +43,28 @@ putTextLn $ "Operation hash: " <> pretty operationHash putTextLn $ "Contract address: " <> formatAddress contractAddr - Transfer TransferArgs{..} -> do + Transfer TransferArgs{taDestination = SomeAddressOrAlias taDestination, ..} -> do sendAddress <- resolveAddress taSender destAddress <- resolveAddress taDestination - operationHash <- case destAddress of + operationHash :: OperationHash <- case destAddress of ContractAddress _ -> do contract <- getContract destAddress SomeContract fullContract <- throwLeft $ pure $ typeCheckingWith def $ typeCheckContract contract case fullContract of (Contract{} :: Contract cp st) -> do - let addrs = extractAddressesFromValue taParameter + 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 destAddress taAmount U.DefEpName parameter taMbFee - KeyAddress _ -> case taParameter of + ImplicitAddress _ -> case taParameter of U.ValueUnit -> transfer sendAddress destAddress taAmount U.DefEpName VUnit Nothing _ -> throwString ("The transaction parameter must be 'Unit' " <> "when transferring to an implicit account") - TransactionRollupAddress _ -> throwString "Only smart contracts can call txr1 addresses" + TxRollupAddress _ -> throwString "Only smart contracts can call txr1 addresses" putTextLn $ "Transaction was successfully sent.\nOperation hash " <> pretty operationHash <> "." 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.2.0 +version: 0.2.1 synopsis: Client to interact with the Tezos blockchain description: A client to interact with the Tezos blockchain, by use of the tezos-node RPC and/or of the tezos-client binary. category: Blockchain @@ -89,6 +89,7 @@ GADTs GeneralizedNewtypeDeriving ImportQualifiedPost + InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf @@ -189,6 +190,7 @@ GADTs GeneralizedNewtypeDeriving ImportQualifiedPost + InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf @@ -235,6 +237,7 @@ main-is: Main.hs other-modules: Ingredients + Test.Addresses Test.BigMapGet Test.Errors Test.Fees @@ -272,6 +275,7 @@ GADTs GeneralizedNewtypeDeriving ImportQualifiedPost + InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf diff --git a/src/Morley/Client.hs b/src/Morley/Client.hs --- a/src/Morley/Client.hs +++ b/src/Morley/Client.hs @@ -68,7 +68,6 @@ , readBigMapValue -- * @tezos-client@ - , addressResolved , HasTezosClient (..) , resolveAddress , TezosClientError (..) 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 @@ -21,7 +21,7 @@ import Morley.Client.TezosClient import Morley.Client.Types import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias) +import Morley.Tezos.Address.Alias import Morley.Util.Batching {- | Where the batched operations occur. @@ -68,11 +68,11 @@ maybeToRight UnexpectedOperationResult . (^? unwrapOut) -- | Perform transaction within a batch. -runTransactionM :: TransactionData -> OperationsBatch () +runTransactionM :: TransactionData -> OperationsBatch [IntOpEvent] runTransactionM = runOperationM OpTransfer _OpTransfer -- | Perform origination within a batch. -originateContractM :: OriginationData -> OperationsBatch Address +originateContractM :: OriginationData -> OperationsBatch ContractAddress originateContractM = runOperationM OpOriginate _OpOriginate -- | Perform key revealing within a batch. @@ -85,7 +85,7 @@ , HasTezosClient m , WithClientLog env m ) - => AddressOrAlias + => ImplicitAddressOrAlias -> 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 @@ -46,7 +46,7 @@ import Morley.Michelson.Typed.Scope import Morley.Michelson.Untyped.Entrypoints import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias) +import Morley.Tezos.Address.Alias import Morley.Tezos.Core import Morley.Tezos.Crypto @@ -65,7 +65,7 @@ -- | Helper for 'TransactionData' and t'Morley.Client.Action.Transaction.LTransactionData'. data TD (t :: Type) = TD - { tdReceiver :: Address + { tdReceiver :: L1Address , tdAmount :: Mutez , tdEpName :: EpName , tdParam :: t @@ -82,19 +82,19 @@ build = buildTxDataWithAlias Nothing -- | Builds 'TransactionData' with additional info about receiver's alias, if present. -buildTxDataWithAlias :: Maybe Alias -> TransactionData -> Builder +buildTxDataWithAlias :: Maybe Text -> TransactionData -> Builder buildTxDataWithAlias mbAlias (TransactionData TD{..}) = "To: " +| tdReceiver |+ buildMbAlias mbAlias |+ ". EP: " +| tdEpName |+ ". Parameter: " +| tdParam |+ ". Amount: " +| tdAmount |+ "" where - buildMbAlias :: Maybe Alias -> Builder + 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 { odReplaceExisting :: Bool - , odName :: Alias + , odName :: ContractAlias , odBalance :: Mutez , odContract :: T.Contract cp st , odStorage :: T.Value st @@ -134,7 +134,7 @@ -- | Preprocess chain operation in order to get required constants. preProcessOperation - :: (HasTezosRpc m) => Address -> m OperationConstants + :: (HasTezosRpc m) => ImplicitAddress -> m OperationConstants preProcessOperation sourceAddr = do -- NOTE: The block hash returned by this function will be used in the "branch" -- field of other operations (e.g. `run_operation`, `forge` and `preapply`). @@ -161,7 +161,7 @@ -- will be thrown. getAppliedResults :: (HasTezosRpc m) - => Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult) + => Either RunOperation PreApplyOperation -> m (NonEmpty AppliedResult, [InternalOperationData]) getAppliedResults op = do (runResult, expectedContentsSize) <- case op of Left runOp -> @@ -179,22 +179,24 @@ -- | Handle a result of an operation: throw errors if there was an error, -- return a nonempty list of applied results if there weren't. handleOperationResult :: - MonadThrow m => RunOperationResult -> Int -> m (NonEmpty AppliedResult) + MonadThrow m => RunOperationResult -> Int -> m (NonEmpty AppliedResult, [InternalOperationData]) handleOperationResult RunOperationResult{..} expectedContentsSize = do when (length rrOperationContents /= expectedContentsSize) $ throwM $ RpcUnexpectedSize expectedContentsSize (length rrOperationContents) let (appliedResults, runErrors) = sconcat $ first pure . collectResults <$> rrOperationContents + ioDatas = concatMap (map ioData . rmInternalOperationResults . unOperationContent) + $ toList rrOperationContents whenJust runErrors handleErrors - pure appliedResults + pure (appliedResults, ioDatas) where collectResults :: OperationContent -> (AppliedResult, Maybe [RunError]) collectResults (OperationContent (RunMetadata res internalOps)) = - res : map unInternalOperation internalOps + res : map ioResult internalOps & flip foldr (mempty, Nothing) \case OperationApplied result -> first (result <>) OperationFailed errors -> second (Just errors <>) @@ -241,13 +243,11 @@ -- Throws an error if given address is a contract address. revealKeyUnlessRevealed :: (WithClientLog env m, HasTezosRpc m, HasTezosClient m) - => Address + => ImplicitAddress -> Maybe ScrubbedBytes -> m () revealKeyUnlessRevealed addr mbPassword = do alias <- getAlias $ AddressResolved addr - unless (isKeyAddress addr) $ - throwM $ CantRevealContract alias mbManagerKey <- getManagerKey addr case mbManagerKey of Nothing -> revealKey alias mbPassword 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 @@ -8,14 +8,16 @@ , runOperationsNonEmpty -- helpers , dryRunOperationsNonEmpty + , DuplicateAlias (..) ) where import Control.Lens (has, (%=), (&~)) import Data.List (zipWith4) import Data.List.NonEmpty qualified as NE +import Data.Ratio ((%)) import Data.Singletons (Sing, SingI, sing) import Data.Text qualified as T -import Fmt (blockListF, blockListF', listF, nameF, pretty, (+|), (|+)) +import Fmt (Buildable(..), blockListF, blockListF', listF, nameF, pretty, (+|), (|+)) import Morley.Client.Action.Common import Morley.Client.Logging @@ -27,7 +29,7 @@ import Morley.Client.Types import Morley.Micheline (StringEncode(..), TezosInt64, TezosMutez(..)) import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias(..)) +import Morley.Tezos.Address.Alias import Morley.Tezos.Core import Morley.Tezos.Crypto import Morley.Util.ByteString @@ -35,17 +37,18 @@ -- | Designates output of an operation. data Result instance OperationInfoDescriptor Result where - type TransferInfo Result = () - type OriginationInfo Result = Address + type TransferInfo Result = [IntOpEvent] + type OriginationInfo Result = ContractAddress type RevealInfo Result = () logOperations - :: forall (runMode :: RunMode) env m. + :: forall (runMode :: RunMode) env m kind. ( WithClientLog env m , HasTezosClient m , SingI runMode -- We don't ask aliases with 'tezos-client' in 'DryRun' mode + , L1AddressKind kind ) - => AddressOrAlias + => AddressOrAlias kind -> NonEmpty (OperationInfo ClientInput) -> m () logOperations sender ops = do @@ -74,12 +77,12 @@ aliases <- case runMode of SRealRun -> forM ops $ \case - OpTransfer (TransactionData tx) -> - Just <$> (getAlias . AddressResolved $ tdReceiver tx) + OpTransfer (TransactionData tx) -> case tdReceiver tx of + MkConstrainedAddress addr -> Just . pretty <$> (getAlias $ AddressResolved addr) OpOriginate _ -> pure Nothing OpReveal r -> - Just <$> (getAlias . AddressResolved . mkKeyAddress $ rdPublicKey r) + Just . pretty <$> (getAlias . AddressResolved . mkKeyAddress $ rdPublicKey r) SDryRun -> pure $ ops $> Nothing logInfo $ T.strip $ -- strip trailing newline @@ -96,7 +99,7 @@ , HasTezosClient m , WithClientLog env m ) - => AddressOrAlias + => ImplicitAddressOrAlias -> [OperationInfo ClientInput] -> m (Maybe OperationHash, [OperationInfo Result]) runOperations sender operations = case operations of @@ -119,7 +122,7 @@ , HasTezosClient m , WithClientLog env m ) - => AddressOrAlias + => ImplicitAddressOrAlias -> NonEmpty (OperationInfo ClientInput) -> m (OperationHash, NonEmpty (OperationInfo Result)) runOperationsNonEmpty sender operations = @@ -161,7 +164,7 @@ , HasTezosClient m , WithClientLog env m ) - => AddressOrAlias + => ImplicitAddressOrAlias -> NonEmpty (OperationInfo ClientInput) -> m (NonEmpty (AppliedResult, TezosMutez)) dryRunOperationsNonEmpty sender operations = @@ -178,13 +181,19 @@ , SingI runMode ) => Natural - -> AddressOrAlias + -> ImplicitAddressOrAlias -> NonEmpty (OperationInfo ClientInput) -> m (RunResult runMode) runOperationsNonEmptyHelper retryCount sender operations = do logOperations @runMode sender operations + -- If any aliases we intend to create already exist, we want to fail + -- now, rather than after contract origination. + forM_ operations $ \case + OpOriginate OriginationData{..} -> unless odReplaceExisting $ do + resolved <- resolveAddressMaybe (AddressAlias odName) + whenJust resolved $ const $ throwM DuplicateAlias + _ -> pure () senderAddress <- resolveAddress sender - prohibitContractSender senderAddress $ head operations mbPassword <- getKeyPassword senderAddress when (isRealRun @runMode && mayNeedSenderRevealing (toList operations)) $ revealKeyUnlessRevealed senderAddress mbPassword @@ -193,9 +202,9 @@ OperationConstants{..} <- preProcessOperation senderAddress let convertOps i = WithCommonOperationData commonData . \case - OpTransfer (TransactionData TD {..}) -> + OpTransfer (TransactionData TD {tdReceiver=MkConstrainedAddress tdReceiver, ..}) -> OpTransfer TransactionOperation - { toDestination = tdReceiver + { toDestination = MkAddress tdReceiver , toAmount = TezosMutez tdAmount , toParameters = toParametersInternals tdEpName tdParam } @@ -227,7 +236,7 @@ } , roChainId = bcChainId ocBlockConstants } - results <- getAppliedResults (Left runOp) + (results, _) <- getAppliedResults (Left runOp) let -- Learn how to forge given operations forgeOp :: NonEmpty OperationInput -> m ByteString @@ -253,12 +262,12 @@ additionalGas = case internalOp of OpOriginate _ -> gasSafetyGuard OpTransfer (TransactionOperation {..}) -> case toDestination of - KeyAddress _ -> 0 - ContractAddress _ -> gasSafetyGuard - TransactionRollupAddress _ -> gasSafetyGuard + MkAddress ImplicitAddress{} -> 0 + MkAddress ContractAddress{} -> gasSafetyGuard + MkAddress TxRollupAddress{} -> gasSafetyGuard OpReveal _ -> 0 let storageLimit = computeStorageLimit [ar] pp + 20 -- similarly to tezos-client, we add 20 for safety - let gasLimit = arConsumedGas ar + additionalGas + let gasLimit = ceiling (arConsumedMilliGas ar % 1000) + additionalGas updateCommonDataForFee fee = updateCommonData gasLimit storageLimit (TezosMutez fee) @@ -319,7 +328,7 @@ , paoContents = updOps , paoSignature = signature' } - ars2 <- getAppliedResults (Right preApplyOp) + (ars2, iopsData) <- getAppliedResults (Right preApplyOp) case sing @runMode of SDryRun -> do let fees = map (codFee . wcoCommon) updOps @@ -329,12 +338,12 @@ let contractAddrs = arOriginatedContracts <$> ars2 opsRes <- forM (NE.zip operations contractAddrs) $ \case (OpTransfer _, []) -> - return $ OpTransfer () + return $ OpTransfer $ mapMaybe iopsDataToEmitOp iopsData (OpTransfer _, addrs) -> do logInfo . T.strip $ "The following contracts were originated during transactions: " +| listF addrs |+ "" - return $ OpTransfer () + return $ OpTransfer $ mapMaybe iopsDataToEmitOp iopsData (OpOriginate _, []) -> throwM RpcOriginatedNoContracts (OpOriginate OriginationData{..}, [addr]) -> do @@ -356,6 +365,11 @@ runOperationsNonEmptyHelper @runMode (retryCount - 1) sender operations e -> throwM e where + iopsDataToEmitOp :: InternalOperationData -> Maybe IntOpEvent + iopsDataToEmitOp = \case + IODEvent evt -> Just evt + _ -> Nothing + mayNeedSenderRevealing :: [OperationInfo i] -> Bool mayNeedSenderRevealing = any \case OpTransfer{} -> True @@ -365,17 +379,13 @@ logStatistics :: AppliedResult -> m () logStatistics ar = do let showTezosInt64 = show . unStringEncode - logInfo $ "Consumed gas: " <> showTezosInt64 (arConsumedGas ar) + logInfo $ "Consumed milli-gas: " <> showTezosInt64 (arConsumedMilliGas ar) logInfo $ "Storage size: " <> showTezosInt64 (arStorageSize ar) logInfo $ "Paid storage size diff: " <> showTezosInt64 (arPaidStorageDiff ar) - prohibitContractSender :: Address -> OperationInfo ClientInput -> m () - prohibitContractSender addr op = case (addr, op) of - (KeyAddress _, _) -> pass - (ContractAddress _, op') -> throwM $ ContractSender addr (opName op') - (TransactionRollupAddress _, op') -> throwM $ ContractSender addr (opName op') - - opName = \case - OpTransfer _ -> "transfer" - OpOriginate _ -> "origination" - OpReveal _ -> "reveal" +data DuplicateAlias = DuplicateAlias + deriving stock Show +instance Exception DuplicateAlias where + displayException = pretty +instance Buildable DuplicateAlias where + build DuplicateAlias = "Attempted to create an alias that already exists." diff --git a/src/Morley/Client/Action/Origination.hs b/src/Morley/Client/Action/Origination.hs --- a/src/Morley/Client/Action/Origination.hs +++ b/src/Morley/Client/Action/Origination.hs @@ -41,7 +41,7 @@ import Morley.Michelson.Typed.Scope import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias, Alias) +import Morley.Tezos.Address.Alias import Morley.Tezos.Core import Morley.Util.Exception @@ -54,9 +54,9 @@ , HasTezosClient m , WithClientLog env m ) - => AddressOrAlias + => ImplicitAddressOrAlias -> [OriginationData] - -> m (Maybe OperationHash, [Address]) + -> m (Maybe OperationHash, [ContractAddress]) originateContracts sender originations = do (opHash, res) <- runOperations sender (OpOriginate <$> originations) return (opHash, fromOrigination <$> res) @@ -75,13 +75,13 @@ , ParameterScope cp ) => Bool - -> Alias - -> AddressOrAlias + -> ContractAlias + -> ImplicitAddressOrAlias -> Mutez -> Contract cp st -> Value st -> Maybe Mutez - -> m (OperationHash, Address) + -> m (OperationHash, ContractAddress) originateContract odReplaceExisting odName sender' odBalance odContract odStorage odMbFee = do (hash, contracts) <- originateContracts sender' [OriginationData{..}] singleOriginatedContract hash contracts @@ -94,13 +94,13 @@ , WithClientLog env m ) => Bool - -> Alias - -> AddressOrAlias + -> ContractAlias + -> ImplicitAddressOrAlias -> Mutez -> U.Contract -> U.Value -> Maybe Mutez - -> m (OperationHash, Address) + -> m (OperationHash, ContractAddress) originateUntypedContract replaceExisting name sender' balance uContract initialStorage mbFee = do SomeContractAndStorage contract storage <- throwLeft . pure . typeCheckingWith def $ @@ -114,9 +114,9 @@ , HasTezosClient m , WithClientLog env m ) - => AddressOrAlias + => ImplicitAddressOrAlias -> [LOriginationData] - -> m (Maybe OperationHash, [Address]) + -> m (Maybe OperationHash, [ContractAddress]) lOriginateContracts sender' originations = originateContracts sender' $ map convertLOriginationData originations @@ -130,13 +130,13 @@ , NiceParameterFull cp ) => Bool - -> Alias - -> AddressOrAlias + -> ContractAlias + -> ImplicitAddressOrAlias -> Mutez -> L.Contract cp st vd -> st -> Maybe Mutez - -> m (OperationHash, Address) + -> m (OperationHash, ContractAddress) lOriginateContract lodReplaceExisting lodName sender' lodBalance lodContract lodStorage lodMbFee = do (hash, contracts) <- lOriginateContracts sender' [LOriginationData{..}] singleOriginatedContract @m hash contracts @@ -153,9 +153,9 @@ , HasTezosClient m , WithClientLog env m ) - => AddressOrAlias + => ImplicitAddressOrAlias -> [OriginationData] - -> m (Maybe OperationHash, [Address]) + -> m (Maybe OperationHash, [ContractAddress]) originateLargeContracts sender' largeOriginations = do senderAddress <- resolveAddress sender' -- calculate large contract originators @@ -186,13 +186,13 @@ , ParameterScope cp ) => Bool - -> Alias - -> AddressOrAlias + -> ContractAlias + -> ImplicitAddressOrAlias -> Mutez -> Contract cp st -> Value st -> Maybe Mutez - -> m (OperationHash, Address) + -> m (OperationHash, ContractAddress) originateLargeContract odReplaceExisting odName sender' odBalance odContract odStorage odMbFee = do (hash, contracts) <- originateLargeContracts sender' [OriginationData{..}] singleOriginatedContract @m hash contracts @@ -205,13 +205,13 @@ , WithClientLog env m ) => Bool - -> Alias - -> AddressOrAlias + -> ContractAlias + -> ImplicitAddressOrAlias -> Mutez -> U.Contract -> U.Value -> Maybe Mutez - -> m (OperationHash, Address) + -> m (OperationHash, ContractAddress) originateLargeUntypedContract replaceExisting name sender' balance uContract initialStorage mbFee = do SomeContractAndStorage contract storage <- throwLeft . pure . typeCheckingWith def $ @@ -225,9 +225,9 @@ , HasTezosClient m , WithClientLog env m ) - => AddressOrAlias + => ImplicitAddressOrAlias -> [LOriginationData] - -> m (Maybe OperationHash, [Address]) + -> m (Maybe OperationHash, [ContractAddress]) lOriginateLargeContracts sender' originations = originateLargeContracts sender' $ map convertLOriginationData originations @@ -241,13 +241,13 @@ , NiceParameterFull cp ) => Bool - -> Alias - -> AddressOrAlias + -> ContractAlias + -> ImplicitAddressOrAlias -> Mutez -> L.Contract cp st vd -> st -> Maybe Mutez - -> m (OperationHash, Address) + -> m (OperationHash, ContractAddress) lOriginateLargeContract lodReplaceExisting lodName sender' lodBalance lodContract lodStorage lodMbFee = do (hash, contracts) <- lOriginateLargeContracts sender' [LOriginationData{..}] singleOriginatedContract @m hash contracts @@ -260,7 +260,7 @@ data LOriginationData = forall cp st vd. (NiceParameterFull cp, NiceStorage st) => LOriginationData { lodReplaceExisting :: Bool - , lodName :: Alias + , lodName :: ContractAlias , lodBalance :: Mutez , lodContract :: L.Contract cp st vd , lodStorage :: st @@ -283,8 +283,8 @@ -- | Checks that the origination result for a single contract is indeed one. singleOriginatedContract :: forall m. HasTezosRpc m - => Maybe OperationHash -> [Address] - -> m (OperationHash, Address) + => Maybe OperationHash -> [ContractAddress] + -> m (OperationHash, ContractAddress) singleOriginatedContract mbHash contracts = case contracts of [addr] -> case mbHash of Just hash -> return (hash, addr) 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 @@ -53,7 +53,8 @@ import Morley.Michelson.Typed.Util (PushableStorageSplit(..), splitPushableStorage) import Morley.Michelson.Typed.Value import Morley.Michelson.Untyped.Annotation (annQ, noAnn) -import Morley.Tezos.Address.Alias (Alias(..)) +import Morley.Tezos.Address +import Morley.Tezos.Address.Alias -- | Just a utility type to hold 'SomeLargeContractOriginator' and its large -- contract 'OriginationData'. @@ -207,21 +208,22 @@ mkLargeOriginatorStore :: StorageScope heavy => Value heavy - -> Address + -> ImplicitAddress -> Value (LargeOriginatorStore heavy) mkLargeOriginatorStore heavyVal owner = - let vAddr = toVal owner in + let vAddr = toVal (MkAddress owner) in VPair (vAddr, VOr $ Right $ VPair (VBytes mempty, heavyVal)) -- | Makes 'OriginationData' of the 'largeContractOriginator' that will generate --- the large contract of the given 'OriginationData' for the sender 'Address'. +-- the large contract of the given 'OriginationData' for the sender +-- t'ImplicitAddress'. mkLargeOriginatorData - :: Address -> LargeOriginationData + :: ImplicitAddress -> LargeOriginationData -> OriginationData mkLargeOriginatorData sender' LargeOriginationData{..} = case largeOriginator of SomeLargeContractOriginator heavyVal origContract _origLambda -> OriginationData { odReplaceExisting = odReplaceExisting $ largeContractData - , odName = Alias $ "largeOriginator." <> unAlias (odName largeContractData) + , odName = ContractAlias $ "largeOriginator." <> unAlias (odName largeContractData) , odBalance = zeroMutez -- Note ^ we don't transfer any balance here, we instead do it as part of the -- last transaction (where it will be transferred to the large contract) @@ -231,9 +233,9 @@ } -- | Makes all the 'TransactionData' to feed the origination lambda into a --- 'largeContractOriginator' from the 'Address' of the latter. +-- 'largeContractOriginator' from the t'ContractAddress' of the latter. mkLargeOriginatorTransactions - :: Address -> LargeOriginationData + :: ContractAddress -> LargeOriginationData -> [TransactionData] mkLargeOriginatorTransactions originatorAddr LargeOriginationData{..} = case largeContractData of @@ -241,14 +243,14 @@ SomeLargeContractOriginator _ _ origLambda -> let lambdaChunks = divideValueInChunks origLambda doRunLambda = TransactionData @'T.TUnit $ TD - { tdReceiver = originatorAddr + { tdReceiver = MkConstrainedAddress originatorAddr , tdAmount = odBalance , tdEpName = eprName $ Call @"run_lambda" , tdParam = VUnit , tdMbFee = odMbFee } mkLoadLambda bytes = TransactionData @'T.TBytes $ TD - { tdReceiver = originatorAddr + { tdReceiver = MkConstrainedAddress originatorAddr , tdAmount = zeroMutez , tdEpName = eprName $ Call @"load_lambda" , tdParam = VBytes bytes @@ -256,14 +258,14 @@ } in foldl' (\lst bytes -> mkLoadLambda bytes : lst) [doRunLambda] lambdaChunks --- | Fetches back the 'Address' of the large contract generated by a completed --- 'largeContractOriginator' process. +-- | Fetches back the t'ContractAddress' of the large contract generated by a +-- completed 'largeContractOriginator' process. -- -- It also uses the large contract 'OriginationData' to associate it to the -- expected alias. retrieveLargeContracts :: (HasTezosRpc m, HasTezosClient m) - => Address -> OriginationData -> m Address + => ContractAddress -> OriginationData -> m ContractAddress retrieveLargeContracts originatorAddr OriginationData{..} = do expr <- getContractStorage originatorAddr -- note: for simplicity here we convert the "wrong" value @@ -272,7 +274,10 @@ let completedStore = fromExpression @(Value (LargeOriginatorStore 'T.TUnit)) expr case completedStore of Right (VPair (_, VOr (Left largeVAddr))) -> do - let largeAddr = fromVal @Address largeVAddr - rememberContract odReplaceExisting largeAddr odName - pure largeAddr + MkConstrainedAddress largeAddr <- pure $ fromVal @Address largeVAddr + case largeAddr of + ContractAddress{} -> do + rememberContract odReplaceExisting largeAddr odName + pure largeAddr + _ -> error "impossible" _ -> throwM RpcOriginatedNoContracts diff --git a/src/Morley/Client/Action/Reveal.hs b/src/Morley/Client/Action/Reveal.hs --- a/src/Morley/Client/Action/Reveal.hs +++ b/src/Morley/Client/Action/Reveal.hs @@ -25,13 +25,14 @@ -- | Reveal given key. -- -- This is a variation of key revealing method that tries to use solely RPC. +-- TODO [#873] remove HasTezosClient dependency revealKey :: forall m env. ( HasTezosRpc m , HasTezosClient m , WithClientLog env m ) - => Address + => ImplicitAddress -> RevealData -> m OperationHash revealKey sender revealing = do @@ -41,13 +42,14 @@ _ -> throwM RpcNoOperationsRun -- | Reveal given key. +-- TODO [#873] remove HasTezosClient dependency revealKeyUnlessRevealed :: forall m env. ( HasTezosRpc m , HasTezosClient m , WithClientLog env m ) - => Address + => ImplicitAddress -> RevealData -> m () revealKeyUnlessRevealed sender param = do 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 @@ -41,7 +41,7 @@ , HasTezosClient m , WithClientLog env m ) - => Address -> [TransactionData] + => ImplicitAddress -> [TransactionData] -> m (Maybe OperationHash) runTransactions sender transactions = do (opHash, _) <- runOperations (AddressResolved sender) (OpTransfer <$> transactions) @@ -60,7 +60,7 @@ , HasTezosClient m , WithClientLog env m ) - => Address + => ImplicitAddress -> [LTransactionData] -> m (Maybe OperationHash) lRunTransactions sender transactions = @@ -78,14 +78,15 @@ } transfer - :: forall m t env. + :: forall m t env kind. ( HasTezosRpc m , HasTezosClient m , WithClientLog env m , ParameterScope t + , L1AddressKind kind ) - => Address - -> Address + => ImplicitAddress + -> KindedAddress kind -> Mutez -> EpName -> T.Value t @@ -94,7 +95,7 @@ transfer from to amount epName param mbFee = do res <- runTransactions from $ [TransactionData TD - { tdReceiver = to + { tdReceiver = MkConstrainedAddress to , tdAmount = amount , tdEpName = epName , tdParam = param @@ -106,14 +107,15 @@ _ -> throwM RpcNoOperationsRun lTransfer - :: forall m t env. + :: forall m t env kind. ( HasTezosRpc m , HasTezosClient m , WithClientLog env m , NiceParameter t + , L1AddressKind kind ) - => Address - -> Address + => ImplicitAddress + -> KindedAddress kind -> Mutez -> EpName -> t 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 @@ -65,7 +65,7 @@ import Morley.Client.RPC import Morley.Client.RPC.API qualified as API import Morley.Micheline (Expression, TezosInt64, TezosNat, unTezosMutez) -import Morley.Tezos.Address (Address) +import Morley.Tezos.Address import Morley.Tezos.Core (ChainId, Mutez, parseChainId) import Morley.Tezos.Crypto (KeyHash, PublicKey) import Morley.Util.ByteString (HexJSONByteString) @@ -111,7 +111,7 @@ getBlockHashImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> m BlockHash getBlockHashImpl = retryOnceOnTimeout ... fmap BlockHash . API.getBlockHash API.nodeMethods -getCounterImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> m TezosInt64 +getCounterImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> ImplicitAddress -> m TezosInt64 getCounterImpl = retryOnceOnTimeout ... API.getCounter API.nodeMethods getBlockHeaderImpl :: @@ -156,18 +156,18 @@ getContractScriptImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => - BlockId -> Address -> m OriginationScript + BlockId -> ContractAddress -> m OriginationScript getContractScriptImpl = retryOnceOnTimeout ... API.getScript API.nodeMethods getContractStorageAtBlockImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => - BlockId -> Address -> m Expression + BlockId -> ContractAddress -> m Expression getContractStorageAtBlockImpl = retryOnceOnTimeout ... API.getStorageAtBlock API.nodeMethods getContractBigMapImpl :: (RunClient m, MonadUnliftIO m, MonadCatch m) => - BlockId -> Address -> GetBigMap -> m GetBigMapResult + BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult getContractBigMapImpl = retryOnceOnTimeout ... API.getBigMap API.nodeMethods getScriptSizeAtBlockImpl :: @@ -192,13 +192,13 @@ retryOnceOnTimeout ... fmap unTezosMutez ... API.getBalance API.nodeMethods getDelegateImpl :: - (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> m (Maybe KeyHash) + (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> ContractAddress -> m (Maybe KeyHash) getDelegateImpl = retryOnceOnTimeout ... API.getDelegate API.nodeMethods -- | Similar to 'API.getManagerKey', but retries once on timeout. getManagerKeyImpl :: - (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> Address -> m (Maybe PublicKey) + (RunClient m, MonadUnliftIO m, MonadCatch m) => BlockId -> ImplicitAddress -> m (Maybe PublicKey) getManagerKeyImpl = retryOnceOnTimeout ... API.getManagerKey API.nodeMethods 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 @@ -1,8 +1,6 @@ -- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA -{-# LANGUAGE InstanceSigs #-} - -- | Implementation of full-featured Morley client. module Morley.Client.Full @@ -21,7 +19,6 @@ import Morley.Client.RPC.Class import Morley.Client.TezosClient.Class import Morley.Client.TezosClient.Impl qualified as TezosClient -import Morley.Client.TezosClient.Types import Morley.Tezos.Crypto (Signature(..)) import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519 @@ -50,25 +47,14 @@ Just sk -> pure . SignatureEd25519 $ Ed25519.sign sk opHash Nothing -> TezosClient.signBytes senderAlias mbPassword opHash rememberContract = failOnTimeout ... TezosClient.rememberContract - importKey = failOnTimeout ... TezosClient.importKey resolveAddressMaybe = retryOnceOnTimeout ... TezosClient.resolveAddressMaybe getAlias = retryOnceOnTimeout ... TezosClient.getAlias - getPublicKey = retryOnceOnTimeout ... TezosClient.getPublicKey - getSecretKey = retryOnceOnTimeout ... TezosClient.getSecretKey - -- This function doesn't perform any chain related operations with tezos-client, - -- so @ECONNRESET@ cannot appear here - getTezosClientConfig = do - path <- tceTezosClientPath <$> view tezosClientEnvL - mbDataDir <- tceMbTezosClientDataDir <$> view tezosClientEnvL - liftIO $ TezosClient.getTezosClientConfig path mbDataDir genFreshKey = retryOnceOnTimeout ... TezosClient.genFreshKey genKey = failOnTimeout ... TezosClient.genKey -- Key revealing cannot be safely retried, so we're not trying to recover it -- from @ECONNRESET@. revealKey = failOnTimeout ... TezosClient.revealKey registerDelegate = failOnTimeout ... TezosClient.registerDelegate - calcTransferFee = retryOnceOnTimeout ... TezosClient.calcTransferFee - calcOriginationFee = retryOnceOnTimeout ... TezosClient.calcOriginationFee getKeyPassword = retryOnceOnTimeout . TezosClient.getKeyPassword instance RunClient MorleyClientM where 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.Tezos.Address (Address, mkKeyAddress) -import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias(..)) +import Morley.Tezos.Address +import Morley.Tezos.Address.Alias import Morley.Tezos.Crypto (SecretKey, sign, toPublic) ---------------- @@ -41,7 +41,7 @@ -- ^ Action used to log messages. , moreClientEnv :: ClientEnv -- ^ Environment necessary to make HTTP calls. - , moreSecretKeys :: Map Address SecretKey + , moreSecretKeys :: Map ImplicitAddress SecretKey -- ^ In-memory secret keys that can be used for signing. } @@ -92,7 +92,7 @@ toString $ "Method '" <> method <> "' is not supported in only-RPC mode" -- | This exception is thrown when something goes wrong in supported methods. -data MorleyOnlyRpcException = UnknownSecretKeyFor Address +data MorleyOnlyRpcException = UnknownSecretKeyFor ImplicitAddress deriving stock (Show, Eq) instance Exception MorleyOnlyRpcException where @@ -127,20 +127,18 @@ -- places and with an exception here it's not possible to send transactions. -- So be aware of this and do not rely on this value! -- TODO [#652]: consider using a `Map` instead - getAlias _ = pure (Alias "MorleyOnlyRpc") + getAlias = \case + AddressResolved x -> case x of + ContractAddress{} -> pure $ ContractAlias "MorleyOnlyRpc" + ImplicitAddress{} -> pure $ ImplicitAlias "MorleyOnlyRpc" + AddressAlias a -> pure a -- Actions that are not supported and simply throw exceptions. genKey _ = throwM $ UnsupportedByOnlyRPC "genKey" genFreshKey _ = throwM $ UnsupportedByOnlyRPC "genFreshKey" - importKey _ _ _ = throwM $ UnsupportedByOnlyRPC "importKey" revealKey _ _ = throwM $ UnsupportedByOnlyRPC "revealKey" resolveAddressMaybe _ = throwM $ UnsupportedByOnlyRPC "resolveAddressMaybe" - getPublicKey _ = throwM $ UnsupportedByOnlyRPC "getPublicKey" - getSecretKey _ = throwM $ UnsupportedByOnlyRPC "getSecretKey" registerDelegate _ _ = throwM $ UnsupportedByOnlyRPC "registerDelegate" - getTezosClientConfig = throwM $ UnsupportedByOnlyRPC "getTezosClientConfig" - calcTransferFee _ _ _ _ = throwM $ UnsupportedByOnlyRPC "calcTransferFee" - calcOriginationFee _ = throwM $ UnsupportedByOnlyRPC "calcOriginationFee" instance RunClient MorleyOnlyRpcM where runRequestAcceptStatus statuses req = do diff --git a/src/Morley/Client/Parser.hs b/src/Morley/Client/Parser.hs --- a/src/Morley/Client/Parser.hs +++ b/src/Morley/Client/Parser.hs @@ -30,7 +30,9 @@ import Morley.Client.Init import Morley.Client.RPC.Types (BlockId(HeadId)) import Morley.Michelson.Untyped qualified as U -import Morley.Tezos.Address.Alias (AddressOrAlias, Alias(..)) +import Morley.Tezos.Address +import Morley.Tezos.Address.Alias +import Morley.Tezos.Address.Kinds import Morley.Tezos.Core import Morley.Util.CLI (mkCLOptionParser, mkCommandParser) import Morley.Util.Named @@ -38,20 +40,20 @@ data ClientArgs = ClientArgs MorleyClientConfig ClientArgsRaw -data ClientArgsRaw - = Originate OriginateArgs - | GetScriptSize GetScriptSizeArgs - | Transfer TransferArgs - | GetBalance AddressOrAlias - | GetBlockHeader BlockId - | GetBlockOperations BlockId +data ClientArgsRaw where + Originate :: OriginateArgs -> ClientArgsRaw + GetScriptSize :: GetScriptSizeArgs -> ClientArgsRaw + Transfer :: TransferArgs -> ClientArgsRaw + GetBalance :: L1AddressKind kind => AddressOrAlias kind -> ClientArgsRaw + GetBlockHeader :: BlockId -> ClientArgsRaw + GetBlockOperations :: BlockId -> ClientArgsRaw data OriginateArgs = OriginateArgs { oaMbContractFile :: Maybe FilePath - , oaContractName :: Alias + , oaContractName :: ContractAlias , oaInitialBalance :: Mutez , oaInitialStorage :: U.Value - , oaOriginateFrom :: AddressOrAlias + , oaOriginateFrom :: ImplicitAddressOrAlias , oaMbFee :: Maybe Mutez } @@ -61,8 +63,8 @@ } data TransferArgs = TransferArgs - { taSender :: AddressOrAlias - , taDestination :: AddressOrAlias + { taSender :: ImplicitAddressOrAlias + , taDestination :: SomeAddressOrAlias , taAmount :: Mutez , taParameter :: U.Value , taMbFee :: Maybe Mutez @@ -153,10 +155,15 @@ "Perform a transfer to the given contract with given amount and parameter" getBalanceCmd = mkCommandParser "get-balance" - (GetBalance <$> addressOrAliasOption - Nothing - (#name :! "addr") - (#help :! "Address or alias to get balance for.") + ((GetBalance <$> + addressOrAliasOption @'AddressKindContract + Nothing + (#name :! "contract-addr") + (#help :! "Contract address or alias to get balance for.")) + <|> (GetBalance <$> addressOrAliasOption @'AddressKindImplicit + Nothing + (#name :! "implicit-addr") + (#help :! "Implicit address or alias to get balance for.")) ) "Get balance for given address" getBlockHeaderCmd = @@ -219,8 +226,8 @@ , help "Path to script file" ] -contractNameOption :: Opt.Parser Alias -contractNameOption = fmap Alias . strOption $ mconcat +contractNameOption :: Opt.Parser ContractAlias +contractNameOption = fmap ContractAlias . strOption $ mconcat [ long "contract-name" , value "stdin" , help "Alias of originated contract" @@ -234,10 +241,14 @@ (#name :! "from") (#help :! "Address or alias from which transfer is performed") taDestination <- - addressOrAliasOption + SomeAddressOrAlias <$> addressOrAliasOption @'AddressKindImplicit Nothing - (#name :! "to") - (#help :! "Address or alias of the contract that receives transfer") + (#name :! "to-implicit") + (#help :! "Address or alias of the transfer's destination implicit address") + <|> SomeAddressOrAlias <$> addressOrAliasOption @'AddressKindContract + Nothing + (#name :! "to-contract") + (#help :! "Address or alias of the transfer's destination contract") taAmount <- mutezOption (Just zeroMutez) 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 @@ -19,7 +19,8 @@ import Morley.Client.RPC.QueryFixedParam import Morley.Client.RPC.Types import Morley.Micheline (Expression, TezosInt64, TezosMutez) -import Morley.Tezos.Address (Address, formatAddress) +import Morley.Tezos.Address +import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto (KeyHash, PublicKey) import Morley.Util.ByteString @@ -30,13 +31,13 @@ -- GET Capture "block_id" BlockId :> "hash" :> Get '[JSON] Text :<|> - Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address' + Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ImplicitAddress' :> "counter" :> Get '[JSON] TezosInt64 :<|> - Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address' + Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' :> "script" :> Get '[JSON] OriginationScript :<|> - Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address' + Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' :> "storage" :> Get '[JSON] Expression :<|> Capture "block_id" BlockId :> Get '[JSON] BlockConstants :<|> @@ -55,7 +56,7 @@ -- seeks for key in it; if there are multiple big_maps with the same key type, -- only one of them is considered (which one - it seems better not to rely on -- this info). - Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address' + Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' :> "big_map_get" :> ReqBody '[JSON] GetBigMap :> Post '[JSON] GetBigMapResult :<|> -- This endpoint supersedes the endpoint above. @@ -79,10 +80,10 @@ :> Capture "contract" Address' :> "balance" :> Get '[JSON] TezosMutez :<|> Capture "block_id" BlockId :> "context" :> "contracts" - :> Capture "contract" Address' :> "delegate" :> Get '[JSON] KeyHash :<|> + :> Capture "contract" ContractAddress' :> "delegate" :> Get '[JSON] KeyHash :<|> - Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "address" Address' :> "manager_key" - :> Get '[JSON] (Maybe PublicKey) :<|> + Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "address" ImplicitAddress' + :> "manager_key" :> Get '[JSON] (Maybe PublicKey) :<|> -- POST @@ -127,25 +128,25 @@ data NodeMethods m = NodeMethods { getBlockHash :: BlockId -> m Text - , getCounter :: BlockId -> Address -> m TezosInt64 - , getScript :: BlockId -> Address -> m OriginationScript - , getStorageAtBlock :: BlockId -> Address -> m Expression + , getCounter :: BlockId -> ImplicitAddress -> m TezosInt64 + , getScript :: BlockId -> ContractAddress -> m OriginationScript + , getStorageAtBlock :: BlockId -> ContractAddress -> m Expression , getBlockConstants :: BlockId -> m BlockConstants , getBlockHeader :: BlockId -> m BlockHeader , getProtocolParameters :: BlockId -> m ProtocolParameters , getBlockOperations :: BlockId -> m [[BlockOperation]] , getBlockOperationHashes :: BlockId -> m [[OperationHash]] - , getBigMap :: BlockId -> Address -> GetBigMap -> m GetBigMapResult + , getBigMap :: BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult , getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression , getBigMapValuesAtBlock :: BlockId -> Natural -> Maybe Natural -> Maybe Natural -> m Expression , getBalance :: BlockId -> Address -> m TezosMutez - , getDelegate :: BlockId -> Address -> m (Maybe KeyHash) + , getDelegate :: BlockId -> ContractAddress -> m (Maybe KeyHash) , getScriptSizeAtBlock :: BlockId -> CalcSize -> m ScriptSize , forgeOperation :: BlockId -> ForgeOperation -> m HexJSONByteString , runOperation :: BlockId -> RunOperation -> m RunOperationResult , preApplyOperations :: BlockId -> [PreApplyOperation] -> m [RunOperationResult] , runCode :: BlockId -> RunCode -> m RunCodeResult - , getManagerKey :: BlockId -> Address -> m (Maybe PublicKey) + , getManagerKey :: BlockId -> ImplicitAddress -> m (Maybe PublicKey) , getChainId :: m Text , injectOperation :: HexJSONByteString -> m OperationHash } @@ -156,24 +157,25 @@ nodeMethods :: forall m. (MonadCatch m, RunClient m) => NodeMethods m nodeMethods = NodeMethods - { getCounter = withAddress' getCounter' - , getScript = withAddress' getScript' - , getStorageAtBlock = withAddress' getStorageAtBlock' - , getBigMap = withAddress' getBigMap' + { getCounter = withKindedAddress' getCounter' + , getScript = withKindedAddress' getScript' + , getStorageAtBlock = withKindedAddress' getStorageAtBlock' + , getBigMap = withKindedAddress' getBigMap' , getBalance = withAddress' getBalance' , getDelegate = \block addr -> do - result <- try $ getDelegate' block (Address' addr) + result <- try $ getDelegate' block (KindedAddress' addr) case result of Left (FailureResponse _ Response{responseStatusCode=Status{statusCode = 404}}) -> pure Nothing Left err -> throwM err Right res -> pure $ Just res - , getManagerKey = withAddress' getManagerKey' + , getManagerKey = withKindedAddress' getManagerKey' , .. } where + withKindedAddress' f blockId = f blockId . KindedAddress' withAddress' f blockId = f blockId . Address' - getDelegate' :: BlockId -> Address' -> m KeyHash + getDelegate' :: BlockId -> ContractAddress' -> m KeyHash (getBlockHash :<|> getCounter' :<|> getScript' @@ -203,8 +205,15 @@ ---------------------------------------------------------------------------- -- | We use this wrapper to avoid orphan instances. -newtype Address' = Address' - { unAddress' :: Address } +newtype KindedAddress' kind = KindedAddress' { unAddress' :: KindedAddress kind } -instance ToHttpApiData Address' where +type ContractAddress' = KindedAddress' 'AddressKindContract +type ImplicitAddress' = KindedAddress' 'AddressKindImplicit + +instance ToHttpApiData (KindedAddress' kind) where toUrlPiece = formatAddress . unAddress' + +newtype Address' = Address' Address + +instance ToHttpApiData Address' where + toUrlPiece (Address' (MkAddress addr)) = formatAddress addr 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 @@ -22,7 +22,7 @@ getBlockHash :: BlockId -> m BlockHash -- ^ Get hash of the given 'BlockId', mostly used to get hash of -- 'HeadId' - getCounterAtBlock :: BlockId -> Address -> m TezosInt64 + getCounterAtBlock :: BlockId -> ImplicitAddress -> m TezosInt64 -- ^ Get address counter, which is required for both transaction sending -- and contract origination. getBlockHeader :: BlockId -> m BlockHeader @@ -51,17 +51,17 @@ injectOperation :: HexJSONByteString -> m OperationHash -- ^ Inject operation, note that this operation has to be signed before -- injection. As a result it returns operation hash. - getContractScriptAtBlock :: BlockId -> Address -> m OriginationScript + getContractScriptAtBlock :: BlockId -> ContractAddress -> m OriginationScript -- ^ Get code and storage of the desired contract. Note that both code and storage -- are presented in low-level Micheline representation. -- If the storage contains a @big_map@, then the expression will contain the @big_map@'s ID, -- not its contents. - getContractStorageAtBlock :: BlockId -> Address -> m Expression + getContractStorageAtBlock :: BlockId -> ContractAddress -> m Expression -- ^ Get storage of the desired contract at some block. Note that storage -- is presented in low-level Micheline representation. -- If the storage contains a @big_map@, then the expression will contain the @big_map@'s ID, -- not its contents. - getContractBigMapAtBlock :: BlockId -> Address -> GetBigMap -> m GetBigMapResult + getContractBigMapAtBlock :: BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult -- ^ Get big map value by contract address. getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression -- ^ Get big map value at some block by the big map's ID and the hashed entry key. @@ -69,14 +69,14 @@ -- ^ Get all big map values at some block by the big map's ID and the optional offset and length. getBalanceAtBlock :: BlockId -> Address -> m Mutez -- ^ Get balance for given address. - getDelegateAtBlock :: BlockId -> Address -> m (Maybe KeyHash) + getDelegateAtBlock :: BlockId -> ContractAddress -> m (Maybe KeyHash) -- ^ Get delegate for given address. runCodeAtBlock :: BlockId -> RunCode -> m RunCodeResult -- ^ Emulate contract call. This RPC endpoint does the same as -- @tezos-client run script@ command does. getChainId :: m ChainId -- ^ Get current @ChainId@ - getManagerKeyAtBlock :: BlockId -> Address -> m (Maybe PublicKey) + getManagerKeyAtBlock :: BlockId -> ImplicitAddress -> m (Maybe PublicKey) -- ^ Get manager key for given address. -- Returns @Nothing@ if this key wasn't revealed. waitForOperation :: m OperationHash -> m OperationHash diff --git a/src/Morley/Client/RPC/Error.hs b/src/Morley/Client/RPC/Error.hs --- a/src/Morley/Client/RPC/Error.hs +++ b/src/Morley/Client/RPC/Error.hs @@ -26,27 +26,27 @@ data ClientRpcError -- | Smart contract execution has failed. = ContractFailed - Address -- ^ Smart contract address. + ContractAddress -- ^ Smart contract address. Expression -- ^ Value the contract has failed with. | BadParameter -- ^ Parameter passed to a contract does not match its type. - Address -- ^ Smart contract address. + Address -- ^ Smart or implicit contract address. Expression -- ^ Value passed as parameter. | EmptyTransaction -- ^ Transfer of 0 to an implicit account. - Address -- ^ Receiver address. + ImplicitAddress -- ^ Receiver address. | ShiftOverflow -- ^ A smart contract execution failed due to a shift overflow. - Address + ContractAddress -- ^ Smart contract address. | GasExhaustion -- ^ A smart contract execution failed due gas exhaustion. - Address + ContractAddress -- ^ Smart contract address. | KeyAlreadyRevealed -- ^ A key has already been revealed. - Address + ImplicitAddress -- ^ The address corresponding to the key. | ClientInternalError -- ^ An error that RPC considers internal occurred. These errors @@ -120,7 +120,7 @@ = RpcUnexpectedSize Int Int | RpcOriginatedNoContracts | RpcNoOperationsRun - | RpcOriginatedMoreContracts [Address] + | RpcOriginatedMoreContracts [ContractAddress] deriving stock Show instance Buildable IncorrectRpcResponse where 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 @@ -54,7 +54,7 @@ import Morley.Client.RPC.Class import Morley.Client.RPC.Types -data ContractGetCounterAttempt = ContractGetCounterAttempt Address +data ContractGetCounterAttempt = ContractGetCounterAttempt ContractAddress deriving stock (Show) instance Exception ContractGetCounterAttempt instance Buildable ContractGetCounterAttempt where @@ -85,7 +85,7 @@ readContractBigMapValue :: forall k v m. (PackedValScope k, HasTezosRpc m, SingI v) - => Address -> Value k -> m (Value v) + => ContractAddress -> Value k -> m (Value v) readContractBigMapValue contract key = do let req = GetBigMap @@ -153,7 +153,7 @@ Right v -> pure v Left _ -> throwM $ ValueDecodeFailure "big map value " (demote @(ToT v)) -data ContractNotFound = ContractNotFound Address +data ContractNotFound = ContractNotFound ContractAddress deriving stock Show instance Buildable ContractNotFound where @@ -164,19 +164,14 @@ displayException = pretty -- | Get originated t'U.Contract' for some address. -getContract :: (HasTezosRpc m) => Address -> m U.Contract +getContract :: (HasTezosRpc m) => ContractAddress -> m U.Contract getContract addr = handleStatusCode 404 (throwM $ ContractNotFound addr) $ throwLeft $ fromExpression . osCode <$> getContractScript addr --- | Get counter value for given address. --- --- Throws an error if given address is a contract address. -getImplicitContractCounter :: (HasTezosRpc m) => Address -> m TezosInt64 -getImplicitContractCounter addr = case addr of - KeyAddress _ -> getCounter addr - ContractAddress _ -> throwM $ ContractGetCounterAttempt addr - TransactionRollupAddress _ -> throwM $ ContractGetCounterAttempt addr +-- | Get counter value for given implicit address. +getImplicitContractCounter :: (HasTezosRpc m) => ImplicitAddress -> m TezosInt64 +getImplicitContractCounter addr = getCounter addr handleStatusCode :: MonadCatch m => Int -> m a -> m a -> m a handleStatusCode code onError action = action `catch` @@ -187,25 +182,22 @@ -- | Extract parameter types for all smart contracts' addresses and return mapping -- from their hashes to their parameter types getContractsParameterTypes - :: HasTezosRpc m => [Address] -> m TcOriginatedContracts + :: HasTezosRpc m => [ContractAddress] -> m TcOriginatedContracts getContractsParameterTypes addrs = Map.fromList <$> concatMapM (fmap maybeToList . extractParameterType) addrs where extractParameterType - :: HasTezosRpc m => Address + :: HasTezosRpc m => ContractAddress -> m (Maybe (ContractHash, SomeParamType)) - extractParameterType addr = case addr of - KeyAddress _ -> return Nothing - TransactionRollupAddress _ -> return Nothing - ContractAddress ch -> - handleStatusCode 404 (return Nothing) $ do - params <- fmap (U.contractParameter) . throwLeft $ - fromExpression @U.Contract . osCode <$> getContractScript addr - (paramNotes :: SomeParamType) <- throwLeft $ pure $ mkSomeParamType params - pure $ Just (ch, paramNotes) + extractParameterType addr@(ContractAddress ch) = + handleStatusCode 404 (return Nothing) $ do + params <- fmap (U.contractParameter) . throwLeft $ + fromExpression @U.Contract . osCode <$> getContractScript addr + (paramNotes :: SomeParamType) <- throwLeft $ pure $ mkSomeParamType params + pure $ Just (ch, paramNotes) -- | 'getContractStorageAtBlock' applied to the head block. -getContractStorage :: HasTezosRpc m => Address -> m Expression +getContractStorage :: HasTezosRpc m => ContractAddress -> m Expression getContractStorage = getContractStorageAtBlock HeadId -- | 'getBigMapValueAtBlock' applied to the head block. @@ -222,7 +214,7 @@ getHeadBlock = getBlockHash HeadId -- | 'getCounterAtBlock' applied to the head block. -getCounter :: HasTezosRpc m => Address -> m TezosInt64 +getCounter :: HasTezosRpc m => ImplicitAddress -> m TezosInt64 getCounter = getCounterAtBlock HeadId -- | 'getProtocolParametersAtBlock' applied to the head block. @@ -242,28 +234,31 @@ forgeOperation = forgeOperationAtBlock HeadId -- | 'getContractScriptAtBlock' applied to the head block. -getContractScript :: HasTezosRpc m => Address -> m OriginationScript +getContractScript :: HasTezosRpc m => ContractAddress -> m OriginationScript getContractScript = getContractScriptAtBlock HeadId -- | 'getContractBigMapAtBlock' applied to the head block. -getContractBigMap :: HasTezosRpc m => Address -> GetBigMap -> m GetBigMapResult +getContractBigMap :: HasTezosRpc m => ContractAddress -> GetBigMap -> m GetBigMapResult getContractBigMap = getContractBigMapAtBlock HeadId -- | 'getBalanceAtBlock' applied to the head block. -getBalance :: HasTezosRpc m => Address -> m Mutez -getBalance = getBalanceAtBlock HeadId +getBalance + :: forall kind m. (HasTezosRpc m, L1AddressKind kind) + => KindedAddress kind + -> m Mutez +getBalance = usingImplicitOrContractKind @kind $ getBalanceAtBlock HeadId . MkAddress -- | 'getScriptSizeAtBlock' applied to the head block. getScriptSize :: HasTezosRpc m => CalcSize -> m ScriptSize getScriptSize = getScriptSizeAtBlock HeadId -- | 'getDelegateAtBlock' applied to the head block. -getDelegate :: HasTezosRpc m => Address -> m (Maybe KeyHash) +getDelegate :: HasTezosRpc m => ContractAddress -> m (Maybe KeyHash) getDelegate = getDelegateAtBlock HeadId -- | 'runCodeAtBlock' applied to the head block. runCode :: HasTezosRpc m => RunCode -> m RunCodeResult runCode = runCodeAtBlock HeadId -getManagerKey :: HasTezosRpc m => Address -> m (Maybe PublicKey) +getManagerKey :: HasTezosRpc m => ImplicitAddress -> m (Maybe PublicKey) getManagerKey = getManagerKeyAtBlock 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 @@ -29,6 +29,8 @@ , ScriptSize(..) , GetBigMapResult (..) , InternalOperation (..) + , InternalOperationData (..) + , IntOpEvent (..) , OperationContent (..) , OperationHash (..) , OperationInput @@ -100,7 +102,8 @@ import Morley.Micheline (Expression, MichelinePrimAp(..), MichelinePrimitive(..), StringEncode(..), TezosInt64, TezosMutez(..), TezosNat, expressionPrim) -import Morley.Tezos.Address (Address) +import Morley.Michelson.Text (MText) +import Morley.Tezos.Address import Morley.Tezos.Core (Mutez, tz, zeroMutez) import Morley.Tezos.Crypto (PublicKey, Signature, decodeBase58CheckWithPrefix, formatSignature) import Morley.Util.CLI (HasCLReader(..), eitherReader) @@ -158,7 +161,7 @@ deriving stock (Eq, Show) deriving newtype (FromJSON, Buildable) -data OperationContent = OperationContent RunMetadata +newtype OperationContent = OperationContent { unOperationContent :: RunMetadata } instance FromJSON OperationContent where parseJSON = withObject "operationCostContent" $ \o -> @@ -174,13 +177,37 @@ RunMetadata <$> o .: "operation_result" <*> o .:? "internal_operation_results" .!= [] -newtype InternalOperation = InternalOperation - { unInternalOperation :: OperationResult } +data InternalOperation = InternalOperation + { ioData :: InternalOperationData + , ioResult :: OperationResult + } instance FromJSON InternalOperation where - parseJSON = withObject "internal_operation" $ \o -> - InternalOperation <$> o .: "result" + parseJSON json = json & withObject "internal_operation" \o -> + InternalOperation <$> parseJSON json <*> o .: "result" +data InternalOperationData + = IODEvent IntOpEvent + | IODIgnored + +instance FromJSON InternalOperationData where + parseJSON json = json & withObject "internal_operation_data" \o -> do + (kind :: Text) <- o .: "kind" + case kind of + "event" -> IODEvent <$> parseJSON json + _ -> pure IODIgnored + +data IntOpEvent = IntOpEvent + { ioeSource :: ContractAddress + , ioeType :: Expression + , ioeTag :: Maybe MText + , ioePayload :: Maybe Expression + } + +instance FromJSON IntOpEvent where + parseJSON = withObject "internal_operation_data_event" \o -> do + IntOpEvent <$> o .: "source" <*> o .: "type" <*> o .:? "tag" <*> o .:? "payload" + data BlockConstants = BlockConstants { bcProtocol :: Text , bcChainId :: Text @@ -307,7 +334,7 @@ -- that can happen when a contract is executed and something goes -- wrong. data RunError - = RuntimeError Address + = RuntimeError ContractAddress | ScriptRejected Expression | BadContractParameter Address | InvalidConstant Expression Expression @@ -322,7 +349,7 @@ | UnexpectedOperation | REEmptyTransaction -- ^ Transfer of 0 to an implicit account. - Address -- ^ Receiver address. + ImplicitAddress -- ^ Receiver address. | ScriptOverflow -- ^ A contract failed due to the detection of an overflow. -- It seems to happen if a too big value is passed to shift instructions @@ -333,7 +360,7 @@ | MutezMultiplicationOverflow TezosInt64 TezosInt64 | CantPayStorageFee | BalanceTooLow ("balance" :! Mutez) ("required" :! Mutez) - | PreviouslyRevealedKey Address + | PreviouslyRevealedKey ImplicitAddress | NonExistingContract Address | InvalidB58Check Text deriving stock Show @@ -461,13 +488,13 @@ data InternalError = CounterInThePast -- ^ An operation assumed a contract counter in the past. - Address -- ^ Address whose counter is invalid. + ImplicitAddress -- ^ Address whose counter is invalid. ("expected" :! Word) -- ^ Expected counter. ("found" :! Word) -- ^ Found counter. | UnrevealedKey -- ^ One tried to apply a manager operation without revealing -- the manager public key. - Address -- ^ Manager address. + ImplicitAddress -- ^ Manager address. | Failure Text -- ^ Failure reported without specific id deriving stock Show @@ -510,10 +537,10 @@ | OperationFailed [RunError] data AppliedResult = AppliedResult - { arConsumedGas :: TezosInt64 + { arConsumedMilliGas :: TezosInt64 , arStorageSize :: TezosInt64 , arPaidStorageDiff :: TezosInt64 - , arOriginatedContracts :: [Address] + , arOriginatedContracts :: [ContractAddress] , arAllocatedDestinationContracts :: TezosInt64 -- ^ We need to count number of destination contracts that are new -- to the chain in order to calculate proper storage_limit @@ -522,7 +549,7 @@ instance Semigroup AppliedResult where (<>) ar1 ar2 = AppliedResult - { arConsumedGas = arConsumedGas ar1 + arConsumedGas ar2 + { arConsumedMilliGas = arConsumedMilliGas ar1 + arConsumedMilliGas ar2 , arStorageSize = arStorageSize ar1 + arStorageSize ar2 , arPaidStorageDiff = arPaidStorageDiff ar1 + arPaidStorageDiff ar2 , arOriginatedContracts = arOriginatedContracts ar1 <> arOriginatedContracts ar2 @@ -538,7 +565,7 @@ status <- o .: "status" case status of "applied" -> OperationApplied <$> do - arConsumedGas <- o .: "consumed_gas" + arConsumedMilliGas <- o .: "consumed_milligas" arStorageSize <- o .:? "storage_size" .!= 0 arPaidStorageDiff <- o .:? "paid_storage_size_diff" .!= 0 arOriginatedContracts <- o .:? "originated_contracts" .!= [] @@ -574,7 +601,7 @@ -- | Data that is common for transaction and origination -- operations. data CommonOperationData = CommonOperationData - { codSource :: Address + { codSource :: ImplicitAddress , codFee :: TezosMutez , codCounter :: TezosInt64 , codGasLimit :: TezosInt64 @@ -587,7 +614,7 @@ -- Fee isn't accounted during operation simulation, so it's safe to use zero amount. -- Real operation fee is calculated later using 'tezos-client'. mkCommonOperationData - :: Address -> TezosInt64 -> ProtocolParameters + :: ImplicitAddress -> TezosInt64 -> ProtocolParameters -> CommonOperationData mkCommonOperationData source counter ProtocolParameters{..} = CommonOperationData { codSource = source @@ -706,8 +733,8 @@ , rcChainId :: Text , rcNow :: Maybe TezosNat , rcLevel :: Maybe TezosNat - , rcSource :: Maybe Address - , rcPayer :: Maybe Address + , rcSource :: Maybe ImplicitAddress + , rcPayer :: Maybe ImplicitAddress } -- | Result storage of @run_code@ RPC endpoint call. 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 @@ -10,60 +10,40 @@ import Data.ByteArray (ScrubbedBytes) -import Morley.Client.TezosClient.Types -import Morley.Micheline -import Morley.Michelson.Typed.Scope import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias, Alias) +import Morley.Tezos.Address.Alias import Morley.Tezos.Crypto -- | Type class that provides interaction with @tezos-client@ binary class (Monad m) => HasTezosClient m where - signBytes :: AddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature + signBytes :: ImplicitAddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature -- ^ Sign an operation with @tezos-client@. - genKey :: Alias -> m Address + genKey :: ImplicitAlias -> m ImplicitAddress -- ^ Generate a secret key and store it with given alias. -- If a key with this alias already exists, the corresponding address -- will be returned and no state will be changed. - genFreshKey :: Alias -> m Address + genFreshKey :: ImplicitAlias -> m ImplicitAddress -- ^ Generate a secret key and store it with given alias. -- Unlike 'genKey' this function overwrites -- the existing key when given alias is already stored. - revealKey :: Alias -> Maybe ScrubbedBytes -> m () + revealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> m () -- ^ Reveal public key associated with given implicit account. - rememberContract :: Bool -> Address -> Alias -> m () + rememberContract :: Bool -> ContractAddress -> ContractAlias -> m () -- ^ Associate the given contract with alias. -- The 'Bool' variable indicates whether or not we should replace already -- existing contract alias or not. - importKey :: Bool -> Alias -> SecretKey -> m Alias - -- ^ Saves 'SecretKey' via @tezos-client@ with given alias or hint associated. - -- The 'Bool' variable indicates whether or not we should replace already - -- existing alias key or not. - -- The returned 'Alias' is the alias under which the key will be accessible. - resolveAddressMaybe :: AddressOrAlias -> m (Maybe Address) + resolveAddressMaybe :: AddressOrAlias kind -> m (Maybe (KindedAddress kind)) -- ^ Retrieve an address from given address or alias. If address or alias does not exist -- returns `Nothing` - getAlias :: AddressOrAlias -> m Alias + getAlias :: L1AddressKind kind => AddressOrAlias kind -> m (Alias kind) -- ^ Retrieve an alias from given address using @tezos-client@. The -- primary (and probably only) reason this function exists is that -- @tezos-client sign@ command only works with aliases. It was -- reported upstream: . - getPublicKey :: AddressOrAlias -> m PublicKey - -- ^ Get public key for given address. Public keys are often used when interacting - -- with the multising contracts - getSecretKey :: AddressOrAlias -> m SecretKey - -- ^ Get secret key for given address. - registerDelegate :: Alias -> Maybe ScrubbedBytes -> m () + registerDelegate :: ImplicitAlias -> Maybe ScrubbedBytes -> m () -- ^ Register a given address as delegate - getTezosClientConfig :: m TezosClientConfig - -- ^ Retrieve the current @tezos-client@ config. - calcTransferFee - :: AddressOrAlias -> Maybe ScrubbedBytes -> TezosInt64 -> [CalcTransferFeeData] -> m [TezosMutez] - -- ^ Calculate fee for transfer using `--dry-run` flag. - calcOriginationFee - :: UntypedValScope st => CalcOriginationFeeData cp st -> m TezosMutez - -- ^ Calculate fee for origination using `--dry-run` flag. - getKeyPassword :: Address -> m (Maybe ScrubbedBytes) + -- TODO [#869] move to HasTezosRpc + getKeyPassword :: ImplicitAddress -> m (Maybe ScrubbedBytes) -- ^ Get password for secret key associated with given address -- in case this key is password-protected. Obtained password is used -- in two places: 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 @@ -54,7 +54,8 @@ import Morley.Micheline import Morley.Michelson.Typed.Scope import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias(..)) +import Morley.Tezos.Address.Alias +import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto import Morley.Util.Peano import Morley.Util.SizedList.Types @@ -76,13 +77,13 @@ -- These errors represent specific known scenarios. | UnknownAddressAlias -- ^ Could not find an address with given name. - Alias -- ^ Name of address which is eventually used + Text -- ^ Name of address which is eventually used | UnknownAddress -- ^ Could not find an address. Address -- ^ Address that is not present in local tezos cache | AlreadyRevealed -- ^ Public key of the given address is already revealed. - Alias -- ^ Address alias that has already revealed its key + ImplicitAlias -- ^ Address alias that has already revealed its key | InvalidOperationHash -- ^ Can't wait for inclusion of operation with given hash because -- the hash is invalid. @@ -110,12 +111,12 @@ -- ^ @tezos-client@ printed a string that doesn't match the format we expect. | CantRevealContract -- ^ Given alias is a contract and cannot be revealed. - Alias -- ^ Address alias of implicit account - | ContractSender Address Text + ImplicitAlias -- ^ Address alias of implicit account + | ContractSender ContractAddress Text -- ^ Given contract is a source of a transfer or origination operation. | EmptyImplicitContract -- ^ Given alias is an empty implicit contract. - Alias -- ^ Address alias of implicit contract + ImplicitAlias -- ^ Address alias of implicit contract | TezosClientUnexpectedSignatureOutput Text -- ^ @tezos-client sign bytes@ produced unexpected output format | TezosClientParseEncryptionTypeError Text Text @@ -184,7 +185,7 @@ -- Secret key of the address corresponding to give 'AddressOrAlias' must be known. signBytes :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) - => AddressOrAlias + => ImplicitAddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature @@ -211,8 +212,8 @@ genKey :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m , Class.HasTezosClient m) - => Alias - -> m Address + => ImplicitAlias + -> m ImplicitAddress genKey name = do let isAlreadyExistsError :: Text -> Bool @@ -232,8 +233,8 @@ genFreshKey :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m , Class.HasTezosClient m) - => Alias - -> m Address + => ImplicitAlias + -> m ImplicitAddress genFreshKey name = do let isNoAliasError :: Text -> Bool @@ -252,7 +253,7 @@ -- Fails if it's already revealed. revealKey :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) - => Alias + => ImplicitAlias -> Maybe ScrubbedBytes -> m () revealKey alias mbPassword = do @@ -269,14 +270,14 @@ _ <- callTezosClient errHandler - ["reveal", "key", "for", toCmdArg alias] ClientMode mbPassword + ["reveal", "key", "for", "key:" <> toCmdArg alias] ClientMode mbPassword logDebug $ "Successfully revealed key for " +| alias |+ "" -- | Register alias as delegate registerDelegate :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) - => Alias + => ImplicitAlias -> Maybe ScrubbedBytes -> m () registerDelegate alias mbPassword = do @@ -293,43 +294,73 @@ logDebug $ "Successfully registered " +| alias |+ " as delegate" --- | Return 'Address' corresponding to given 'AddressOrAlias', covered in @Maybe@. +-- | Return 'KindedAddress' corresponding to given 'AddressOrAlias', covered in @Maybe@. -- Return @Nothing@ if address alias is unknown resolveAddressMaybe - :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) - => AddressOrAlias - -> m (Maybe Address) + :: forall env m kind. (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) + => AddressOrAlias kind + -> m (Maybe (KindedAddress kind)) resolveAddressMaybe addressOrAlias = case addressOrAlias of - AddressResolved addr -> (pure . Just) addr - AddressAlias originatorName -> do - logDebug $ "Resolving " +| originatorName |+ "" - output <- callTezosClientStrict ["list", "known", "contracts"] MockupMode Nothing - let parse = T.stripPrefix (unAlias originatorName <> ": ") - liftIO case safeHead . mapMaybe parse . lines $ output of + AddressResolved addr -> pure . Just $ addr + AddressAlias alias -> do + logDebug $ "Resolving " +| alias |+ "" + let + parse alias' = T.stripPrefix (alias' <> ":") + findSatisfyingAddresses alias' output = mapMaybe (parse alias') . lines $ output + aliasText = unAlias alias + + output <- case alias of + ImplicitAlias{} -> callListKnown "addresses" + ContractAlias{} -> callListKnown "contracts" + + let + maybeAddress = safeHead $ findSatisfyingAddresses aliasText output + + liftIO case maybeAddress of Nothing -> pure Nothing - Just addrText -> - either (throwM . TezosClientParseAddressError addrText) (pure . Just) $ - parseAddress addrText + Just addrPlainText -> Just <$> do + let addrText = fromMaybe addrPlainText $ safeHead $ words addrPlainText + either (throwM . TezosClientParseAddressError addrText) pure $ case alias of + ContractAlias{} -> parseKindedAddress @'AddressKindContract addrText + ImplicitAlias{} -> parseKindedAddress @'AddressKindImplicit addrText -- | Return 'Alias' corresponding to given 'AddressOrAlias'. getAlias - :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) - => AddressOrAlias - -> m Alias -getAlias = \case + :: forall kind env m + . ( WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m + , L1AddressKind kind) + => AddressOrAlias kind + -> m (Alias kind) +getAlias = usingImplicitOrContractKind @kind $ \case AddressAlias alias -> pure alias - AddressResolved senderAddress -> do - logDebug $ "Getting an alias for " <> pretty senderAddress - output <- callTezosClientStrict ["list", "known", "contracts"] MockupMode Nothing - let parse = T.stripSuffix (": " <> pretty senderAddress) - liftIO case safeHead . mapMaybe parse . lines $ output of - Nothing -> throwM $ UnknownAddress senderAddress - Just alias -> pure (Alias alias) + AddressResolved address -> do + logDebug $ "Getting an alias for " <> pretty address + output <- case address of + ImplicitAddress{} -> callListKnown "addresses" + ContractAddress{} -> callListKnown "contracts" + let + parse address' line = case T.splitOn (": " <> pretty address') line of + [_noMatch] -> Nothing + (alias : _) -> Just alias + _ -> Nothing + liftIO case safeHead . mapMaybe (parse address). lines $ output of + Nothing -> throwM $ UnknownAddress $ MkAddress address + Just alias -> case address of + ImplicitAddress{} -> pure $ ImplicitAlias alias + ContractAddress{} -> pure $ ContractAlias alias + +-- | Call tezos-client to list known addresses or contracts +callListKnown + :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) + => String -> m Text +callListKnown objects = + callTezosClientStrict ["list", "known", objects] MockupMode Nothing + -- | Return 'PublicKey' corresponding to given 'AddressOrAlias'. getPublicKey :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) - => AddressOrAlias + => ImplicitAddressOrAlias -> m PublicKey getPublicKey addrOrAlias = do alias <- getAlias addrOrAlias @@ -347,7 +378,7 @@ -- | Return 'SecretKey' corresponding to given 'AddressOrAlias'. getSecretKey :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) - => AddressOrAlias + => ImplicitAddressOrAlias -> m SecretKey getSecretKey addrOrAlias = do alias <- getAlias addrOrAlias @@ -368,8 +399,8 @@ rememberContract :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) => Bool - -> Address - -> Alias + -> ContractAddress + -> ContractAlias -> m () rememberContract replaceExisting contractAddress name = do let @@ -385,9 +416,9 @@ importKey :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m) => Bool - -> Alias + -> ImplicitAlias -> SecretKey - -> m Alias + -> m ImplicitAlias importKey replaceExisting name key = do let isAlreadyExistsError = T.isInfixOf "already exists" @@ -416,7 +447,11 @@ :: ( WithClientLog env m, HasTezosClientEnv env , MonadIO m, MonadCatch m ) - => AddressOrAlias -> Maybe ScrubbedBytes -> TezosInt64 -> [CalcTransferFeeData] -> m [TezosMutez] + => AddressOrAlias kind + -> Maybe ScrubbedBytes + -> TezosInt64 + -> [CalcTransferFeeData] + -> m [TezosMutez] calcTransferFee from mbPassword burnCap transferFeeDatas = do output <- callTezosClientStrict [ "multiple", "transfers", "from", pretty from, "using" @@ -452,7 +487,7 @@ :: ( WithClientLog env m, HasTezosClientEnv env , MonadIO m, MonadCatch m ) - => Alias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez + => ImplicitAlias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez calcRevealFee alias mbPassword burnCap = do output <- callTezosClientStrict [ "reveal", "key", "for", toCmdArg alias @@ -479,14 +514,12 @@ -- in case this key is password-protected getKeyPassword :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadMask m) - => Address -> m (Maybe ScrubbedBytes) -getKeyPassword = \case - ContractAddress _ -> pure Nothing - keyAddr -> (getAlias $ AddressResolved keyAddr) >>= getKeyPassword' + => ImplicitAddress -> m (Maybe ScrubbedBytes) +getKeyPassword key = (getAlias $ AddressResolved key) >>= getKeyPassword' where getKeyPassword' :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, MonadMask m) - => Alias -> m (Maybe ScrubbedBytes) + => ImplicitAlias -> m (Maybe ScrubbedBytes) getKeyPassword' alias = do output <- callTezosClientStrict [ "show", "address", pretty alias, "-S"] MockupMode Nothing encryptionType <- @@ -499,7 +532,7 @@ Just <$> withoutEcho readScrubbedBytes _ -> pure Nothing - -- | Hide entered password + -- Hide entered password withoutEcho :: (MonadIO m, MonadMask m) => m a -> m a withoutEcho action = do old <- hGetEcho stdin @@ -585,7 +618,7 @@ | "Unix.ECONNRESET" `T.isInfixOf` errOutput = throwM EConnreset checkEConnreset _ = pass - -- | Helper function that retries @tezos-client@ call action in case of @ECONNRESET@. + -- Helper function that retries @tezos-client@ call action in case of @ECONNRESET@. -- Note that this error cannot appear in case of 'MockupMode' call. retryEConnreset :: CallMode -> m a -> m a retryEConnreset MockupMode action = action @@ -629,15 +662,15 @@ "ERROR!! There was an error in executing `" <> toText fp <> "` program. Is the \ \ executable available in PATH ?" --- | Return 'Address' corresponding to given 'AddressOrAlias'. +-- | Return 'KindedAddress' corresponding to given 'AddressOrAlias'. resolveAddress :: (MonadThrow m, Class.HasTezosClient m) - => AddressOrAlias - -> m Address + => AddressOrAlias kind + -> m (KindedAddress kind) resolveAddress addr = case addr of AddressResolved addrResolved -> pure addrResolved alias@(AddressAlias originatorName) -> Class.resolveAddressMaybe alias >>= (\case - Nothing -> throwM $ UnknownAddressAlias originatorName + Nothing -> throwM $ UnknownAddressAlias (unAlias originatorName) Just existingAddress -> return existingAddress ) 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,7 @@ module Morley.Client.TezosClient.Types ( CmdArg (..) - , addressResolved + -- , addressResolved , CalcOriginationFeeData (..) , CalcTransferFeeData (..) , TezosClientConfig (..) @@ -27,14 +27,14 @@ import Servant.Client (BaseUrl(..), showBaseUrl) import Text.Hex (encodeHex) -import Lorentz (ToAddress, toAddress) +-- import Lorentz (ToAddress, toAddress) import Morley.Client.RPC.Types (OperationHash) import Morley.Client.Util import Morley.Micheline import Morley.Michelson.Printer import Morley.Michelson.Typed (Contract, EpName, Value) import Morley.Michelson.Typed qualified as T -import Morley.Tezos.Address (Address) +import Morley.Tezos.Address import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias) import Morley.Tezos.Core import Morley.Tezos.Crypto @@ -55,6 +55,8 @@ instance CmdArg SecretKey where toCmdArg = toCmdArg . formatSecretKey +instance CmdArg (KindedAddress kind) where + instance CmdArg Address where instance CmdArg ByteString where @@ -77,13 +79,9 @@ instance CmdArg OperationHash -instance CmdArg Alias where - -instance CmdArg AddressOrAlias where +instance CmdArg (Alias kind) where --- | Creates an 'AddressOrAlias' with the given address. -addressResolved :: ToAddress addr => addr -> AddressOrAlias -addressResolved = AddressResolved . toAddress +instance CmdArg (AddressOrAlias kind) where -- | Representation of address secret key encryption type data SecretKeyEncryption @@ -121,8 +119,8 @@ tezosClientEnvL :: Lens' env TezosClientEnv -- | Data required for calculating fee for transfer operation. -data CalcTransferFeeData = forall t. T.UntypedValScope t => CalcTransferFeeData - { ctfdTo :: AddressOrAlias +data CalcTransferFeeData = forall t kind. T.UntypedValScope t => CalcTransferFeeData + { ctfdTo :: AddressOrAlias kind , ctfdParam :: Value t , ctfdEp :: EpName , ctfdAmount :: TezosMutez @@ -137,8 +135,8 @@ ] -- | Data required for calculating fee for origination operation. -data CalcOriginationFeeData cp st = CalcOriginationFeeData - { cofdFrom :: AddressOrAlias +data CalcOriginationFeeData cp st = forall kind. CalcOriginationFeeData + { cofdFrom :: AddressOrAlias kind , cofdBalance :: TezosMutez , cofdMbFromPassword :: Maybe ScrubbedBytes , cofdContract :: Contract cp st diff --git a/src/Morley/Client/Util.hs b/src/Morley/Client/Util.hs --- a/src/Morley/Client/Util.hs +++ b/src/Morley/Client/Util.hs @@ -28,12 +28,13 @@ import Generics.SYB (everything, mkQ) import System.Environment (setEnv) -import Morley.AsRPC (AsRPC, MaybeRPC, rpcStorageScopeEvi) +import Morley.AsRPC (AsRPC, rpcStorageScopeEvi) import Morley.Client.RPC.Class import Morley.Client.RPC.Getters import Morley.Client.RPC.Types import Morley.Micheline import Morley.Michelson.Text +import Morley.Michelson.Typed (HasNoOp, untypeValue) import Morley.Michelson.Typed qualified as T import Morley.Michelson.Typed.Entrypoints (EpAddress(..), parseEpAddress) import Morley.Michelson.Untyped (InternalByteString(..), Value, Value'(..)) @@ -74,27 +75,40 @@ -- | A structure with all the parameters for 'runContract' data RunContractParameters cp st = RunContractParameters { rcpContract :: T.Contract cp st - , rcpParameter :: MaybeRPC (T.Value cp) - , rcpStorage :: MaybeRPC (T.Value st) + , rcpParameter :: Value + -- ^ The parameter value should have the same "structure" as @cp@, except it _may_ also have big_map IDs. + -- E.g. if the contract's parameter is @pair (big_map string string) (big_map string string)@, + -- then 'rcpParameter' may be one of: + -- + -- * @pair (big_map string string) (big_map string string)@ + -- * @pair nat (big_map string string)@ + -- * @pair (big_map string string) nat@ + -- * @pair nat nat@ + -- + -- ... where @nat@ represents a big_map ID. + , rcpStorage :: Value + -- ^ The storage value should have the same "structure" as @st@, except it _may_ also have big_map IDs. + -- See the documentation of 'rcpParameter'. , rcpBalance :: Mutez , rcpNow :: Maybe Timestamp , rcpLevel :: Maybe Natural , rcpAmount :: Mutez - , rcpSender :: Maybe Address - , rcpSource :: Maybe Address + , rcpSender :: Maybe ImplicitAddress + , rcpSource :: Maybe ImplicitAddress } -- | Initializes the parameters for `runContract` with sensible defaults. -- -- Use the @with*@ lenses to set any optional parameters. runContractParameters - :: T.Contract cp st -> MaybeRPC (T.Value cp) -> MaybeRPC (T.Value st) + :: (HasNoOp cp, HasNoOp st) + => T.Contract cp st -> T.Value cp -> T.Value st -> RunContractParameters cp st runContractParameters contract cp st = RunContractParameters { rcpContract = contract - , rcpParameter = cp - , rcpStorage = st + , rcpParameter = untypeValue cp + , rcpStorage = untypeValue st , rcpBalance = zeroMutez , rcpAmount = zeroMutez , rcpNow = Nothing @@ -116,7 +130,7 @@ -- | Run contract with given parameter and storage and get new storage without -- injecting anything to the chain. runContract - :: forall cp st m. (HasTezosRpc m, T.ParameterScope cp, T.StorageScope st) + :: forall cp st m. (HasTezosRpc m, T.StorageScope st) => RunContractParameters cp st -> m (AsRPC (T.Value st)) runContract RunContractParameters{..} = do headConstants <- getBlockConstants HeadId diff --git a/test/Test/Addresses.hs b/test/Test/Addresses.hs new file mode 100644 --- /dev/null +++ b/test/Test/Addresses.hs @@ -0,0 +1,15 @@ +-- SPDX-FileCopyrightText: 2022 Oxhead Alpha +-- SPDX-License-Identifier: LicenseRef-MIT-OA + +module Test.Addresses + ( contractAddress1 + , contractAddress2 + , contractAddress3 + ) where + +import Morley.Tezos.Address + +contractAddress1, contractAddress2, contractAddress3 :: ContractAddress +contractAddress1 = ContractAddress $ mkContractHashHack "contractAddress1" +contractAddress2 = ContractAddress $ mkContractHashHack "contractAddress2" +contractAddress3 = ContractAddress $ mkContractHashHack "contractAddress3" diff --git a/test/Test/BigMapGet.hs b/test/Test/BigMapGet.hs --- a/test/Test/BigMapGet.hs +++ b/test/Test/BigMapGet.hs @@ -14,13 +14,14 @@ import Lorentz qualified as L import Lorentz.Pack (expressionToScriptExpr) import Morley.Micheline (decodeExpression) -import Morley.Tezos.Crypto (encodeBase58Check) +import Morley.Tezos.Crypto import Morley.Client.RPC.Getters import Morley.Client.RPC.Types -import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2, genesisAddress3) import Morley.Michelson.Typed -import Morley.Tezos.Address.Alias (AddressOrAlias(..)) +import Morley.Tezos.Address +import Morley.Tezos.Address.Alias +import Test.Addresses import Test.Util import TestM @@ -30,11 +31,10 @@ assertHeadBlockId blkId st <- get case lookup addr (fsContracts st) of - Nothing -> throwM $ UnknownContract $ AddressResolved addr + Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved addr Just ContractState{..} -> case csContractData of - ImplicitContractData _ -> throwM $ UnexpectedImplicitContract addr ContractData _ mbBigMap -> case mbBigMap of - Nothing -> throwM $ ContractDoesntHaveBigMap addr + Nothing -> throwM $ ContractDoesntHaveBigMap $ MkAddress addr Just ContractStateBigMap{..} -> case lookup (encodeBase58Check $ expressionToScriptExpr bmKey) csbmMap of Nothing -> pure GetBigMapNotFound Just serializedValue -> pure $ GetBigMapResult $ decodeExpression serializedValue @@ -44,13 +44,12 @@ :: FakeState fakeStateWithBigMapContract = defaultFakeState { fsContracts = fromList $ - [ (genesisAddress1, dumbContractState + [ (contractAddress1, dumbContractState { csContractData = (csContractData dumbContractState) & \case ContractData os _ -> ContractData os $ Just $ mapToContractStateBigMap @Integer @Integer bigMapId $ fromList [(2, 3), (3, 5)] - implicitData -> implicitData }) - , (genesisAddress2, dumbContractState) + , (contractAddress2, dumbContractState) ] } where @@ -61,19 +60,19 @@ test_BigMapGetUnit = testGroup "Fake test big map getter" [ testCase "Successful big map get" $ handleSuccessfulGet $ runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $ - readContractBigMapValue @'TInt @'TInt genesisAddress1 $ + readContractBigMapValue @'TInt @'TInt contractAddress1 $ L.toVal (3 :: Integer) , testCase "Value not found in big map" $ handleValueNotFound $ runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $ - readContractBigMapValue @'TInt @'TInt genesisAddress1 $ + readContractBigMapValue @'TInt @'TInt contractAddress1 $ L.toVal (4 :: Integer) , testCase "Contract without big map" $ handleContractWithoutBigMap $ runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $ - readContractBigMapValue @'TInt @'TInt genesisAddress2 $ + readContractBigMapValue @'TInt @'TInt contractAddress2 $ L.toVal (2 :: Integer) , testCase "Big map get for unknown contract" $ handleUnknownContract $ runFakeTest bigMapGetHandlers fakeStateWithBigMapContract $ - readContractBigMapValue @'TInt @'TInt genesisAddress3 $ + readContractBigMapValue @'TInt @'TInt contractAddress3 $ L.toVal (2 :: Integer) ] where diff --git a/test/Test/Errors.hs b/test/Test/Errors.hs --- a/test/Test/Errors.hs +++ b/test/Test/Errors.hs @@ -28,8 +28,8 @@ (RunMetadata { rmOperationResult = OperationFailed [] , rmInternalOperationResults = - [ InternalOperation {unInternalOperation = OperationFailed []} - , InternalOperation {unInternalOperation = OperationFailed []} + [ InternalOperation {ioData = IODIgnored, ioResult = OperationFailed []} + , InternalOperation {ioData = IODIgnored, ioResult = OperationFailed []} ] }) :| @@ -40,8 +40,8 @@ , BalanceTooLow (#balance :! [tz|149.38m|]) (#required :! [tz|355m|]) ] , rmInternalOperationResults = - [ InternalOperation {unInternalOperation = OperationFailed []} - , InternalOperation {unInternalOperation = OperationFailed []} + [ InternalOperation {ioData = IODIgnored, ioResult = OperationFailed []} + , InternalOperation {ioData = IODIgnored, ioResult = OperationFailed []} ] }) , OperationContent (RunMetadata { rmOperationResult = OperationFailed [] diff --git a/test/Test/Fees.hs b/test/Test/Fees.hs --- a/test/Test/Fees.hs +++ b/test/Test/Fees.hs @@ -13,20 +13,19 @@ import Morley.Client.Action.Origination import Morley.Client.Action.Transaction import Morley.Client.RPC.Types -import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2) +import Morley.Michelson.Runtime.GState (genesisAddress1) import Morley.Michelson.Untyped.Entrypoints import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core (tz) +import Test.Addresses import Test.Util import TestM fakeState :: FakeState fakeState = defaultFakeState - { fsContracts = fromList $ - [ (genesisAddress1, dumbImplicitContractState) - , (genesisAddress2, dumbContractState) - ] + { fsContracts = fromList $ one $ (contractAddress2, dumbContractState) + , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitContractState) } countForgesHandlers :: Handlers $ TestT (State Word) @@ -45,7 +44,7 @@ { rmOperationResult = OperationApplied $ -- Real-life numbers AppliedResult - { arConsumedGas = 10100 + { arConsumedMilliGas = 10100000 , arStorageSize = 250 , arPaidStorageDiff = 250 , arOriginatedContracts = originatedContracts @@ -82,7 +81,7 @@ [ testCase "One transaction" $ let forgeCalls = runForgesCountingTest $ - lTransfer genesisAddress1 genesisAddress2 + lTransfer genesisAddress1 contractAddress2 [tz|10u|] DefEpName () Nothing in forgeCalls @?= sum [ 2 -- for fees adjustment diff --git a/test/Test/KeyRevealing.hs b/test/Test/KeyRevealing.hs --- a/test/Test/KeyRevealing.hs +++ b/test/Test/KeyRevealing.hs @@ -20,7 +20,7 @@ fakeState :: FakeState fakeState = defaultFakeState - { fsContracts = one ( genesisAddress1 + { fsImplicits = one ( genesisAddress1 , dumbImplicitContractState { csContractData = ImplicitContractData $ Just dumbManagerKey } ) @@ -66,18 +66,6 @@ local (const noRevealHandlers) (originateDummy originatorAddress) - - , testCase "Transfer from contract fails with proper error message, without details about revealing" $ - (runFakeTest chainOperationHandlers fakeState $ do - (_, addr) <- originateDummy genesisAddress1 - dummyTransfer addr genesisAddress1) - & - \case - (Left err) -> - case fromException @TezosClientError err of - Just (ContractSender _ "transfer") -> pass - _ -> assertFailure $ "Test failed with unexpected error: " <> displayException err - (Right _) -> assertFailure "Test expected to fail, but it passed" ] where dummyTransfer from to = diff --git a/test/Test/Origination.hs b/test/Test/Origination.hs --- a/test/Test/Origination.hs +++ b/test/Test/Origination.hs @@ -12,19 +12,18 @@ import Lorentz qualified as L import Morley.Client -import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2, genesisAddress3) +import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress3) import Morley.Tezos.Address.Alias (AddressOrAlias(..)) import Morley.Tezos.Core +import Test.Addresses import Test.Util import TestM fakeState :: FakeState fakeState = defaultFakeState - { fsContracts = fromList $ - [ (genesisAddress1, dumbImplicitContractState) - , (genesisAddress2, dumbContractState) - ] + { fsContracts = fromList $ one $ (contractAddress2, dumbContractState) + , fsImplicits = fromList $ one $ (genesisAddress1, dumbImplicitContractState) } dumbLorentzContract :: L.Contract Integer () () diff --git a/test/Test/ParameterTypeGet.hs b/test/Test/ParameterTypeGet.hs --- a/test/Test/ParameterTypeGet.hs +++ b/test/Test/ParameterTypeGet.hs @@ -20,8 +20,8 @@ import Morley.Michelson.Typed import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (Alias) -import Morley.Tezos.Crypto +import Morley.Tezos.Address.Alias +import Morley.Tezos.Address.Kinds import Test.Util import TestM @@ -30,7 +30,7 @@ L.cdr L.# L.nil L.# L.pair buildSmartContractState - :: Alias -> L.Contract param () () -> ContractState + :: ContractAlias -> L.Contract param () () -> ContractState 'AddressKindContract buildSmartContractState alias contract = ContractState { csCounter = 100500 , csAlias = alias @@ -40,11 +40,11 @@ } contractHash1, contractHash2, contractHash3 :: ContractHash -contractHash1 = Hash HashContract "lol" -contractHash2 = Hash HashContract "kek" -contractHash3 = Hash HashContract "mda" +contractHash1 = mkContractHashHack "lol" +contractHash2 = mkContractHashHack "kek" +contractHash3 = mkContractHashHack "mda" -smartContractAddr1, smartContractAddr2, smartContractAddr3 :: Address +smartContractAddr1, smartContractAddr2, smartContractAddr3 :: ContractAddress smartContractAddr1 = ContractAddress contractHash1 smartContractAddr2 = ContractAddress contractHash2 smartContractAddr3 = ContractAddress contractHash3 @@ -55,8 +55,8 @@ { fsContracts = fromList $ [ (smartContractAddr1, buildSmartContractState "lol" (testContract @Natural)) , (smartContractAddr2, buildSmartContractState "kek" (testContract @Bool)) - , (genesisAddress1, dumbImplicitContractState) ] + , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitContractState) } test_parameterTypeGetUnit :: TestTree @@ -64,7 +64,7 @@ [ testCase "Only parameters for smart contracts are extracted" $ expectContractMap (runFakeTest chainOperationHandlers fakeStateWithSmartContracts $ getContractsParameterTypes - [genesisAddress1, smartContractAddr1, smartContractAddr2] + [smartContractAddr1, smartContractAddr2] ) $ fromList [ (contractHash1, unsafe . mkSomeParamType $ U.ParameterType (U.Ty U.TNat U.noAnn) U.noAnn) , (contractHash2, unsafe . mkSomeParamType $ U.ParameterType (U.Ty U.TBool U.noAnn) U.noAnn) diff --git a/test/Test/ReadBigMapValue.hs b/test/Test/ReadBigMapValue.hs --- a/test/Test/ReadBigMapValue.hs +++ b/test/Test/ReadBigMapValue.hs @@ -11,8 +11,8 @@ import Test.Tasty.HUnit (testCase, (@?=)) import Morley.Client.RPC.Getters -import Morley.Michelson.Runtime.GState (genesisAddress1) import Morley.Michelson.Typed (BigMapId(..)) +import Test.Addresses import Test.Util import TestM @@ -25,11 +25,10 @@ :: FakeState fakeStateWithBigMapContract = defaultFakeState { fsContracts = fromList $ - [ (genesisAddress1, dumbContractState + [ (contractAddress1, dumbContractState { csContractData = (csContractData dumbContractState) & \case ContractData os _ -> ContractData os $ Just $ mapToContractStateBigMap @Integer @Integer validBigMapId $ fromList [(2, 3), (3, 5)] - implicitData -> implicitData } ) ] diff --git a/test/Test/Transaction.hs b/test/Test/Transaction.hs --- a/test/Test/Transaction.hs +++ b/test/Test/Transaction.hs @@ -11,30 +11,29 @@ import Test.Tasty.HUnit (testCase) import Morley.Client.Action.Transaction -import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress2, genesisAddress3) +import Morley.Michelson.Runtime.GState (genesisAddress1, genesisAddress3) import Morley.Michelson.Untyped.Entrypoints import Morley.Tezos.Core (tz) +import Test.Addresses import Test.Util import TestM fakeState :: FakeState fakeState = defaultFakeState - { fsContracts = fromList $ - [ (genesisAddress1, dumbImplicitContractState) - , (genesisAddress2, dumbContractState) - ] + { fsContracts = fromList $ one (contractAddress2, dumbContractState) + , fsImplicits = fromList $ one (genesisAddress1, dumbImplicitContractState) } test_lRunTransactionsUnit :: TestTree test_lRunTransactionsUnit = testGroup "Fake test transaction sending" [ testCase "Successful transaction" $ handleSuccess $ runFakeTest chainOperationHandlers fakeState $ - lTransfer genesisAddress1 genesisAddress2 + lTransfer genesisAddress1 contractAddress2 [tz|10u|] DefEpName () Nothing , testCase "Sender doesn't exist" $ handleUnknownContract $ runFakeTest chainOperationHandlers fakeState $ - lTransfer genesisAddress3 genesisAddress2 + lTransfer genesisAddress3 contractAddress2 [tz|10u|] DefEpName () Nothing , testCase "Destination doesn't exist" $ handleUnknownContract $ runFakeTest chainOperationHandlers fakeState $ diff --git a/test/Test/Util.hs b/test/Test/Util.hs --- a/test/Test/Util.hs +++ b/test/Test/Util.hs @@ -37,8 +37,8 @@ import Morley.Micheline import Morley.Michelson.Typed import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias(..), Alias(..)) -import Morley.Tezos.Core +import Morley.Tezos.Address.Alias +import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519 import Morley.Util.ByteString @@ -59,7 +59,7 @@ } -- | Initial simple contract fake state. -dumbContractState :: ContractState +dumbContractState :: ContractState 'AddressKindContract dumbContractState = ContractState { csCounter = 100500 , csAlias = "genesis2" @@ -71,7 +71,7 @@ Nothing } -dumbImplicitContractState :: ContractState +dumbImplicitContractState :: ContractState 'AddressKindImplicit dumbImplicitContractState = ContractState { csCounter = 100500 , csAlias = "genesis1" @@ -96,8 +96,6 @@ , hGetAlias = handleGetAlias , hResolveAddressMaybe = handleResolveAddressMaybe , hRememberContract = handleRememberContract - , hCalcTransferFee = \_ _ _ _ -> pure $ [TezosMutez [tz|100500u|]] - , hCalcOriginationFee = \_ -> pure $ TezosMutez [tz|100500u|] , hGetKeyPassword = \_ -> pure Nothing , hGenKey = handleGenKey , hGetManagerKey = handleGetManagerKey @@ -107,7 +105,7 @@ testSecretKey :: Ed25519.SecretKey testSecretKey = Ed25519.detSecretKey "\001\002\003\004" -mkRunOperationResult :: [Address] -> RunOperationResult +mkRunOperationResult :: [ContractAddress] -> RunOperationResult mkRunOperationResult originatedContracts = RunOperationResult { rrOperationContents = one $ OperationContent $ RunMetadata @@ -129,12 +127,12 @@ :: ( MonadState FakeState m , MonadThrow m ) - => BlockId -> Address -> m TezosInt64 + => BlockId -> ImplicitAddress -> m TezosInt64 handleGetCounter blk addr = do assertHeadBlockId blk FakeState{..} <- get - case lookup addr fsContracts of - Nothing -> throwM $ UnknownContract $ AddressResolved addr + case lookup addr fsImplicits of + Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved addr Just ContractState{..} -> pure $ csCounter handleGetBlockConstants @@ -189,33 +187,40 @@ throwM $ InvalidBranch $ foBranch op pure . HexJSONByteString . LBS.toStrict . encode $ op -handleRunOperationInternal :: Monad m => RunOperationInternal -> TestT m [Address] +handleRunOperationInternal :: Monad m => RunOperationInternal -> TestT m [ContractAddress] handleRunOperationInternal RunOperationInternal{..} = do concatMapM handleTransactionOrOrigination roiContents handleTransactionOrOrigination - :: Monad m => OperationInput -> TestT m [Address] + :: (Monad m, HasCallStack) => OperationInput -> TestT m [ContractAddress] handleTransactionOrOrigination op = do FakeState{..} <- get case wcoCustom op of -- Ensure that transaction sender exists - OpTransfer TransactionOperation{..} -> case lookup codSource fsContracts of - Nothing -> throwM $ UnknownContract $ AddressResolved codSource + OpTransfer TransactionOperation{..} -> case lookup codSource fsImplicits of + Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved codSource Just ContractState{..} -> do -- Ensure that sender counter matches unless (csCounter + 1 == codCounter) (throwM CounterMismatch) - case lookup toDestination fsContracts of - Nothing -> throwM $ UnknownContract $ AddressResolved toDestination - Just _ -> pure [] + case toDestination of + MkAddress dest@ContractAddress{} -> + case lookup dest fsContracts of + Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved dest + Just _ -> pure [] + MkAddress dest@ImplicitAddress{} -> + case lookup dest fsImplicits of + Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved dest + Just _ -> pure [] + MkAddress TxRollupAddress{} -> error "tx rollup unsupported" -- Ensure that originator exists - OpOriginate _ -> case lookup codSource fsContracts of - Nothing -> throwM $ UnknownContract $ AddressResolved codSource + OpOriginate _ -> case lookup codSource fsImplicits of + Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved codSource Just ContractState{..} -> do -- Ensure that originator counter matches unless (csCounter + 1 == codCounter) (throwM CounterMismatch) pure [dummyContractAddr] where - dummyContractAddr = unsafe $ parseAddress "KT1LZwEZqbqtLYhwzaidBp6So9LgYDpkpEv7" + dummyContractAddr = [ta|KT1LZwEZqbqtLYhwzaidBp6So9LgYDpkpEv7|] OpReveal _ -> -- We do not care about reveals at the moment return [] @@ -232,7 +237,7 @@ , MonadThrow m ) => BlockId - -> Address + -> ContractAddress -> m OriginationScript handleGetContractScript blockId addr = do assertHeadBlockId blockId @@ -240,7 +245,6 @@ case lookup addr fsContracts of Nothing -> throwM $ err404 path Just ContractState{..} -> case csContractData of - ImplicitContractData _ -> throwM $ UnexpectedImplicitContract addr ContractData script _ -> pure script where path = "/chains/main/blocks/head/context/contracts/" <> formatAddress addr <> "/script" @@ -254,7 +258,6 @@ catMaybes $ Map.elems (fsContracts st) <&> \cs -> case (csContractData cs) of ContractData _ bigMapMaybe -> bigMapMaybe - ImplicitContractData _ -> Nothing -- Check if a big_map with the given ID exists and, if so, check -- whether the giv en key exists. @@ -267,7 +270,7 @@ where path = "/chains/main/blocks/head/context/big_maps/" <> show bigMapId <> "/" <> scriptExpr -handleRememberContract :: Monad m => Bool -> Address -> Alias -> TestT m () +handleRememberContract :: Monad m => Bool -> ContractAddress -> ContractAlias -> TestT m () handleRememberContract replaceExisting addr alias = do let cs = dumbContractState { csAlias = alias } @@ -279,34 +282,41 @@ Nothing -> remember addr cs st _ -> bool pass (remember addr cs st) replaceExisting -handleGenKey :: Monad m => Alias -> TestT m Address +handleGenKey :: Monad m => ImplicitAlias -> TestT m ImplicitAddress handleGenKey alias = do let addr = detGenKeyAddress (encodeUtf8 $ unAlias alias) newContractState = dumbImplicitContractState { csAlias = alias } modify $ \s -> - s & fsContractsL . at addr ?~ newContractState + s & fsImplicitsL . at addr ?~ newContractState pure addr -handleGetAlias :: Monad m => AddressOrAlias -> TestT m Alias +handleGetAlias + :: forall m kind. (Monad m, HasCallStack) + => AddressOrAlias kind -> TestT m (Alias kind) handleGetAlias = \case AddressAlias alias -> pure alias AddressResolved addr -> do FakeState{..} <- get - case lookup addr fsContracts of - Nothing -> throwM $ UnknownContract $ AddressResolved addr + case addr of + ContractAddress{} -> go addr fsContracts + ImplicitAddress{} -> go addr fsImplicits + TxRollupAddress{} -> error "tx rollup unsupported" + where + go :: KindedAddress kind -> Map (KindedAddress kind) (ContractState kind) -> TestT m (Alias kind) + go addr m = case lookup addr m of + Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved addr Just ContractState{..} -> pure $ csAlias -handleGetManagerKey :: (Monad m) => BlockId -> Address -> TestT m (Maybe PublicKey) +handleGetManagerKey :: (Monad m) => BlockId -> ImplicitAddress -> TestT m (Maybe PublicKey) handleGetManagerKey blk addr = do assertHeadBlockId blk s <- get - let mbCs = s ^. fsContractsL . at addr + let mbCs = s ^. fsImplicitsL . at addr case mbCs of Just ContractState{..} -> case csContractData of ImplicitContractData mbManagerKey -> pure mbManagerKey - ContractData _ _ -> throwString "Only implicit account can have a manager key" - Nothing -> throwM $ UnknownContract $ AddressResolved addr + Nothing -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressResolved addr -- In scenarios where the system under test checks for 404 errors, we -- use this function to fake and simulate those errors. @@ -328,34 +338,38 @@ , responseBody = "Contract with given address not found" } -handleResolveAddressMaybe :: Monad m => AddressOrAlias -> TestT m (Maybe Address) +handleResolveAddressMaybe + :: forall m kind. Monad m + => AddressOrAlias kind + -> TestT m (Maybe (KindedAddress kind)) handleResolveAddressMaybe = \case AddressResolved addr -> pure (Just addr) AddressAlias alias -> do FakeState{..} <- get - case find checkAlias $ Map.toList fsContracts of - Just (addr, _) -> pure (Just addr) - Nothing -> pure Nothing + case alias of + ImplicitAlias{} -> go fsImplicits + ContractAlias{} -> go fsContracts where checkAlias (_, ContractState { csAlias = alias' }) = alias == alias' + go :: Map (KindedAddress kind) (ContractState kind) -> TestT m (Maybe (KindedAddress kind)) + go m = case find checkAlias $ Map.toList m of + Just (addr, _) -> pure (Just addr) + Nothing -> pure Nothing -handleRevealKey :: Monad m => Alias -> Maybe ScrubbedBytes -> TestT m () +handleRevealKey :: Monad m => ImplicitAlias -> Maybe ScrubbedBytes -> TestT m () handleRevealKey alias _ = do - contracts <- gets (Map.toList . fsContracts) + contracts <- gets (Map.toList . fsImplicits) let contracts' = filter (\(_, ContractState{..}) -> csAlias == alias) contracts case contracts' of - [] -> throwM $ UnknownContract $ AddressAlias alias + [] -> throwM $ UnknownContract $ SomeAddressOrAlias $ AddressAlias alias [(addr, cs@ContractState{..})] -> - case (addr, csContractData) of - (ContractAddress _, ContractData _ _) -> - throwM $ CantRevealContract addr - (KeyAddress _, ImplicitContractData (Just _)) -> - throwM $ AlreadyRevealed addr - (KeyAddress _, ImplicitContractData Nothing) -> + case csContractData of + ImplicitContractData (Just _) -> + throwM $ AlreadyRevealed $ MkAddress addr + ImplicitContractData Nothing -> -- We don't care about the public key itself, but only its presence. let newContractState = cs { csContractData = ImplicitContractData $ Just dumbManagerKey } - in modify $ \s -> s & fsContractsL . at addr ?~ newContractState - _ -> error "Inconsitent fake state. This most likely a bug in tests." + in modify $ \s -> s & fsImplicitsL . at addr ?~ newContractState _ -> error $ "Multiple contracts have alias '" +| alias |+ "'. This is most likely a bug in tests." diff --git a/test/TestM.hs b/test/TestM.hs --- a/test/TestM.hs +++ b/test/TestM.hs @@ -13,6 +13,7 @@ , FakeState (..) , TestError (..) , TestHandlers (..) + , SomeAddressOrAlias (..) , TestM , TestT , defaultHandlers @@ -22,7 +23,7 @@ , liftToFakeTest -- * Lens - , fsContractsL + , fsImplicitsL ) where import Colog.Core.Class (HasLog(..)) @@ -36,24 +37,27 @@ import Morley.Client import Morley.Client.Logging (ClientLogAction) import Morley.Client.RPC -import Morley.Client.TezosClient (CalcOriginationFeeData, CalcTransferFeeData, TezosClientConfig) import Morley.Micheline -import Morley.Michelson.Typed.Scope (UntypedValScope) import Morley.Tezos.Address -import Morley.Tezos.Address.Alias (AddressOrAlias, Alias(..)) +import Morley.Tezos.Address.Alias +import Morley.Tezos.Address.Kinds import Morley.Tezos.Core -import Morley.Tezos.Crypto (KeyHash, PublicKey, SecretKey, Signature) +import Morley.Tezos.Crypto (KeyHash, PublicKey, Signature) import Morley.Util.ByteString -- | A test-specific orphan. -instance IsString Alias where - fromString = Alias . fromString +instance IsString ImplicitAlias where + fromString = ImplicitAlias . fromString +-- | A test-specific orphan. +instance IsString ContractAlias where + fromString = ContractAlias . fromString + -- | Reader environment to interact with the fake state. data Handlers m = Handlers { -- HasTezosRpc hGetBlockHash :: BlockId -> m BlockHash - , hGetCounter :: BlockId -> Address -> m TezosInt64 + , hGetCounter :: BlockId -> ImplicitAddress -> m TezosInt64 , hGetBlockHeader :: BlockId -> m BlockHeader , hGetBlockConstants :: BlockId -> m BlockConstants , hGetBlockOperations :: BlockId -> m [[BlockOperation]] @@ -64,35 +68,27 @@ , hPreApplyOperations :: BlockId -> [PreApplyOperation] -> m [RunOperationResult] , hForgeOperation :: BlockId -> ForgeOperation -> m HexJSONByteString , hInjectOperation :: HexJSONByteString -> m OperationHash - , hGetContractScript :: BlockId -> Address -> m OriginationScript - , hGetContractBigMap :: BlockId -> Address -> GetBigMap -> m GetBigMapResult + , hGetContractScript :: BlockId -> ContractAddress -> m OriginationScript + , hGetContractBigMap :: BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult , hGetBigMapValue :: BlockId -> Natural -> Text -> m Expression , hGetBigMapValues :: BlockId -> Natural -> Maybe Natural -> Maybe Natural -> m Expression , hGetBalance :: BlockId -> Address -> m Mutez , hRunCode :: BlockId -> RunCode -> m RunCodeResult , hGetChainId :: m ChainId - , hGetManagerKey :: BlockId -> Address -> m (Maybe PublicKey) - , hGetDelegateAtBlock :: BlockId -> Address -> m (Maybe KeyHash) + , hGetManagerKey :: BlockId -> ImplicitAddress -> m (Maybe PublicKey) + , hGetDelegateAtBlock :: BlockId -> ContractAddress -> m (Maybe KeyHash) -- HasTezosClient - , hSignBytes :: AddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature - , hGenKey :: Alias -> m Address - , hGenFreshKey :: Alias -> m Address - , hRevealKey :: Alias -> Maybe ScrubbedBytes -> m () + , hSignBytes :: ImplicitAddressOrAlias -> Maybe ScrubbedBytes -> ByteString -> m Signature + , hGenKey :: ImplicitAlias -> m ImplicitAddress + , hGenFreshKey :: ImplicitAlias -> m ImplicitAddress + , hRevealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> m () , hWaitForOperation :: m OperationHash -> m OperationHash - , hRememberContract :: Bool -> Address -> Alias -> m () - , hImportKey :: Bool -> Alias -> SecretKey -> m Alias - , hResolveAddressMaybe :: AddressOrAlias -> m (Maybe Address) - , hGetAlias :: AddressOrAlias -> m Alias - , hGetPublicKey :: AddressOrAlias -> m PublicKey - , hGetSecretKey :: AddressOrAlias -> m SecretKey - , hGetTezosClientConfig :: m TezosClientConfig - , hCalcTransferFee - :: AddressOrAlias -> Maybe ScrubbedBytes -> TezosInt64 -> [CalcTransferFeeData] -> m [TezosMutez] - , hCalcOriginationFee - :: forall cp st. UntypedValScope st => CalcOriginationFeeData cp st -> m TezosMutez - , hGetKeyPassword :: Address -> m (Maybe ScrubbedBytes) - , hRegisterDelegate :: Alias -> Maybe ScrubbedBytes -> m () + , hRememberContract :: Bool -> ContractAddress -> ContractAlias -> m () + , hResolveAddressMaybe :: forall kind. AddressOrAlias kind -> m (Maybe (KindedAddress kind)) + , hGetAlias :: forall kind. AddressOrAlias kind -> m (Alias kind) + , hGetKeyPassword :: ImplicitAddress -> m (Maybe ScrubbedBytes) + , hRegisterDelegate :: ImplicitAlias -> Maybe ScrubbedBytes -> m () -- HasLog , hLogAction :: ClientLogAction m @@ -128,14 +124,8 @@ , hRevealKey = \_ _ -> throwM $ UnexpectedClientCall "revealKey" , hWaitForOperation = \_ -> throwM $ UnexpectedRpcCall "waitForOperation" , hRememberContract = \_ _ _ -> throwM $ UnexpectedClientCall "hRememberContract" - , hImportKey = \_ _ _ -> throwM $ UnexpectedClientCall "importKey" , hResolveAddressMaybe = \_ -> throwM $ UnexpectedRpcCall "resolveAddressMaybe" , hGetAlias = \_ -> throwM $ UnexpectedRpcCall "getAlias" - , hGetPublicKey = \_ -> throwM $ UnexpectedRpcCall "getPublicKey" - , hGetSecretKey = \_ -> throwM $ UnexpectedRpcCall "getSecretKey" - , hGetTezosClientConfig = throwM $ UnexpectedClientCall "getTezosClientConfig" - , hCalcTransferFee = \_ _ _ _ -> throwM $ UnexpectedClientCall "calcTransferFee" - , hCalcOriginationFee = \_ -> throwM $ UnexpectedClientCall "calcOriginationFee" , hGetKeyPassword = \_ -> throwM $ UnexpectedClientCall "getKeyPassword" , hRegisterDelegate = \_ _ -> throwM $ UnexpectedClientCall "registerDelegate" @@ -144,15 +134,15 @@ -- | Type to represent contract state in the @FakeState@. -- This type can represent both implicit accounts and contracts. -data ContractState = ContractState +data ContractState k = ContractState { csCounter :: TezosInt64 - , csAlias :: Alias - , csContractData :: ContractData + , csAlias :: Alias k + , csContractData :: ContractData k } -data ContractData - = ContractData OriginationScript (Maybe ContractStateBigMap) - | ImplicitContractData (Maybe PublicKey) +data ContractData k where + ContractData :: OriginationScript -> Maybe ContractStateBigMap -> ContractData 'AddressKindContract + ImplicitContractData :: Maybe PublicKey -> ContractData 'AddressKindImplicit -- | Type to represent big_map in @ContractState@. data ContractStateBigMap = ContractStateBigMap @@ -166,9 +156,12 @@ newtype TestHandlers m = TestHandlers {unTestHandlers :: Handlers (TestT m)} +type AddressMap k = Map (KindedAddress k) (ContractState k) + -- | Type to represent chain state in mock tests. data FakeState = FakeState - { fsContracts :: Map Address ContractState + { fsContracts :: AddressMap 'AddressKindContract + , fsImplicits :: AddressMap 'AddressKindImplicit , fsHeadBlock :: BlockHash -- ^ Hash of the `head` block , fsFinalHeadBlock :: BlockHash @@ -180,6 +173,7 @@ defaultFakeState :: FakeState defaultFakeState = FakeState { fsContracts = mempty + , fsImplicits = mempty , fsHeadBlock = BlockHash "HEAD" , fsFinalHeadBlock = BlockHash "HEAD~2" , fsBlockConstants = \blkId -> BlockConstants @@ -222,10 +216,8 @@ = AlreadyRevealed Address | UnexpectedRpcCall Text | UnexpectedClientCall Text - | UnknownContract AddressOrAlias - | UnexpectedImplicitContract Address + | UnknownContract SomeAddressOrAlias | ContractDoesntHaveBigMap Address - | CantRevealContract Address | InvalidChainId | InvalidProtocol | InvalidBranch BlockHash @@ -255,29 +247,12 @@ rememberContract replaceExisting addr alias = do h <- getHandler hRememberContract h replaceExisting addr alias - importKey replaceExisting alias key = do - h <- getHandler hImportKey - h replaceExisting alias key resolveAddressMaybe addr = do - h <- getHandler hResolveAddressMaybe + h <- ask >>= \t -> pure $ hResolveAddressMaybe $ unTestHandlers t h addr getAlias originator = do - h <- getHandler hGetAlias + h <- ask >>= \t -> pure $ hGetAlias $ unTestHandlers t h originator - getPublicKey alias = do - h <- getHandler hGetPublicKey - h alias - getSecretKey alias = do - h <- getHandler hGetSecretKey - h alias - getTezosClientConfig = - join $ getHandler hGetTezosClientConfig - calcTransferFee from mbPassword burnCap transferDatas = do - h <- getHandler hCalcTransferFee - h from mbPassword burnCap transferDatas - calcOriginationFee origData = do - h <- getHandler (\hs -> hCalcOriginationFee hs) - h origData getKeyPassword addr = do h <- getHandler hGetKeyPassword h addr @@ -354,4 +329,4 @@ h <- getHandler hWaitForOperation h opHash -makeLensesFor [("fsContracts", "fsContractsL")] ''FakeState +makeLensesFor [("fsImplicits", "fsImplicitsL")] ''FakeState