diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,20 @@ +0.4.0 +===== +* [!1366](https://gitlab.com/morley-framework/morley/-/merge_requests/1366) + Split instance `Resolve (AddressOrAlias kind)` into two + + Now, to call `resolveAddress` on an alias, wrapping it in `AddressAlias` is + optional + + Ditto for `resolveAlias`, address and `AddressResolved` + + `AmbiguousAlias` error is slightly generalized + + `AmbiguousAlias` moved from `TezosClientError` to `ResolveError` + + `resolveAddressEither` thus doesn't throw anymore, returning `Left + AmbiguousAlias` instead. +* [!1364](https://gitlab.com/morley-framework/morley/-/merge_requests/1364) + Update to LTS-21.4 (GHC 9.4.5) + 0.3.2 ===== * [!1350](https://gitlab.com/morley-framework/morley/-/merge_requests/1350) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ -> :warning: **Note: this project is being deprecated.** +> :warning: **Note: this project is deprecated.** > -> It will no longer be maintained after the activation of protocol "N" on the Tezos mainnet. +> It is no longer maintained since the activation of protocol "Nairobi" on the Tezos mainnet (June 24th, 2023). # Morley-client diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -7,7 +7,7 @@ import GHC.IO.Encoding (setFileSystemEncoding) import Options.Applicative qualified as Opt -import Options.Applicative.Help.Pretty (Doc, linebreak) +import Options.Applicative.Help.Pretty (Doc, line) import System.IO (utf8) import Morley.Client.Parser @@ -33,31 +33,31 @@ usageDoc :: Doc usageDoc = mconcat - [ "You can use help for specific COMMAND", linebreak - , "EXAMPLE:", linebreak - , "morley-client originate --help", linebreak - , linebreak - , "Documentation for morley tools can be found at the following links:", linebreak - , " https://gitlab.com/morley-framework/morley/blob/master/README.md", linebreak - , " https://gitlab.com/morley-framework/morley/tree/master/docs", linebreak - , linebreak - , "Sample contracts for running can be found at the following link:", linebreak - , " https://gitlab.com/morley-framework/morley/tree/master/contracts", linebreak - , linebreak - , "USAGE EXAMPLE:", linebreak - , "morley-client -E florence.testnet.tezos.serokell.team:8732 originate \\", linebreak - , " --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak - , " --contract ../contracts/tezos_examples/attic/add1.tz --initial-balance 1 --initial-storage 0", linebreak - , linebreak - , " This command will originate contract with code stored in add1.tz", linebreak - , " on real network with initial balance 1 and initial storage set to 0", linebreak - , " and return info about operation: operation hash and originated contract address", linebreak - , linebreak - , "morley-client -E florence.testnet.tezos.serokell.team:8732 transfer \\", linebreak - , " --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", linebreak - , " --to KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW --amount 1 --parameter 0", linebreak - , linebreak - , " This command will perform tranfer to contract with address on real network", linebreak - , " KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW with amount 1 and parameter 0", linebreak + [ "You can use help for specific COMMAND", line + , "EXAMPLE:", line + , "morley-client originate --help", line + , line + , "Documentation for morley tools can be found at the following links:", line + , " https://gitlab.com/morley-framework/morley/blob/master/README.md", line + , " https://gitlab.com/morley-framework/morley/tree/master/docs", line + , line + , "Sample contracts for running can be found at the following link:", line + , " https://gitlab.com/morley-framework/morley/tree/master/contracts", line + , line + , "USAGE EXAMPLE:", line + , "morley-client -E florence.testnet.tezos.serokell.team:8732 originate \\", line + , " --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", line + , " --contract ../contracts/tezos_examples/attic/add1.tz --initial-balance 1 --initial-storage 0", line + , line + , " This command will originate contract with code stored in add1.tz", line + , " on real network with initial balance 1 and initial storage set to 0", line + , " and return info about operation: operation hash and originated contract address", line + , line + , "morley-client -E florence.testnet.tezos.serokell.team:8732 transfer \\", line + , " --from tz1akcPmG1Kyz2jXpS4RvVJ8uWr7tsiT9i6A \\", line + , " --to KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW --amount 1 --parameter 0", line + , line + , " This command will perform tranfer to contract with address on real network", line + , " KT1USbmjj6P2oJ54UM6HxBZgpoPtdiRSVABW with amount 1 and parameter 0", line , " as a result it will return operation hash" ] diff --git a/morley-client.cabal b/morley-client.cabal --- a/morley-client.cabal +++ b/morley-client.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: morley-client -version: 0.3.2 +version: 0.4.0 synopsis: Client to interact with the Tezos blockchain description: A client to interact with the Tezos blockchain, by use of the octez-node RPC and/or of the octez-client binary. category: Blockchain @@ -127,7 +127,7 @@ ViewPatterns DerivingStrategies DeriveAnyClass - ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode + ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -Wno-missing-kind-signatures -Wno-implicit-lift -Wno-unticked-promoted-constructors build-depends: aeson , aeson-casing @@ -224,7 +224,7 @@ UndecidableInstances UndecidableSuperClasses ViewPatterns - ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode + ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -Wno-missing-kind-signatures -Wno-implicit-lift -Wno-unticked-promoted-constructors build-depends: base-noprelude >=4.7 && <5 , morley @@ -307,7 +307,7 @@ UndecidableInstances UndecidableSuperClasses ViewPatterns - ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -threaded -eventlog -rtsopts "-with-rtsopts=-N -A64m -AL256m" + ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-prepositive-qualified-module -Wno-missing-safe-haskell-mode -Wno-missing-kind-signatures -Wno-implicit-lift -Wno-unticked-promoted-constructors -threaded -rtsopts "-with-rtsopts=-N -A64m -AL256m" -Wno-unused-imports build-tool-depends: tasty-discover:tasty-discover build-depends: 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 @@ -206,7 +206,7 @@ -- after contract origination. forM_ operations $ \case OpOriginate OriginationData{odAliasBehavior = ForbidDuplicateAlias, ..} -> do - resolved <- resolveAddressMaybe (AddressAlias odName) + resolved <- resolveAddressMaybe odName whenJust resolved $ const $ throwM $ DuplicateAlias (unAlias odName) _ -> pass mbPassword <- getKeyPassword sender 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 @@ -99,9 +99,8 @@ in SomeLargeContractOriginator VUnit origContract origLambda PartlyPushableStorage val instr -> - let origContract = largeContractOriginator - origLambda = mkOriginationLambda instr largeContract xtzs - in SomeLargeContractOriginator val origContract origLambda + let origLambda = mkOriginationLambda instr largeContract xtzs + in SomeLargeContractOriginator val largeContractOriginator origLambda -------------------------------------------------------------------------------- @@ -248,14 +247,14 @@ doRunLambda = TransactionData @'T.TUnit $ TD { tdReceiver = Constrained originatorAddr , tdAmount = odBalance - , tdEpName = eprName $ Call @"run_lambda" + , tdEpName = eprName #run_lambda , tdParam = VUnit , tdMbFee = odMbFee } mkLoadLambda bytes = TransactionData @'T.TBytes $ TD { tdReceiver = Constrained originatorAddr , tdAmount = zeroMutez - , tdEpName = eprName $ Call @"load_lambda" + , tdEpName = eprName #load_lambda , tdParam = VBytes bytes , tdMbFee = odMbFee } 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 @@ -397,7 +397,7 @@ , "script_rejected" ~> ScriptRejected <$> o .: "with" , "bad_contract_parameter" ~> BadContractParameter <$> o .: "contract" , "invalid_constant" ~> InvalidConstant <$> o .: "expected_type" <*> o .: "wrong_expression" - , "invalid_contract" ~> InvalidContract <$> o.: "contract" + , "invalid_contract" ~> InvalidContract <$> o .: "contract" , "inconsistent_types" ~> InconsistentTypes <$> o .: "first_type" <*> o .: "other_type" , "invalid_primitive" ~> InvalidPrimitive <$> o .: "expected_primitive_names" <*> o .: "wrong_primitive_name" @@ -417,7 +417,7 @@ , "tez.multiplication_overflow" ~> MutezMultiplicationOverflow <$> o .: "amount" <*> o .: "multiplicator" , "cannot_pay_storage_fee" ~> pure CantPayStorageFee - , "balance_too_low"~> do + , "balance_too_low" ~> do balance <- unTezosMutez <$> o .: "balance" amount <- unTezosMutez <$> o .: "amount" return $ BalanceTooLow (#balance :! balance) (#required :! amount) 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 @@ -119,7 +119,7 @@ callTezosClient errHandler ["gen", "keys", toCmdArg name] MockupMode Nothing invalidateAliasCache - resolveAddress (AddressAlias name) + resolveAddress name -- | Generate a new secret key and save it with given alias. -- If an address with given alias already exists, it will be removed @@ -138,7 +138,7 @@ ["forget", "address", toCmdArg name, "--force"] MockupMode Nothing callTezosClientStrict ["gen", "keys", toCmdArg name] MockupMode Nothing invalidateAliasCache - resolveAddress (AddressAlias name) + resolveAddress name -- | Reveal public key corresponding to the given alias. -- Fails if it's already revealed. diff --git a/src/Morley/Client/TezosClient/Resolve.hs b/src/Morley/Client/TezosClient/Resolve.hs --- a/src/Morley/Client/TezosClient/Resolve.hs +++ b/src/Morley/Client/TezosClient/Resolve.hs @@ -17,7 +17,6 @@ import Data.Constraint ((\\)) import Fmt (pretty) -import Morley.Client.Logging import Morley.Client.TezosClient.Class qualified as Class import Morley.Client.TezosClient.Config import Morley.Client.TezosClient.Types.Errors @@ -37,12 +36,11 @@ -- -- When the alias is associated with __both__ an implicit and a contract address: -- - -- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError', + -- * The 'SomeAddressOrAlias' instance will return 'REAmbiguousAlias', -- unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate. -- * The 'AddressOrAlias' instance will return the address with the requested kind. resolveAddressEither - :: forall m env - . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m) + :: (Class.HasTezosClient m) => addressOrAlias -> m (Either ResolveError (ResolvedAddress addressOrAlias)) @@ -50,7 +48,7 @@ When the alias is associated with __both__ an implicit and a contract address: - * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError', + * The 'SomeAddressOrAlias' instance will return 'REAmbiguousAlias', unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate. * The 'AddressOrAlias' instance will return the alias of the address with the requested kind. @@ -59,18 +57,64 @@ reported upstream: . -} getAliasEither - :: forall m env - . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m) + :: (Class.HasTezosClient m) => addressOrAlias -> m (Either ResolveError (ResolvedAlias addressOrAlias)) -- | Resolve both address and alias at the same time resolveAddressWithAliasEither - :: forall m env - . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m) + :: (Class.HasTezosClient m) => addressOrAlias -> m (Either ResolveError (ResolvedAddressAndAlias addressOrAlias)) +instance L1AddressKind kind => Resolve (KindedAddress kind) where + type ResolvedAddress (KindedAddress kind) = KindedAddress kind + type ResolvedAlias (KindedAddress kind) = Alias kind + type ResolvedAddressAndAlias (KindedAddress kind) = AddressWithAlias kind + + resolveAddressEither + :: (Class.HasTezosClient m) + => KindedAddress kind -> m (Either ResolveError (KindedAddress kind)) + resolveAddressEither = pure . Right + + getAliasEither + :: (Class.HasTezosClient m) + => KindedAddress kind -> m (Either ResolveError (Alias kind)) + getAliasEither addr + = maybeToRight (REAddressNotFound addr) + . lookupAlias addr <$> Class.getAliasesAndAddresses + + resolveAddressWithAliasEither addr = fmap (AddressWithAlias addr) <$> getAliasEither addr + +instance Resolve (Alias kind) where + type ResolvedAddress (Alias kind) = KindedAddress kind + type ResolvedAlias (Alias kind) = Alias kind + type ResolvedAddressAndAlias (Alias kind) = AddressWithAlias kind + + resolveAddressEither + :: (Class.HasTezosClient m) + => Alias kind -> m (Either ResolveError (KindedAddress kind)) + resolveAddressEither alias = do + aas <- Class.getAliasesAndAddresses + pure $ lookupAddr alias aas + & maybeToRight (handleMissing aas) + where + handleMissing :: AliasesAndAddresses -> ResolveError + handleMissing aas + = maybe (REAliasNotFound $ pretty $ AddressAlias alias) (REWrongKind alias) + $ case alias of + -- notice kind is flipped + ImplicitAlias aliasTxt -> Constrained <$> lookupAddr (ContractAlias aliasTxt) aas + ContractAlias aliasTxt -> Constrained <$> lookupAddr (ImplicitAlias aliasTxt) aas + + getAliasEither + :: (Class.HasTezosClient m) + => Alias kind -> m (Either ResolveError (Alias kind)) + getAliasEither alias = ($> alias) <$> resolveAddressEither alias -- check if alias exists + + resolveAddressWithAliasEither alias = + fmap (`AddressWithAlias` alias) <$> resolveAddressEither alias + instance Resolve (AddressOrAlias kind) where type ResolvedAddress (AddressOrAlias kind) = KindedAddress kind type ResolvedAlias (AddressOrAlias kind) = Alias kind @@ -80,32 +124,19 @@ :: (Class.HasTezosClient m) => AddressOrAlias kind -> m (Either ResolveError (KindedAddress kind)) resolveAddressEither = \case - AddressResolved addr -> pure $ Right addr - aoa@(AddressAlias alias) -> do - aas <- Class.getAliasesAndAddresses - pure $ lookupAddr alias aas - & maybeToRight (handleMissing aas) - where - handleMissing :: AliasesAndAddresses -> ResolveError - handleMissing aas - = maybe (REAliasNotFound (pretty aoa)) (REWrongKind alias) - $ case alias of - -- notice kind is flipped - ImplicitAlias aliasTxt -> Constrained <$> lookupAddr (ContractAlias aliasTxt) aas - ContractAlias aliasTxt -> Constrained <$> lookupAddr (ImplicitAlias aliasTxt) aas + AddressResolved addr -> resolveAddressEither addr + AddressAlias alias -> resolveAddressEither alias getAliasEither - :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m) + :: (Class.HasTezosClient m) => AddressOrAlias kind -> m (Either ResolveError (Alias kind)) getAliasEither = \case - aoa@(AddressAlias alias) -> - -- Check if the alias exists - ($> alias) <$> resolveAddressEither aoa - AddressResolved addr -> - maybeToRight (REAddressNotFound addr) . lookupAlias addr <$> Class.getAliasesAndAddresses + AddressAlias alias -> getAliasEither alias + AddressResolved addr -> getAliasEither addr - resolveAddressWithAliasEither addr = - (liftA2 . liftA2) AddressWithAlias (resolveAddressEither addr) (getAliasEither addr) + resolveAddressWithAliasEither = \case + AddressAlias alias -> resolveAddressWithAliasEither alias + AddressResolved addr -> resolveAddressWithAliasEither addr instance Resolve SomeAddressOrAlias where type ResolvedAddress SomeAddressOrAlias = L1Address @@ -113,23 +144,24 @@ type ResolvedAddressAndAlias SomeAddressOrAlias = Constrained L1AddressKind AddressWithAlias resolveAddressEither - :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m) + :: (Class.HasTezosClient m) => SomeAddressOrAlias -> m (Either ResolveError L1Address) resolveAddressEither = \case SAOAKindUnspecified aliasText -> do aas <- Class.getAliasesAndAddresses - let contractAddress = lookupAddr (mkAlias @'AddressKindContract aliasText) aas - implicitAddress = lookupAddr (mkAlias @'AddressKindImplicit aliasText) aas - case (contractAddress, implicitAddress) of - (Nothing, Nothing) -> pure $ Left $ REAliasNotFound aliasText - (Just addr, Nothing) -> pure $ Right $ Constrained addr - (Nothing, Just addr) -> pure $ Right $ Constrained addr - (Just ca, Just ia) -> throwM $ AmbiguousAlias aliasText ca ia + let addrs = traverseConstrained (`lookupAddr` aas) `mapMaybe` + [ Constrained $ mkAlias @'AddressKindContract aliasText + , Constrained $ mkAlias @'AddressKindImplicit aliasText + ] + pure $ case addrs of + [] -> Left $ REAliasNotFound aliasText + [addr] -> Right addr + as -> Left $ REAmbiguousAlias aliasText as SAOAKindSpecified aoa -> fmap Constrained <$> resolveAddressEither aoa \\ addressOrAliasKindSanity aoa getAliasEither - :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m) + :: (Class.HasTezosClient m) => SomeAddressOrAlias -> m (Either ResolveError SomeAlias) getAliasEither = \case SAOAKindSpecified aoa -> do @@ -151,16 +183,16 @@ -- | Looks up the address and alias with the given @addressOrAlias@. resolveAddressWithAlias - :: forall addressOrAlias m env - . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias) + :: forall addressOrAlias m + . (Class.HasTezosClient m, MonadThrow m,Resolve addressOrAlias) => addressOrAlias -> m (ResolvedAddressAndAlias addressOrAlias) resolveAddressWithAlias = resolveAddressWithAliasEither >=> either (throwM . ResolveError) pure -- | Looks up the address and alias with the given @addressOrAlias@. resolveAddressWithAliasMaybe - :: forall addressOrAlias m env - . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias) + :: forall addressOrAlias m + . (Class.HasTezosClient m, Resolve addressOrAlias) => addressOrAlias -> m (Maybe (ResolvedAddressAndAlias addressOrAlias)) resolveAddressWithAliasMaybe = fmap rightToMaybe . resolveAddressWithAliasEither @@ -178,8 +210,8 @@ -- unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate. -- * The 'AddressOrAlias' instance will return the address with the requested kind. resolveAddress - :: forall addressOrAlias m env - . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias) + :: forall addressOrAlias m + . (Class.HasTezosClient m, MonadThrow m, Resolve addressOrAlias) => addressOrAlias -> m (ResolvedAddress addressOrAlias) resolveAddress = resolveAddressEither >=> either (throwM . ResolveError) pure @@ -197,12 +229,19 @@ -- unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate. -- * The 'AddressOrAlias' instance will return the address with the requested kind. resolveAddressMaybe - :: forall addressOrAlias m env - . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias) + :: forall addressOrAlias m + . (Class.HasTezosClient m, MonadThrow m, Resolve addressOrAlias) => addressOrAlias -> m (Maybe (ResolvedAddress addressOrAlias)) -resolveAddressMaybe aoa = rightToMaybe <$> resolveAddressEither aoa +resolveAddressMaybe aoa = resolveAddressEither aoa >>= either handleResolveError (pure . Just) +handleResolveError :: MonadThrow m => ResolveError -> m (Maybe a) +handleResolveError = \case + e@REAmbiguousAlias{} -> throwM $ ResolveError e + REAliasNotFound{} -> pure Nothing + REAddressNotFound{} -> pure Nothing + REWrongKind{} -> pure Nothing + {- | Looks up the alias associated with the given @addressOrAlias@. Will throw a 'TezosClientError' if @addressOrAlias@: @@ -218,8 +257,8 @@ * The 'AddressOrAlias' instance will return the alias. -} getAlias - :: forall addressOrAlias m env - . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias) + :: forall addressOrAlias m + . (Class.HasTezosClient m, MonadThrow m, Resolve addressOrAlias) => addressOrAlias -> m (ResolvedAlias addressOrAlias) getAlias = getAliasEither >=> either (throwM . ResolveError) pure @@ -239,8 +278,8 @@ * The 'AddressOrAlias' instance will return the alias. -} getAliasMaybe - :: forall addressOrAlias m env - . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias) + :: forall addressOrAlias m + . (Class.HasTezosClient m, MonadThrow m, Resolve addressOrAlias) => addressOrAlias -> m (Maybe (ResolvedAlias addressOrAlias)) -getAliasMaybe aoa = rightToMaybe <$> getAliasEither aoa +getAliasMaybe aoa = getAliasEither aoa >>= either handleResolveError (pure . Just) diff --git a/src/Morley/Client/TezosClient/Types/Errors.hs b/src/Morley/Client/TezosClient/Types/Errors.hs --- a/src/Morley/Client/TezosClient/Types/Errors.hs +++ b/src/Morley/Client/TezosClient/Types/Errors.hs @@ -11,12 +11,14 @@ import Data.Constraint ((\\)) import Data.Singletons (demote) +import Data.Text qualified as T import Lorentz.Value import Morley.Client.RPC.Types import Morley.Tezos.Address import Morley.Tezos.Address.Alias import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto +import Morley.Util.Constrained import Morley.Util.Interpolate (itu) -- | A data type for all /predicatable/ errors that can happen during @@ -72,9 +74,6 @@ -- ^ @octez-client@ produced invalid output for parsing secret key encryption type. | DuplicateAlias Text -- ^ Tried to save alias, but such alias already exists. - | AmbiguousAlias Text ContractAddress ImplicitAddress - -- ^ Expected an alias to be associated with either an implicit address or a - -- contract address, but it was associated with both. | ResolveError ResolveError deriving stock instance Show TezosClientError @@ -122,13 +121,6 @@ "`octez-client` produced invalid output for parsing secret key encryption type: " +| txt |+ ".\n Parsing error is: " +| err |+ "" DuplicateAlias alias -> "Attempted to save alias '" +| alias |+ "', but it already exists" - AmbiguousAlias aliasText contractAddr implicitAddr -> - [itu| - The alias '#{aliasText}' is assigned to both: - * a contract address: #{contractAddr} - * and an implicit address: #{implicitAddr} - Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate. - |] ResolveError err -> build err data ResolveError where @@ -139,6 +131,9 @@ -- associated with a contract address, or vice-versa. REAddressNotFound :: KindedAddress kind -> ResolveError -- ^ Could not find an alias with given address. + REAmbiguousAlias :: Text -> [L1Address] -> ResolveError + -- ^ Expected an alias to be associated with either an implicit address or a + -- contract address, but it was associated with both. deriving stock instance Show ResolveError @@ -156,3 +151,13 @@ [itu|Could not find the alias '#{aliasText}'.|] REAddressNotFound addr -> [itu|Could not find an alias for the address '#{addr}'.|] + REAmbiguousAlias aliasText addrs -> + [itu| + The alias '#{aliasText}' is assigned to: + #{addrs'} + Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate. + |] + where + addrs' = T.intercalate "\n" . toList $ addrs <&> foldConstrained \case + ContractAddress contractAddr -> [itu|* a contract address: #{contractAddr}|] + ImplicitAddress implicitAddr -> [itu|* an implicit address: #{implicitAddr}|] diff --git a/test/Test/BigMapGet.hs b/test/Test/BigMapGet.hs --- a/test/Test/BigMapGet.hs +++ b/test/Test/BigMapGet.hs @@ -6,8 +6,8 @@ ) where import Control.Lens (at) -import Test.HUnit (Assertion, assertFailure) import Test.Hspec.Expectations (shouldThrow) +import Test.HUnit (Assertion, assertFailure) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) diff --git a/test/Test/Fees.hs b/test/Test/Fees.hs --- a/test/Test/Fees.hs +++ b/test/Test/Fees.hs @@ -32,7 +32,7 @@ countForgesHandlers = chainOperationHandlers { hForgeOperation = \blkId op -> do assertHeadBlockId blkId - liftToFakeTest $ modify (+1) + liftToFakeTest $ modify (+ 1) hForgeOperation chainOperationHandlers blkId op , hRunOperation = \blkId RunOperation{..} -> do diff --git a/test/Test/Resolve.hs b/test/Test/Resolve.hs --- a/test/Test/Resolve.hs +++ b/test/Test/Resolve.hs @@ -37,7 +37,7 @@ countAliasStoreCalls :: Handlers (TestT (State Word)) countAliasStoreCalls = chainOperationHandlers { hGetAliasesAndAddresses = do - liftToFakeTest $ modify (+1) + liftToFakeTest $ modify (+ 1) hGetAliasesAndAddresses chainOperationHandlers }