Last active
August 17, 2016 23:53
-
-
Save alpmestan/3629f511357bc794e745 to your computer and use it in GitHub Desktop.
File upload with servant
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TypeSynonymInstances #-} | |
module Files where | |
import Control.Monad.IO.Class | |
import Control.Monad.Trans.Either | |
import Control.Monad.Trans.Resource | |
import Data.ByteString.Lazy (ByteString) | |
import Network.Wai | |
import Network.Wai.Handler.Warp (run) | |
import Network.Wai.Parse | |
import Servant | |
import Servant.Server.Internal | |
-- Backends for file upload: in memory or in /tmp ? | |
data Mem | |
data Tmp | |
class KnownBackend b where | |
type Storage b :: * | |
withBackend :: Proxy b -> (BackEnd (Storage b) -> IO r) -> IO r | |
instance KnownBackend Mem where | |
type Storage Mem = ByteString | |
withBackend Proxy f = f lbsBackEnd | |
instance KnownBackend Tmp where | |
type Storage Tmp = FilePath | |
withBackend Proxy f = runResourceT . withInternalState $ \s -> | |
f (tempFileBackEnd s) | |
-- * Files combinator, to get all of the uploaded files | |
data Files b | |
instance (KnownBackend b, HasServer api) => HasServer (Files b :> api) where | |
type ServerT (Files b :> api) m = | |
[File (Storage b)] -> ServerT api m | |
route Proxy subserver req respond = withBackend pb $ \b -> do | |
(_, files) <- parseRequestBody b req | |
route (Proxy :: Proxy api) (subserver files) req respond | |
where pb = Proxy :: Proxy b | |
type FilesMem = Files Mem | |
type FilesTmp = Files Tmp | |
-- test | |
type API = "files" :> FilesTmp :> Post '[JSON] () | |
:<|> Raw | |
api :: Proxy API | |
api = Proxy | |
server :: Server API | |
server = filesHandler :<|> serveDirectory "." | |
where filesHandler :: [File FilePath] -> EitherT ServantErr IO () | |
filesHandler = liftIO . mapM_ ppFile | |
ppFile :: File FilePath -> IO () | |
ppFile (name, fileinfo) = do | |
putStrLn $ "Input name: " ++ show name | |
putStrLn $ "File name: " ++ show (fileName fileinfo) | |
putStrLn $ "Content type: " ++ show (fileContentType fileinfo) | |
putStrLn $ "------- Content --------" | |
readFile (fileContent fileinfo) >>= putStrLn | |
putStrLn $ "------------------------" | |
app :: Application | |
app = serve api server | |
f :: IO () | |
f = run 8083 app |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<form action="/files" method="post" enctype="multipart/form-data"> | |
Select a file: <input type="file" name="blah" /> | |
Select another one: <input type="file" name="foo" /> | |
<hr /> | |
<input type="submit" value="Upload" /> | |
</form> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Input name: "blah" | |
File name: "README.md" | |
Content type: "application/octet-stream" | |
------- Content -------- | |
# servant | |
[![Build Status](https://secure.travis-ci.org/haskell-servant/servant.svg)](http://travis-ci.org/haskell-servant/servant) | |
[![Coverage Status](https://coveralls.io/repos/haskell-servant/servant/badge.svg)](https://coveralls.io/r/haskell-servant/servant) | |
![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) | |
These libraries provides a family of combinators to define webservices and automatically generate the documentation and client-side querying functions for each endpoint. | |
In order to minimize the dependencies depending on your needs, we provide these features under different packages. | |
- `servant`, which contains everything you need to *declare* a webservice API. | |
- `servant-server`, which lets you *implement* an HTTP server with handlers for each endpoint of an API. | |
- `servant-client`, which lets you derive automatically Haskell functions that let you query each endpoint of a `servant` webservice. | |
- `servant-docs`, which lets you generate API docs for your webservice. | |
- `servant-jquery`, which lets you derive Javascript functions (based on jquery) to query your API's endpoints, in the same spirit as `servant-client`. | |
- `servant-blaze` and `servant-lucid` provide easy HTML rendering of your data as an `HTML` content-type "combinator". | |
## Tutorial | |
We have a [tutorial](http://haskell-servant.github.io/tutorial) guide that introduces the core types and features of servant. After this article, you should be able to write your first servant webservices, learning the rest from the haddocks' examples. | |
------------------------ | |
Input name: "foo" | |
File name: "files.html" | |
Content type: "text/html" | |
------- Content -------- | |
<form action="/files" method="post" enctype="multipart/form-data"> | |
Select a file: <input type="file" name="blah" /> | |
Select another one: <input type="file" name="foo" /> | |
<hr /> | |
<input type="submit" value="Upload" /> | |
</form> | |
------------------------ |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment