diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ -Servant. -================== +Servant.Checked.Exceptions +========================== [![Build Status](https://secure.travis-ci.org/cdepillabout/servant-checked-exceptions.svg)](http://travis-ci.org/cdepillabout/servant-checked-exceptions) [![Hackage](https://img.shields.io/hackage/v/servant-checked-exceptions.svg)](https://hackage.haskell.org/package/servant-checked-exceptions) @@ -8,7 +8,205 @@ [![Stackage Nightly](http://stackage.org/package/servant-checked-exceptions/badge/nightly)](http://stackage.org/nightly/package/servant-checked-exceptions) ![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg) -`servant-checked-exceptions` +`servant-checked-exceptions` provides a way to specify errors thrown by a +Servant api on the type level. It allows easy composition between different +error types. -For documentation and usage examples, see the +`servant-checked-exceptions` provides the +[`Throws`](https://hackage.haskell.org/package/servant-checked-exceptions/docs/Servant-Checked-Exceptions.html#t:Throws) +data type to signify which errors can be thrown by an api. For instance, +imagine a `getAuthor` api that returns an `Author` based on an `AuthorId`: + +```haskell +-- This is a servant-compatible type describing our api. +type Api = + "author" :> + Capture "author-id" AuthorId :> + Throws CouldNotConnectToDbError :> + Throws AuthorNotFoundError :> + Get '[JSON] Author + +-- These are the two errors that can be thrown: +data CouldNotConnectToDbError = CouldNotConnectToDbError +data AuthorNotFoundError = AuthorNotFoundError +``` + +The corresponding handler function uses the +[`Envelope`](https://hackage.haskell.org/package/servant-checked-exceptions/docs/Servant-Checked-Exceptions.html#t:Envelope) +data type to model the possibility of returning an `Author` successfully, or +either `CouldNotConnectToDbError` or `AuthorNotFoundError` unsuccessfully. +Internally, `Envelope` is using an open sum-type to easily represent multiple +different errors: + +```haskell +getAuthorHandler + :: AuthorId + -> Handler (Envelope '[DatabaseError, AuthorNotFoundError] Author) +getAuthorHandler authorId = ... +``` + +For more documentation and usage examples, see the [documentation](https://hackage.haskell.org/package/servant-checked-exceptions) on Hackage. + +## Why would I want to use this? + +Using `Envelope` with its open sum-type to represent errors gives us an easy +way to reuse errors on multiple routes. + +For instance, imagine that we had another api for updating an author's name, +given the author's ID. Using `Throws` and `Envelope`, it might look like this: + +```haskell +type Api = + "update-author-name" :> + Capture "author-id" AuthorId :> + Capture "author-name" AuthorName :> + Throws CouldNotConnectToDbError :> + Throws AuthorNotFoundError :> + Throws AuthorNameTooShort :> + Post '[JSON] Author + +data AuthorNameTooShort = AuthorNameTooShort + +postChangeAuthorName + :: AuthorId + -> AuthorName + -> Handler (Envelope '[DatabaseError, AuthorNotFoundError, AuthorNameTooShort] Author) +postChangeAuthorName authorId newAuthorName = ... +``` + +We are able to reuse the `DatabaseError` and `AuthorNotFoundError`. If we try +to return an error that is not declared using `Throws`, GHC will give us an +error. We get flexiblity and type-safety. + +When using [servant-docs](https://hackage.haskell.org/package/servant-docs) to +create documentation, only one instance of `ToSample` needs to be created for +each error (`DatabaseError`, `AuthorNotFoundError`, and `AuthorNameTooShort`). +Multiple instances of `ToSample` do not need to be created for _every_ +different `Envelope` used in a handler. + +## Example + +This repository contains an [example](example/) of using +`servant-checked-exceptions`. This includes an [api](example/Api.hs), +[server](example/Server.hs), [client](example/Client.hs), and +[documentation](example/Docs.hs). + +Below I show how to compile and run these examples. + +### Compile + +The examples can be compiled by using the `buildexample` flag: + +```sh +$ stack build --flag servant-checked-exceptions:buildexample +``` + +This creates three executables. A server, a client, and a documentaiton +generator. + +### Run the server + +The server is a small example that will take search queries and return results. +The server can be run with the following command: + +```sh +$ stack exec -- servant-checked-exceptions-example-server +``` + +This runs the server on port 8201. Here is an example of using `curl` to +access the server. This will send the query `hello`: + +```sh +$ curl \ + --request POST \ + --header 'Accept: application/json' \ + 'http://localhost:8201/lax-search/hello' +{"data":"good"} +``` + +If you try to send a query that is not `hello`, the server will return an error: + +```sh +$ curl \ + --request POST \ + --header 'Accept: application/json' \ + 'http://localhost:8201/lax-search/hello' +{"err":"BadSearchTermErr"} +``` + +There is also a strict api, that requires `hello` to be capitalized like `Hello`: + +```sh +$ curl \ + --request POST \ + --header 'Accept: application/json' \ + 'http://localhost:8201/strict-search/hello' +{"err":"IncorrectCapitalization"} +$ curl \ + --request POST \ + --header 'Accept: application/json' \ + 'http://localhost:8201/strict-search/Hello' +{"data":"good"} +``` + +### Run the client + +The client provides a small command line application to query the server. In +order to use the client, the server must be running. + +Use the client to access the lax search api: + +```sh +$ stack exec -- servant-checked-exceptions-example-client foobar +the search term was not "Hello" +$ stack exec -- servant-checked-exceptions-example-client hello +Success: good +``` + +Use the client to access the strict search api: + +```sh +$ stack exec -- servant-checked-exceptions-example-client --strict hello +the search term was not capitalized correctly +$ stack exec -- servant-checked-exceptions-example-client --strict Hello +Success: good +``` + +### Run the documentation generator + +The documentation generator will generate documentation for the api in Markdown: + +```sh +$ stack exec -- servant-checked-exceptions-example-docs +``` + +Here is a small example of the documentation that will be generated for the lax +search api: + +```markdown +## POST /lax-search/:query + +#### Captures: + +- *query*: a search string like "hello" or "bye" + +#### Response: + +- Status code 200 +- Headers: [] + +- Supported content types are: + + - `application/json` + +- This is a successful response. + +{"data":"good"} + +- a completely incorrect search term was used + +{"err":"BadSearchTermErr"} +``` + +You can see that both the success and error responses are documented. diff --git a/example/Api.hs b/example/Api.hs --- a/example/Api.hs +++ b/example/Api.hs @@ -1,34 +1,18 @@ -{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE EmptyCase #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} module Api where import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON), Value, withText) import Data.Aeson.Types (Parser) --- import Data.Proxy (Proxy(Proxy)) import Data.String (IsString) import Data.Text (unpack) import Servant.API (Capture, JSON, Post, (:>), (:<|>)) --- import Servant.Client (Client, ClientM, client) --- import Servant.Docs --- (ToParam(toParam), ToSample(toSamples), docs, markdown) --- import Servant.Docs.Internal --- (DocQueryParam(DocQueryParam), ParamKind(Normal)) import Text.Read (readMaybe) import Web.HttpApiData (FromHttpApiData, ToHttpApiData) @@ -38,8 +22,19 @@ -- API -- --------- +-- | This is our main 'Api' type. We will create a server, a client, and +-- documentation for this api. +-- +-- This api is composed of two routes, 'ApiStrictSearch' and 'ApiLaxSearch'. type Api = ApiStrictSearch :<|> ApiLaxSearch +-- | This is a strict search api. You pass it a @\"query\"@, and it returns a +-- 'SearchResponse'. It potentially returns a 'BadSearchTermErr' if your query +-- is not the string @\"hello\"@. It returns an 'IncorrectCapitialization' +-- error if your query is not capitalized like @\"Hello\"@. +-- +-- Notice how we are using 'Throws' to indicate we will potentially throw an +-- error. Also, notice how we can list multiple 'Throws'. type ApiStrictSearch = "strict-search" :> Capture "query" SearchQuery :> @@ -47,6 +42,8 @@ Throws IncorrectCapitalization :> Post '[JSON] SearchResponse +-- | This is similar to 'ApiStrictSearch', but it doesn't force the query to be +-- capitalized correctly. It only returns a 'BadSearchTermErr'. type ApiLaxSearch = "lax-search" :> Capture "query" SearchQuery :> @@ -57,6 +54,7 @@ -- Parameters and Responses -- ------------------------------ +-- | This 'SearchQuery' type is just a newtype wrapper around a 'String'. newtype SearchQuery = SearchQuery { unSearchQuery :: String } deriving ( Eq @@ -70,6 +68,7 @@ , ToJSON ) +-- | This 'SearchResponse' type is just a newtype wrapper around a 'String'. newtype SearchResponse = SearchResponse { unSearchResponse :: String } deriving ( Eq @@ -87,6 +86,7 @@ -- Errors -- ------------ +-- | This error is returned when the search query is not the string @\"hello\"@. data BadSearchTermErr = BadSearchTermErr deriving (Eq, Read, Show) instance ToJSON BadSearchTermErr where @@ -98,6 +98,10 @@ parseJSON = withText "BadSearchTermErr" $ maybe (fail "could not parse as BadSearchTermErr") pure . readMaybe . unpack +-- | This error is returned when the search query is @\"hello\"@, but it is not +-- capitalized correctly. For example, the search query @\"hello\"@ will +-- return an 'IncorrectCapitialization' error. However, the search query +-- @\"Hello\"@ will return a success. data IncorrectCapitalization = IncorrectCapitalization deriving (Eq, Read, Show) instance ToJSON IncorrectCapitalization where @@ -113,5 +117,6 @@ -- Port -- ---------- +-- | The port to run the server on. port :: Int port = 8201 diff --git a/example/Client.hs b/example/Client.hs --- a/example/Client.hs +++ b/example/Client.hs @@ -35,6 +35,13 @@ IncorrectCapitalization(IncorrectCapitalization), SearchQuery(SearchQuery), SearchResponse(SearchResponse), port) +----------------------------------------- +-- Clients generated by servant-client -- +----------------------------------------- + +-- We generate the client functions just like normal. Note that when we use +-- 'Throws', the client functions get generated with the 'Envelope' type. + strictSearch :: SearchQuery -> ClientM (Envelope '[BadSearchTermErr, IncorrectCapitalization] SearchResponse) @@ -43,6 +50,13 @@ -> ClientM (Envelope '[BadSearchTermErr] SearchResponse) strictSearch :<|> laxSearch = client (Proxy :: Proxy Api) +-------------------------------------- +-- Command-line options and parsers -- +-------------------------------------- + +-- The following are needed for using optparse-applicative to parse command +-- line arguments. Most people shouldn't need to worry about how this works. + data Options = Options { query :: String, useStrict :: Bool } queryParser :: Parser String @@ -56,6 +70,15 @@ commandParser :: Parser Options commandParser = Options <$> queryParser <*> useStrictParser +------------------------------------------------------------------------- +-- Command Runners (these use the clients generated by servant-client) -- +------------------------------------------------------------------------- + +-- | This function uses the 'strictSearch' function to send a 'SearchQuery' to +-- the server. +-- +-- Note how 'catchesEnvelope' is used to handle the two error reponses and the +-- success response. runStrict :: ClientEnv -> String -> IO () runStrict clientEnv query = do eitherRes <- runClientM (strictSearch $ SearchQuery query) clientEnv @@ -70,6 +93,8 @@ (\(SearchResponse searchResponse) -> "Success: " <> searchResponse) env +-- | This function uses the 'laxSearch' function to send a 'SearchQuery' to +-- the server. runLax :: ClientEnv -> String -> IO () runLax clientEnv query = do eitherRes <- runClientM (laxSearch $ SearchQuery query) clientEnv @@ -82,10 +107,15 @@ (\(SearchResponse searchResponse) -> "Success: " <> searchResponse) env +-- | Run either 'runStrict' or 'runLax' depending on the command line options. run :: ClientEnv -> Options -> IO () run clientEnv Options{query, useStrict = True} = runStrict clientEnv query run clientEnv Options{query, useStrict = False} = runLax clientEnv query +---------- +-- Main -- +---------- + main :: IO () main = do manager <- newManager defaultManagerSettings @@ -99,4 +129,3 @@ baseUrl :: BaseUrl baseUrl = BaseUrl Http "localhost" port "" - diff --git a/example/Docs.hs b/example/Docs.hs --- a/example/Docs.hs +++ b/example/Docs.hs @@ -31,6 +31,12 @@ IncorrectCapitalization(IncorrectCapitalization), SearchQuery, SearchResponse) +-- This module prints out documentation for 'Api'. +-- +-- Notice how we only need 'ToSample' instances for the two errors we are +-- throwing with 'Throws': 'BadSearchTermErr' and 'IncorrectCapitialization'. +-- We don't have to directly worry about writing instances for 'Envelope'. + instance ToSample SearchResponse where toSamples :: Proxy SearchResponse -> [(Text, SearchResponse)] toSamples Proxy = [("This is a successful response.", "good")] @@ -52,5 +58,6 @@ , IncorrectCapitalization) ] +-- | Print the documentation rendered as markdown to stdout. main :: IO () main = putStrLn . markdown $ docs (Proxy :: Proxy Api) diff --git a/example/Server.hs b/example/Server.hs --- a/example/Server.hs +++ b/example/Server.hs @@ -30,9 +30,25 @@ IncorrectCapitalization(IncorrectCapitalization), SearchQuery(SearchQuery), SearchResponse, port) +-- | This is our server root for the 'ServerT' for 'Api'. We only have two +-- handlers, 'postStrictSearch' and 'postLaxSearch'. serverRoot :: ServerT Api Handler serverRoot = postStrictSearch :<|> postLaxSearch +-- | This is the handler for 'Api.ApiStrictSearch'. +-- +-- If we get the 'SearchQuery' @\"Hello\"@, we return a 'SuccEnvelope'. +-- However, if we get a search query like @\"hello\"@, we return an +-- 'ErrEnvelope' with an 'IncorrectCapitialization' error. If we get a search +-- query that is not @\"hello\"@, we return an 'ErrEnvelope' with a +-- 'BadSearchTermErr'. +-- +-- Notice how we can use the polymorphic function 'pureErrEnvelope' to return +-- either an 'IncorrectCapitialization' error, or a 'BadSearchTermErr', even +-- though these two have different types. +-- +-- Also, notice how this function returns an 'Envelope' because we are using +-- 'Throws' in the api definition. postStrictSearch :: SearchQuery -> Handler (Envelope '[BadSearchTermErr, IncorrectCapitalization] SearchResponse) @@ -41,6 +57,10 @@ | fmap toLower query == "hello" = pureErrEnvelope IncorrectCapitalization | otherwise = pureErrEnvelope BadSearchTermErr +-- | This is the handler for 'Api.ApiLaxSearch'. +-- +-- This is similar to 'postStrictSearch', but it doesn't require correctly +-- capitalization. postLaxSearch :: SearchQuery -> Handler (Envelope '[BadSearchTermErr] SearchResponse) @@ -48,8 +68,10 @@ | fmap toLower query == "hello" = pureSuccEnvelope "good" | otherwise = pureErrEnvelope BadSearchTermErr +-- | Create a WAI 'Application'. app :: Application app = serve (Proxy :: Proxy Api) serverRoot +-- | Run the WAI 'Application' using 'run' on the port defined by 'port'. main :: IO () main = run port app diff --git a/servant-checked-exceptions.cabal b/servant-checked-exceptions.cabal --- a/servant-checked-exceptions.cabal +++ b/servant-checked-exceptions.cabal @@ -1,5 +1,5 @@ name: servant-checked-exceptions -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Checked exceptions for Servant APIs. description: Please see . homepage: https://github.com/cdepillabout/servant-checked-exceptions diff --git a/src/Servant/Checked/Exceptions.hs b/src/Servant/Checked/Exceptions.hs --- a/src/Servant/Checked/Exceptions.hs +++ b/src/Servant/Checked/Exceptions.hs @@ -1,3 +1,93 @@ +{- | +Module : Servant.Checked.Exceptions + +Copyright : Dennis Gosnell 2017 +License : BSD3 + +Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) +Stability : experimental +Portability : unknown + +This module gives you the ability to specify which errors are thrown by a +Servant api. This is done with the 'Throws' data type. Here is an example of +creating an api that uses 'Throws': + +@ + type Api = + \"author\" 'Servant.API.:>' + 'Servant.API.Capture' \"author-id\" AuthorId 'Servant.API.:>' + 'Throws' CouldNotConnectToDbError 'Servant.API.:>' + 'Throws' AuthorNotFoundError 'Servant.API.:>' + 'Servant.API.Get' \'['Servant.API.JSON'] Author +@ + +This api will return an @Author@ for a given @AuthorId@. 'Throws' is used +to indicate that this api will potentially return two different errors: +@CouldNotConnectToDbError@ and @AuthorNotFoundError@. + +These two errors might be defined like this: + +@ + data CouldNotConnectToDbError = CouldNotConnectToDbError + deriving ('Eq', 'Read', 'Show') + + data AuthorNotFoundError = AuthorNotFoundError + deriving ('Eq', 'Read', 'Show') +@ + +Writing the server handler for this api will look like the following. Notice +how the 'Envelope' type is used: + +@ + getAuthorHandler + :: AuthorId + -> 'Handler' ('Envelope' \'[DatabaseError, AuthorNotFoundError] Author) + getAuthorHandler authorId = do + eitherAuthor <- getAuthorFromDb authorId + case eitherAuthor of + Left NoDb -> pure $ 'toErrEnvelope' CouldNotConnectToDbError + Left NoAuthor -> pure $ 'toErrEnvelope' AuthorNotFoundError + Right author -> pure $ 'toSuccEnvelope' author + + getAuthorFromDb :: AuthorId -> Handler (Either DbErr Author) + getAuthorFromDb = ... + + data DbErr = NoDb | NoAuthor +@ + +@'Envelope' \'[DatabaseError, AuthorNotFoundError] Author@ represents a +response that will contain an @Author@ on success, or contain either a +@DatabaseError@ or a @AuthorNotFoundError@ on error. + +Under the hood, 'Envelope' is using an extensible sum-type ('OpenUnion') to +represent possible errors. Working with an api that returns two possible +errors is just as easy as working with an api that returns three possible +errors. + +Clients will also use the 'Envelope' type: + +@ + getAuthor + :: AuthorId + -> 'Servant.Client.ClientM' ('Envelope' \'[DatabaseError, AuthorNotFoundError] Author) + getAuthor = 'Servant.Client.client' ('Data.Proxy.Proxy' :: 'Data.Proxy.Proxy' Api) +@ + +It is easy to do case analysis (similar to pattern matching) on the 'Envelope' +type with the 'catchesEnvelope' function. + +Checkout the + +in the repository on Github. It includes a fleshed-out example of an +, +, +, +and +. +The +shows how to compile and run the examples. +-} + module Servant.Checked.Exceptions ( -- * 'Throws' API parameter diff --git a/src/Servant/Checked/Exceptions/Internal/Envelope.hs b/src/Servant/Checked/Exceptions/Internal/Envelope.hs --- a/src/Servant/Checked/Exceptions/Internal/Envelope.hs +++ b/src/Servant/Checked/Exceptions/Internal/Envelope.hs @@ -324,14 +324,14 @@ -- >>> catchesEnvelope (intHandler, strHandler) succHandler env :: String -- "3" -- --- Given an 'Envelope' like @'Envelope' \'['Int', 'String'] Double@, the type of +-- Given an 'Envelope' like @'Envelope' \'['Int', 'String'] 'Double'@, the type of -- 'catchesEnvelope' becomes the following: -- -- @ -- 'catchesEnvelope' -- :: ('Int' -> x, 'String' -> x) -- -> ('Double' -> x) --- -> 'Envelope' \'['Int', 'String'] Double +-- -> 'Envelope' \'['Int', 'String'] 'Double' -- -> x -- @ -- @@ -346,19 +346,19 @@ -- >>> catchesEnvelope (intHandler, strHandler, chrHandler) succHandler env :: String -- "hi" -- --- Given an 'Envelope' like @'Envelope' \'['Int', 'String', 'Char'] Double@, +-- Given an 'Envelope' like @'Envelope' \'['Int', 'String', 'Char'] 'Double'@, -- the type of 'catchesEnvelope' becomes the following: -- -- @ -- 'catchesEnvelope' -- :: ('Int' -> x, 'String' -> x, 'Char' -> x) -- -> ('Double' -> x) --- -> 'Envelope' \'['Int', 'String', 'Char'] Double +-- -> 'Envelope' \'['Int', 'String', 'Char'] 'Double' -- -> x -- @ -- -- Here is an example of handling an 'ErrEnvelope' with only one possible error value. --- Notice that a normal hanlders is used (not a tuple): +-- Notice that a normal handler is used (not a tuple): -- -- >>> let env = toErrEnvelope (3 :: Int) :: Envelope '[Int] Double -- >>> let intHandler = (\int -> show int) :: Int -> String @@ -366,14 +366,14 @@ -- >>> catchesEnvelope intHandler succHandler env :: String -- "3" -- --- Given an 'Envelope' like @'Envelope' \'['Int'] Double@, the type of +-- Given an 'Envelope' like @'Envelope' \'['Int'] 'Double'@, the type of -- 'catchesEnvelope' becomes the following: -- -- @ -- 'catchesEnvelope' -- :: ('Int' -> x) -- -> ('Double' -> x) --- -> 'Envelope' \'['Int'] Double +-- -> 'Envelope' \'['Int'] 'Double' -- -> x -- @ --