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.  ')

Author: akegalj

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

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) #-}

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

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