Skip to content

Instantly share code, notes, and snippets.

@naoto-ogawa
Created March 14, 2017 12:03
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save naoto-ogawa/eab6669ac7bcbedae0497f58ae6f4ac5 to your computer and use it in GitHub Desktop.
Save naoto-ogawa/eab6669ac7bcbedae0497f58ae6f4ac5 to your computer and use it in GitHub Desktop.
servant file upload sample
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
import Control.Monad.IO.Class -- liftIO
import Control.Monad.Trans.Except -- Handler
import Data.Aeson.Types -- JSON
import Data.Aeson.Parser -- JSON
import GHC.Generics
import Network.Wai.Handler.Warp
import Servant
import Servant.Multipart -- file upload
import qualified Data.Text as T
data Ret = Ret { msg :: String , len:: Int} deriving (Eq, Show, Generic)
instance ToJSON Ret
type MyAPI = "file" :> MultipartForm MultipartData :> Put '[JSON] Ret
upload :: MultipartData -> Handler Ret
upload multipartData = do
mapM_ (liftIO . putStrLn . show ) (files multipartData) -- log
let content = lookupFile "upfile" multipartData
case content of
Just file ->
liftIO $ do
c <- readFile (fdFilePath file)
putStrLn c
return $ Ret {msg= "uploaded", len = (length c)}
Nothing ->
liftIO $ do
putStrLn "not exist"
return $ Ret {msg= "\"upfile doesn't exist\"", len = -1}
myServer :: Server MyAPI
myServer = upload
myProxy :: Proxy MyAPI
myProxy = Proxy
myApp :: Application
myApp = serve myProxy myServer
main :: IO ()
main = run 8081 myApp
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment