From 1e613670e348827651b6a0ee8811d6b6770499b9 Mon Sep 17 00:00:00 2001 From: Ante Kegalj Date: Thu, 28 Jun 2018 12:40:00 +0200 Subject: [PATCH] Akegalj/co 319/swagger account index (#3086) * [CO-319] Fix account index swagger example * [CO-319] Add roundtrip tests * [CO-319] Fix recursive buildable instances * [CO-319] Use strongly typed error * [CO-319] Remove duplication in 'renderAccountIndexError' * [CO-319] Distangle V1/Errors This makes it now possible to import V1/Errors from the V1/Types module and leverage errors from this module. One thing is still unclear to me: Why Errors isn't defined in V1/Types already? There's a circular dependency between V1/Response and V1/Types if we go this way, as well as between V1/Migration and V1/Types. Nevertheless, it would make sense to have three data-types here: - WalletError (defined in V1/Types) - MigrationError (defined in V1/Types) - JSONParsingError (defined in Response) This way, we could remove the conflicting constructor from WalletError and remove the need for an extra module here. It will also makes thing clearer * [CO-319] Make V1/Error part of V1/Types To realize this, we had to extract JSONValidationFailed and MigrationFailed constructor from WalletError. They're now defined as constructor in different data-types (resp. JSONValidationError and MigrationError). * [CO-319] Solve rebase conflicts * [CO-319] Correctly format (jsend) newtype errors This is rather ugly and could probably be achieved nicely with a better understanding of the Generics.SOP library. As far as I could tell, there's no easy way to retrieve 'Tag' for single constructor (cf: 'For a datatype with a single constructor we do not need to tag values with their constructor; but for a datatype with multiple constructors we do. ') --- wallet-new/cardano-sl-wallet-new.cabal | 1 + wallet-new/integration/TransactionSpecs.hs | 8 +- wallet-new/integration/WalletSpecs.hs | 2 - wallet-new/src/Cardano/Wallet/API/Response.hs | 91 +++- .../src/Cardano/Wallet/API/V1/Errors.hs | 450 +---------------- .../src/Cardano/Wallet/API/V1/Generic.hs | 59 ++- .../src/Cardano/Wallet/API/V1/Headers.hs | 11 + .../Wallet/API/V1/LegacyHandlers/Addresses.hs | 1 - .../API/V1/LegacyHandlers/Transactions.hs | 29 +- .../Wallet/API/V1/LegacyHandlers/Wallets.hs | 1 - .../Cardano/Wallet/API/V1/Migration/Types.hs | 117 ++++- .../src/Cardano/Wallet/API/V1/Swagger.hs | 75 ++- .../Cardano/Wallet/API/V1/Swagger/Example.hs | 3 +- wallet-new/src/Cardano/Wallet/API/V1/Types.hs | 477 ++++++++++++++++-- wallet-new/src/Cardano/Wallet/Client.hs | 7 +- .../src/Cardano/Wallet/Server/Plugins.hs | 17 +- .../Wallet/WalletLayer/Kernel/Active.hs | 2 +- .../Cardano/Wallet/WalletLayer/Kernel/Conv.hs | 10 +- .../Wallet/WalletLayer/Kernel/Transactions.hs | 2 +- wallet-new/test/MarshallingSpec.hs | 37 +- 20 files changed, 818 insertions(+), 582 deletions(-) create mode 100644 wallet-new/src/Cardano/Wallet/API/V1/Headers.hs diff --git a/wallet-new/cardano-sl-wallet-new.cabal b/wallet-new/cardano-sl-wallet-new.cabal index 40172459a1c..fa2d6aa6a00 100755 --- a/wallet-new/cardano-sl-wallet-new.cabal +++ b/wallet-new/cardano-sl-wallet-new.cabal @@ -44,6 +44,7 @@ library Cardano.Wallet.API.V1.Handlers.Addresses Cardano.Wallet.API.V1.Handlers.Transactions Cardano.Wallet.API.V1.Handlers.Wallets + Cardano.Wallet.API.V1.Headers Cardano.Wallet.API.V1.Info Cardano.Wallet.API.V1.LegacyHandlers Cardano.Wallet.API.V1.LegacyHandlers.Accounts diff --git a/wallet-new/integration/TransactionSpecs.hs b/wallet-new/integration/TransactionSpecs.hs index 3e1955d5e71..89dc730e515 100644 --- a/wallet-new/integration/TransactionSpecs.hs +++ b/wallet-new/integration/TransactionSpecs.hs @@ -5,14 +5,14 @@ module TransactionSpecs (transactionSpecs) where import Universum -import Cardano.Wallet.API.V1.Errors hiding (describe) import Cardano.Wallet.Client.Http +import Control.Concurrent (threadDelay) import Control.Lens -import qualified Pos.Core as Core import Test.Hspec - -import Control.Concurrent (threadDelay) import Text.Show.Pretty (ppShow) + +import qualified Pos.Core as Core + import Util {-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-} diff --git a/wallet-new/integration/WalletSpecs.hs b/wallet-new/integration/WalletSpecs.hs index f04e99d2788..e16749f3177 100644 --- a/wallet-new/integration/WalletSpecs.hs +++ b/wallet-new/integration/WalletSpecs.hs @@ -5,8 +5,6 @@ module WalletSpecs (walletSpecs) where import Universum -import Cardano.Wallet.API.V1.Errors - (WalletError (WalletAlreadyExists)) import Cardano.Wallet.Client.Http import Control.Lens import Test.Hspec diff --git a/wallet-new/src/Cardano/Wallet/API/Response.hs b/wallet-new/src/Cardano/Wallet/API/Response.hs index f2c6b5326e6..7fa136ec505 100644 --- a/wallet-new/src/Cardano/Wallet/API/Response.hs +++ b/wallet-new/src/Cardano/Wallet/API/Response.hs @@ -1,10 +1,12 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLists #-} module Cardano.Wallet.API.Response ( Metadata (..) , ResponseStatus(..) , WalletResponse(..) + , JSONValidationError(..) -- * Generating responses for collections , respondWith , fromSlice @@ -18,39 +20,42 @@ module Cardano.Wallet.API.Response ( ) where import Prelude -import Universum (Buildable, decodeUtf8, toText, (<>)) +import Universum (Buildable, Exception, Text, decodeUtf8, toText, + (<>)) +import Cardano.Wallet.API.Indices (Indexable', IxSet') +import Cardano.Wallet.API.Request (RequestParams (..)) +import Cardano.Wallet.API.Request.Filter (FilterOperations (..)) +import Cardano.Wallet.API.Request.Pagination (Page (..), + PaginationMetadata (..), PaginationParams (..), + PerPage (..)) +import Cardano.Wallet.API.Request.Sort (SortOperations (..)) +import Cardano.Wallet.API.Response.Filter.IxSet as FilterBackend import Cardano.Wallet.API.Response.JSend (ResponseStatus (..)) +import Cardano.Wallet.API.Response.Sort.IxSet as SortBackend +import Cardano.Wallet.API.V1.Errors (ToServantError (..)) import Cardano.Wallet.API.V1.Swagger.Example (Example, example) -import Control.Lens -import Data.Aeson +import Control.Lens hiding ((.=)) +import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecode, encode, + object, pairs, (.:), (.=)) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.TH +import Data.Aeson.Types (Value (..), typeMismatch) import Data.Swagger as S hiding (Example, example) import Data.Typeable import Formatting (bprint, build, (%)) +import Generics.SOP.TH (deriveGeneric) import GHC.Generics (Generic) +import Servant (err400) import Servant.API.ContentTypes (Accept (..), JSON, MimeRender (..), MimeUnrender (..), OctetStream) import Test.QuickCheck -import Cardano.Wallet.API.Indices (Indexable', IxSet') -import Cardano.Wallet.API.Request (RequestParams (..)) -import Cardano.Wallet.API.Request.Filter (FilterOperations (..)) -import Cardano.Wallet.API.Request.Pagination (Page (..), - PaginationMetadata (..), PaginationParams (..), - PerPage (..)) -import Cardano.Wallet.API.Request.Sort (SortOperations (..)) -import Cardano.Wallet.API.Response.Filter.IxSet as FilterBackend -import Cardano.Wallet.API.Response.Sort.IxSet as SortBackend -import Cardano.Wallet.API.V1.Errors - (WalletError (JSONValidationFailed)) - import qualified Data.Aeson.Options as Serokell import qualified Data.Char as Char +import qualified Data.HashMap.Strict as HMS import qualified Formatting.Buildable - -- | Extra information associated with an HTTP response. data Metadata = Metadata { metaPagination :: PaginationMetadata @@ -166,7 +171,7 @@ respondWith :: (Monad m, Indexable' a) -> m (WalletResponse [a]) respondWith RequestParams{..} fops sorts generator = do (theData, paginationMetadata) <- paginate rpPaginationParams . sortData sorts . applyFilters fops <$> generator - return $ WalletResponse { + return WalletResponse { wrData = theData , wrStatus = SuccessStatus , wrMeta = Metadata paginationMetadata @@ -225,3 +230,55 @@ instance Accept ValidJSON where instance ToJSON a => MimeRender ValidJSON a where mimeRender _ = mimeRender (Proxy @ JSON) + + +-- +-- Error from parsing / validating JSON inputs +-- + +newtype JSONValidationError + = JSONValidationFailed Text + deriving (Generic, Show, Eq) + +deriveGeneric ''JSONValidationError + +instance ToJSON JSONValidationError where + toEncoding (JSONValidationFailed weValidationError) = pairs $ mconcat + [ "message" .= String "JSONValidationFailed" + , "status" .= String "error" + , "diagnostic" .= object + [ "validationError" .= weValidationError + ] + ] + +instance FromJSON JSONValidationError where + parseJSON (Object o) + | HMS.member "message" o = + case HMS.lookup "message" o of + Just "JSONValidationFailed" -> + JSONValidationFailed <$> ((o .: "diagnostic") >>= (.: "validationError")) + _ -> + fail "Incorrect JSON encoding for JSONValidationError" + + | otherwise = + fail "Incorrect JSON encoding for JSONValidationError" + + parseJSON invalid = + typeMismatch "JSONValidationError" invalid + +instance Exception JSONValidationError + +instance Arbitrary JSONValidationError where + arbitrary = oneof + [ pure $ JSONValidationFailed "JSON validation failed." + ] + +instance Buildable JSONValidationError where + build = \case + JSONValidationFailed _ -> + bprint "Couldn't decode a JSON input." + +instance ToServantError JSONValidationError where + declareServantError = \case + JSONValidationFailed _ -> + err400 diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Errors.hs b/wallet-new/src/Cardano/Wallet/API/V1/Errors.hs index bb16635288e..78352ca4bf5 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Errors.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Errors.hs @@ -1,439 +1,27 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - module Cardano.Wallet.API.V1.Errors where import Universum -import Data.Aeson -import Data.Aeson.Encoding (pairStr) -import Data.Aeson.Types (Value (..), typeMismatch) -import qualified Data.HashMap.Strict as HMS -import Data.List.NonEmpty (NonEmpty ((:|))) +import Cardano.Wallet.API.V1.Headers (applicationJson) +import Data.Aeson (ToJSON, encode) import Formatting (build, sformat) -import Generics.SOP.TH (deriveGeneric) -import qualified Network.HTTP.Types as HTTP -import qualified Pos.Client.Txp.Util as TxError -import qualified Pos.Core as Core -import qualified Pos.Core.Attributes as Core -import qualified Pos.Crypto.Hashing as Crypto -import Pos.Util.Util (aesonError) -import Servant -import Test.QuickCheck (Arbitrary (..), oneof) - -import Cardano.Wallet.API.V1.Types (SyncPercentage, SyncProgress (..), - V1 (..), WalletId, exampleWalletId, - mkEstimatedCompletionTime, mkSyncPercentage, - mkSyncThroughput) - - --- --- Error handling --- - --- | Type representing any error which might be thrown by wallet. --- --- Errors are represented in JSON in the JSend format (): --- ``` --- { --- "status": "error" --- "message" : , --- "diagnostic" : --- } --- ``` --- where `` is a string containing name of error's constructor (e. g. `NotEnoughMoney`), --- and `` is an object containing additional error data. --- Additional data contains constructor fields, field names are record field names without --- a `we` prefix, e. g. for `OutputIsRedeem` error "diagnostic" field will be the following: --- ``` --- { --- "address" :
--- } --- ``` --- --- Additional data in constructor should be represented as record fields. --- Otherwise TemplateHaskell will raise an error. --- --- If constructor does not have additional data (like in case of `WalletNotFound` error), --- then "diagnostic" field will be empty object. --- --- TODO: change fields' types to actual Cardano core types, like `Coin` and `Address` -data WalletError = - -- | NotEnoughMoney weNeedMore - NotEnoughMoney !Int - -- | OutputIsRedeem weAddress - | OutputIsRedeem !(V1 Core.Address) - -- | MigrationFailed weDescription - | MigrationFailed !Text - -- | JSONValidationFailed weValidationError - | JSONValidationFailed !Text - -- | UnknownError weMsg - | UnknownError !Text - -- | InvalidAddressFormat weMsg - | InvalidAddressFormat !Text - | WalletNotFound - -- FIXME(akegalj): https://iohk.myjetbrains.com/youtrack/issue/CSL-2496 - | WalletAlreadyExists { weWalletId :: WalletId } - | AddressNotFound - | TxFailedToStabilize - | InvalidPublicKey !Text - | UnsignedTxCreationError - | TooBigTransaction - -- ^ Size of transaction (in bytes) is greater than maximum. - | SignedTxSubmitError !Text - | TxRedemptionDepleted - -- | TxSafeSignerNotFound weAddress - | TxSafeSignerNotFound !(V1 Core.Address) - -- | MissingRequiredParams requiredParams - | MissingRequiredParams !(NonEmpty (Text, Text)) - -- | WalletIsNotReadyToProcessPayments weStillRestoring - | CannotCreateAddress !Text - -- ^ Cannot create derivation path for new address (for external wallet). - | WalletIsNotReadyToProcessPayments !SyncProgress - -- ^ The @Wallet@ where a @Payment@ is being originated is not fully - -- synced (its 'WalletSyncState' indicates it's either syncing or - -- restoring) and thus cannot accept new @Payment@ requests. - -- | NodeIsStillSyncing wenssStillSyncing - | NodeIsStillSyncing !SyncPercentage - -- ^ The backend couldn't process the incoming request as the underlying - -- node is still syncing with the blockchain. - deriving (Generic, Show, Eq) - -convertTxError :: TxError.TxError -> WalletError -convertTxError err = case err of - TxError.NotEnoughMoney coin -> - NotEnoughMoney . fromIntegral . Core.getCoin $ coin - TxError.NotEnoughAllowedMoney coin -> - NotEnoughMoney . fromIntegral . Core.getCoin $ coin - TxError.FailedToStabilize -> - TxFailedToStabilize - TxError.OutputIsRedeem addr -> - OutputIsRedeem (V1 addr) - TxError.RedemptionDepleted -> - TxRedemptionDepleted - TxError.SafeSignerNotFound addr -> - TxSafeSignerNotFound (V1 addr) - TxError.SignedTxNotBase16Format -> - SignedTxSubmitError $ sformat build TxError.SignedTxNotBase16Format - TxError.SignedTxUnableToDecode txt -> - SignedTxSubmitError $ sformat build (TxError.SignedTxUnableToDecode txt) - TxError.SignedTxSignatureNotBase16Format -> - SignedTxSubmitError $ sformat build TxError.SignedTxSignatureNotBase16Format - TxError.SignedTxInvalidSignature txt -> - SignedTxSubmitError $ sformat build (TxError.SignedTxInvalidSignature txt) - TxError.GeneralTxError txt -> - UnknownError txt - --- --- Instances for `WalletError` - -deriveGeneric ''WalletError - -instance ToJSON WalletError where - toEncoding (NotEnoughMoney weNeedMore) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" - (pairs $ pairStr "needMore" (toEncoding weNeedMore)) - <> "message" .= String "NotEnoughMoney" - toEncoding (OutputIsRedeem weAddress) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" - (pairs $ pairStr "address" (toEncoding weAddress)) - <> "message" .= String "OutputIsRedeem" - toEncoding (MigrationFailed weDescription) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" - (pairs $ pairStr "description" (toEncoding weDescription)) - <> "message" .= String "MigrationFailed" - toEncoding (JSONValidationFailed weValidationError) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" - (pairs $ pairStr "validationError" - (toEncoding weValidationError)) - <> "message" .= String "JSONValidationFailed" - toEncoding (UnknownError weMsg) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weMsg)) - <> "message" .= String "UnknownError" - toEncoding (InvalidAddressFormat weMsg) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weMsg)) - <> "message" .= String "InvalidAddressFormat" - toEncoding (WalletNotFound) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ mempty) - <> "message" .= String "WalletNotFound" - toEncoding (WalletAlreadyExists wid) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ pairStr "walletId" (toEncoding wid)) - <> "message" .= String "WalletAlreadyExists" - toEncoding (AddressNotFound) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ mempty) - <> "message" .= String "AddressNotFound" - toEncoding (TxFailedToStabilize) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ mempty) - <> "message" .= String "TxFailedToStabilize" - toEncoding (InvalidPublicKey weProblem) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weProblem)) - <> "message" .= String "InvalidPublicKey" - toEncoding (UnsignedTxCreationError) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ mempty) - <> "message" .= String "UnsignedTxCreationError" - toEncoding (TooBigTransaction) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ mempty) - <> "message" .= String "TooBigTransaction" - toEncoding (SignedTxSubmitError weProblem) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weProblem)) - <> "message" .= String "SignedTxSubmitError" - toEncoding (TxRedemptionDepleted) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ mempty) - <> "message" .= String "TxRedemptionDepleted" - toEncoding (TxSafeSignerNotFound weAddress) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" - (pairs $ pairStr "address" (toEncoding weAddress)) - <> "message" .= String "TxSafeSignerNotFound" - toEncoding (MissingRequiredParams requiredParams) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" - (pairs $ pairStr "params" (toEncoding requiredParams)) - <> "message" .= String "MissingRequiredParams" - toEncoding (CannotCreateAddress weProblem) = - pairs $ pairStr "status" (toEncoding $ String "error") - <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weProblem)) - <> "message" .= String "CannotCreateAddress" - toEncoding (WalletIsNotReadyToProcessPayments weStillRestoring) = - toEncoding $ toJSON weStillRestoring - toEncoding (NodeIsStillSyncing wenssStillSyncing) = - toEncoding $ toJSON wenssStillSyncing - -instance FromJSON WalletError where - parseJSON (Object o) - | HMS.member "message" o = - case HMS.lookup "message" o of - Just "NotEnoughMoney" -> - NotEnoughMoney - <$> ((o .: "diagnostic") >>= (.: "needMore")) - Just "OutputIsRedeem" -> - OutputIsRedeem <$> ((o .: "diagnostic") >>= (.: "address")) - Just "MigrationFailed" -> - MigrationFailed - <$> ((o .: "diagnostic") >>= (.: "description")) - Just "JSONValidationFailed" -> - JSONValidationFailed - <$> ((o .: "diagnostic") >>= (.: "validationError")) - Just "UnknownError" -> - UnknownError <$> ((o .: "diagnostic") >>= (.: "msg")) - Just "InvalidAddressFormat" -> - InvalidAddressFormat - <$> ((o .: "diagnostic") >>= (.: "msg")) - Just "WalletNotFound" -> pure WalletNotFound - Just "WalletAlreadyExists" -> - WalletAlreadyExists <$> ((o .: "diagnostic") >>= (.: "walletId")) - Just "AddressNotFound" -> pure AddressNotFound - Just "TxFailedToStabilize" -> pure TxFailedToStabilize - Just "TxRedemptionDepleted" -> pure TxRedemptionDepleted - Just "TxSafeSignerNotFound" -> - TxSafeSignerNotFound - <$> ((o .: "diagnostic") >>= (.: "address")) - Just "InvalidPublicKey" -> - InvalidPublicKey <$> ((o .: "diagnostic") >>= (.: "msg")) - Just "UnsignedTxCreationError" -> pure UnsignedTxCreationError - Just "TooBigTransaction" -> pure TooBigTransaction - Just "SignedTxSubmitError" -> - SignedTxSubmitError <$> ((o .: "diagnostic") >>= (.: "msg")) - Just "CannotCreateAddress" -> - CannotCreateAddress <$> ((o .: "diagnostic") >>= (.: "msg")) - Just "MissingRequiredParams" -> - MissingRequiredParams - <$> ((o .: "diagnostic") >>= (.: "params")) - Just _ -> - fail "Incorrect JSON encoding for WalletError" - Nothing -> - fail "Incorrect JSON encoding for WalletError" - -- WalletIsNotReadyToProcessPayments - | HMS.member "estimatedCompletionTime" o = do - estCompTO <- (o .: "estimatedCompletionTime") - sThroughPO <- (o .: "throughput") - prctO <- (o .: "percentage") - estCompT <- parseJSON estCompTO - sThroughP <- parseJSON sThroughPO - prct <- parseJSON prctO - return . WalletIsNotReadyToProcessPayments - $ SyncProgress estCompT sThroughP prct - -- NodeIsStillSyncing - | HMS.member "quantity" o = do - quantityO <- o .: "quantity" - quantity <- parseJSON quantityO - return . NodeIsStillSyncing $ mkSyncPercentage quantity - | otherwise = aesonError "Incorrect JSON encoding for WalletError" - parseJSON invalid = typeMismatch "WalletError" invalid - -instance Exception WalletError where +import Servant (ServantErr (..)) --- TODO: generate `Arbitrary` instance with TH too? -instance Arbitrary WalletError where - arbitrary = oneof (map pure sample) - - --- --- Helpers --- - -type ErrorName = Text -type ErrorCode = Int -type ErrorExample = Value - - -sampleSyncProgress :: SyncProgress -sampleSyncProgress = SyncProgress { - spEstimatedCompletionTime = mkEstimatedCompletionTime 3000 - , spThroughput = mkSyncThroughput (Core.BlockCount 400) - , spPercentage = mkSyncPercentage 80 -} - -sampleAddress :: V1 Core.Address -sampleAddress = V1 $ Core.Address - { Core.addrRoot = - Crypto.unsafeAbstractHash ("asdfasdf" :: String) - , Core.addrAttributes = - Core.mkAttributes $ Core.AddrAttributes Nothing Core.BootstrapEraDistr - , Core.addrType = - Core.ATPubKey - } - --- | Sample of errors we use for documentation -sample :: [WalletError] -sample = - [ NotEnoughMoney 1400 - , OutputIsRedeem sampleAddress - , MigrationFailed "Migration failed" - , JSONValidationFailed "Expected String, found Null." - , UnknownError "Unknown error" - , InvalidAddressFormat "Invalid base58 representation." - , WalletNotFound - , WalletAlreadyExists exampleWalletId - , AddressNotFound - , InvalidPublicKey "Invalid root public key for external wallet." - , UnsignedTxCreationError - , SignedTxSubmitError "Cannot submit externally-signed transaction." - , TooBigTransaction - , MissingRequiredParams (("wallet_id", "walletId") :| []) - , CannotCreateAddress "Cannot create derivation path for new address in external wallet." - , WalletIsNotReadyToProcessPayments sampleSyncProgress - , NodeIsStillSyncing (mkSyncPercentage 42) - ] - - --- | Give a short description of an error -describe :: WalletError -> String -describe = \case - NotEnoughMoney _ -> - "Not enough available coins to proceed." - OutputIsRedeem _ -> - "One of the TX outputs is a redemption address." - MigrationFailed _ -> - "Error while migrating a legacy type into the current version." - JSONValidationFailed _ -> - "Couldn't decode a JSON input." - UnknownError _ -> - "Unexpected internal error." - InvalidAddressFormat _ -> - "Provided address format is not valid." - WalletNotFound -> - "Reference to an unexisting wallet was given." - WalletAlreadyExists _ -> - "Can't create or restore a wallet. The wallet already exists." - AddressNotFound -> - "Reference to an unexisting address was given." - MissingRequiredParams _ -> - "Missing required parameters in the request payload." - WalletIsNotReadyToProcessPayments _ -> - "This wallet is restoring, and it cannot send new transactions until restoration completes." - NodeIsStillSyncing _ -> - "The node is still syncing with the blockchain, and cannot process the request yet." - InvalidPublicKey _ -> - "Extended public key (for external wallet) is invalid." - UnsignedTxCreationError -> - "Unable to create unsigned transaction for an external wallet." - TooBigTransaction -> - "Transaction size is greater than 4096 bytes." - SignedTxSubmitError _ -> - "Unable to submit externally-signed transaction." - TxRedemptionDepleted -> - "The redemption address was already used." - TxSafeSignerNotFound _ -> - "The safe signer at the specified address was not found." - TxFailedToStabilize -> - "We were unable to find a set of inputs to satisfy this transaction." - CannotCreateAddress _ -> - "Cannot create derivation path for new address, for external wallet." - --- | Convert wallet errors to Servant errors -toServantError :: WalletError -> ServantErr -toServantError err = - mkServantErr $ case err of - NotEnoughMoney{} -> - err403 - OutputIsRedeem{} -> - err403 - MigrationFailed{} -> - err422 - JSONValidationFailed{} -> - err400 - UnknownError{} -> - err500 - WalletNotFound{} -> - err404 - WalletAlreadyExists{} -> - err403 - InvalidAddressFormat{} -> - err401 - AddressNotFound{} -> - err404 - MissingRequiredParams{} -> - err400 - WalletIsNotReadyToProcessPayments{} -> - err403 - NodeIsStillSyncing{} -> - err412 -- Precondition failed - TxFailedToStabilize{} -> - err500 - TxRedemptionDepleted{} -> - err400 - TxSafeSignerNotFound{} -> - err400 - InvalidPublicKey{} -> - err400 - UnsignedTxCreationError{} -> - err500 - TooBigTransaction{} -> - err400 - SignedTxSubmitError{} -> - err500 - CannotCreateAddress{} -> - err500 - where - mkServantErr serr@ServantErr{..} = serr - { errBody = encode err - , errHeaders = applicationJson : errHeaders - } +import qualified Network.HTTP.Types as HTTP -toHttpStatus :: WalletError -> HTTP.Status -toHttpStatus err = HTTP.Status (errHTTPCode $ toServantError err) - (encodeUtf8 $ describe err) --- | Generates the @Content-Type: application/json@ 'HTTP.Header'. -applicationJson :: HTTP.Header -applicationJson = - let [hdr] = getHeaders (addHeader "application/json" mempty :: (Headers '[Header "Content-Type" String] String)) - in hdr +class (ToJSON e) => ToServantError e where + declareServantError :: e -> ServantErr + toServantError :: e -> ServantErr + toServantError err = + mkServantErr (declareServantError err) + where + mkServantErr serr@ServantErr{..} = serr + { errBody = encode err + , errHeaders = applicationJson : errHeaders + } + +class (ToServantError e, Buildable e) => ToHttpErrorStatus e where + toHttpErrorStatus :: e -> HTTP.Status + toHttpErrorStatus err = + HTTP.Status (errHTTPCode $ toServantError err) (encodeUtf8 $ sformat build err) diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Generic.hs b/wallet-new/src/Cardano/Wallet/API/V1/Generic.hs index eafdd164544..a6723e554ad 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Generic.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Generic.hs @@ -11,17 +11,18 @@ import Universum hiding (All, Generic) import Data.Aeson import Data.Aeson.Types (Parser) -import qualified Data.HashMap.Strict as HM -import qualified Data.Vector as V +import Data.List ((!!)) import Generics.SOP import Generics.SOP.JSON (JsonInfo (..), JsonOptions (..), Tag (..), - defaultJsonOptions, jsonInfo) + defaultJsonOptions) import Cardano.Wallet.API.Response.JSend (ResponseStatus (..)) import Cardano.Wallet.Util (mkJsonKey) -import Data.List ((!!)) import Pos.Util.Util (aesonError) +import qualified Data.HashMap.Strict as HM +import qualified Data.Vector as V + -- -- Helper proxies -- @@ -42,24 +43,46 @@ allpf = Proxy -- JSON encoding/decoding -- --- | Returns `JsonInfo` for type (from `json-sop` package) --- for representing a type in a JSend format. -jsendInfo - :: forall a. (HasDatatypeInfo a, SListI (Code a)) - => Proxy a -> NP JsonInfo (Code a) -jsendInfo pa = jsonInfo pa $ defaultJsonOptions - { jsonFieldName = const mkJsonKey - } - -- | Generic method which makes JSON `Value` from a Haskell value in -- JSend format. gtoJsend :: forall a. (Generic a, HasDatatypeInfo a, All2 ToJSON (Code a)) => ResponseStatus -> a -> Value -gtoJsend rs a = hcollapse $ - hcliftA2 allpt (gtoJsend' rs) - (jsendInfo (Proxy :: Proxy a)) - (unSOP $ from a) +gtoJsend rs a = + hcollapse $ + hcliftA2 allpt (gtoJsend' rs) + (jsendInfo (Proxy :: Proxy a) jsendOptions) + (unSOP $ from a) + +-- | Our custom naming options +jsendOptions :: JsonOptions +jsendOptions = defaultJsonOptions + { jsonFieldName = const mkJsonKey + } + +-- | Slightly modified version compared to Generics.SOP.JSON, we also tag +-- single-constructor (ADT with one constructor and newtype) because we +-- rely on that information to wrap the corresponding json in a jsend payload. +jsendInfo :: forall a. (HasDatatypeInfo a, SListI (Code a)) + => Proxy a -> JsonOptions -> NP JsonInfo (Code a) +jsendInfo pa opts = + case datatypeInfo pa of + Newtype _ t _ -> JsonOne (Tag $ jsonTagName opts t) :* Nil + ADT _ n cs -> hliftA (jsonInfoFor opts n (Tag . jsonTagName opts)) cs + +-- Extracted from Generics.SOP.JSON +jsonInfoFor :: forall xs. JsonOptions -> DatatypeName -> (ConstructorName -> Tag) -> ConstructorInfo xs -> JsonInfo xs +jsonInfoFor _ _ tag (Infix n _ _) = JsonMultiple (tag n) +jsonInfoFor _ _ tag (Constructor n) = + case shape :: Shape xs of + ShapeNil -> JsonZero n + ShapeCons ShapeNil -> JsonOne (tag n) + _ -> JsonMultiple (tag n) +jsonInfoFor opts d tag (Record n fields) = + JsonRecord (tag n) (hliftA jfieldName fields) + where + jfieldName :: FieldInfo a -> K String a + jfieldName (FieldInfo name) = K (jsonFieldName opts d name) gtoJsend' :: All ToJSON xs @@ -79,7 +102,7 @@ gtoJsend' rs (JsonRecord tag fields) cs = gparseJsend :: forall a. (Generic a, HasDatatypeInfo a, All2 FromJSON (Code a)) => Value -> Parser a -gparseJsend v = to <$> gparseJsend' v (jsendInfo (Proxy :: Proxy a)) +gparseJsend v = to <$> gparseJsend' v (jsendInfo (Proxy :: Proxy a) jsendOptions) gparseJsend' :: forall (xss :: [[*]]). All2 FromJSON xss diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Headers.hs b/wallet-new/src/Cardano/Wallet/API/V1/Headers.hs new file mode 100644 index 00000000000..eba778586f5 --- /dev/null +++ b/wallet-new/src/Cardano/Wallet/API/V1/Headers.hs @@ -0,0 +1,11 @@ +module Cardano.Wallet.API.V1.Headers + ( applicationJson + ) where + +import Network.HTTP.Types (Header, hContentType) + + +-- | Generates the @Content-Type: application/json@ 'HTTP.Header'. +applicationJson :: Header +applicationJson = + (hContentType, "application/json") diff --git a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Addresses.hs b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Addresses.hs index 94b519901a6..a2e9c155ac0 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Addresses.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Addresses.hs @@ -34,7 +34,6 @@ import Cardano.Wallet.API.Indices (IxSet') import Cardano.Wallet.API.Request import Cardano.Wallet.API.Response import qualified Cardano.Wallet.API.V1.Addresses as Addresses -import Cardano.Wallet.API.V1.Errors import Cardano.Wallet.API.V1.Migration import Cardano.Wallet.API.V1.Types diff --git a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs index 1192e974ed7..8cfc15e80a3 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Transactions.hs @@ -4,6 +4,7 @@ import Universum import qualified Data.IxSet.Typed as IxSet import qualified Data.List.NonEmpty as NE +import Formatting (build, sformat) import Servant import Pos.Chain.Txp (TxpConfiguration) @@ -25,12 +26,38 @@ import qualified Pos.Wallet.Web.Util as V0 import Cardano.Wallet.API.Request import Cardano.Wallet.API.Response -import Cardano.Wallet.API.V1.Errors import Cardano.Wallet.API.V1.Migration (HasConfigurations, MonadV1, migrate) import qualified Cardano.Wallet.API.V1.Transactions as Transactions import Cardano.Wallet.API.V1.Types + +convertTxError :: V0.TxError -> WalletError +convertTxError err = case err of + V0.NotEnoughMoney coin -> + NotEnoughMoney . fromIntegral . Core.getCoin $ coin + V0.NotEnoughAllowedMoney coin -> + NotEnoughMoney . fromIntegral . Core.getCoin $ coin + V0.FailedToStabilize -> + TxFailedToStabilize + V0.OutputIsRedeem addr -> + OutputIsRedeem (V1 addr) + V0.RedemptionDepleted -> + TxRedemptionDepleted + V0.SafeSignerNotFound addr -> + TxSafeSignerNotFound (V1 addr) + V0.SignedTxNotBase16Format -> + SignedTxSubmitError $ sformat build V0.SignedTxNotBase16Format + V0.SignedTxUnableToDecode txt -> + SignedTxSubmitError $ sformat build (V0.SignedTxUnableToDecode txt) + V0.SignedTxSignatureNotBase16Format -> + SignedTxSubmitError $ sformat build V0.SignedTxSignatureNotBase16Format + V0.SignedTxInvalidSignature txt -> + SignedTxSubmitError $ sformat build (V0.SignedTxInvalidSignature txt) + V0.GeneralTxError txt -> + UnknownError txt + + handlers :: HasConfigurations => ProtocolMagic diff --git a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs index acd0decc67d..451c543092b 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs @@ -16,7 +16,6 @@ import qualified Pos.Wallet.Web.State.Storage as V0 import Cardano.Wallet.API.Request import Cardano.Wallet.API.Response -import Cardano.Wallet.API.V1.Errors import Cardano.Wallet.API.V1.Migration import Cardano.Wallet.API.V1.Types as V1 import qualified Cardano.Wallet.API.V1.Wallets as Wallets diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Migration/Types.hs b/wallet-new/src/Cardano/Wallet/API/V1/Migration/Types.hs index ea7dd2c0efc..d90d13e6408 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Migration/Types.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Migration/Types.hs @@ -1,39 +1,51 @@ {- | This is a temporary module to help migration @V0@ datatypes into @V1@ datatypes. -} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeSynonymInstances #-} module Cardano.Wallet.API.V1.Migration.Types ( Migrate(..) + , MigrationError(..) , migrate ) where import Universum hiding (elems) -import qualified Control.Lens as Lens -import qualified Control.Monad.Catch as Catch +import Cardano.Wallet.API.V1.Errors (ToServantError (..)) +import Cardano.Wallet.API.V1.Types (V1 (..)) +import Data.Aeson (FromJSON (..), ToJSON (..), object, pairs, (.:), + (.=)) +import Data.Aeson.Types (Value (..), typeMismatch) import Data.Map (elems) import Data.Time.Clock.POSIX (POSIXTime) import Data.Time.Units (fromMicroseconds, toMicroseconds) import Data.Typeable (typeRep) -import Formatting (sformat) +import Formatting (bprint, build, sformat) +import Generics.SOP.TH (deriveGeneric) +import GHC.Generics (Generic) +import Pos.Core (addressF) +import Pos.Crypto (decodeHash) +import Pos.Util.Mnemonic (Mnemonic) +import Pos.Wallet.Web.ClientTypes.Instances () +import Pos.Wallet.Web.Tracking.Sync (calculateEstimatedRemainingTime) +import Servant (err422) +import Test.QuickCheck (Arbitrary (..)) +import Test.QuickCheck.Gen (oneof) -import Cardano.Wallet.API.V1.Errors as Errors -import Cardano.Wallet.API.V1.Types (V1 (..)) import qualified Cardano.Wallet.API.V1.Types as V1 +import qualified Control.Lens as Lens +import qualified Control.Monad.Catch as Catch +import qualified Data.HashMap.Strict as HMS +import qualified Formatting.Buildable import qualified Pos.Chain.Txp as V0 import qualified Pos.Client.Txp.Util as V0 -import Pos.Core (addressF) import qualified Pos.Core.Common as Core import qualified Pos.Core.Slotting as Core import qualified Pos.Core.Txp as Txp -import Pos.Crypto (decodeHash) -import Pos.Util.Mnemonic (Mnemonic) import qualified Pos.Util.Servant as V0 -import qualified Pos.Wallet.Web.ClientTypes.Instances () import qualified Pos.Wallet.Web.ClientTypes.Types as V0 import qualified Pos.Wallet.Web.State.Storage as OldStorage -import Pos.Wallet.Web.Tracking.Sync (calculateEstimatedRemainingTime) -- | 'Migrate' encapsulates migration between types, when possible. -- NOTE: This has @nothing@ to do with database migrations (see `safecopy`), @@ -41,7 +53,7 @@ import Pos.Wallet.Web.Tracking.Sync (calculateEstimatedRemainingTime) -- will be completed and the V0 API removed, we will be able to remove this -- typeclass altogether. class Migrate from to where - eitherMigrate :: from -> Either Errors.WalletError to + eitherMigrate :: from -> Either MigrationError to -- | "Run" the migration. migrate :: ( Migrate from to, Catch.MonadThrow m ) => from -> m to @@ -93,14 +105,14 @@ instance Migrate (OldStorage.SyncStatistics, Maybe Core.ChainDifficulty) V1.Sync Just nd | wspCurrentBlockchainDepth >= nd -> 100 Just nd -> (fromIntegral wspCurrentBlockchainDepth / max 1.0 (fromIntegral nd)) * 100.0 toMs (Core.Timestamp microsecs) = - V1.mkEstimatedCompletionTime (round @Double $ (realToFrac (toMicroseconds microsecs) / 1000.0)) + V1.mkEstimatedCompletionTime (round @Double (realToFrac (toMicroseconds microsecs) / 1000.0)) tput (OldStorage.SyncThroughput blocks) = V1.mkSyncThroughput blocks remainingBlocks = fmap (\total -> total - wspCurrentBlockchainDepth) currentBlockchainHeight in V1.SyncProgress <$> pure (toMs (maybe unknownCompletionTime (calculateEstimatedRemainingTime wspThroughput) remainingBlocks)) <*> pure (tput wspThroughput) - <*> pure (V1.mkSyncPercentage (floor @Double $ percentage)) + <*> pure (V1.mkSyncPercentage (floor @Double percentage)) -- NOTE: Migrate V1.Wallet V0.CWallet unable to do - not idempotent @@ -116,7 +128,7 @@ instance Migrate V1.AssuranceLevel V0.CWalletAssurance where -- instance Migrate V0.CCoin (V1 Core.Coin) where eitherMigrate c = - let err = Left . Errors.MigrationFailed . mappend "error migrating V0.CCoin -> Core.Coin, mkCoin failed: " + let err = Left . MigrationFailed . mappend "error migrating V0.CCoin -> Core.Coin, mkCoin failed: " in either err (pure . V1) (V0.decodeCType c) instance Migrate (V1 Core.Coin) V0.CCoin where @@ -159,7 +171,7 @@ instance Migrate V0.CAddress V1.WalletAddress where instance Migrate V0.SyncProgress V1.SyncPercentage where eitherMigrate V0.SyncProgress{..} = let percentage = case _spNetworkCD of - Nothing -> (0 :: Word8) + Nothing -> 0 :: Word8 Just nd | _spLocalCD >= nd -> 100 Just nd -> floor @Double $ (fromIntegral _spLocalCD / max 1.0 (fromIntegral nd)) * 100.0 in pure $ V1.mkSyncPercentage (fromIntegral percentage) @@ -183,7 +195,7 @@ instance Migrate V0.CAccount V1.Account where -- in old API 'V0.AccountId' supposed to carry both wallet id and derivation index instance Migrate (V1.WalletId, V1.AccountIndex) V0.AccountId where eitherMigrate (walId, accIdx) = - V0.AccountId <$> eitherMigrate walId <*> pure accIdx + V0.AccountId <$> eitherMigrate walId <*> pure (V1.getAccIndex accIdx) instance Migrate V1.PaymentSource V0.AccountId where eitherMigrate V1.PaymentSource{..} = eitherMigrate (psWalletId, psAccountIndex) @@ -197,10 +209,14 @@ instance Migrate V1.PaymentSource V0.CAccountId where instance Migrate V0.AccountId (V1.WalletId, V1.AccountIndex) where eitherMigrate accId = - (,) <$> eitherMigrate (V0.aiWId accId) <*> pure (V0.aiIndex accId) + (,) + <$> eitherMigrate (V0.aiWId accId) + <*> first + (MigrationFailed . sformat build) + (V1.mkAccountIndex $ V0.aiIndex accId) instance Migrate V0.CAccountId V0.AccountId where - eitherMigrate = first Errors.MigrationFailed . V0.decodeCType + eitherMigrate = first MigrationFailed . V0.decodeCType instance Migrate V0.CAccountId V1.AccountIndex where eitherMigrate cAccId = do @@ -216,24 +232,24 @@ instance Migrate V0.CAccountId V1.WalletId where instance Migrate V0.CAddress (V1 Core.Address) where eitherMigrate V0.CAddress {..} = - let err = Left . Errors.MigrationFailed . mappend "Error migrating V0.CAddress -> Core.Address failed: " + let err = Left . MigrationFailed . mappend "Error migrating V0.CAddress -> Core.Address failed: " in either err (pure . V1) (V0.decodeCType cadId) instance Migrate (V0.CId V0.Addr) (V1 Core.Address) where eitherMigrate (V0.CId (V0.CHash h)) = - let err = Left . Errors.MigrationFailed . mappend "Error migrating (V0.CId V0.Addr) -> Core.Address failed." + let err = Left . MigrationFailed . mappend "Error migrating (V0.CId V0.Addr) -> Core.Address failed." in either err (pure . V1) (Core.decodeTextAddress h) instance Migrate (V1 Core.Address) (V0.CId V0.Addr) where eitherMigrate (V1 address) = let h = sformat addressF address in - pure $ (V0.CId (V0.CHash h)) + pure (V0.CId (V0.CHash h)) instance Migrate (V0.CId V0.Addr, V0.CCoin) V1.PaymentDistribution where eitherMigrate (cIdAddr, cCoin) = do pdAddress <- eitherMigrate cIdAddr pdAmount <- eitherMigrate cCoin - pure $ V1.PaymentDistribution {..} + pure V1.PaymentDistribution {..} instance Migrate V1.PaymentDistribution (V0.CId V0.Addr, Core.Coin) where eitherMigrate V1.PaymentDistribution {..} = @@ -248,7 +264,7 @@ instance Migrate (V0.CId V0.Addr, Core.Coin) V1.PaymentDistribution where instance Migrate V0.CTxId (V1 Txp.TxId) where eitherMigrate (V0.CTxId (V0.CHash h)) = - let err = Left . Errors.MigrationFailed . mappend "Error migrating a TxId: " + let err = Left . MigrationFailed . mappend "Error migrating a TxId: " in either err (pure . V1) (decodeHash h) instance Migrate POSIXTime (V1 Core.Timestamp) where @@ -309,7 +325,7 @@ instance Migrate V1.EstimatedFees V0.TxFee where instance Migrate V1.WalletUpdate V0.CWalletMeta where eitherMigrate V1.WalletUpdate{..} = do migratedAssurance <- eitherMigrate uwalAssuranceLevel - pure $ V0.CWalletMeta + pure V0.CWalletMeta { cwName = uwalName , cwAssurance = migratedAssurance , cwUnit = 0 @@ -318,7 +334,58 @@ instance Migrate V1.WalletUpdate V0.CWalletMeta where instance Migrate V0.CWalletMeta V1.WalletUpdate where eitherMigrate V0.CWalletMeta{..} = do migratedAssurance <- eitherMigrate cwAssurance - pure $ V1.WalletUpdate + pure V1.WalletUpdate { uwalName = cwName , uwalAssuranceLevel = migratedAssurance } + +-- +-- Migration Errors +-- + +newtype MigrationError + = MigrationFailed Text + deriving (Eq, Show, Generic) + +deriveGeneric ''MigrationError + +instance ToJSON MigrationError where + toEncoding (MigrationFailed weDescription) = pairs $ mconcat + [ "message" .= String "MigrationFailed" + , "status" .= String "error" + , "diagnostic" .= object + [ "description" .= weDescription + ] + ] + +instance FromJSON MigrationError where + parseJSON (Object o) + | HMS.member "message" o = + case HMS.lookup "message" o of + Just "MigrationFailed" -> + MigrationFailed <$> ((o .: "diagnostic") >>= (.: "description")) + _ -> + fail "Incorrect JSON encoding for MigrationError" + + | otherwise = + fail "Incorrect JSON encoding for MigrationError" + + parseJSON invalid = + typeMismatch "MigrationError" invalid + +instance Exception MigrationError + +instance Arbitrary MigrationError where + arbitrary = oneof + [ pure $ MigrationFailed "Migration failed." + ] + +instance Buildable MigrationError where + build = \case + MigrationFailed _ -> + bprint "Error while migrating a legacy type into the current version." + +instance ToServantError MigrationError where + declareServantError = \case + MigrationFailed _ -> + err422 diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs b/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs index 82de5090272..7d3d8076566 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Swagger.hs @@ -17,31 +17,26 @@ import Cardano.Wallet.API.Request.Pagination import Cardano.Wallet.API.Request.Sort import Cardano.Wallet.API.Response import Cardano.Wallet.API.Types -import qualified Cardano.Wallet.API.V1.Errors as Errors import Cardano.Wallet.API.V1.Generic (gconsName) +import Cardano.Wallet.API.V1.Migration.Types (MigrationError (..)) import Cardano.Wallet.API.V1.Parameters import Cardano.Wallet.API.V1.Swagger.Example import Cardano.Wallet.API.V1.Types import Cardano.Wallet.TypeLits (KnownSymbols (..)) -import qualified Pos.Core as Core -import Pos.Core.Update (SoftwareVersion) -import Pos.Util.CompileInfo (CompileTimeInfo, ctiGitRevision) -import Pos.Util.Servant (LoggingApi) -import Pos.Wallet.Web.Swagger.Instances.Schema () import Control.Lens ((?~)) import Data.Aeson (ToJSON (..), encode) import Data.Aeson.Encode.Pretty -import qualified Data.ByteString.Lazy as BL import Data.Map (Map) -import qualified Data.Map.Strict as M -import qualified Data.Set as Set import Data.Swagger hiding (Example, Header, example) import Data.Swagger.Declare -import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Data.Typeable +import Formatting (build, sformat) import NeatInterpolation +import Pos.Core.Update (SoftwareVersion) +import Pos.Util.CompileInfo (CompileTimeInfo, ctiGitRevision) +import Pos.Util.Servant (LoggingApi) +import Pos.Wallet.Web.Swagger.Instances.Schema () import Servant (Handler, ServantErr (..), Server) import Servant.API.Sub import Servant.Swagger @@ -52,13 +47,23 @@ import Test.QuickCheck import Test.QuickCheck.Gen import Test.QuickCheck.Random +import qualified Data.ByteString.Lazy as BL +import qualified Data.Map.Strict as M +import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Pos.Core as Core +import qualified Pos.Core.Attributes as Core +import qualified Pos.Crypto.Hashing as Crypto + + -- -- Helper functions -- -- | Generates an example for type `a` with a static seed. genExample :: Example a => a -genExample = (unGen (resize 3 example)) (mkQCGen 42) 42 +genExample = unGen (resize 3 example) (mkQCGen 42) 42 -- | Generates a `NamedSchema` exploiting the `ToJSON` instance in scope, -- by calling `sketchSchema` under the hood. @@ -155,7 +160,7 @@ instance in swgr & over (operationsOf swgr . parameters) addSortOperation where addSortOperation :: [Referenced Param] -> [Referenced Param] - addSortOperation xs = (Inline newParam) : xs + addSortOperation xs = Inline newParam : xs newParam :: Param newParam = @@ -196,7 +201,6 @@ instance ToParamSchema Core.Address where instance ToParamSchema (V1 Core.Address) where toParamSchema _ = toParamSchema (Proxy @Core.Address) - -- -- Descriptions -- @@ -229,14 +233,45 @@ Error Name / Description | HTTP Error code | Example $errors |] where errors = T.intercalate "\n" rows - rows = map (mkRow errToDescription) Errors.sample + rows = + [ mkRow errToDescription $ NotEnoughMoney 1400 + , mkRow errToDescription $ OutputIsRedeem sampleAddress + , mkRow errToDescription $ MigrationFailed "Migration failed." + , mkRow errToDescription $ JSONValidationFailed "Expected String, found Null." + , mkRow errToDescription $ UnknownError "Unknown error." + , mkRow errToDescription $ InvalidAddressFormat "Invalid Base58 representation." + , mkRow errToDescription WalletNotFound + , mkRow errToDescription $ WalletAlreadyExists sampleWalletId + , mkRow errToDescription AddressNotFound + , mkRow errToDescription $ MissingRequiredParams (("wallet_id", "walletId") :| []) + , mkRow errToDescription $ WalletIsNotReadyToProcessPayments sampleSyncProgress + , mkRow errToDescription $ NodeIsStillSyncing (mkSyncPercentage 42) + ] mkRow fmt err = T.intercalate "|" (fmt err) errToDescription err = - [ surroundedBy "`" (gconsName err) <> "
" <> toText (Errors.describe err) - , show $ errHTTPCode $ Errors.toServantError err + [ surroundedBy "`" (gconsName err) <> "
" <> toText (sformat build err) + , show $ errHTTPCode $ toServantError err , inlineCodeBlock (T.decodeUtf8 $ BL.toStrict $ encodePretty err) ] + sampleWalletId = + WalletId "J7rQqaLLHBFPrgJXwpktaMB1B1kQBXAyc2uRSfRPzNVGiv6TdxBzkPNBUWysZZZdhFG9gRy3sQFfX5wfpLbi4XTFGFxTg" + + sampleAddress = V1 Core.Address + { Core.addrRoot = + Crypto.unsafeAbstractHash ("asdfasdf" :: String) + , Core.addrAttributes = + Core.mkAttributes $ Core.AddrAttributes Nothing Core.BootstrapEraDistr + , Core.addrType = + Core.ATPubKey + } + + sampleSyncProgress = SyncProgress + { spEstimatedCompletionTime = mkEstimatedCompletionTime 3000 + , spThroughput = mkSyncThroughput (Core.BlockCount 400) + , spPercentage = mkSyncPercentage 80 + } + -- | Shorter version of the doc below, only for Dev & V0 documentations highLevelShortDescription :: DescriptionEnvironment -> T.Text @@ -874,12 +909,12 @@ api (compileInfo, curSoftwareVersion) walletAPI mkDescription = toSwagger wallet & info.title .~ "Cardano Wallet API" & info.version .~ fromString (show curSoftwareVersion) & host ?~ "127.0.0.1:8090" - & info.description ?~ (mkDescription $ DescriptionEnvironment - { deErrorExample = decodeUtf8 $ encodePretty Errors.WalletNotFound + & info.description ?~ mkDescription DescriptionEnvironment + { deErrorExample = decodeUtf8 $ encodePretty WalletNotFound , deMnemonicExample = decodeUtf8 $ encode (genExample @BackupPhrase) , deDefaultPerPage = fromString (show defaultPerPageEntries) , deWalletErrorTable = errorsDescription , deGitRevision = ctiGitRevision compileInfo , deSoftwareVersion = fromString $ show curSoftwareVersion - }) + } & info.license ?~ ("MIT" & url ?~ URL "https://raw.githubusercontent.com/input-output-hk/cardano-sl/develop/lib/LICENSE") diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs b/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs index d4644b50522..c53691a12f4 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Swagger/Example.hs @@ -2,11 +2,10 @@ module Cardano.Wallet.API.V1.Swagger.Example where import Universum -import Test.QuickCheck (Arbitrary (..), Gen, listOf1) - import Cardano.Wallet.Orphans.Arbitrary () import Pos.Wallet.Web.ClientTypes (CUpdateInfo) import Pos.Wallet.Web.Methods.Misc (WalletStateSnapshot (..)) +import Test.QuickCheck (Arbitrary (..), Gen, listOf1) import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet import qualified Data.Map.Strict as Map diff --git a/wallet-new/src/Cardano/Wallet/API/V1/Types.hs b/wallet-new/src/Cardano/Wallet/API/V1/Types.hs index 2042c7a23ef..dae20eba78d 100644 --- a/wallet-new/src/Cardano/Wallet/API/V1/Types.hs +++ b/wallet-new/src/Cardano/Wallet/API/V1/Types.hs @@ -45,6 +45,9 @@ module Cardano.Wallet.API.V1.Types ( , AccountIndex , AccountAddresses (..) , AccountBalance (..) + , getAccIndex + , mkAccountIndex + , AccountIndexError(..) -- * Addresses , WalletAddress (..) , NewAddress (..) @@ -87,75 +90,80 @@ module Cardano.Wallet.API.V1.Types ( , CaptureAccountId -- * Core re-exports , Core.Address + -- * Wallet Errors + , WalletError(..) + , toServantError + , toHttpErrorStatus ) where import Universum -import Data.Semigroup (Semigroup) - -import Cardano.Wallet.API.V1.Swagger.Example (Example, example) import Control.Lens (At, Index, IxValue, at, ix, makePrisms, to, (?~)) import Data.Aeson -import qualified Data.Aeson.Options as Serokell +import Data.Aeson.Encoding (pairStr) import Data.Aeson.TH as A -import Data.Aeson.Types (toJSONKeyText, typeMismatch) -import qualified Data.Char as C +import Data.Aeson.Types (Value (..), toJSONKeyText, typeMismatch) +import Data.Bifunctor (first) import Data.Default (Default (def)) -import qualified Data.IxSet.Typed as IxSet +import Data.Semigroup (Semigroup) import Data.Swagger hiding (Example, example) -import qualified Data.Swagger as S import Data.Swagger.Declare (Declare, look) import Data.Swagger.Internal.Schema (GToSchema) import Data.Swagger.Internal.TypeShape (GenericHasSimpleShape, GenericShape) import Data.Text (Text, dropEnd, toLower) -import qualified Data.Text as T import Data.Version (Version) import Formatting (bprint, build, fconst, int, sformat, (%)) -import qualified Formatting.Buildable +import Generics.SOP.TH (deriveGeneric) import GHC.Generics (Generic, Rep) import Network.Transport (EndPointAddress (..)) import Node (NodeId (..)) -import qualified Prelude import Serokell.Util (listJson) -import qualified Serokell.Util.Base16 as Base16 import Servant +import Test.Pos.Core.Arbitrary () import Test.QuickCheck import Test.QuickCheck.Gen (Gen (..)) import Test.QuickCheck.Random (mkQCGen) import Cardano.Wallet.API.Types.UnitOfMeasure (MeasuredIn (..), UnitOfMeasure (..)) +import Cardano.Wallet.API.V1.Errors (ToHttpErrorStatus (..), + ToServantError (..)) +import Cardano.Wallet.API.V1.Swagger.Example (Example, example) import Cardano.Wallet.Kernel.DB.Util.IxSet (HasPrimKey (..), IndicesOf, OrdByPrimKey, ixFun, ixList) import Cardano.Wallet.Orphans.Aeson () - --- V0 logic +import Cardano.Wallet.Util (showApiUtcTime) +import Pos.Core (addressF) +import Pos.Crypto (decodeHash, hashHexF) +import Pos.Infra.Communication.Types.Protocol () +import Pos.Infra.Diffusion.Subscription.Status + (SubscriptionStatus (..)) +import Pos.Infra.Util.LogSafe (BuildableSafeGen (..), SecureLog (..), + buildSafe, buildSafeList, buildSafeMaybe, + deriveSafeBuildable, plainOrSecureF) import Pos.Util.Mnemonic (Mnemonic) - --- importing for orphan instances for Coin import Pos.Wallet.Web.ClientTypes.Instances () -import Cardano.Wallet.Util (showApiUtcTime) +import qualified Data.Aeson.Options as Serokell import qualified Data.ByteArray as ByteArray import qualified Data.ByteString as BS +import qualified Data.Char as C +import qualified Data.HashMap.Strict as HMS +import qualified Data.IxSet.Typed as IxSet import qualified Data.Map.Strict as Map +import qualified Data.Swagger as S +import qualified Data.Text as T +import qualified Formatting.Buildable import qualified Pos.Client.Txp.Util as Core -import Pos.Core (addressF) import qualified Pos.Core as Core import qualified Pos.Core.Txp as Txp import qualified Pos.Core.Update as Core -import Pos.Crypto (decodeHash, hashHexF) import qualified Pos.Crypto.Signing as Core -import Pos.Infra.Communication.Types.Protocol () -import Pos.Infra.Diffusion.Subscription.Status - (SubscriptionStatus (..)) -import Pos.Infra.Util.LogSafe (BuildableSafeGen (..), SecureLog (..), - buildSafe, buildSafeList, buildSafeMaybe, - deriveSafeBuildable, plainOrSecureF) import qualified Pos.Wallet.Web.State.Storage as OldStorage +import qualified Prelude +import qualified Serokell.Util.Base16 as Base16 -import Test.Pos.Core.Arbitrary () -- | Declare generic schema, while documenting properties -- For instance: @@ -203,7 +211,7 @@ genericSchemaDroppingPrefix prfx extraDoc proxy = do & schema . S.example ?~ toJSON (genExample :: a) where genExample = - (unGen (resize 3 example)) (mkQCGen 42) 42 + unGen (resize 3 example) (mkQCGen 42) 42 addFieldDescription defs field desc = over (at field) (addDescription defs field desc) @@ -266,13 +274,14 @@ instance Buildable (SecureLog a) => Buildable (SecureLog (V1 a)) where instance (Buildable a, Buildable b) => Buildable (a, b) where build (a, b) = bprint ("("%build%", "%build%")") a b + -- -- Benign instances -- instance ByteArray.ByteArrayAccess a => ByteArray.ByteArrayAccess (V1 a) where length (V1 a) = ByteArray.length a - withByteArray (V1 a) callback = ByteArray.withByteArray a callback + withByteArray (V1 a) = ByteArray.withByteArray a mkPassPhrase :: Text -> Either Text Core.PassPhrase mkPassPhrase text = @@ -301,7 +310,7 @@ instance Arbitrary (V1 Core.PassPhrase) where arbitrary = fmap V1 arbitrary instance ToSchema (V1 Core.PassPhrase) where - declareNamedSchema _ = do + declareNamedSchema _ = pure $ NamedSchema (Just "V1PassPhrase") $ mempty & type_ .~ SwaggerString & format ?~ "hex|base16" @@ -416,7 +425,7 @@ deriveJSON Serokell.defaultOptions { A.constructorTagModifier = toString . toLow } ''AssuranceLevel instance ToSchema AssuranceLevel where - declareNamedSchema _ = do + declareNamedSchema _ = pure $ NamedSchema (Just "AssuranceLevel") $ mempty & type_ .~ SwaggerString & enum_ ?~ ["normal", "strict"] @@ -468,7 +477,7 @@ deriveJSON Serokell.defaultOptions { A.constructorTagModifier = reverse . drop } ''WalletOperation instance ToSchema WalletOperation where - declareNamedSchema _ = do + declareNamedSchema _ = pure $ NamedSchema (Just "WalletOperation") $ mempty & type_ .~ SwaggerString & enum_ ?~ ["create", "restore"] @@ -592,7 +601,7 @@ instance FromJSON SyncPercentage where parseJSON = withObject "SyncPercentage" $ \sl -> mkSyncPercentage <$> sl .: "quantity" instance ToSchema SyncPercentage where - declareNamedSchema _ = do + declareNamedSchema _ = pure $ NamedSchema (Just "SyncPercentage") $ mempty & type_ .~ SwaggerObject & required .~ ["quantity", "unit"] @@ -627,6 +636,14 @@ instance Ord EstimatedCompletionTime where instance Arbitrary EstimatedCompletionTime where arbitrary = EstimatedCompletionTime . MeasuredIn <$> arbitrary +deriveSafeBuildable ''EstimatedCompletionTime +instance BuildableSafeGen EstimatedCompletionTime where + buildSafeGen _ (EstimatedCompletionTime (MeasuredIn w)) = bprint ("{" + %" quantity="%build + %" unit=milliseconds" + %" }") + w + instance ToJSON EstimatedCompletionTime where toJSON (EstimatedCompletionTime (MeasuredIn w)) = object [ "quantity" .= toJSON w @@ -637,7 +654,7 @@ instance FromJSON EstimatedCompletionTime where parseJSON = withObject "EstimatedCompletionTime" $ \sl -> mkEstimatedCompletionTime <$> sl .: "quantity" instance ToSchema EstimatedCompletionTime where - declareNamedSchema _ = do + declareNamedSchema _ = pure $ NamedSchema (Just "EstimatedCompletionTime") $ mempty & type_ .~ SwaggerObject & required .~ ["quantity", "unit"] @@ -667,6 +684,14 @@ instance Ord SyncThroughput where instance Arbitrary SyncThroughput where arbitrary = SyncThroughput . MeasuredIn . OldStorage.SyncThroughput <$> arbitrary +deriveSafeBuildable ''SyncThroughput +instance BuildableSafeGen SyncThroughput where + buildSafeGen _ (SyncThroughput (MeasuredIn (OldStorage.SyncThroughput (Core.BlockCount blocks)))) = bprint ("{" + %" quantity="%build + %" unit=blocksPerSecond" + %" }") + blocks + instance ToJSON SyncThroughput where toJSON (SyncThroughput (MeasuredIn (OldStorage.SyncThroughput (Core.BlockCount blocks)))) = object [ "quantity" .= toJSON blocks @@ -677,7 +702,7 @@ instance FromJSON SyncThroughput where parseJSON = withObject "SyncThroughput" $ \sl -> mkSyncThroughput . Core.BlockCount <$> sl .: "quantity" instance ToSchema SyncThroughput where - declareNamedSchema _ = do + declareNamedSchema _ = pure $ NamedSchema (Just "SyncThroughput") $ mempty & type_ .~ SwaggerObject & required .~ ["quantity", "unit"] @@ -713,7 +738,14 @@ instance ToSchema SyncProgress where deriveSafeBuildable ''SyncProgress -- Nothing secret to redact for a SyncProgress. instance BuildableSafeGen SyncProgress where - buildSafeGen _ sp = bprint build sp + buildSafeGen sl SyncProgress {..} = bprint ("{" + %" estimatedCompletionTime="%buildSafe sl + %" throughput="%buildSafe sl + %" percentage="%buildSafe sl + %" }") + spEstimatedCompletionTime + spThroughput + spPercentage instance Example SyncProgress where instance Arbitrary SyncProgress where @@ -863,7 +895,7 @@ newtype AddressValidity = AddressValidity { isValid :: Bool } deriveJSON Serokell.defaultOptions ''AddressValidity instance ToSchema AddressValidity where - declareNamedSchema = genericSchemaDroppingPrefix "is" (\_ -> identity) + declareNamedSchema = genericSchemaDroppingPrefix "is" (const identity) instance Arbitrary AddressValidity where arbitrary = AddressValidity <$> arbitrary @@ -899,7 +931,67 @@ instance Arbitrary WalletAddress where <*> arbitrary <*> arbitrary -type AccountIndex = Word32 +newtype AccountIndex = AccountIndex { getAccIndex :: Word32 } + deriving (Show, Eq, Ord, Generic) + +newtype AccountIndexError = AccountIndexError Word32 + deriving (Eq, Show) + +instance Buildable AccountIndexError where + build (AccountIndexError i) = + bprint + ("Account index should be in range ["%int%".."%int%"], but "%int%" was provided.") + (getAccIndex minBound) + (getAccIndex maxBound) + i + +mkAccountIndex :: Word32 -> Either AccountIndexError AccountIndex +mkAccountIndex index + | index >= getAccIndex minBound = Right $ AccountIndex index + | otherwise = Left $ AccountIndexError index + +instance Bounded AccountIndex where + -- NOTE: minimum for hardened key. See https://iohk.myjetbrains.com/youtrack/issue/CO-309 + minBound = AccountIndex 2147483648 + maxBound = AccountIndex maxBound + +instance ToJSON AccountIndex where + toJSON = toJSON . getAccIndex + +instance FromJSON AccountIndex where + parseJSON = + either fmtFail pure . mkAccountIndex <=< parseJSON + where + fmtFail = fail . toString . sformat build + +instance Arbitrary AccountIndex where + arbitrary = + AccountIndex <$> choose (getAccIndex minBound, getAccIndex maxBound) + +deriveSafeBuildable ''AccountIndex +-- Nothing secret to redact for a AccountIndex. +instance BuildableSafeGen AccountIndex where + buildSafeGen _ = + bprint build . getAccIndex + +instance ToParamSchema AccountIndex where + toParamSchema _ = mempty + & type_ .~ SwaggerNumber + & minimum_ .~ Just (fromIntegral $ getAccIndex minBound) + & maximum_ .~ Just (fromIntegral $ getAccIndex maxBound) + +instance ToSchema AccountIndex where + declareNamedSchema = + pure . paramSchemaToNamedSchema defaultSchemaOptions + +instance FromHttpApiData AccountIndex where + parseQueryParam = + first (sformat build) . mkAccountIndex <=< parseQueryParam + +instance ToHttpApiData AccountIndex where + toQueryParam = + fromString . show . getAccIndex + -- | A wallet 'Account'. data Account = Account @@ -1689,7 +1781,7 @@ instance FromJSON LocalTimeDifference where parseJSON = withObject "LocalTimeDifference" $ \sl -> mkLocalTimeDifference <$> sl .: "quantity" instance ToSchema LocalTimeDifference where - declareNamedSchema _ = do + declareNamedSchema _ = pure $ NamedSchema (Just "LocalTimeDifference") $ mempty & type_ .~ SwaggerObject & required .~ ["quantity"] @@ -1730,7 +1822,7 @@ instance FromJSON BlockchainHeight where mkBlockchainHeight . Core.BlockCount <$> sl .: "quantity" instance ToSchema BlockchainHeight where - declareNamedSchema _ = do + declareNamedSchema _ = pure $ NamedSchema (Just "BlockchainHeight") $ mempty & type_ .~ SwaggerObject & required .~ ["quantity"] @@ -2071,3 +2163,310 @@ instance Example Redemption where <*> example <*> example <*> example + +-- +-- Wallet Errors +-- + +-- | Type representing any error which might be thrown by wallet. +-- +-- Errors are represented in JSON in the JSend format (): +-- ``` +-- { +-- "status": "error" +-- "message" : , +-- "diagnostic" : +-- } +-- ``` +-- where `` is a string containing name of error's constructor (e. g. `NotEnoughMoney`), +-- and `` is an object containing additional error data. +-- Additional data contains constructor fields, field names are record field names without +-- a `we` prefix, e. g. for `OutputIsRedeem` error "diagnostic" field will be the following: +-- ``` +-- { +-- "address" :
+-- } +-- ``` +-- +-- Additional data in constructor should be represented as record fields. +-- Otherwise TemplateHaskell will raise an error. +-- +-- If constructor does not have additional data (like in case of `WalletNotFound` error), +-- then "diagnostic" field will be empty object. +-- +-- TODO: change fields' types to actual Cardano core types, like `Coin` and `Address` +data WalletError = + -- | NotEnoughMoney weNeedMore + NotEnoughMoney !Int + -- | OutputIsRedeem weAddress + | OutputIsRedeem !(V1 Core.Address) + -- | UnknownError weMsg + | UnknownError !Text + -- | InvalidAddressFormat weMsg + | InvalidAddressFormat !Text + | WalletNotFound + | WalletAlreadyExists !WalletId + | AddressNotFound + | TxFailedToStabilize + | InvalidPublicKey !Text + | UnsignedTxCreationError + | TooBigTransaction + -- ^ Size of transaction (in bytes) is greater than maximum. + | SignedTxSubmitError !Text + | TxRedemptionDepleted + -- | TxSafeSignerNotFound weAddress + | TxSafeSignerNotFound !(V1 Core.Address) + -- | MissingRequiredParams requiredParams + | MissingRequiredParams !(NonEmpty (Text, Text)) + -- | WalletIsNotReadyToProcessPayments weStillRestoring + | CannotCreateAddress !Text + -- ^ Cannot create derivation path for new address (for external wallet). + | WalletIsNotReadyToProcessPayments !SyncProgress + -- ^ The @Wallet@ where a @Payment@ is being originated is not fully + -- synced (its 'WalletSyncState' indicates it's either syncing or + -- restoring) and thus cannot accept new @Payment@ requests. + -- | NodeIsStillSyncing wenssStillSyncing + | NodeIsStillSyncing !SyncPercentage + -- ^ The backend couldn't process the incoming request as the underlying + -- node is still syncing with the blockchain. + deriving (Generic, Show, Eq) + +-- deriveWalletErrorJSON ''WalletError +deriveGeneric ''WalletError + +instance Exception WalletError + +instance Arbitrary WalletError where + arbitrary = oneof + [ NotEnoughMoney <$> arbitrary + , OutputIsRedeem <$> arbitrary + , pure (UnknownError "Unknown error.") + , pure (InvalidAddressFormat "Invalid Base58 representation.") + , pure WalletNotFound + , WalletAlreadyExists <$> arbitrary + , pure AddressNotFound + , pure (InvalidPublicKey "Invalid root public key for external wallet.") + , pure UnsignedTxCreationError + , pure (SignedTxSubmitError "Cannot submit externally-signed transaction.") + , pure TooBigTransaction + , pure TxFailedToStabilize + , pure TxRedemptionDepleted + , TxSafeSignerNotFound <$> arbitrary + , pure (MissingRequiredParams (("wallet_id", "walletId") :| [])) + , WalletIsNotReadyToProcessPayments <$> arbitrary + , NodeIsStillSyncing <$> arbitrary + , pure (CannotCreateAddress "Cannot create derivation path for new address in external wallet.") + ] + +-- | Give a short description of an error +instance Buildable WalletError where + build = \case + NotEnoughMoney _ -> + bprint "Not enough available coins to proceed." + OutputIsRedeem _ -> + bprint "One of the TX outputs is a redemption address." + UnknownError _ -> + bprint "Unexpected internal error." + InvalidAddressFormat _ -> + bprint "Provided address format is not valid." + WalletNotFound -> + bprint "Reference to an unexisting wallet was given." + WalletAlreadyExists _ -> + bprint "Can't create or restore a wallet. The wallet already exists." + AddressNotFound -> + bprint "Reference to an unexisting address was given." + InvalidPublicKey _ -> + bprint "Extended public key (for external wallet) is invalid." + UnsignedTxCreationError -> + bprint "Unable to create unsigned transaction for an external wallet." + TooBigTransaction -> + bprint "Transaction size is greater than 4096 bytes." + SignedTxSubmitError _ -> + bprint "Unable to submit externally-signed transaction." + MissingRequiredParams _ -> + bprint "Missing required parameters in the request payload." + WalletIsNotReadyToProcessPayments _ -> + bprint "This wallet is restoring, and it cannot send new transactions until restoration completes." + NodeIsStillSyncing _ -> + bprint "The node is still syncing with the blockchain, and cannot process the request yet." + TxRedemptionDepleted -> + bprint "The redemption address was already used." + TxSafeSignerNotFound _ -> + bprint "The safe signer at the specified address was not found." + TxFailedToStabilize -> + bprint "We were unable to find a set of inputs to satisfy this transaction." + CannotCreateAddress _ -> + bprint "Cannot create derivation path for new address, for external wallet." + + +-- | Convert wallet errors to Servant errors +instance ToServantError WalletError where + declareServantError = \case + NotEnoughMoney{} -> + err403 + OutputIsRedeem{} -> + err403 + UnknownError{} -> + err500 + WalletNotFound{} -> + err404 + WalletAlreadyExists{} -> + err403 + InvalidAddressFormat{} -> + err401 + AddressNotFound{} -> + err404 + InvalidPublicKey{} -> + err400 + UnsignedTxCreationError{} -> + err500 + TooBigTransaction{} -> + err400 + SignedTxSubmitError{} -> + err500 + MissingRequiredParams{} -> + err400 + WalletIsNotReadyToProcessPayments{} -> + err403 + NodeIsStillSyncing{} -> + err412 -- Precondition failed + TxFailedToStabilize{} -> + err500 + TxRedemptionDepleted{} -> + err400 + TxSafeSignerNotFound{} -> + err400 + CannotCreateAddress{} -> + err500 + +instance ToHttpErrorStatus WalletError + +instance ToJSON WalletError where + toEncoding (NotEnoughMoney weNeedMore) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" + (pairs $ pairStr "needMore" (toEncoding weNeedMore)) + <> "message" .= String "NotEnoughMoney" + toEncoding (OutputIsRedeem weAddress) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" + (pairs $ pairStr "address" (toEncoding weAddress)) + <> "message" .= String "OutputIsRedeem" + toEncoding (UnknownError weMsg) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weMsg)) + <> "message" .= String "UnknownError" + toEncoding (InvalidAddressFormat weMsg) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weMsg)) + <> "message" .= String "InvalidAddressFormat" + toEncoding (WalletNotFound) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ mempty) + <> "message" .= String "WalletNotFound" + toEncoding (WalletAlreadyExists wid) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ pairStr "walletId" (toEncoding wid)) + <> "message" .= String "WalletAlreadyExists" + toEncoding (AddressNotFound) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ mempty) + <> "message" .= String "AddressNotFound" + toEncoding (TxFailedToStabilize) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ mempty) + <> "message" .= String "TxFailedToStabilize" + toEncoding (InvalidPublicKey weProblem) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weProblem)) + <> "message" .= String "InvalidPublicKey" + toEncoding (UnsignedTxCreationError) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ mempty) + <> "message" .= String "UnsignedTxCreationError" + toEncoding (TooBigTransaction) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ mempty) + <> "message" .= String "TooBigTransaction" + toEncoding (SignedTxSubmitError weProblem) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weProblem)) + <> "message" .= String "SignedTxSubmitError" + toEncoding (TxRedemptionDepleted) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ mempty) + <> "message" .= String "TxRedemptionDepleted" + toEncoding (TxSafeSignerNotFound weAddress) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" + (pairs $ pairStr "address" (toEncoding weAddress)) + <> "message" .= String "TxSafeSignerNotFound" + toEncoding (MissingRequiredParams requiredParams) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" + (pairs $ pairStr "params" (toEncoding requiredParams)) + <> "message" .= String "MissingRequiredParams" + toEncoding (CannotCreateAddress weProblem) = + pairs $ pairStr "status" (toEncoding $ String "error") + <> pairStr "diagnostic" (pairs $ pairStr "msg" (toEncoding weProblem)) + <> "message" .= String "CannotCreateAddress" + toEncoding (WalletIsNotReadyToProcessPayments weStillRestoring) = + toEncoding $ toJSON weStillRestoring + toEncoding (NodeIsStillSyncing wenssStillSyncing) = + toEncoding $ toJSON wenssStillSyncing + +instance FromJSON WalletError where + parseJSON (Object o) + | HMS.member "message" o = + case HMS.lookup "message" o of + Just "NotEnoughMoney" -> + NotEnoughMoney + <$> ((o .: "diagnostic") >>= (.: "needMore")) + Just "OutputIsRedeem" -> + OutputIsRedeem <$> ((o .: "diagnostic") >>= (.: "address")) + Just "UnknownError" -> + UnknownError <$> ((o .: "diagnostic") >>= (.: "msg")) + Just "InvalidAddressFormat" -> + InvalidAddressFormat + <$> ((o .: "diagnostic") >>= (.: "msg")) + Just "WalletNotFound" -> pure WalletNotFound + Just "WalletAlreadyExists" -> + WalletAlreadyExists <$> ((o .: "diagnostic") >>= (.: "walletId")) + Just "AddressNotFound" -> pure AddressNotFound + Just "TxFailedToStabilize" -> pure TxFailedToStabilize + Just "TxRedemptionDepleted" -> pure TxRedemptionDepleted + Just "TxSafeSignerNotFound" -> + TxSafeSignerNotFound + <$> ((o .: "diagnostic") >>= (.: "address")) + Just "InvalidPublicKey" -> + InvalidPublicKey <$> ((o .: "diagnostic") >>= (.: "msg")) + Just "UnsignedTxCreationError" -> pure UnsignedTxCreationError + Just "TooBigTransaction" -> pure TooBigTransaction + Just "SignedTxSubmitError" -> + SignedTxSubmitError <$> ((o .: "diagnostic") >>= (.: "msg")) + Just "CannotCreateAddress" -> + CannotCreateAddress <$> ((o .: "diagnostic") >>= (.: "msg")) + Just "MissingRequiredParams" -> + MissingRequiredParams + <$> ((o .: "diagnostic") >>= (.: "params")) + Just _ -> + fail "Incorrect JSON encoding for WalletError" + Nothing -> + fail "Incorrect JSON encoding for WalletError" + -- WalletIsNotReadyToProcessPayments + | HMS.member "estimatedCompletionTime" o = do + estCompTO <- (o .: "estimatedCompletionTime") + sThroughPO <- (o .: "throughput") + prctO <- (o .: "percentage") + estCompT <- parseJSON estCompTO + sThroughP <- parseJSON sThroughPO + prct <- parseJSON prctO + return . WalletIsNotReadyToProcessPayments + $ SyncProgress estCompT sThroughP prct + -- NodeIsStillSyncing + | HMS.member "quantity" o = do + quantityO <- o .: "quantity" + quantity <- parseJSON quantityO + return . NodeIsStillSyncing $ mkSyncPercentage quantity + | otherwise = fail "Incorrect JSON encoding for WalletError" + parseJSON invalid = typeMismatch "WalletError" invalid diff --git a/wallet-new/src/Cardano/Wallet/Client.hs b/wallet-new/src/Cardano/Wallet/Client.hs index 153763108d0..9a218ed7fa2 100644 --- a/wallet-new/src/Cardano/Wallet/Client.hs +++ b/wallet-new/src/Cardano/Wallet/Client.hs @@ -16,7 +16,7 @@ module Cardano.Wallet.Client , liftClient -- * The type of errors that the client might return , ClientError(..) - , V1Errors.WalletError(..) + , WalletError(..) , ServantError(..) , Response , GenResponse(..) @@ -40,7 +40,6 @@ import Cardano.Wallet.API.Request.Filter import Cardano.Wallet.API.Request.Pagination import Cardano.Wallet.API.Request.Sort import Cardano.Wallet.API.Response -import qualified Cardano.Wallet.API.V1.Errors as V1Errors import Cardano.Wallet.API.V1.Parameters import Cardano.Wallet.API.V1.Types import qualified Pos.Core as Core @@ -148,7 +147,7 @@ paginateAll request = fmap fixMetadata <$> paginatePage 1 where fixMetadata WalletResponse{..} = WalletResponse - { wrMeta = Metadata $ + { wrMeta = Metadata PaginationMetadata { metaTotalPages = 1 , metaPage = Page 1 @@ -256,7 +255,7 @@ type Resp m a = m (Either ClientError (WalletResponse a)) -- | The type of errors that the wallet might return. data ClientError - = ClientWalletError V1Errors.WalletError + = ClientWalletError WalletError -- ^ The 'WalletError' type represents known failures that the API -- might return. | ClientHttpError ServantError diff --git a/wallet-new/src/Cardano/Wallet/Server/Plugins.hs b/wallet-new/src/Cardano/Wallet/Server/Plugins.hs index b3fb64c1d1e..0067ba46a35 100644 --- a/wallet-new/src/Cardano/Wallet/Server/Plugins.hs +++ b/wallet-new/src/Cardano/Wallet/Server/Plugins.hs @@ -2,7 +2,6 @@ A @Plugin@ is essentially a set of actions which will be run in a particular monad, at some point in time. -} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} module Cardano.Wallet.Server.Plugins ( @@ -20,7 +19,8 @@ module Cardano.Wallet.Server.Plugins ( import Universum import Cardano.Wallet.API as API -import qualified Cardano.Wallet.API.V1.Errors as V1 +import Cardano.Wallet.API.V1.Headers (applicationJson) +import qualified Cardano.Wallet.API.V1.Types as V1 import Cardano.Wallet.Kernel (PassiveWallet) import qualified Cardano.Wallet.Kernel.Diffusion as Kernel import qualified Cardano.Wallet.Kernel.Mode as Kernel @@ -169,7 +169,7 @@ legacyWalletBackend pm txpConfig WalletBackendParams {..} ntpStatus = pure $ \di handleV1Errors :: SomeException -> Maybe Response handleV1Errors se = let reify (we :: V1.WalletError) = - responseLBS (V1.toHttpStatus we) [V1.applicationJson] . encode $ we + responseLBS (V1.toHttpErrorStatus we) [applicationJson] . encode $ we in fmap reify (fromException se) -- Handles domain-specific errors coming from the V0 API, but rewraps it @@ -185,13 +185,18 @@ legacyWalletBackend pm txpConfig WalletBackendParams {..} ntpStatus = pure $ \di V0.RequestError _ -> err V0.InternalError _ -> V0.RequestError "InternalError" V0.DecodeError _ -> V0.RequestError "DecodeError" - reify (re :: V0.WalletError) = V1.UnknownError (sformat build . maskSensitive $ re) - in fmap (responseLBS badRequest400 [V1.applicationJson] . encode . reify) (fromException se) + reify :: V0.WalletError -> V1.WalletError + reify = V1.UnknownError . sformat build . maskSensitive + in fmap (responseLBS badRequest400 [applicationJson] . encode . reify) (fromException se) -- Handles any generic error, trying to prevent internal exceptions from leak outside. handleGenericError :: SomeException -> Response handleGenericError _ = - responseLBS badRequest400 [V1.applicationJson] . encode $ V1.UnknownError "Something went wrong." + let + unknownV1Error = V1.UnknownError "Something went wrong." + in + responseLBS badRequest400 [applicationJson] $ encode unknownV1Error + -- | A 'Plugin' to start the wallet REST server -- diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs index f7d51213af5..ba3c05f4b8f 100644 --- a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs +++ b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Active.hs @@ -90,7 +90,7 @@ setupPayment grouping regulation payment = do csoExpenseRegulation = regulation , csoInputGrouping = grouping } - accIx = HD.HdAccountIx (V1.psAccountIndex . V1.pmtSource $ payment) + accIx = HD.HdAccountIx (V1.getAccIndex . V1.psAccountIndex . V1.pmtSource $ payment) accId = HD.HdAccountId { _hdAccountIdParent = rootId , _hdAccountIdIx = accIx diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs index ffbd278087e..7637cadf0f1 100644 --- a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs +++ b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Conv.hs @@ -55,7 +55,7 @@ fromAccountId wId accIx = aux <$> fromRootId wId where aux :: HD.HdRootId -> HD.HdAccountId - aux hdRootId = HD.HdAccountId hdRootId (HD.HdAccountIx accIx) + aux hdRootId = HD.HdAccountId hdRootId (HD.HdAccountIx $ V1.getAccIndex accIx) -- | Converts from the @V1@ 'AssuranceLevel' to the HD one. fromAssuranceLevel :: V1.AssuranceLevel -> HD.AssuranceLevel @@ -67,7 +67,11 @@ fromAssuranceLevel V1.StrictAssurance = HD.AssuranceLevelStrict -------------------------------------------------------------------------------} toAccountId :: HD.HdAccountId -> V1.AccountIndex -toAccountId = HD.getHdAccountIx . view HD.hdAccountIdIx +toAccountId = + either (error . show) identity -- Invariant: Assuming HD AccountId are valid~ + . V1.mkAccountIndex + . HD.getHdAccountIx + . view HD.hdAccountIdIx toRootId :: HD.HdRootId -> V1.WalletId toRootId = V1.WalletId . sformat build . _fromDb . HD.getHdRootId @@ -85,7 +89,7 @@ toAccount snapshot account = V1.Account { -- NOTE(adn): Perhaps we want the minimum or expected balance here? accountAvailableBalance = Kernel.accountAvailableBalance snapshot hdAccountId hdAccountId = account ^. HD.hdAccountId - accountIndex = account ^. HD.hdAccountId . HD.hdAccountIdIx . to HD.getHdAccountIx + accountIndex = toAccountId (account ^. HD.hdAccountId) hdAddresses = Kernel.accountAddresses snapshot hdAccountId addresses = IxSet.toList hdAddresses hdRootId = account ^. HD.hdAccountId . HD.hdAccountIdParent diff --git a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs index 099da6dc97d..44d42791ff8 100644 --- a/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs +++ b/wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs @@ -77,7 +77,7 @@ castAccountFiltering mbWalletId mbAccountIndex = (Just (V1.WalletId wId), _) -> case decodeTextAddress wId of Left _ -> throwError $ GetTxAddressDecodingFailed wId - Right rootAddr -> return $ TxMeta.AccountFops rootAddr mbAccountIndex + Right rootAddr -> return $ TxMeta.AccountFops rootAddr (V1.getAccIndex <$> mbAccountIndex) -- This function reads at most the head of the SortOperations and expects to find "created_at". castSorting :: Monad m => S.SortOperations V1.Transaction -> ExceptT GetTxError m (Maybe TxMeta.Sorting) diff --git a/wallet-new/test/MarshallingSpec.hs b/wallet-new/test/MarshallingSpec.hs index 32124c02032..93bbcb8d28d 100644 --- a/wallet-new/test/MarshallingSpec.hs +++ b/wallet-new/test/MarshallingSpec.hs @@ -11,6 +11,7 @@ import qualified Pos.Chain.Txp as V0 import Pos.Client.Txp.Util (InputSelectionPolicy) import qualified Pos.Crypto as Crypto import qualified Pos.Wallet.Web.ClientTypes.Types as V0 +import Servant.API (FromHttpApiData (..), ToHttpApiData (..)) import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck @@ -21,8 +22,10 @@ import qualified Pos.Core as Core import qualified Pos.Core.Update as Core import Cardano.Wallet.API.Indices -import Cardano.Wallet.API.V1.Errors (WalletError) -import Cardano.Wallet.API.V1.Migration.Types (Migrate (..)) +import Cardano.Wallet.API.Request.Pagination (Page, PerPage) +import Cardano.Wallet.API.Response (JSONValidationError) +import Cardano.Wallet.API.V1.Migration.Types (Migrate (..), + MigrationError) import Cardano.Wallet.API.V1.Types import Cardano.Wallet.Orphans () import qualified Cardano.Wallet.Util as Util @@ -31,7 +34,6 @@ import qualified Cardano.Wallet.Util as Util spec :: Spec spec = parallel $ describe "Marshalling & Unmarshalling" $ do parallel $ describe "Roundtrips" $ do - -- Aeson roundrips aesonRoundtripProp @Account Proxy aesonRoundtripProp @AssuranceLevel Proxy aesonRoundtripProp @BackupPhrase Proxy @@ -52,6 +54,8 @@ spec = parallel $ describe "Marshalling & Unmarshalling" $ do aesonRoundtripProp @TransactionType Proxy aesonRoundtripProp @TransactionStatus Proxy aesonRoundtripProp @WalletError Proxy + aesonRoundtripProp @JSONValidationError Proxy + aesonRoundtripProp @MigrationError Proxy aesonRoundtripProp @WalletId Proxy aesonRoundtripProp @Wallet Proxy aesonRoundtripProp @SlotDuration Proxy @@ -63,8 +67,19 @@ spec = parallel $ describe "Marshalling & Unmarshalling" $ do aesonRoundtripProp @EstimatedCompletionTime Proxy aesonRoundtripProp @SyncProgress Proxy aesonRoundtripProp @SyncThroughput Proxy - - -- Migrate roundrips + aesonRoundtripProp @AccountIndex Proxy + + -- HttpApiData roundtrips + httpApiDataRoundtripProp @AccountIndex Proxy + httpApiDataRoundtripProp @(V1 Core.TxId) Proxy + httpApiDataRoundtripProp @WalletId Proxy + httpApiDataRoundtripProp @(V1 Core.Timestamp) Proxy + httpApiDataRoundtripProp @(V1 Core.Address) Proxy + httpApiDataRoundtripProp @PerPage Proxy + httpApiDataRoundtripProp @Page Proxy + httpApiDataRoundtripProp @Core.Coin Proxy + + -- Migrate roundtrips migrateRoundtripProp @(V1 Core.Address) @(V0.CId V0.Addr) Proxy Proxy migrateRoundtripProp @(V1 Core.Coin) @V0.CCoin Proxy Proxy migrateRoundtripProp @AssuranceLevel @V0.CWalletAssurance Proxy Proxy @@ -133,7 +148,7 @@ migrateRoundtrip :: (Arbitrary from, Migrate from to, Migrate to from, Eq from, migrateRoundtrip (_ :: proxy from) (_ :: proxy to) = forAll arbitrary $ \(arbitraryFrom :: from) -> do (eitherMigrate =<< migrateTo arbitraryFrom) === Right arbitraryFrom where - migrateTo x = eitherMigrate x :: Either WalletError to + migrateTo x = eitherMigrate x :: Either MigrationError to migrateRoundtripProp :: (Arbitrary from, Migrate from to, Migrate to from, Eq from, Show from, Typeable from, Typeable to) @@ -151,6 +166,16 @@ aesonRoundtripProp aesonRoundtripProp proxy = prop ("Aeson " <> show (typeRep proxy) <> " roundtrips") (aesonRoundtrip proxy) +httpApiDataRoundtrip :: (Arbitrary a, FromHttpApiData a, ToHttpApiData a, Eq a, Show a) => proxy a -> Property +httpApiDataRoundtrip (_ :: proxy a) = forAll arbitrary $ \(s :: a) -> do + parseQueryParam (toQueryParam s) === Right s + +httpApiDataRoundtripProp + :: (Arbitrary a, ToHttpApiData a, FromHttpApiData a, Eq a, Show a, Typeable a) + => proxy a -> Spec +httpApiDataRoundtripProp proxy = + prop ("HttpApiData " <> show (typeRep proxy) <> " roundtrips") (httpApiDataRoundtrip proxy) + generalRoundtrip :: (Arbitrary from, Eq from, Show from, Show e) => (from -> to) -> (to -> Either e from) -> Property