From 9b73435d21f7c5b48596986f67725493ba08fbb5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Domen=20Ko=C5=BEar?= <domen@dev.si>
Date: Tue, 17 Apr 2018 15:25:38 +0100
Subject: [PATCH] cookbook: add jsonerror section

---
 doc/cookbook/cabal.project             |  1 +
 doc/cookbook/index.rst                 |  1 +
 doc/cookbook/jsonerror/Jsonerror.lhs   | 50 ++++++++++++++++++++++++++
 doc/cookbook/jsonerror/jsonerror.cabal | 24 +++++++++++++
 4 files changed, 76 insertions(+)
 create mode 100644 doc/cookbook/jsonerror/Jsonerror.lhs
 create mode 100644 doc/cookbook/jsonerror/jsonerror.cabal

diff --git a/doc/cookbook/cabal.project b/doc/cookbook/cabal.project
index 4f2a4255..8481d0f2 100644
--- a/doc/cookbook/cabal.project
+++ b/doc/cookbook/cabal.project
@@ -5,6 +5,7 @@ packages:
   using-custom-monad/
   jwt-and-basic-auth/
   file-upload/
+  jsonerror/
   structuring-apis/
   https/
   pagination/
diff --git a/doc/cookbook/index.rst b/doc/cookbook/index.rst
index 93322c91..553e9ed4 100644
--- a/doc/cookbook/index.rst
+++ b/doc/cookbook/index.rst
@@ -26,3 +26,4 @@ you name it!
   jwt-and-basic-auth/JWTAndBasicAuth.lhs
   file-upload/FileUpload.lhs
   pagination/Pagination.lhs
+  jsonerror/Jsonerror.lhs
diff --git a/doc/cookbook/jsonerror/Jsonerror.lhs b/doc/cookbook/jsonerror/Jsonerror.lhs
new file mode 100644
index 00000000..d1caee53
--- /dev/null
+++ b/doc/cookbook/jsonerror/Jsonerror.lhs
@@ -0,0 +1,50 @@
+# HTTP 4XX/5XX errors with JSON body
+
+Common RESTful design pattern is to return
+HTTP 4XX or 5XX errors with JSON as body content.
+
+Servant offer such support via `MonadError` instance: 
+
+```haskell
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+import Servant
+import GHC.Generics         (Generic)
+import Data.Aeson           (ToJSON, encode)
+import Data.Text            (Text)
+import Network.HTTP.Types   (hContentType)
+import Control.Monad.Except (MonadError)
+
+
+throwJSONError :: (MonadError ServantErr m, ToJSON a) => ServantErr -> a -> m b
+throwJSONError err json = throwError $ err
+  { errBody = encode json
+  , errHeaders = [ jsonHeader ]
+  }
+  where
+    jsonHeader = ( hContentType
+                 , "application/json;charset=utf-8" )
+```
+
+And simple usage with servant-server:
+
+```haskell
+data JSONError = JSONError
+  { error :: Text
+  } deriving (Generic, ToJSON)
+
+handler :: Handler NoContent
+handler = throwJSONError err400 $ JSONError "test"
+
+main :: IO ()
+main = undefined
+```
+
+There are (at least) two shortcomings with this approach:
+
+1) [throwError sacrifices content negotiation](https://github.com/haskell-servant/servant/issues/732)
+
+2) Errors are not part of the type-level API safety, there are solutions like [servant-checked-exceptions](https://github.com/cdepillabout/servant-checked-exceptions) but they don't implement all HasServer, etc instances.
diff --git a/doc/cookbook/jsonerror/jsonerror.cabal b/doc/cookbook/jsonerror/jsonerror.cabal
new file mode 100644
index 00000000..e2fae36a
--- /dev/null
+++ b/doc/cookbook/jsonerror/jsonerror.cabal
@@ -0,0 +1,24 @@
+name:                cookbook-jsonerror
+version:             0.1
+synopsis:            Jsonerror with Servant example
+homepage:            http://haskell-servant.readthedocs.org/
+license:             BSD3
+author:              Servant Contributors
+maintainer:          haskell-servant-maintainers@googlegroups.com
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable cookbook-jsonerror
+  if impl(ghc < 7.10.1)
+    buildable:          False
+  main-is:             Jsonerror.lhs
+  build-depends:       base == 4.*
+                     , aeson
+                     , servant
+                     , servant-server
+                     , http-types
+                     , mtl
+                     , text
+  default-language:    Haskell2010
+  ghc-options:         -Wall -pgmL markdown-unlit
+  build-tool-depends: markdown-unlit:markdown-unlit