Skip to content
This repository has been archived by the owner on Aug 18, 2020. It is now read-only.

Commit

Permalink
Akegalj/co 319/swagger account index (#3086)
Browse files Browse the repository at this point in the history
* [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.  ')
  • Loading branch information
akegalj authored and KtorZ committed Aug 17, 2018
1 parent 9d07db6 commit 1e61367
Show file tree
Hide file tree
Showing 20 changed files with 818 additions and 582 deletions.
1 change: 1 addition & 0 deletions wallet-new/cardano-sl-wallet-new.cabal
Expand Up @@ -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
Expand Down
8 changes: 4 additions & 4 deletions wallet-new/integration/TransactionSpecs.hs
Expand Up @@ -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) #-}
Expand Down
2 changes: 0 additions & 2 deletions wallet-new/integration/WalletSpecs.hs
Expand Up @@ -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
Expand Down
91 changes: 74 additions & 17 deletions 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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

0 comments on commit 1e61367

Please sign in to comment.