From 191db672c5a6723362faf006c969e3e9414d196a Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 24 Sep 2020 16:41:35 +0200 Subject: [PATCH 1/2] implement new stateless endpoint for inspecting addresses It takes any arbitrary string as input and tries to deserialize it into some address information if possible, otherwise it fails with a proper error. --- lib/core/src/Cardano/Wallet/Api.hs | 11 +++ lib/core/src/Cardano/Wallet/Api/Client.hs | 10 ++- lib/core/src/Cardano/Wallet/Api/Server.hs | 15 +++- .../Cardano/Wallet/Jormungandr/Api/Server.hs | 4 +- .../src/Cardano/Wallet/Shelley/Api/Server.hs | 17 +++- .../Cardano/Wallet/Shelley/Compatibility.hs | 78 ++++++++++------ specifications/api/swagger.yaml | 90 +++++++++++++++++++ 7 files changed, 191 insertions(+), 34 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs index 8a972195284..d26335a7e70 100644 --- a/lib/core/src/Cardano/Wallet/Api.hs +++ b/lib/core/src/Cardano/Wallet/Api.hs @@ -31,6 +31,7 @@ module Cardano.Wallet.Api , Addresses , ListAddresses + , InspectAddress , CoinSelections , SelectCoins @@ -163,6 +164,8 @@ import Data.Generics.Labels () import Data.Generics.Product.Typed ( HasType, typed ) +import Data.Text + ( Text ) import GHC.Generics ( Generic ) import Servant.API @@ -187,6 +190,8 @@ import Servant.API.Verbs , PutNoContent ) +import qualified Data.Aeson as Aeson + type ApiV2 n apiPool = "v2" :> Api n apiPool -- | The full cardano-wallet API. @@ -269,6 +274,7 @@ type GetUTxOsStatistics = "wallets" type Addresses n = ListAddresses n + :<|> InspectAddress -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/listAddresses type ListAddresses n = "wallets" @@ -277,6 +283,11 @@ type ListAddresses n = "wallets" :> QueryParam "state" (ApiT AddressState) :> Get '[JSON] [ApiAddressT n] +-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/inspectAddress +type InspectAddress = "addresses" + :> Capture "addressId" Text + :> Get '[JSON] Aeson.Value + {------------------------------------------------------------------------------- Coin Selections diff --git a/lib/core/src/Cardano/Wallet/Api/Client.hs b/lib/core/src/Cardano/Wallet/Api/Client.hs index ec17738d2bd..ad9ba1a94e3 100644 --- a/lib/core/src/Cardano/Wallet/Api/Client.hs +++ b/lib/core/src/Cardano/Wallet/Api/Client.hs @@ -168,6 +168,9 @@ data AddressClient = AddressClient :: ApiT WalletId -> Maybe (ApiT AddressState) -> ClientM [Aeson.Value] + , inspectAddress + :: Text + -> ClientM Aeson.Value , postRandomAddress :: ApiT WalletId -> ApiPostRandomAddressData @@ -311,21 +314,25 @@ addressClient addressClient = let _listAddresses + :<|> _inspectAddress = client (Proxy @("v2" :> Addresses Aeson.Value)) in AddressClient { listAddresses = _listAddresses + , inspectAddress = _inspectAddress , postRandomAddress = \_ _ -> fail "feature unavailable." , putRandomAddress = \_ _ -> fail "feature unavailable." , putRandomAddresses = \_ _ -> fail "feature unavailable." } - -- | Produces an 'AddressClient n' working against the /wallets API byronAddressClient :: AddressClient byronAddressClient = let + _ :<|> _inspectAddress + = client (Proxy @("v2" :> Addresses Aeson.Value)) + _postRandomAddress :<|> _putRandomAddress :<|> _putRandomAddresses @@ -334,6 +341,7 @@ byronAddressClient = in AddressClient { listAddresses = _listAddresses + , inspectAddress = _inspectAddress , postRandomAddress = _postRandomAddress , putRandomAddress = _putRandomAddress , putRandomAddresses = _putRandomAddresses diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 8dfac48a6d3..7c4342569f5 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -314,7 +314,12 @@ import Control.Concurrent import Control.Concurrent.Async ( race_ ) import Control.Exception - ( IOException, bracket, throwIO, try, tryJust ) + ( IOException + , bracket + , throwIO + , try + , tryJust + ) import Control.Monad ( forM, forever, void, when, (>=>) ) import Control.Monad.Catch @@ -1194,7 +1199,6 @@ listAddresses ctx normalize (ApiT wid) stateFilter = do Just (ApiT s) -> (== s) . snd coerceAddress (a, s) = ApiAddress (ApiT a, Proxy @n) (ApiT s) - {------------------------------------------------------------------------------- Transactions -------------------------------------------------------------------------------} @@ -1998,6 +2002,9 @@ apiError err code message = err ] } +newtype ErrMalformedAddress = ErrMalformedAddress String + deriving (Eq, Show) + data ErrUnexpectedPoolIdPlaceholder = ErrUnexpectedPoolIdPlaceholder deriving (Eq, Show) @@ -2513,6 +2520,10 @@ instance LiftHandler ErrListPools where ErrListPoolsNetworkError e -> handler e ErrListPoolsPastHorizonException e -> handler e +instance LiftHandler ErrMalformedAddress where + handler = \case + ErrMalformedAddress e -> apiError err400 BadRequest (T.pack e) + instance LiftHandler (Request, ServerError) where handler (req, err@(ServerError code _ body headers)) | not (isJSON body) = case code of diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs index 21162a7b8ef..b76f04e59ef 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs @@ -164,8 +164,8 @@ server byron icarus jormungandr spl ntp = :<|> getUTxOsStatistics jormungandr addresses :: Server (Addresses n) - addresses = listAddresses jormungandr - (normalizeDelegationAddress @_ @JormungandrKey @n) + addresses = listAddresses jormungandr (normalizeDelegationAddress @_ @JormungandrKey @n) + :<|> (\_ -> throwError err501) coinSelections :: Server (CoinSelections n) coinSelections = selectCoins jormungandr (delegationAddress @n) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs index 1803c21b37d..c22dede1e57 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs @@ -105,12 +105,14 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random ( RndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( SeqState ) +import Cardano.Wallet.Shelley.Compatibility + ( inspectAddress ) import Cardano.Wallet.Shelley.Pools ( StakePoolLayer (..) ) import Control.Applicative ( liftA2 ) import Control.Monad.Trans.Except - ( throwE ) + ( except, throwE, withExceptT ) import Data.Coerce ( coerce ) import Data.Generics.Internal.VL.Lens @@ -119,15 +121,21 @@ import Data.Generics.Labels () import Data.List ( sortOn ) +import Data.Text.Class + ( TextDecodingError (..) ) import Fmt ( Buildable ) import Network.Ntp ( NtpClient ) import Servant ( (:<|>) (..), Handler (..), Server, err400 ) +import Servant.Server + ( ServerError (..) ) import Type.Reflection ( Typeable ) +import qualified Data.Text as T + server :: forall t n. ( Buildable (ErrValidateSelection t) @@ -167,8 +175,11 @@ server byron icarus shelley spl ntp = :<|> getUTxOsStatistics shelley addresses :: Server (Addresses n) - addresses = listAddresses shelley - (normalizeDelegationAddress @_ @ShelleyKey @n) + addresses = listAddresses shelley (normalizeDelegationAddress @_ @ShelleyKey @n) + :<|> (Handler . withExceptT toServerError . except . inspectAddress) + where + toServerError :: TextDecodingError -> ServerError + toServerError = apiError err400 BadRequest . T.pack . getTextDecodingError coinSelections :: Server (CoinSelections n) coinSelections = selectCoins shelley (delegationAddress @n) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index e3ef8a0f938..37db9e9aade 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -88,6 +88,7 @@ module Cardano.Wallet.Shelley.Compatibility , decentralizationLevelFromPParams -- * Utilities + , inspectAddress , invertUnitInterval , interval0 , interval1 @@ -95,8 +96,12 @@ module Cardano.Wallet.Shelley.Compatibility import Prelude +import Cardano.Address + ( unsafeMkAddress ) import Cardano.Address.Derivation ( XPub, xpubPublicKey ) +import Cardano.Address.Style.Shelley + ( inspectShelleyAddress ) import Cardano.Api.Shelley.Genesis ( ShelleyGenesis (..) ) import Cardano.Api.Typed @@ -133,7 +138,7 @@ import Control.Applicative import Control.Arrow ( left ) import Control.Monad - ( when ) + ( when, (>=>) ) import Crypto.Hash.Utils ( blake2b224 ) import Data.Bifunctor @@ -226,6 +231,7 @@ import qualified Cardano.Wallet.Primitive.Types as W import qualified Codec.Binary.Bech32 as Bech32 import qualified Codec.Binary.Bech32.TH as Bech32 import qualified Codec.CBOR.Decoding as CBOR +import qualified Data.Aeson as Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Short as SBS @@ -1004,6 +1010,35 @@ instance DecodeAddress 'Mainnet where instance DecodeAddress ('Testnet pm) where decodeAddress = _decodeAddress SL.Testnet +decodeBytes :: Text -> Either TextDecodingError ByteString +decodeBytes t = + case tryBase16 t <|> tryBech32 t <|> tryBase58 t of + Just bytes -> + Right bytes + _ -> + Left $ TextDecodingError + "Unrecognized address encoding: must be either bech32, base58 or base16" + +-- | Attempt decoding an 'Address' using a Bech32 encoding. +tryBech32 :: Text -> Maybe ByteString +tryBech32 text = do + (_, dp) <- either (const Nothing) Just (Bech32.decodeLenient text) + dataPartToBytes dp + +-- | Attempt decoding a legacy 'Address' using a Base58 encoding. +tryBase58 :: Text -> Maybe ByteString +tryBase58 text = + decodeBase58 bitcoinAlphabet (T.encodeUtf8 text) + +-- | Attempt decoding an 'Address' using Base16 encoding +tryBase16 :: Text -> Maybe ByteString +tryBase16 text = + either (const Nothing) Just $ convertFromBase Base16 (T.encodeUtf8 text) + +errMalformedAddress :: TextDecodingError +errMalformedAddress = TextDecodingError + "Unable to decode address: not a well-formed Shelley nor Byron address." + -- Note that for 'Byron', we always assume no discrimination. In -- practice, there is one discrimination for 'Shelley' addresses, and one for -- 'Byron' addresses. Yet, on Mainnet, 'Byron' addresses have no explicit @@ -1012,30 +1047,9 @@ _decodeAddress :: SL.Network -> Text -> Either TextDecodingError W.Address -_decodeAddress serverNetwork text = - case tryBase16 <|> tryBech32 <|> tryBase58 of - Just bytes -> - decodeShelleyAddress @StandardCrypto bytes - _ -> - Left $ TextDecodingError - "Unrecognized address encoding: must be either bech32, base58 or base16" +_decodeAddress serverNetwork = + decodeBytes >=> decodeShelleyAddress @StandardCrypto where - -- | Attempt decoding an 'Address' using a Bech32 encoding. - tryBech32 :: Maybe ByteString - tryBech32 = do - (_, dp) <- either (const Nothing) Just (Bech32.decodeLenient text) - dataPartToBytes dp - - -- | Attempt decoding a legacy 'Address' using a Base58 encoding. - tryBase58 :: Maybe ByteString - tryBase58 = - decodeBase58 bitcoinAlphabet (T.encodeUtf8 text) - - -- | Attempt decoding an 'Address' using Base16 encoding - tryBase16 :: Maybe ByteString - tryBase16 = - either (const Nothing) Just $ convertFromBase Base16 (T.encodeUtf8 text) - decodeShelleyAddress :: forall c. (SL.Crypto c) => ByteString -> Either TextDecodingError W.Address decodeShelleyAddress bytes = do case SL.deserialiseAddr @(SL.Shelley c) bytes of @@ -1047,8 +1061,7 @@ _decodeAddress serverNetwork text = guardNetwork (toNetwork (Byron.addrNetworkMagic addr)) serverNetwork pure (W.Address bytes) - Nothing -> Left $ TextDecodingError - "Unable to decode address: not a well-formed Shelley nor Byron address." + Nothing -> Left errMalformedAddress where toNetwork :: Byron.NetworkMagic -> SL.Network @@ -1056,6 +1069,19 @@ _decodeAddress serverNetwork text = Byron.NetworkMainOrStage -> SL.Mainnet Byron.NetworkTestnet{} -> SL.Testnet +-- FIXME: 'cardano-addresses' currently gives us an opaque 'Value'. It'd be +-- nicer to model this as a proper Haskell type and to serialize in due times. +inspectAddress + :: Text + -> Either TextDecodingError Aeson.Value +inspectAddress = + decodeBytes >=> inspect + where + inspect :: ByteString -> Either TextDecodingError Aeson.Value + inspect = maybe (Left errMalformedAddress) Right + . inspectShelleyAddress + . unsafeMkAddress + toHDPayloadAddress :: W.Address -> Maybe Byron.HDAddressPayload toHDPayloadAddress (W.Address addr) = do payload <- CBOR.deserialiseCbor CBOR.decodeAddressPayload addr diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 3f948f8e16d..06903f9f076 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -947,6 +947,72 @@ components: id: *addressId state: *addressState + ApiAddressInspect: &ApiAddressInspect + type: object + required: + - address_style + - stake_reference + - network_tag + properties: + address_style: + type: string + enum: + - Shelley + - Icarus + - Byron + stake_reference: + type: string + enum: + - none + - by value + - by pointer + network_tag: + description: Can only be null for 'Icarus' and 'Byron' styles. + oneOf: + - type: integer + minimum: 0 + - type: 'null' + spending_key_hash: + type: string + format: base16 + minimum_length: '56' + maximum_length: '56' + stake_key_hash: + type: string + format: base16 + minimum_length: '56' + maximum_length: '56' + script_hash: + type: string + format: base16 + minimum_length: '64' + maximum_length: '64' + pointer: + type: object + additionalProperties: false + required: + - slot_num + - transaction_index + - output_index + properties: + slot_num: + type: integer + minimum: 0 + transaction_index: + type: integer + minimum: 0 + output_index: + type: integer + minimum: 0 + address_root: + description: Only for 'Icarus' and 'Byron' styles. + type: string + format: base16 + derivation_path: + description: Only for 'Byron' style. + type: string + format: base16 + ApiNetworkTip: &ApiNetworkTip description: A network tip type: object @@ -2077,6 +2143,17 @@ x-responsesPutRandomAddresses: &responsesPutRandomAddresses 204: description: No Content +x-responsesInspectAddress: &responsesInspectAddress + <<: *responsesErr400 + <<: *responsesErr405 + <<: *responsesErr415 + 200: + description: Ok + content: + application/json: + schema: *ApiAddressInspect + + ############################################################################# # # # PATHS # @@ -2853,3 +2930,16 @@ paths: application/octet-stream: schema: *signedTransactionBlob responses: *responsesPostExternalTransaction + + /addresses/{addressId}: + get: + operationId: inspectAddress + tags: ["Addresses", "Byron Addresses"] + summary: Inspect Address + description: | +

status: stable

+ + Give useful information about the structure of a given address. + parameters: + - *parametersAddressId + responses: *responsesInspectAddress From 49e5000ecccf49f5f3bc65946f2e75b74960e95e Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 24 Sep 2020 18:04:23 +0200 Subject: [PATCH 2/2] add unit and integration tests for the new 'inspectAddress' function & endpoint --- .../Scenario/API/Shelley/Addresses.hs | 11 +++ lib/core/src/Cardano/Wallet/Api.hs | 10 ++- lib/core/src/Cardano/Wallet/Api/Client.hs | 12 +++- lib/core/src/Cardano/Wallet/Api/Link.hs | 10 ++- lib/core/src/Cardano/Wallet/Api/Server.hs | 14 +--- lib/core/src/Cardano/Wallet/Api/Types.hs | 25 +++++++ .../test/unit/Cardano/Wallet/Api/Malformed.hs | 11 ++- .../test/unit/Cardano/Wallet/Api/TypesSpec.hs | 15 ++++- .../src/Cardano/Wallet/Shelley/Api/Server.hs | 10 ++- .../Wallet/Shelley/CompatibilitySpec.hs | 67 ++++++++++++++++++- specifications/api/swagger.yaml | 26 +++---- 11 files changed, 169 insertions(+), 42 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs index 152aeba3b69..87277a45042 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs @@ -61,6 +61,7 @@ import Test.Integration.Framework.TestData ( errMsg404NoWallet ) import qualified Cardano.Wallet.Api.Link as Link +import qualified Data.Aeson as Aeson import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP @@ -224,3 +225,13 @@ spec = describe "SHELLEY_ADDRESSES" $ do (Link.listAddresses @'Shelley w) Default Empty expectResponseCode @IO HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r + + it "ADDRESS_INSPECT_01 - Address inspect OK" $ \ctx -> do + let str = "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + r <- request @Aeson.Value ctx (Link.inspectAddress str) Default Empty + expectResponseCode @IO HTTP.status200 r + + it "ADDRESS_INSPECT_02 - Address inspect KO" $ \ctx -> do + let str = "patate" + r <- request @Aeson.Value ctx (Link.inspectAddress str) Default Empty + expectResponseCode @IO HTTP.status400 r diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs index d26335a7e70..cafae55ddcb 100644 --- a/lib/core/src/Cardano/Wallet/Api.hs +++ b/lib/core/src/Cardano/Wallet/Api.hs @@ -106,6 +106,8 @@ import Cardano.Wallet ( WalletLayer (..), WalletLog ) import Cardano.Wallet.Api.Types ( ApiAddressIdT + , ApiAddressInspect + , ApiAddressInspectData , ApiAddressT , ApiByronWallet , ApiCoinSelectionT @@ -164,8 +166,6 @@ import Data.Generics.Labels () import Data.Generics.Product.Typed ( HasType, typed ) -import Data.Text - ( Text ) import GHC.Generics ( Generic ) import Servant.API @@ -190,8 +190,6 @@ import Servant.API.Verbs , PutNoContent ) -import qualified Data.Aeson as Aeson - type ApiV2 n apiPool = "v2" :> Api n apiPool -- | The full cardano-wallet API. @@ -285,8 +283,8 @@ type ListAddresses n = "wallets" -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/inspectAddress type InspectAddress = "addresses" - :> Capture "addressId" Text - :> Get '[JSON] Aeson.Value + :> Capture "addressId" ApiAddressInspectData + :> Get '[JSON] ApiAddressInspect {------------------------------------------------------------------------------- Coin Selections diff --git a/lib/core/src/Cardano/Wallet/Api/Client.hs b/lib/core/src/Cardano/Wallet/Api/Client.hs index ad9ba1a94e3..c8c11b5c160 100644 --- a/lib/core/src/Cardano/Wallet/Api/Client.hs +++ b/lib/core/src/Cardano/Wallet/Api/Client.hs @@ -58,6 +58,8 @@ import Cardano.Wallet.Api ) import Cardano.Wallet.Api.Types ( ApiAddressIdT + , ApiAddressInspect (..) + , ApiAddressInspectData (..) , ApiAddressT , ApiByronWallet , ApiCoinSelectionT @@ -319,7 +321,10 @@ addressClient = in AddressClient { listAddresses = _listAddresses - , inspectAddress = _inspectAddress + , inspectAddress = + fmap unApiAddressInspect + . _inspectAddress + . ApiAddressInspectData , postRandomAddress = \_ _ -> fail "feature unavailable." , putRandomAddress = \_ _ -> fail "feature unavailable." , putRandomAddresses = \_ _ -> fail "feature unavailable." @@ -341,7 +346,10 @@ byronAddressClient = in AddressClient { listAddresses = _listAddresses - , inspectAddress = _inspectAddress + , inspectAddress = + fmap unApiAddressInspect + . _inspectAddress + . ApiAddressInspectData , postRandomAddress = _postRandomAddress , putRandomAddress = _putRandomAddress , putRandomAddresses = _putRandomAddresses diff --git a/lib/core/src/Cardano/Wallet/Api/Link.hs b/lib/core/src/Cardano/Wallet/Api/Link.hs index 4e3bb8aecb3..acb91e0f913 100644 --- a/lib/core/src/Cardano/Wallet/Api/Link.hs +++ b/lib/core/src/Cardano/Wallet/Api/Link.hs @@ -53,6 +53,7 @@ module Cardano.Wallet.Api.Link , putRandomAddresses , listAddresses , listAddresses' + , inspectAddress -- * CoinSelections , selectCoins @@ -88,7 +89,8 @@ module Cardano.Wallet.Api.Link import Prelude import Cardano.Wallet.Api.Types - ( ApiPoolId (..) + ( ApiAddressInspectData (..) + , ApiPoolId (..) , ApiT (..) , ApiTxId (ApiTxId) , Iso8601Time @@ -299,6 +301,12 @@ listAddresses' w mstate = discriminate @style where wid = w ^. typed @(ApiT WalletId) +inspectAddress + :: ApiAddressInspectData + -> (Method, Text) +inspectAddress addr = + endpoint @Api.InspectAddress (addr &) + -- -- Coin Selections -- diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 7c4342569f5..496621070dd 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -314,12 +314,7 @@ import Control.Concurrent import Control.Concurrent.Async ( race_ ) import Control.Exception - ( IOException - , bracket - , throwIO - , try - , tryJust - ) + ( IOException, bracket, throwIO, try, tryJust ) import Control.Monad ( forM, forever, void, when, (>=>) ) import Control.Monad.Catch @@ -2002,9 +1997,6 @@ apiError err code message = err ] } -newtype ErrMalformedAddress = ErrMalformedAddress String - deriving (Eq, Show) - data ErrUnexpectedPoolIdPlaceholder = ErrUnexpectedPoolIdPlaceholder deriving (Eq, Show) @@ -2520,10 +2512,6 @@ instance LiftHandler ErrListPools where ErrListPoolsNetworkError e -> handler e ErrListPoolsPastHorizonException e -> handler e -instance LiftHandler ErrMalformedAddress where - handler = \case - ErrMalformedAddress e -> apiError err400 BadRequest (T.pack e) - instance LiftHandler (Request, ServerError) where handler (req, err@(ServerError code _ body headers)) | not (isJSON body) = case code of diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index ca7afdf3f21..5d368a02a40 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -72,6 +72,8 @@ module Cardano.Wallet.Api.Types , ApiTxInput (..) , ApiTxMetadata (..) , AddressAmount (..) + , ApiAddressInspect (..) + , ApiAddressInspectData (..) , ApiErrorCode (..) , ApiNetworkInformation (..) , ApiNtpStatus (..) @@ -244,6 +246,8 @@ import Data.Proxy ( Proxy (..) ) import Data.Quantity ( Percentage, Quantity (..) ) +import Data.String + ( IsString ) import Data.Text ( Text, split ) import Data.Text.Class @@ -638,6 +642,15 @@ data AddressAmount addr = AddressAmount , amount :: !(Quantity "lovelace" Natural) } deriving (Eq, Generic, Show) +newtype ApiAddressInspect = ApiAddressInspect + { unApiAddressInspect :: Aeson.Value } + deriving (Eq, Generic, Show) + +newtype ApiAddressInspectData = ApiAddressInspectData + { unApiAddressInspectData :: Text } + deriving (Eq, Generic, Show) + deriving newtype (IsString) + data ApiTimeReference = ApiTimeReference { time :: !UTCTime , block :: !ApiBlockReference @@ -1530,6 +1543,12 @@ instance ToJSON ApiWalletDiscovery where toJSON = genericToJSON $ Aeson.defaultOptions { constructorTagModifier = drop 1 . dropWhile (/= '_') . camelTo2 '_' } +instance ToJSON ApiAddressInspect where + toJSON = unApiAddressInspect + +instance FromJSON ApiAddressInspect where + parseJSON = pure . ApiAddressInspect + {------------------------------------------------------------------------------- FromText/ToText instances -------------------------------------------------------------------------------} @@ -1591,6 +1610,12 @@ instance ToHttpApiData ApiPoolId where ApiPoolIdPlaceholder -> "*" ApiPoolId pid -> encodePoolIdBech32 pid +instance FromHttpApiData ApiAddressInspectData where + parseUrlPiece = pure . ApiAddressInspectData + +instance ToHttpApiData ApiAddressInspectData where + toUrlPiece = unApiAddressInspectData + {------------------------------------------------------------------------------- Aeson Options -------------------------------------------------------------------------------} diff --git a/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs b/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs index 664df5f02fe..045406de1b8 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs @@ -50,7 +50,8 @@ module Cardano.Wallet.Api.Malformed import Prelude import Cardano.Wallet.Api.Types - ( ApiNetworkTip + ( ApiAddressInspectData + , ApiNetworkTip , ApiPoolId , ApiPostRandomAddressData , ApiPutAddressesData @@ -171,6 +172,14 @@ instance Wellformed (PathParam (ApiT Address, Proxy ('Testnet 0))) where instance Malformed (PathParam (ApiT Address, Proxy ('Testnet 0))) where malformed = [] +instance Wellformed (PathParam ApiAddressInspectData) where + wellformed = PathParam <$> + [ "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + ] + +instance Malformed (PathParam ApiAddressInspectData) where + malformed = [] + -- -- Class instances (BodyParam) -- diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index 2035bff90d0..800d681ab74 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs @@ -46,6 +46,7 @@ import Cardano.Wallet.Api.Types , ApiAddressDerivationPath (..) , ApiAddressDerivationSegment (..) , ApiAddressDerivationType (..) + , ApiAddressInspect (..) , ApiBlockReference (..) , ApiByronWallet (..) , ApiByronWalletBalance (..) @@ -173,7 +174,7 @@ import Control.Monad.IO.Class import Crypto.Hash ( hash ) import Data.Aeson - ( FromJSON (..), ToJSON (..) ) + ( FromJSON (..), ToJSON (..), (.=) ) import Data.Aeson.QQ ( aesonQQ ) import Data.Char @@ -1456,6 +1457,15 @@ instance Arbitrary ApiPostRandomAddressData where arbitrary = genericArbitrary shrink = genericShrink +instance Arbitrary ApiAddressInspect where + arbitrary = do + style <- elements [ "Byron", "Icarus", "Shelley" ] + stake <- elements [ "none", "by value", "by pointer" ] + pure $ ApiAddressInspect $ Aeson.object + [ "address_style" .= Aeson.String style + , "stake_reference" .= Aeson.String stake + ] + {------------------------------------------------------------------------------- Specification / Servant-Swagger Machinery @@ -1511,6 +1521,9 @@ specification = instance ToSchema (ApiAddress t) where declareNamedSchema _ = declareSchemaForDefinition "ApiAddress" +instance ToSchema ApiAddressInspect where + declareNamedSchema _ = declareSchemaForDefinition "ApiAddressInspect" + instance ToSchema (ApiPutAddressesData t) where declareNamedSchema _ = declareSchemaForDefinition "ApiPutAddressesData" diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs index c22dede1e57..25ad3061aa0 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs @@ -88,7 +88,9 @@ import Cardano.Wallet.Api.Server , withLegacyLayer' ) import Cardano.Wallet.Api.Types - ( ApiErrorCode (..) + ( ApiAddressInspect (..) + , ApiAddressInspectData (..) + , ApiErrorCode (..) , ApiStakePool , ApiT (..) , SomeByronWalletPostData (..) @@ -176,11 +178,15 @@ server byron icarus shelley spl ntp = addresses :: Server (Addresses n) addresses = listAddresses shelley (normalizeDelegationAddress @_ @ShelleyKey @n) - :<|> (Handler . withExceptT toServerError . except . inspectAddress) + :<|> (handler ApiAddressInspect . inspectAddress . unApiAddressInspectData) where toServerError :: TextDecodingError -> ServerError toServerError = apiError err400 BadRequest . T.pack . getTextDecodingError + handler :: (a -> result) -> Either TextDecodingError a -> Handler result + handler transform = + Handler . withExceptT toServerError . except . fmap transform + coinSelections :: Server (CoinSelections n) coinSelections = selectCoins shelley (delegationAddress @n) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs index 276e05ce661..5113999b319 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs @@ -56,6 +56,7 @@ import Cardano.Wallet.Shelley.Compatibility , StandardCrypto , decentralizationLevelFromPParams , fromTip + , inspectAddress , interval0 , interval1 , invertUnitInterval @@ -74,6 +75,8 @@ import Data.ByteString ( ByteString ) import Data.ByteString.Base58 ( bitcoinAlphabet, encodeBase58 ) +import Data.Either + ( isLeft, isRight ) import Data.Function ( (&) ) import Data.Proxy @@ -91,7 +94,7 @@ import GHC.TypeLits import Ouroboros.Network.Block ( BlockNo (..), Point, SlotNo (..), Tip (..), getTipPoint ) import Test.Hspec - ( Spec, describe, it, shouldBe ) + ( Spec, describe, it, shouldBe, shouldSatisfy ) import Test.Hspec.QuickCheck ( prop ) import Test.QuickCheck @@ -226,6 +229,68 @@ spec = do let half = SL.truncateUnitInterval (1 % 2) in invertUnitInterval half `shouldBe` half + describe "InspectAddr" $ do + -- Cases below are taken straight from cardano-addresses. We don't go in + -- depth with testing here because this is already tested on + -- cardano-addresses. + let matrix = + [ ( "Byron (1)" + , "37btjrVyb4KEgoGCHJ7XFaJRLBRiVuvcrQWPpp4HeaxdTxhKwQjXHNKL43\ + \NhXaQNa862BmxSFXZFKqPqbxRc3kCUeTRMwjJevFeCKokBG7A7num5Wh" + , isRight + ) + , ( "Byron (2)" + , "DdzFFzCqrht5csm2GKhnVrjzKpVHHQFNXUDhAFDyLWVY5w8ZsJRP2uhwZ\ + \q2CEAVzDZXYXa4GvggqYEegQsdKAKikFfrrCoHheLH2Jskr" + , isRight + ) + , ( "Icarus" + , "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" + , isRight + ) + , ( "Shelley (base)" + , "addr1vpu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5eg0yu80w" + , isRight + ) + , ( "Shelley (stake by value)" + , "addr1qdu5vlrf4xkxv2qpwngf6cjhtw542ayty80v8dyr49rf5ew\ + \vxwdrt70qlcpeeagscasafhffqsxy36t90ldv06wqrk2q5ggg4z" + , isRight + ) + , ( "Shelley (stake by pointer)" + , "addr1gw2fxv2umyhttkxyxp8x0dlpdt3k6cwng5pxj3jhsydzer5ph3wczvf2x4v58t" + , isRight + ) + , ( "Shelley (reward by key)" + , "stake1upshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mqcjv83c" + , isRight + ) + , ( "Shelley (reward by script)" + , "stake17pshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mrgdp5xscfm7jc" + , isRight + ) + , ( "Shelley (testnet 1)" + , "addr_test1qpwr8l57ceql23ylyprl6qgct239lxph8clwxy5w8r4qdz8ct9uut5a\ + \hmxqkgwy9ecn5carsv39frsgsq09u70wmqwhqjqcjqs" + , isRight + ) + , ( "Shelley (testnet 2)" + , "stake_test1uru9j7w96wmanqty8zzuuf6vw3cxgj53cygq8j708hds8tsntl0j7" + , isRight + ) + , ( "Malformed (1)" + , "💩" + , isLeft + ) + , ( "Malformed (2)" + , "79467c69a9ac66280174d09d62575ba955748b21dec3b483a9469a65" + , isLeft + ) + ] + + forM_ matrix $ \(title, addr, predicate) -> + it title $ inspectAddress addr `shouldSatisfy` predicate + instance Arbitrary (Hash "Genesis") where arbitrary = Hash . BS.pack <$> vector 32 diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 06903f9f076..f35b429eceb 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -950,9 +950,8 @@ components: ApiAddressInspect: &ApiAddressInspect type: object required: - - address_style - - stake_reference - - network_tag + - address_style + - stake_reference properties: address_style: type: string @@ -967,26 +966,24 @@ components: - by value - by pointer network_tag: - description: Can only be null for 'Icarus' and 'Byron' styles. - oneOf: - - type: integer - minimum: 0 - - type: 'null' + description: Can be null for 'Icarus' and 'Byron' styles. + type: integer + minimum: 0 spending_key_hash: type: string format: base16 - minimum_length: '56' - maximum_length: '56' + minLength: 56 + maxLength: 56 stake_key_hash: type: string format: base16 - minimum_length: '56' - maximum_length: '56' + minLength: 56 + maxLength: 56 script_hash: type: string format: base16 - minimum_length: '64' - maximum_length: '64' + minLength: 64 + maxLength: 64 pointer: type: object additionalProperties: false @@ -2153,7 +2150,6 @@ x-responsesInspectAddress: &responsesInspectAddress application/json: schema: *ApiAddressInspect - ############################################################################# # # # PATHS #