diff --git a/cabal.project b/cabal.project index 1a2b1085..5893d321 100644 --- a/cabal.project +++ b/cabal.project @@ -9,6 +9,7 @@ packages: servant/ doc/cookbook/db-postgres-pool/ doc/cookbook/db-sqlite-simple/ doc/cookbook/jwt-and-basic-auth/ + doc/cookbook/file-upload/ allow-newer: servant-js:servant-foreign diff --git a/doc/cookbook/file-upload/FileUpload.lhs b/doc/cookbook/file-upload/FileUpload.lhs new file mode 100644 index 00000000..353803ef --- /dev/null +++ b/doc/cookbook/file-upload/FileUpload.lhs @@ -0,0 +1,187 @@ +# File Upload (`multipart/form-data`) + +In this recipe, we will implement a web application +with a single endpoint that can process +`multipart/form-data` request bodies, which most +commonly come from HTML forms that allow file upload. + +As usual, a bit of throat clearing. + +``` haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} + +import Control.Concurrent +import Control.Exception +import Control.Monad +import Control.Monad.IO.Class +import Data.Text.Encoding (encodeUtf8) +import Network (withSocketsDo) +import Network.HTTP.Client hiding (Proxy) +import Network.HTTP.Client.MultipartFormData +import Network.Wai.Handler.Warp +import Servant +import Servant.Multipart + +import qualified Data.ByteString.Lazy as LBS +``` + +Our API consists in a single `POST` endpoint at `/` +that takes a `multipart/form-data` request body and +pretty-prints the data it got to stdout before returning `0` +(because why not). + +``` haskell +type API = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer + +api :: Proxy API +api = Proxy +``` + +Because of some technicalities, multipart form data is not +represented as a good old content type like `JSON` in servant, +that one could use with `ReqBody`, but instead is its own +dedicated `ReqBody`-like combinator named +[`MultiPartForm`](https://hackage.haskell.org/package/servant-multipart-0.11/docs/Servant-Multipart.html#t:MultipartForm). + +This combinator takes two parameters. The first one is the +"backend" to use. Currently, you only have the choice between +`Mem` and `Tmp`. The former loads the entire input in memory, +even the uploadedd files, while `Tmp` will stream uploaded +files to some temporary directory. + +The second parameter is the type you want the multipart data +to be decoded to. Indeed there is a `FromMultipart` class that +allows you to specify how to decode multipart form data from +`MultipartData` to a custom type of yours. Here we use the +trivial "decoding" to `MultipartData` itself, and simply +will get our hands on the raw input. If you want to use +a type of yours, see the documentation for +[`FromMultipart`](https://hackage.haskell.org/package/servant-multipart-0.11/docs/Servant-Multipart.html#t:FromMultipart). + +Our only request handler has type `MultipartData Mem -> Handler Integer`. +All it does is list the textual and file inputs that +were sent in the multipart request body. The textual +inputs are in the `inputs` field while the file inputs +are in the `files` field of `multipartData`. + +``` haskell +-- MultipartData consists in textual inputs, +-- accessible through its "inputs" field, as well +-- as files, accessible through its "files" field. +upload :: Server API +upload multipartData = do + liftIO $ do + putStrLn "Inputs:" + forM_ (inputs multipartData) $ \input -> + putStrLn $ " " ++ show (iName input) + ++ " -> " ++ show (iValue input) + + forM_ (files multipartData) $ \file -> do + let content = fdPayload file + putStrLn $ "Content of " ++ show (fdFileName file) + LBS.putStr content + return 0 + +startServer :: IO () +startServer = run 8080 (serve api upload) +``` + +Finally, a main function that brings up our server and +sends some test request with `http-client` (and not +servant-client this time, has servant-multipart does not +yet have support for client generation. + +``` haskell +main :: IO () +main = withSocketsDo . bracket (forkIO startServer) killThread $ \_threadid -> do + -- we fork the server in a separate thread and send a test + -- request to it from the main thread. + manager <- newManager defaultManagerSettings + req <- parseRequest "http://localhost:8080/" + resp <- flip httpLbs manager =<< formDataBody form req + print resp + + where form = + [ partBS "title" "World" + , partBS "text" $ encodeUtf8 "Hello" + , partFileSource "file" "./README.md" + ] +``` + +If you run this, you should get: + +``` +$ cabal new-build cookbook-file-upload +[...] +$ 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 +Inputs: + "title" -> "World" + "text" -> "Hello" +Content of "README.md" +# servant - A Type-Level Web DSL + +![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) + +## Getting Started + +We have a [tutorial](http://haskell-servant.readthedocs.org/en/stable/tutorial/index.html) that +introduces the core features of servant. After this article, you should be able +to write your first servant webservices, learning the rest from the haddocks' +examples. + +The central documentation can be found [here](http://haskell-servant.readthedocs.org/). +Other blog posts, videos and slides can be found on the +[website](http://haskell-servant.github.io/). + +If you need help, drop by the IRC channel (#servant on freenode) or [mailing +list](https://groups.google.com/forum/#!forum/haskell-servant). + +## Version history + +This table lists the versions of some `servant-` libraries at the point of +release of `servant` package. + +| | **0.10** | **0.11** | **0.12** | +| ------------------- | -------- |----------|----------| +| servant | 0.10 | 0.11 | 0.12 | +| servant-blaze | 0.7.1 | ? | ? | +| servant-cassava | 0.7 | ? | ? | +| servant-client | 0.10 | 0.11 | 0.12 | +| servant-docs | 0.10 | 0.11 | 0.11.1 | +| servant-foreign | 0.10 | 0.10.0.1 | 0.10.2 | +| servant-js | 0.9.1 | ? | ? | +| servant-lucid | 0.7.1 | ? | ? | +| servant-mock | 0.8.1.1 | ? | ? | +| servant-server | 0.10 | 0.11 | 0.12 | +| servant-swagger | 1.1.2.1 | ? | ? | + +## Contributing + +See `CONTRIBUTING.md` + +## Release process outline (by phadej) + +- Update changelog and bump versions in `master` + - `git log --oneline v0.12.. | grep 'Merge pull request'` is a good starting point (use correct previous release tag) +- Create a release branch, e.g. `release-0.13`, and *protect it* from accidental force pushes. + - Release branch is useful for backporting fixes from `master` +- Smoke test in [`servant-universe`](https://github.com/phadej/servant-universe) + - `git submodule foreach git checkout master` and `git submodule foreach git pull` to get newest of everything. + - `cabal new-build --enable-tests all` to verify that everything builds, and `cabal new-test all` to run tests + - It's a good idea to separate these steps, as tests often pass, if they compile :) + - See `cabal.project` to selectively `allow-newer` + - If some packages are broken, on your discretisation there are two options: + - Fix them and make PRs: it's good idea to test against older `servant` version too. + - Temporarily comment out broken package + - If you make a commit for `servant-universe`, you can use it as submodule in private projects to test even more +- When ripples are cleared out: + - `git tag -s` the release + - `git push --tags` + - `cabal sdist` and `cabal upload` +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} +``` + +As usual, the code for this recipe is available in a cabal +project [here](). diff --git a/doc/cookbook/file-upload/file-upload.cabal b/doc/cookbook/file-upload/file-upload.cabal new file mode 100644 index 00000000..538cc019 --- /dev/null +++ b/doc/cookbook/file-upload/file-upload.cabal @@ -0,0 +1,30 @@ +name: cookbook-file-upload +version: 0.1 +synopsis: File upload cookbook example +homepage: http://haskell-servant.readthedocs.org/ +license: BSD3 +license-file: ../../../servant/LICENSE +author: Servant Contributors +maintainer: haskell-servant-maintainers@googlegroups.com +build-type: Simple +cabal-version: >=1.10 + +executable cookbook-file-upload + if impl(ghc < 7.10.1) + buildable: False + main-is: FileUpload.lhs + build-depends: base == 4.* + , text + , mtl + , network + , bytestring + , servant + , servant-server + , servant-multipart + , warp + , wai + , markdown-unlit >= 0.4 + , http-client + default-language: Haskell2010 + ghc-options: -Wall -pgmL markdown-unlit + build-tool-depends: markdown-unlit:markdown-unlit diff --git a/doc/cookbook/index.rst b/doc/cookbook/index.rst index 0472d768..d4df3798 100644 --- a/doc/cookbook/index.rst +++ b/doc/cookbook/index.rst @@ -21,3 +21,4 @@ you name it! db-postgres-pool/PostgresPool.lhs basic-auth/BasicAuth.lhs jwt-and-basic-auth/JWTAndBasicAuth.lhs + file-upload/FileUpload.lhs