http-rfc7807 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+349/−20 lines, 5 filesdep +HUnitdep ~servantdep ~servant-serverPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit

Dependency ranges changed: servant, servant-server

API changes (from Hackage documentation)

Files

• ChangeLog.md +21/−0
• README.md +83/−1
• http-rfc7807.cabal +9/−5
• src/Servant/Server/RFC7807.hs +140/−5
• test/Main.hs +96/−9

@@ -1,5 +1,26 @@ For latest version of this document see [`ChangeLog.md on GitHub`](https://github.com/trskop/http-rfc7807/blob/main/ChangeLog.md). ++### 0.2.0.0++* (**breaking change**) Function `rfc7807ServerError` sets the value of `title`+  field is set to HTTP reason from Servant's `ServerError` by default. User can+  still override it as before, but this is a breaking change as it changes the+  expected output.++* (**breaking change**) Type variable `body` is now first in the definition of+  `rfc7807ServerError`. If you've used `TypeApplications` when calling+  `rfc7807ServerError` function then this may be a breaking change for you.++* (**change**) Support `servant-server-0.15` in addition to currently supported+  versions. We are planning to drop the support once again in next major+  release. See [@servant-server-1.16 ChangeLog+  ](https://hackage.haskell.org/package/servant-server-0.16/changelog) to see+  what it entails.++* Documentation updates++ ### 0.1.0.0  Initial release

@@ -23,6 +23,88 @@ } ``` ++## Table of Contents++(Links work on GitHub, but not on Hackage.)++* [What does this package do?](#what-does-this-package-do)+* [Why would I want to use this?](#why-would-i-want-to-use-this)+* [When would I want to use something else?](#when-would-i-want-to-use-something-else)+* [Usage examples](#usage-examples)+++## What does this package do?+ This library provides a data type `Rfc7807Error` that represents such error responses. It is designed to be extensible and to allow alternative-representation of user defined fields.+representation of user defined fields. See module `Network.HTTP.RFC7807` for+documentation.++In addition the package provides basic support for [`servant-server` package+](https://hackage.haskell.org/package/servant-server). See+[`Servant.Server.RFC7807` module documentation+](https://hackage.haskell.org/package/http-rfc7807/docs/Servant-Server-RFC7807.html)+for more information and usage examples.+++## Why would I want to use this?++[![Oh my](https://raw.githubusercontent.com/trskop/http-rfc7807/f9d81307fff768ebe55eff7b009310aefc9af233/doc/nixcraft-tweet-with-obscure-error-response.png)+](https://twitter.com/nixcraft/status/1321898390209273856)++There are many ways common ways how API error responses are structured in HTTP+APIs. Using this one has few advantages:++* It is standardised in [RFC7807 — Problem Details for HTTP APIs+  ](https://tools.ietf.org/html/rfc7807). This can be leveraged in terms of+  documentation, libraries built with it in mind, and not heaving to reinvent+  something that people have put a lot of thought into.++* Gives you a nice template that is still flexible and extensible. This is+  important if we are retrofitting it into an existing API.++* Documented by default. The `type` field is a URL, used correctly can allow us+  to prevent a lot of issues by linking errors with their documentation.++* Increasing level of detail. We have `type`, `title`, then `detail`, and+  finally custom fields. This way we can progressively add more information+  allowing users to easily debug issues.++* Proxy friendly. When proxies are involved, so called layering, it is quite+  easy to loose the original status code. This can also happen with some HTTP+  libraries that do not retain the status code.++* Probably more...++There's an interesting article "[REST API Error Handling - Problem Details+Response by Guy Levin published on 23rd of May, 2018+](https://blog.restcase.com/rest-api-error-handling-problem-details-response/)"+that compares various stiles of error responses AKA problem details responses.+++## When would I want to use something else?++This response structure may not serve your needs if it's clashing with your+needs. Some examples of that:++* Your needs are in direct conflict with the [RFC7807 — Problem Details for+  HTTP APIs](https://tools.ietf.org/html/rfc7807) standard. For example, fields+  that are defined by the standard are reserved in your system or protocol+  you're using.++* When RFC7807 messages cannot easily be retrofitted into your API and you need+  to preserve backward compatibility.++* Probably more...+++## Usage examples++General usage (not tied to Servant) is documented in [module+`Network.HTTP.RFC7807` in section Usage Examples+](https://hackage.haskell.org/package/http-rfc7807/docs/Network-HTTP-RFC7807.html#usage-examples).++Basic usage with Servant (actually `servant-server`) is documented in+[module `Servant.Server.RFC7807` in section Usage Examples+](https://hackage.haskell.org/package/http-rfc7807/docs/Servant-Server-RFC7807.html#usage-examples).

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 31ff663e1db6eb5ce1c51bdec4504de59a9d87225c9a4052382cec7633c603db+-- hash: 81f1ad1976b7e75902fd442b0e1b09b0e6295bb53eba518d35aaddff3a0ec408  name:           http-rfc7807-version:        0.1.0.0+version:        0.2.0.0 synopsis:       RFC7807 style response messages  description:    [RFC7807 — Problem Details for HTTP APIs](https://tools.ietf.org/html/rfc7807)@@ -47,8 +47,8 @@     , base >=4.12 && <5     , http-media >=0.7.1.3 && <1     , http-types >=0.12.2 && <1-    , servant >=0.16 && <1-    , servant-server >=0.16 && <1+    , servant >=0.15 && <1+    , servant-server >=0.15 && <1     , text >=1.2.3.0 && <2   default-language: Haskell2010 @@ -62,11 +62,15 @@   default-extensions: BlockArguments DeriveGeneric DerivingStrategies DuplicateRecordFields FlexibleContexts FlexibleInstances InstanceSigs LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings RecordWildCards ScopedTypeVariables TypeApplications   ghc-options: -Wall -Wcompat -threaded -rtsopts -with-rtsopts=-N   build-depends:-      aeson >=1.4.1.0 && <2+      HUnit >=1.6.0.0 && <1.7+    , aeson >=1.4.1.0 && <2     , base >=4.12 && <5     , call-stack >=0.2.0 && <1     , hspec-expectations-json >=1.0.0.0 && <2     , http-rfc7807+    , http-types >=0.12.2 && <1+    , servant >=0.15 && <1+    , servant-server >=0.15 && <1     , tasty >=1.2.3 && <2     , tasty-hunit >=0.10.0.2 && <1     , text >=1.2.3.0 && <2

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module:      Servant.Server.RFC7807 -- Description: Servant support for RFC7807 style error response messages@@ -18,6 +19,14 @@     -- * Mime Type @application\/problem+json@     , ProblemJSON +    -- * Usage Examples+    --+    -- $usageExamples++    -- ** Direct Use Example+    --+    -- $directUseExample+     -- * Re-exported     --     -- | When using 'Rfc7807Error' in more complex way, please, depend on@@ -25,13 +34,27 @@     -- detailed usage examples can be found in "Network.HTTP.RFC7807" module     -- documentation.     , Rfc7807Error(..)++#if !MIN_VERSION_servant_server(0,16,0)+    -- * Servant 0.15 Compatibility+    --+    -- | In @servant-server@ version 0.16 'ServantErr' was renamed to+    -- 'ServerError'. This package provides compatiblity for that version, but+    -- it may be dropped in the near future.+    --+    -- For more information see [@servant-server-1.16 ChangeLog+    -- ](https://hackage.haskell.org/package/servant-server-0.16/changelog).+    , ServerError+#endif     )   where +import Data.Function (($)) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Maybe (Maybe(Just)) import Data.Proxy (Proxy) import Data.Semigroup ((<>))+import Data.String (fromString)  import qualified Data.Aeson as Aeson (FromJSON, ToJSON, encode) import Network.HTTP.Media ((//), (/:), renderHeader)@@ -72,6 +95,12 @@ instance Aeson.FromJSON a => MimeUnrender ProblemJSON a where     mimeUnrender _ = eitherDecodeLenient +#if !MIN_VERSION_servant_server(0,16,0)+-- | Compatibility with newer @servant-server@ versions as 'ServantErr' was+-- renamed to 'ServerError' in version 0.16.+type ServerError = ServantErr+#endif+ -- | Construct Servant 'ServerError' with RFC7807 style response body. -- -- By using Servant abstractions (like 'MimeRender' and 'Accept') we are able@@ -85,7 +114,7 @@ --     -- ... -- -- instance 'Aeson.ToJSON' ErrorType where---     'Aeson.toJSON' = \\case+--     toJSON = \\case --         ValidationError -> --              'Aeson.String' \"/errors#validation-error\" --@@ -98,7 +127,8 @@ --                } -- @ rfc7807ServerError-    :: (MimeRender ctype body)+    :: forall body ctype errorType errorInfo context+    .  (MimeRender ctype body)     => Proxy ctype     -- ^ Media type to use when encoding the error response body. This allows     -- us to select appropriate mime type, e.g. 'Servant.API.ContentTypes.JSON'@@ -111,16 +141,32 @@     -> (Rfc7807Error errorType errorInfo context -> body)     -- ^ Modify the 'Rfc7807Error' type to your hearts desire.     --+    -- The @'Rfc7807Error' errorType errorInfo context@ given to this function+    -- will have @type@, @title@, and @status@ set. Values for @title@ and+    -- @status@ are taken from Servant's 'ServerError'. It is highly advised+    -- to modify the @title@ to something more useful.+    --     -- Reason for the return type to be polymorphic (i.e. @body@) is that we     -- may want to use a newtype to use a different encoding. This still allows     -- us to use the @'Rfc7807Error' errorType errorInfo context@ type as a     -- return type if @errorType@, @errorInfo@, and @context@ can be encoded-    -- into JSON.+    -- into JSON. In other words, 'Data.Function.id' is a valid fit.     -> ServerError-rfc7807ServerError ctype serverError@ServerError{errHTTPCode, errHeaders} t f =+rfc7807ServerError+  ctype+#if MIN_VERSION_servant_server(0,16,0)+  serverError@ServerError{errHTTPCode, errHeaders, errReasonPhrase}+#else+  serverError@ServantErr{errHTTPCode, errHeaders, errReasonPhrase}+#endif+  errorType'+  f =     serverError         { errBody =-            mimeRender ctype (f (rfc7807Error t){status = Just errHTTPCode})+            mimeRender ctype $ f (rfc7807Error errorType')+                { status = Just errHTTPCode+                , title = Just (fromString errReasonPhrase)+                }          , errHeaders = errHeaders             <>  [ (hContentType, renderHeader (contentType ctype))@@ -136,3 +182,92 @@ -- use. This is especially true if we are migrating existing error responses. -- Another benefit of the abstract way it's defined is that we can potentially -- use different encoding or serialisation libraries.+--+-- If you're interested in using this module right away then jump straight to+-- [Usage Examples section](#usage-examples).++-- $usageExamples+--+-- #usage-examples#+--+-- These examples focus on usage of 'rfc7807ServerError', to see examples more+-- related to the 'Rfc7807Error' messages go to "Network.HTTP.RFC7807" module.+--+-- Haskell\/GHC language extensions being used in the examples:+--+-- * @RecordWildCards@ and @NamedFieldPuns@ — please read this great article+--   if you're not familiar with these extensions: [The Power of RecordWildCards+--   by Dmitrii Kovanikov](https://kodimensional.dev/recordwildcards).+--+-- * @OverloadedStrings@ — allows us to define string literals for types like+--   'Text' without needing to manually pack\/convert 'String' values. See+--   [GHC User's Guide — Overloaded string literals+--   ](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/glasgow_exts.html#overloaded-string-literals)+--   for more information.++-- $directUseExample+--+-- This example is intended to illustrate how we can start producing RFC7807+-- style responses without too much fuss. No complex abstractions, no custom+-- wrappers for 'Rfc7807Error', no custom serialisation, and no extra @context@.+--+-- @+-- -- | Servant definition of an endpoint.+-- type SomeEndpoint = {- ... -}+--+-- -- | This code is not complex enough to actually need to be in a function,+-- -- but it makes some things more obious and easier to change.+-- badRequest+--     :: ( MonadError 'ServerError' m+--        , 'Aeson.ToJSON' errorType+--        , 'Aeson.ToJSON' errorInfo+--        )+--     => errorType+--     -> ( 'Rfc7807Error' errorType errorInfo ()+--        -> 'Rfc7807Error' errorType errorInfo ()+--        )+--     -> m a+-- badRequest errorType =+--     throwError . 'rfc7807ServerError' (Proxy \@'ProblemJSON') 'err400' errorType+--+-- -- | See "Network.HTTP.RFC7807" module for more information and examples on+-- -- how to use and define data types to be used for @errorType@.+-- data ErrorType+--     = ValidationError+--     -- ...+--+-- instance 'Aeson.ToJSON' ErrorType where+--     toJSON = \\case+--         ValidationError ->+--              'Data.Aeson.String' \"/errors#some-endpoint-validation-error\"+--+-- someHandler :: 'ServerT' SomeEndpoint m+-- someHandler request = do+--     response <- doTheEndpointStuffBasedOn request+--+--     case response of+--         Success r ->+--             pure r+--+--         InvalidRequest error_@DataValidationFailed ->+--             badRequest ValidationError \\e -> e+--                 { title = \"Request data validation failed\"+--                 , detail = \"One or more members of request's 'data' field\\+--                     \\ failed validation, see 'error' field\"+--+--                 -- If we've used something like \@{\"error\": TheError}\@+--                 -- before switching to RFC7807 then this will be backward+--                 -- compatible. We can also play with the serialisation if we+--                 -- need to preserve backward compatibility. It won't work+--                 -- all the time though.+--                 --+--                 -- Huge downside of this approach is that the error is+--                 -- directly serialised into JSON. API contract can easily be+--                 -- affected by changes that seem unrelated. Please, consider+--                 -- having a separate data type for this purpose or use JSON+--                 -- combinators.+--                 , error_+--                 }+--+--         {- ... -}+-- @

@@ -1,6 +1,6 @@ -- | -- Module:      Main--- Description: TODO: Module synopsis+-- Description: Unit tests for Haskell implementation of RFC7807 style responses -- Copyright:   (c) 2020 Peter Trško -- License:     BSD3 --@@ -8,7 +8,7 @@ -- Stability:   experimental -- Portability: GHC specific language extensions. ----- TODO: Module description.+-- Unit tests for Haskell implementation of RFC7807 style responses. module Main     ( main     )@@ -16,18 +16,35 @@  import Prelude +import Control.Exception (handle, throwIO) import Data.Maybe (isJust)+import Data.Proxy (Proxy(Proxy))  import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import Data.Text (Text)-import Test.Hspec.Expectations.Json (shouldBeJson)+import Network.HTTP.Types (hContentType)+import Servant.API as Servant (JSON)+import Servant.Server as Servant+import qualified Test.HUnit.Lang as HUnit+  ( HUnitFailure(HUnitFailure)+  , formatFailureReason+  )+import qualified Test.Hspec.Expectations.Json as Json (shouldBeJson) --import Test.QuickCheck.Instances () import Test.Tasty (TestName, TestTree, defaultMain, testGroup)-import Test.Tasty.HUnit ({-(@?=),-} testCase{-, assertEqual-})+import Test.Tasty.HUnit+  ( Assertion+  , HasCallStack+  , assertEqual+  , assertFailure+  , testCase+  , HUnitFailure(..)+  ) --import Test.Tasty.QuickCheck (testProperty) -import Network.HTTP.RFC7807+import Network.HTTP.RFC7807 (Rfc7807Error(..))+import Servant.Server.RFC7807 (ProblemJSON, rfc7807ServerError)   main :: IO ()@@ -35,6 +52,68 @@     [ testGroup "Network.HTTP.RFC7807"         [ testDefaultSerialisation         ]++    , testGroup "Servant.Server.RFC7807"+        [ testCase "err400, JSON" do+            let actual =+                    rfc7807ServerError @(Rfc7807Error Text () ())+                        (Proxy @Servant.JSON) Servant.err400 "/errors#400" id++            assertEqual "HTTP status code hasn't changed"+                (Servant.errHTTPCode Servant.err400)+                (Servant.errHTTPCode actual)+            assertEqual "HTTP reason phrase hasn't changed"+                (Servant.errReasonPhrase Servant.err400)+                (Servant.errReasonPhrase actual)+            assertEqual "Content-Type is present and is\+                \ application/json;charset=utf-8"+                (Just "application/json;charset=utf-8")+                (hContentType `lookup` Servant.errHeaders actual)++            case Aeson.eitherDecode (Servant.errBody actual) of+                Left err ->+                    assertFailure+                        ( "HTTP response body is valid JSON, but we got:\n"+                        <> err+                        )++                Right actualJson ->+                    actualJson `shouldBeJson` Aeson.object+                    [ "type" .= Aeson.String "/errors#400"+                    , "status" .= Servant.errHTTPCode Servant.err400+                    , "title" .= Servant.errReasonPhrase Servant.err400+                    ]++        , testCase "err500, ProblemJSON" do+            let actual =+                    rfc7807ServerError @(Rfc7807Error Text () ())+                        (Proxy @ProblemJSON) Servant.err500 "/errors#500" id++            assertEqual "HTTP status code hasn't changed"+                (Servant.errHTTPCode Servant.err500)+                (Servant.errHTTPCode actual)+            assertEqual "HTTP reason phrase hasn't changed"+                (Servant.errReasonPhrase Servant.err500)+                (Servant.errReasonPhrase actual)+            assertEqual "Content-Type is present and is\+                \ application/json;charset=utf8"+                (Just "application/problem+json;charset=utf-8")+                (hContentType `lookup` Servant.errHeaders actual)++            case Aeson.eitherDecode (Servant.errBody actual) of+                Left err ->+                    assertFailure+                        ( "HTTP response body is valid JSON, but we got:\n"+                        <> err+                        )++                Right actualJson ->+                    actualJson `shouldBeJson` Aeson.object+                        [ "type" .= Aeson.String "/errors#500"+                        , "status" .= Servant.errHTTPCode Servant.err500+                        , "title" .= Servant.errReasonPhrase Servant.err500+                        ]+        ]     ]  testDefaultSerialisation :: TestTree@@ -74,10 +153,9 @@             ]         } -    -- Missing values were strategically chosen to belong to have one among-    -- fields defined by the standard and one among the extension fields.  As-    -- the logic is uniform we are able to verify both classes at the same-    -- time.+    -- Missing values were strategically chosen to have one among fields+    -- defined by the standard and one among the extension fields.  As the+    -- logic is uniform we are able to verify both classes at the same time.     , testDefaultSerialisationCase "Few empty values sample" Rfc7807Error         { type_ = "https://example.com/docs/error" :: Text         , title = Just "Not so detailed error"@@ -109,3 +187,12 @@             , ["context" .= context | isJust context]             ]         )++shouldBeJson :: HasCallStack => Aeson.Value -> Aeson.Value -> Assertion+shouldBeJson actual expected = hUnitToTasty (Json.shouldBeJson actual expected)++-- | Converts @HUnit@ exception to @tasty-hunit@ exception so that formatting+-- is preserved.+hUnitToTasty :: Assertion -> Assertion+hUnitToTasty = handle \(HUnit.HUnitFailure src reason) ->+    throwIO $ HUnitFailure src (HUnit.formatFailureReason reason)