git.iko.soy/typeable/servant
on master help sign in
add file upload recipe
commit5ac6de82773bcf2f352dda432a07225178feba2b authorAlp Mestanogullari <alpmestan@gmail.com> dateFri 8 Dec 2017, 18:59 (9 years ago) parent6dc9d04
4 files changed+219
cabal.project+1 doc/cookbook/file-upload/FileUpload.lhs+187 doc/cookbook/file-upload/file-upload.cabal+30 doc/cookbook/index.rst+1
cabal.project+1
@@ -9,6 +9,7 @@ packages: servant/
99 doc/cookbook/db-postgres-pool/
1010 doc/cookbook/db-sqlite-simple/
1111 doc/cookbook/jwt-and-basic-auth/
12+ doc/cookbook/file-upload/
1213
1314allow-newer: servant-js:servant-foreign
1415
doc/cookbook/file-upload/FileUpload.lhsnew file+187
@@ -0,0 +1,187 @@
1+# File Upload (`multipart/form-data`)
2+
3+In this recipe, we will implement a web application
4+with a single endpoint that can process
5+`multipart/form-data` request bodies, which most
6+commonly come from HTML forms that allow file upload.
7+
8+As usual, a bit of throat clearing.
9+
10+``` haskell
11+{-# LANGUAGE DataKinds #-}
12+{-# LANGUAGE TypeOperators #-}
13+{-# LANGUAGE OverloadedStrings #-}
14+
15+import Control.Concurrent
16+import Control.Exception
17+import Control.Monad
18+import Control.Monad.IO.Class
19+import Data.Text.Encoding (encodeUtf8)
20+import Network (withSocketsDo)
21+import Network.HTTP.Client hiding (Proxy)
22+import Network.HTTP.Client.MultipartFormData
23+import Network.Wai.Handler.Warp
24+import Servant
25+import Servant.Multipart
26+
27+import qualified Data.ByteString.Lazy as LBS
28+```
29+
30+Our API consists in a single `POST` endpoint at `/`
31+that takes a `multipart/form-data` request body and
32+pretty-prints the data it got to stdout before returning `0`
33+(because why not).
34+
35+``` haskell
36+type API = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer
37+
38+api :: Proxy API
39+api = Proxy
40+```
41+
42+Because of some technicalities, multipart form data is not
43+represented as a good old content type like `JSON` in servant,
44+that one could use with `ReqBody`, but instead is its own
45+dedicated `ReqBody`-like combinator named
46+[`MultiPartForm`](https://hackage.haskell.org/package/servant-multipart-0.11/docs/Servant-Multipart.html#t:MultipartForm).
47+
48+This combinator takes two parameters. The first one is the
49+"backend" to use. Currently, you only have the choice between
50+`Mem` and `Tmp`. The former loads the entire input in memory,
51+even the uploadedd files, while `Tmp` will stream uploaded
52+files to some temporary directory.
53+
54+The second parameter is the type you want the multipart data
55+to be decoded to. Indeed there is a `FromMultipart` class that
56+allows you to specify how to decode multipart form data from
57+`MultipartData` to a custom type of yours. Here we use the
58+trivial "decoding" to `MultipartData` itself, and simply
59+will get our hands on the raw input. If you want to use
60+a type of yours, see the documentation for
61+[`FromMultipart`](https://hackage.haskell.org/package/servant-multipart-0.11/docs/Servant-Multipart.html#t:FromMultipart).
62+
63+Our only request handler has type `MultipartData Mem -> Handler Integer`.
64+All it does is list the textual and file inputs that
65+were sent in the multipart request body. The textual
66+inputs are in the `inputs` field while the file inputs
67+are in the `files` field of `multipartData`.
68+
69+``` haskell
70+-- MultipartData consists in textual inputs,
71+-- accessible through its "inputs" field, as well
72+-- as files, accessible through its "files" field.
73+upload :: Server API
74+upload multipartData = do
75+ liftIO $ do
76+ putStrLn "Inputs:"
77+ forM_ (inputs multipartData) $ \input ->
78+ putStrLn $ " " ++ show (iName input)
79+ ++ " -> " ++ show (iValue input)
80+
81+ forM_ (files multipartData) $ \file -> do
82+ let content = fdPayload file
83+ putStrLn $ "Content of " ++ show (fdFileName file)
84+ LBS.putStr content
85+ return 0
86+
87+startServer :: IO ()
88+startServer = run 8080 (serve api upload)
89+```
90+
91+Finally, a main function that brings up our server and
92+sends some test request with `http-client` (and not
93+servant-client this time, has servant-multipart does not
94+yet have support for client generation.
95+
96+``` haskell
97+main :: IO ()
98+main = withSocketsDo . bracket (forkIO startServer) killThread $ \_threadid -> do
99+ -- we fork the server in a separate thread and send a test
100+ -- request to it from the main thread.
101+ manager <- newManager defaultManagerSettings
102+ req <- parseRequest "http://localhost:8080/"
103+ resp <- flip httpLbs manager =<< formDataBody form req
104+ print resp
105+
106+ where form =
107+ [ partBS "title" "World"
108+ , partBS "text" $ encodeUtf8 "Hello"
109+ , partFileSource "file" "./README.md"
110+ ]
111+```
112+
113+If you run this, you should get:
114+
115+```
116+$ cabal new-build cookbook-file-upload
117+[...]
118+$ 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
119+Inputs:
120+ "title" -> "World"
121+ "text" -> "Hello"
122+Content of "README.md"
123+# servant - A Type-Level Web DSL
124+
125+![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
126+
127+## Getting Started
128+
129+We have a [tutorial](http://haskell-servant.readthedocs.org/en/stable/tutorial/index.html) that
130+introduces the core features of servant. After this article, you should be able
131+to write your first servant webservices, learning the rest from the haddocks'
132+examples.
133+
134+The central documentation can be found [here](http://haskell-servant.readthedocs.org/).
135+Other blog posts, videos and slides can be found on the
136+[website](http://haskell-servant.github.io/).
137+
138+If you need help, drop by the IRC channel (#servant on freenode) or [mailing
139+list](https://groups.google.com/forum/#!forum/haskell-servant).
140+
141+## Version history
142+
143+This table lists the versions of some `servant-` libraries at the point of
144+release of `servant` package.
145+
146+| | **0.10** | **0.11** | **0.12** |
147+| ------------------- | -------- |----------|----------|
148+| servant | 0.10 | 0.11 | 0.12 |
149+| servant-blaze | 0.7.1 | ? | ? |
150+| servant-cassava | 0.7 | ? | ? |
151+| servant-client | 0.10 | 0.11 | 0.12 |
152+| servant-docs | 0.10 | 0.11 | 0.11.1 |
153+| servant-foreign | 0.10 | 0.10.0.1 | 0.10.2 |
154+| servant-js | 0.9.1 | ? | ? |
155+| servant-lucid | 0.7.1 | ? | ? |
156+| servant-mock | 0.8.1.1 | ? | ? |
157+| servant-server | 0.10 | 0.11 | 0.12 |
158+| servant-swagger | 1.1.2.1 | ? | ? |
159+
160+## Contributing
161+
162+See `CONTRIBUTING.md`
163+
164+## Release process outline (by phadej)
165+
166+- Update changelog and bump versions in `master`
167+ - `git log --oneline v0.12.. | grep 'Merge pull request'` is a good starting point (use correct previous release tag)
168+- Create a release branch, e.g. `release-0.13`, and *protect it* from accidental force pushes.
169+ - Release branch is useful for backporting fixes from `master`
170+- Smoke test in [`servant-universe`](https://github.com/phadej/servant-universe)
171+ - `git submodule foreach git checkout master` and `git submodule foreach git pull` to get newest of everything.
172+ - `cabal new-build --enable-tests all` to verify that everything builds, and `cabal new-test all` to run tests
173+ - It's a good idea to separate these steps, as tests often pass, if they compile :)
174+ - See `cabal.project` to selectively `allow-newer`
175+ - If some packages are broken, on your discretisation there are two options:
176+ - Fix them and make PRs: it's good idea to test against older `servant` version too.
177+ - Temporarily comment out broken package
178+ - If you make a commit for `servant-universe`, you can use it as submodule in private projects to test even more
179+- When ripples are cleared out:
180+ - `git tag -s` the release
181+ - `git push --tags`
182+ - `cabal sdist` and `cabal upload`
183+Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Transfer-Encoding","chunked"),("Date","Fri, 08 Dec 2017 16:50:14 GMT"),("Server","Warp/3.2.13"),("Content-Type","application/json;charset=utf-8")], responseBody = "0", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
184+```
185+
186+As usual, the code for this recipe is available in a cabal
187+project [here]().
doc/cookbook/file-upload/file-upload.cabalnew file+30
@@ -0,0 +1,30 @@
1+name: cookbook-file-upload
2+version: 0.1
3+synopsis: File upload cookbook example
4+homepage: http://haskell-servant.readthedocs.org/
5+license: BSD3
6+license-file: ../../../servant/LICENSE
7+author: Servant Contributors
8+maintainer: haskell-servant-maintainers@googlegroups.com
9+build-type: Simple
10+cabal-version: >=1.10
11+
12+executable cookbook-file-upload
13+ if impl(ghc < 7.10.1)
14+ buildable: False
15+ main-is: FileUpload.lhs
16+ build-depends: base == 4.*
17+ , text
18+ , mtl
19+ , network
20+ , bytestring
21+ , servant
22+ , servant-server
23+ , servant-multipart
24+ , warp
25+ , wai
26+ , markdown-unlit >= 0.4
27+ , http-client
28+ default-language: Haskell2010
29+ ghc-options: -Wall -pgmL markdown-unlit
30+ build-tool-depends: markdown-unlit:markdown-unlit
doc/cookbook/index.rst+1
@@ -21,3 +21,4 @@ you name it!
2121 db-postgres-pool/PostgresPool.lhs
2222 basic-auth/BasicAuth.lhs
2323 jwt-and-basic-auth/JWTAndBasicAuth.lhs
24+ file-upload/FileUpload.lhs