Safe Haskell | None |
---|---|
Language | Haskell2010 |
multipart/form-data
Servant API support for servant.
see servant-multipart and servant-multipart-client for server- and client-
definitions.
This is mostly useful for adding file upload support to
an API. See haddocks of MultipartForm
for an introduction.
Synopsis
- type MultipartForm tag a = MultipartForm' '[] tag a
- data MultipartForm' (mods :: [*]) tag a
- data MultipartData tag = MultipartData {}
- class ToMultipart tag a where
- toMultipart :: a -> MultipartData tag
- class FromMultipart tag a where
- fromMultipart :: MultipartData tag -> Either String a
- type family MultipartResult tag :: *
- data Tmp
- data Mem
- data Input = Input {}
- data FileData tag = FileData {
- fdInputName :: Text
- fdFileName :: Text
- fdFileCType :: Text
- fdPayload :: MultipartResult tag
Documentation
type MultipartForm tag a = MultipartForm' '[] tag a Source #
Combinator for specifying a multipart/form-data
request
body, typically (but not always) issued from an HTML <form>
.
multipart/form-data
can't be made into an ordinary content
type for now in servant because it doesn't just decode the
request body from some format but also performs IO in the case
of writing the uploaded files to disk, e.g in /tmp
, which is
not compatible with servant's vision of a content type as things
stand now. This also means that MultipartForm
can't be used in
conjunction with ReqBody
in an endpoint.
The tag
type parameter instructs the function to handle data
either as data to be saved to temporary storage (Tmp
) or saved to
memory (Mem
).
The a
type parameter represents the Haskell type to which
you are going to decode the multipart data to, where the
multipart data consists in all the usual form inputs along
with the files sent along through <input type="file">
fields in the form.
One option provided out of the box by this library is to decode
to MultipartData
.
Example:
type API = MultipartForm Tmp (MultipartData Tmp) :> Post '[PlainText] String api :: Proxy API api = Proxy server :: MultipartData Tmp -> Handler String server multipartData = return str where str = "The form was submitted with " ++ show nInputs ++ " textual inputs and " ++ show nFiles ++ " files." nInputs = length (inputs multipartData) nFiles = length (files multipartData)
You can alternatively provide a FromMultipart
instance
for some type of yours, allowing you to regroup data
into a structured form and potentially selecting
a subset of the entire form data that was submitted.
Example, where we only look extract one input, username, and one file, where the corresponding input field's name attribute was set to pic:
data User = User { username :: Text, pic :: FilePath } instance FromMultipart Tmp User where fromMultipart multipartData = User <$> lookupInput "username" multipartData <*> fmap fdPayload (lookupFile "pic" multipartData) type API = MultipartForm Tmp User :> Post '[PlainText] String server :: User -> Handler String server usr = return str where str = username usr ++ "'s profile picture" ++ " got temporarily uploaded to " ++ pic usr ++ " and will be removed from there " ++ " after this handler has run."
Note that the behavior of this combinator is configurable,
by using serveWith
from servant-server instead of serve
,
which takes an additional Context
argument. It simply is an
heterogeneous list where you can for example store
a value of type MultipartOptions
that has the configuration that
you want, which would then get picked up by servant-multipart.
Important: as mentionned in the example above, the file paths point to temporary files which get removed after your handler has run, if they are still there. It is therefore recommended to move or copy them somewhere in your handler code if you need to keep the content around.
data MultipartForm' (mods :: [*]) tag a Source #
MultipartForm
which can be modified with Lenient
.
Instances
HasLink sub => HasLink (MultipartForm tag a :> sub :: Type) Source # | |
Defined in Servant.Multipart.API type MkLink (MultipartForm tag a :> sub) a # toLink :: (Link -> a0) -> Proxy (MultipartForm tag a :> sub) -> Link -> MkLink (MultipartForm tag a :> sub) a0 # | |
type MkLink (MultipartForm tag a :> sub :: Type) r Source # | |
Defined in Servant.Multipart.API |
data MultipartData tag Source #
What servant gets out of a multipart/form-data
form submission.
The type parameter tag
tells if MultipartData
is stored as a
temporary file or stored in memory. tag
is type of either Mem
or Tmp
.
The inputs
field contains a list of textual Input
s, where
each input for which a value is provided gets to be in this list,
represented by the input name and the input value. See haddocks for
Input
.
The files
field contains a list of files that were sent along with the
other inputs in the form. Each file is represented by a value of type
FileData
which among other things contains the path to the temporary file
(to be removed when your handler is done running) with a given uploaded
file's content. See haddocks for FileData
.
Instances
ToMultipart tag (MultipartData tag) Source # | |
Defined in Servant.Multipart.API toMultipart :: MultipartData tag -> MultipartData tag Source # | |
FromMultipart tag (MultipartData tag) Source # | |
Defined in Servant.Multipart.API fromMultipart :: MultipartData tag -> Either String (MultipartData tag) Source # |
class ToMultipart tag a where Source #
Allows you to tell servant how to turn a more structured type
into a MultipartData
, which is what is actually sent by the
client.
data User = User { username :: Text, pic :: FilePath } instance toMultipart Tmp User where toMultipart user = MultipartData [Input "username" $ username user] [FileData "pic" (pic user) "image/png" (pic user) ]
toMultipart :: a -> MultipartData tag Source #
Given a value of type a
, convert it to a
MultipartData
.
Instances
ToMultipart tag (MultipartData tag) Source # | |
Defined in Servant.Multipart.API toMultipart :: MultipartData tag -> MultipartData tag Source # |
class FromMultipart tag a where Source #
MultipartData
is the type representing
multipart/form-data
form inputs. Sometimes
you may instead want to work with a more structured type
of yours that potentially selects only a fraction of
the data that was submitted, or just reshapes it to make
it easier to work with. The FromMultipart
class is exactly
what allows you to tell servant how to turn "raw" multipart
data into a value of your nicer type.
data User = User { username :: Text, pic :: FilePath } instance FromMultipart Tmp User where fromMultipart form = User <$> lookupInput "username" (inputs form) <*> fmap fdPayload (lookupFile "pic" $ files form)
fromMultipart :: MultipartData tag -> Either String a Source #
Given a value of type MultipartData
, which consists
in a list of textual inputs and another list for
files, try to extract a value of type a
. When
extraction fails, servant errors out with status code 400.
Instances
FromMultipart tag (MultipartData tag) Source # | |
Defined in Servant.Multipart.API fromMultipart :: MultipartData tag -> Either String (MultipartData tag) Source # |
type family MultipartResult tag :: * Source #
Instances
type MultipartResult Mem Source # | |
Defined in Servant.Multipart.API | |
type MultipartResult Tmp Source # | |
Defined in Servant.Multipart.API |
Tag for data stored as a temporary file
Instances
type MultipartResult Tmp Source # | |
Defined in Servant.Multipart.API |
Tag for data stored in memory
Instances
type MultipartResult Mem Source # | |
Defined in Servant.Multipart.API |
Representation for a textual input (any <input>
type but file
).
<input name="foo" value="bar" />
would appear as
.Input
"foo" "bar"
Representation for an uploaded file, usually resulting from
picking a local file for an HTML input that looks like
<input type="file" name="somefile" />
.
FileData | |
|