Skip to content

Commit 4494de0

Browse files
theophile-scrivefisx
authored andcommitted
Integrate MultiVerb into the servant packages
This commit is Part 1 of the integration, where only the `servant`Epackage is touched. `Verb` is redefined as an alias for `MultiVerb1` inEorder to make the transition transparent to users of `Verb`.
1 parent cd7d93d commit 4494de0

File tree

31 files changed

+1376
-101
lines changed

31 files changed

+1376
-101
lines changed

.readthedocs.yml

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
# Read the Docs configuration file for Sphinx projects
2+
# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details
3+
4+
# Required
5+
version: 2
6+
7+
# Set the OS, Python version and other tools you might need
8+
build:
9+
os: ubuntu-22.04
10+
tools:
11+
python: "3.12"
12+
# You can also specify other tool versions:
13+
# nodejs: "20"
14+
# rust: "1.70"
15+
# golang: "1.20"
16+
17+
# Build documentation in the "docs/" directory with Sphinx
18+
sphinx:
19+
configuration: docs/conf.py
20+
# You can configure Sphinx to use a different builder, for instance use the dirhtml builder for simpler URLs
21+
# builder: "dirhtml"
22+
# Fail on all warnings to avoid broken references
23+
# fail_on_warning: true

cabal.project

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -87,3 +87,7 @@ allow-newer: openapi3:hashable
8787
-- http2-5.3.3 is blacklisted, force http2-5.3.2 or http2-5.3.4
8888
constraints:
8989
http2 ==5.3.2 || ==5.3.4
90+
91+
package HsOpenSSL
92+
-- Fix compilation with GCC >= 14
93+
ghc-options: -optc-Wno-incompatible-pointer-types

doc/conf.py

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,12 @@
3939
# The suffix(es) of source filenames.
4040
# You can specify multiple suffix as a list of string:
4141
#
42-
source_suffix = ['.rst', '.md', '.lhs']
42+
source_suffix = {
43+
'.rst': 'restructuredtext',
44+
'.md': 'markdown',
45+
'.lhs': 'markdown',
46+
}
47+
4348

4449
# The master toctree document.
4550
master_doc = 'index'
@@ -63,7 +68,7 @@
6368
#
6469
# This is also used if you do content translation via gettext catalogs.
6570
# Usually you set "language" from the command line for these cases.
66-
language = None
71+
language = 'en'
6772

6873
# List of patterns, relative to source directory, that match files and
6974
# directories to ignore when looking for source files.
@@ -166,6 +171,4 @@
166171

167172
# -- Markdown -------------------------------------------------------------
168173

169-
source_parsers = {
170-
'.lhs': CommonMarkParser,
171-
}
174+
extensions.append('recommonmark')

doc/cookbook/basic-streaming/Streaming.lhs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,7 @@ main = do
123123
go !acc (S.Yield _ s) = go (acc + 1) s
124124
_ -> do
125125
putStrLn "Try:"
126-
putStrLn "cabal new-run cookbook-basic-streaming server"
127-
putStrLn "cabal new-run cookbook-basic-streaming client 10"
126+
putStrLn "cabal run cookbook-basic-streaming server"
127+
putStrLn "cabal run cookbook-basic-streaming client 10"
128128
putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
129129
```

doc/cookbook/cabal.project

Lines changed: 0 additions & 22 deletions
This file was deleted.

doc/cookbook/cabal.project.local

Whitespace-only changes.

doc/cookbook/file-upload/FileUpload.lhs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -113,7 +113,7 @@ main = withSocketsDo . bracket (forkIO startServer) killThread $ \_threadid -> d
113113
If you run this, you should get:
114114
115115
``` bash
116-
$ cabal new-build cookbook-file-upload
116+
$ cabal build cookbook-file-upload
117117
[...]
118118
$ dist-newstyle/build/x86_64-linux/ghc-8.2.1/cookbook-file-upload-0.1/x/cookbook-file-upload/build/cookbook-file-upload/cookbook-file-upload
119119
Inputs:

doc/cookbook/generic/Generic.lhs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -107,7 +107,7 @@ main = do
107107
("run-custom-monad":_) -> do
108108
putStrLn "Starting cookbook-generic with a custom monad at http://localhost:8000"
109109
run 8000 (appMyMonad AppCustomState)
110-
_ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
110+
_ -> putStrLn "To run, pass 'run' argument: cabal run cookbook-generic run"
111111
```
112112
113113
## Using generics together with a custom monad

doc/cookbook/index.rst

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ you name it!
2828
using-free-client/UsingFreeClient.lhs
2929
custom-errors/CustomErrors.lhs
3030
uverb/UVerb.lhs
31+
multiverb/MultiVerb.lhs
3132
basic-auth/BasicAuth.lhs
3233
basic-streaming/Streaming.lhs
3334
jwt-and-basic-auth/JWTAndBasicAuth.lhs

doc/cookbook/multiverb/MultiVerb.lhs

Lines changed: 249 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,249 @@
1+
# MultiVerb: Powerful endpoint types
2+
3+
`MultiVerb` allows you to represent an API endpoint with multiple response types, status codes and headers.
4+
5+
## Preliminaries
6+
7+
```haskell
8+
{-# LANGUAGE GHC2021 #-}
9+
{-# LANGUAGE DataKinds #-}
10+
{-# LANGUAGE DerivingStrategies #-}
11+
{-# LANGUAGE DerivingVia #-}
12+
13+
import GHC.Generics
14+
import Generics.SOP qualified as GSOP
15+
import Network.Wai.Handler.Warp as Warp
16+
17+
import Servant.API
18+
import Servant.API.MultiVerb
19+
import Servant.Server
20+
import Servant.Server.Generic
21+
```
22+
23+
## Writing an endpoint
24+
25+
Let us create an endpoint that captures an 'Int' and has the following logic:
26+
27+
* If the number is negative, we return status code 400 and an empty body;
28+
* If the number is even, we return a 'Bool' in the response body;
29+
* If the number is odd, we return another 'Int' in the response body.
30+
31+
Let us list all possible HTTP responses:
32+
```haskell
33+
34+
type Responses =
35+
'[ RespondEmpty 400 "Negative"
36+
, Respond 200 "Odd number" Int
37+
, Respond 200 "Even number" Bool
38+
]
39+
```
40+
41+
Let us create the return type. We will create a sum type that lists the values on the Haskell side that correspond to our HTTP responses.
42+
In order to tie the two types together, we will use a mechanism called `AsUnion` to create a correspondance between the two:
43+
44+
```haskell
45+
data Result
46+
= NegativeNumber
47+
| Odd Int
48+
| Even Bool
49+
deriving stock (Generic)
50+
deriving (AsUnion Responses)
51+
via GenericAsUnion Responses Result
52+
53+
instance GSOP.Generic Result
54+
```
55+
56+
These deriving statements above tie together the responses and the return values, and the order in which they are defined matters. For instance, if `Even` and `Odd` had switched places in the definition of `Result`, this would provoke an error:
57+
58+
```
59+
• No instance for ‘AsConstructor
60+
((:) @Type Int ('[] @Type)) (Respond 200 "Even number" Bool)’
61+
arising from the 'deriving' clause of a data type declaration
62+
```
63+
64+
(_If you would prefer to write an intance of 'AsUnion' by yourself, read more in Annex 1 “Implementing AsUnion manually” section._)
65+
66+
Finally, let us write our endpoint description:
67+
68+
```haskell
69+
type MultipleChoicesInt =
70+
Capture "int" Int
71+
:> MultiVerb
72+
'GET
73+
'[JSON]
74+
Responses
75+
Result
76+
```
77+
78+
This piece of code is to be read as "Create an endpoint that captures an integer, and accepts a GET request with the `application/json` MIME type,
79+
and can send one of the responses and associated result value."
80+
81+
### Implementing AsUnion manually
82+
83+
In the above example, the `AsUnion` typeclass is derived through the help of the `DerivingVia` mechanism,
84+
and the `GenericAsUnion` wrapper.
85+
86+
If you would prefer implementing it yourself, you need to encode your responses as [Peano numbers](https://wiki.haskell.org/Peano_numbers),
87+
augmented with the `I`(identity) combinator.
88+
89+
See how three options can be encoded as the Z (zero), S Z (successor to zero, so one),
90+
and S (S Z) (the sucessor to the successor to zero, so two). This encoding is static, so we know in advance how to decode them to
91+
Haskell datatypes. See the instance below for the encoding/decoding process:
92+
93+
```
94+
instance AsUnion MultipleChoicesIntResponses MultipleChoicesIntResult where
95+
toUnion NegativeNumber = Z (I ())
96+
toUnion (Even b) = S (Z (I b))
97+
toUnion (Odd i) = S (S (Z (I i)))
98+
99+
fromUnion (Z (I ())) = NegativeNumber
100+
fromUnion (S (Z (I b))) = Even b
101+
fromUnion (S (S (Z (I i)))) = Odd i
102+
fromUnion (S (S (S x))) = case x of {}
103+
```
104+
105+
## Integration in a routing table
106+
107+
We want to integrate our endpoint into a wider routing table with another
108+
endpoint: `version`, which returns the version of the API
109+
110+
```haskell
111+
data Routes mode = Routes
112+
{ choicesRoutes :: mode :- "choices" :> Choices
113+
, version :: mode :- "version" :> Get '[JSON] Int
114+
}
115+
deriving stock (Generic)
116+
```
117+
118+
```haskell
119+
type Choices = NamedRoutes Choices'
120+
data Choices' mode = Choices'
121+
{ choices :: mode :- MultipleChoicesInt
122+
}
123+
deriving stock (Generic)
124+
125+
choicesServer :: Choices' AsServer
126+
choicesServer =
127+
Choices'
128+
{ choices = choicesHandler
129+
}
130+
131+
routesServer :: Routes AsServer
132+
routesServer =
133+
Routes
134+
{ choicesRoutes = choicesServer
135+
, version = versionHandler
136+
}
137+
138+
choicesHandler :: Int -> Handler Result
139+
choicesHandler parameter =
140+
if parameter < 0
141+
then pure NegativeNumber
142+
else
143+
if even parameter
144+
then pure $ Odd 3
145+
else pure $ Even True
146+
147+
versionHandler :: Handler Int
148+
versionHandler = pure 1
149+
```
150+
151+
We can now plug everything together:
152+
153+
154+
```haskell
155+
main :: IO ()
156+
main = do
157+
putStrLn "Starting server on http://localhost:5000"
158+
let server = genericServe routesServer
159+
Warp.run 5000 server
160+
```
161+
162+
Now let us run the server and observe how it behaves:
163+
164+
```
165+
$ http http://localhost:5000/version
166+
HTTP/1.1 200 OK
167+
Content-Type: application/json;charset=utf-8
168+
Date: Thu, 29 Aug 2024 14:22:20 GMT
169+
Server: Warp/3.4.1
170+
Transfer-Encoding: chunked
171+
172+
1
173+
```
174+
175+
176+
```
177+
$ http http://localhost:5000/choices/3
178+
HTTP/1.1 200 OK
179+
Content-Type: application/json;charset=utf-8
180+
Date: Thu, 29 Aug 2024 14:22:30 GMT
181+
Server: Warp/3.4.1
182+
Transfer-Encoding: chunked
183+
184+
true
185+
```
186+
187+
```
188+
$ http http://localhost:5000/choices/2
189+
HTTP/1.1 200 OK
190+
Content-Type: application/json;charset=utf-8
191+
Date: Thu, 29 Aug 2024 14:22:33 GMT
192+
Server: Warp/3.4.1
193+
Transfer-Encoding: chunked
194+
195+
3
196+
```
197+
198+
```
199+
$ http http://localhost:5000/choices/-432
200+
HTTP/1.1 400 Bad Request
201+
Date: Thu, 29 Aug 2024 14:22:41 GMT
202+
Server: Warp/3.4.1
203+
Transfer-Encoding: chunked
204+
```
205+
206+
You have now learned how to use the MultiVerb feature of Servant.
207+
208+
## Annex 1: Implementing AsUnion manually
209+
210+
Should you need to implement `AsUnion` manually, here is how to do it. `AsUnion` relies on
211+
two methods, `toUnion` and `fromUnion`. They respectively encode your response type to, and decode it from, an inductive type that resembles a [Peano number](https://wiki.haskell.org/Peano_numbers).
212+
213+
Let's see it in action, with explanations below:
214+
215+
```haskell
216+
instance => AsUnion MultipleChoicesIntResponses MultipleChoicesIntResult where
217+
toUnion NegativeNumber = Z (I ())
218+
toUnion (Even b) = S (Z (I b))
219+
toUnion (Odd i) = S (S (Z (I i)))
220+
221+
fromUnion (Z (I ())) = NegativeNumber
222+
fromUnion (S (Z (I b))) = Even b
223+
fromUnion (S (S (Z (I i)))) = Odd i
224+
fromUnion (S (S (S x))) = case x of {}
225+
```
226+
227+
### Encoding our data to a Union
228+
229+
Let's see how the implementation of `toUnion` works:
230+
231+
In the first equation for `toUnion`, `NegativeNumber` gets translated by `toUnion` into `Z (I ())`.
232+
`I` is the constructor that holds a value. Here it is holds no meaningful value, because `NegativeNumber` does not have any argument.
233+
In the tradition of Peano numbers, we start with the `Z`, for Zero.
234+
235+
Then `Even`, which holds a value, `b`, must then be encoded. Following Zero is its Successor, so we wrap the `Z` within a `S` constructor.
236+
Since it has one argument, we can store it in the `I` constructor.
237+
238+
The pattern repeats with `Odd`, which hole a value (`i`) too. We add a `S`uccessor constructor to the previous encoding,
239+
and we store the value inside `I`.
240+
241+
### Decoding the Union
242+
243+
Since every member of our sum type was encoded to a unique form as an inductive data structure, we can decode them quite easily:
244+
245+
* `Z (I ())` is our `NegativeNumber` constructor;
246+
* `(S (Z (I b)))` is `Even` with `b`;
247+
* `(S (S (Z (I i))))` is `Odd` with `i`.
248+
249+
Finally, the last equation of `fromUnion` is here to satisfy GHC's pattern checker. It does not serve any functional purpose.

0 commit comments

Comments
 (0)