Programming Languages, Martials Arts and Computers. The Weblog of Chris Double.
This is not intended to be a tutorial to HAppS, a Haskell Web Application Framework. Instead it is a cookbook style description of how to do various things based on what I've been learning as I use it. It serves primarily as a reminder to myself on how to do things but published so that others may find it useful too.
Version Date Comment
1.0 2008/12/06 Initial Version 1.1 2008/12/14 Added File Upload Section
Table: Revision History
The easiest way to install HAppS is to use cabal. This should install the needed libraries if GHC is correctly installed:
$ cabal install happs-server
To start a webserver that will produce simple dynamic content we'll
use the simpleHTTP function from the HAppS.Server module. simpleHTTP
takes two arguments:
$ ghci
Prelude> :m +HAppS.Server
Prelude HAppS.Server> :t simpleHTTP
simpleHTTP :: (ToMessage a) => Conf -> [ServerPartT IO a] -> IO ()
The first argument is an object containing configuration settings.
This includes things like what port to start the server on. I'll
discuss this later. For now we'll use nullConf which results in a
server running on port 8000.
The second argument is a list of server parts. For now think of a server part as something that performs some actions, returning a web page to the user, depending on some matched part of the URL. I'll go into more details on how server parts work later but this definition will serve us for now.
The simplest Haskell program that uses HAppS to return a page to the user looks like:
import HAppS.Server
main = simpleHTTP nullConf [
method GET $ ok $ toResponse "Hello World"
]
In this case we only have one server part. This gets run when the HTTP request method is GET. In that case it returns a 'ok' HTTP response, and the text is a page containing the text 'HelloWorld'. Build this and run it, visit the page in your browser with the URL http://localhost:8000.
$ ghc --make eg1.hs
[1 of 1 ] Compiling Main ( eg1.hs, eg1.o )
Linking eg1 ...
$ ./eg1
This server part will only run if you enter the root of the URL. if
you enter any text on the URL after that then you'll get a 'No
suitable handler found' error. You can use other server parts to
selectively run depending on the URL. One such is the dir server
part:
import HAppS.Server
main = simpleHTTP nullConf [
method GET $ ok $ toResponse "Hello World",
dir "one" [ method GET $ ok $ toResponse "One" ],
dir "two" [ method GET $ ok $ toResponse "Two" ]
]
The URL's that work with this example are:
From this you can see that the dir server part runs when the given
string matches the URL. dir itself has a second argument that is a list
of server parts that are run when the URL matches. In this case we use the
same method part as previously to display some text.
Since dir takes a list of parts as an argument you can nest parts.
import HAppS.Server
main = simpleHTTP nullConf [
method GET $ ok $ toResponse "Hello World",
dir "a" [
dir "one" [ method GET $ ok $ toResponse "One" ],
dir "two" [ method GET $ ok $ toResponse "Two" ]
],
dir "b" [
dir "three" [ method GET $ ok $ toResponse "Three" ],
dir "four" [ method GET $ ok $ toResponse "Four" ]
]
]
The URL's that work with this example are:
Serving static files is very easy. HAppS provides a server part to do
this called fileServe. It takes two arguments. The first is a list
of filenames that serve as the 'welcome' file. This is the file that
is first served if no path is given. Usually this is something like
'index.html'. The second is the path to a directory containing the
static files.
The following example serves the same dynamic content as one of the previous examples but also serves any files containing in the '/var/www/' directory if the URL matches 'www'.
import HAppS.Server
main = simpleHTTP nullConf [
method GET $ ok $ toResponse "Hello World",
dir "one" [ method GET $ ok $ toResponse "One" ],
dir "two" [ method GET $ ok $ toResponse "Two" ],
dir "www" [ fileServe ["index.html"] "/var/www/" ]
]
A request to the URL http://localhost:8000/www/test.html will serve the file from /var/www/test.html. A request to the URL http://localhost:8000/www will serve the file /var/www/index.html.
Generating dynamic content by concatenating strings isn't very useful. It can be difficult to read the code, and it's easy to accidentally generated invalid HTML.
The Text.Html package has some combinators to make generating HTML a
bit easier. We'll take a brief aside into using these combinators, and
then go on to how to use the generated HTML in HAppS.
Text.Html has functions for the various HTML elements. You can string
these functions together to create HTML content with the <<
function. The result is a data structure that can be converted to an
string containing HTML using renderHtml.
import Text.Html
page =
body << [
p << "First Paragraph",
p << "Second paragraph"
]
main = putStrLn $ renderHtml page
This results in the following output when compiled and run:
$ ghc --make eg5.hs
$ ./eg5
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 FINAL//EN">
<!--Rendered using the Haskell Html Library v0.2-->
<HTML
><BODY
><P
>First Paragraph</P
><P
>Second paragraph</P
></BODY
></HTML
>
Notice the weird HTML formatting. This is to ensure that there is no additional whitespace in the HTML elements for formatting.
The format for adding attributes to an element is to use the ! infix
operator, with the element on the left hand side, and a list of
attributes on the right. The attributes in the list are formed by
using the functions named for the attribute from Text.Html, passing
the value for that attribute as an argument. Here's a simple HTML
form that uses this:
import Text.Html
page = [
header << thetitle << "Form Example",
body << [
form ! [ method "POST",
enctype "multipart/form-data"
] << [
textfield "name",
textarea ! [ name "address" ] << "Enter address here",
submit "submit" "Submit"
]
]
]
main = putStrLn $ renderHtml page
The output for this is:
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 FINAL//EN">
<!--Rendered using the Haskell Html Library v0.2-->
<HTML
><HEAD
><TITLE
>Form Example</TITLE
></HEAD
><BODY
><FORM METHOD = "POST" ENCTYPE = "multipart/form-data"
><INPUT TYPE = "TEXT" NAME = "name"
><TEXTAREA NAME = "address"
>Enter address here</TEXTAREA
><INPUT TYPE = "SUBMIT" NAME = "submit" VALUE = "Submit"
></FORM
></BODY
></HTML
>
There are a few things that need to be done before Text.Html can be
used directly with HAppS. The first is that there is a name clash
between the method function in Text.Html and HAppS.Server. One of
these will need to be imported with a prefix attached to it.
The second is that the function renderHtml returns a string. If we
use this directly in HAppS we end up with a plain text page containing
the HTML output. This can be seen in this example:
import HAppS.Server
import Text.Html hiding (method)
import qualified Text.Html as H (method)
page =
body << p << "Hello World"
main = simpleHTTP nullConf [
method GET $ ok $ toResponse $ renderHtml page
]
Compile, run, and visit http://localhost:8000 and you'll see the raw
HTML output as plain text. What's needed is to serve the content as
the text/html mime type rather than the default text/plain.
The trick to doing this is understanding what toResponse returns. Here
is what GHCI tells us about toResponse:
$ ghci
Prelude> :m +HAppS.Server
Prelude HAppS.Server> :t toResponse
toResponse :: (ToMessage a) => a -> Response
So given an a that is an instance of the ToMessage typeclass, we get
a Response object back. What does toResponse on a string return?
Prelude HAppS.Server> toResponse "hello"
Response { rsCode = 200,
rsHeaders = fromList [ ("content-type",
HeaderPair {
hName = "Content-Type",
hValue = ["text/plain"]
})],
rsFlags = RsFlags { rsfContentLength = True },
rsBody = Chunk "hello" Empty,
rsValidator = Nothing
}
That's a lot of stuff but the important one for this point is the
content-type which is text/plain. What we need to do is tell
toResponse how to deal with Html objects directly. Recall that
toResponse takes an instance of the ToMessage typeclass.
There are two functions we need to implement for this typeclass. The
first is toContentType and the second is toMessage:
Prelude HAppS.Server> :t toContentType
toContentType :: (ToMessage a) =>
a -> Data.ByteString.Internal.ByteString
Prelude HAppS.Server> :t toMessage
toMessage :: (ToMessage a) =>
a -> Data.ByteString.Lazy.Internal.ByteString
To put it in simple english, toContentType must return a ByteString
holding the mime type. toMessageType must return a Lazy ByteString
holding the contents to be served to the web browser. In this case,
our HTML.
The instance of ToMessage is easier than the explanation:
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
instance ToMessage Html where
toContentType _ = B.pack "text/html"
toMessage = (L.pack . renderHtml)
With this in place we can directly pass the Html object generated by
page to toResponse.
Here's the full example:
import HAppS.Server
import Text.Html hiding (method)
import qualified Text.Html as H (method)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
instance ToMessage Html where
toContentType _ = B.pack "text/html"
toMessage = (L.pack . renderHtml)
page =
body << p << "Hello World"
main = simpleHTTP nullConf [
method GET $ ok $ toResponse $ page
]
Actually I lied. You get a compile error with this code about a
duplicate instance of ToMessage Html. This is because HAppS already
has a ToMessage instance for Html in the latest versions. I went down
this path so you could see how it works, or you may in fact have to do
it with an older HAppS version. So this code works using the HAppS
built in ToMessage Html instance:
import HAppS.Server
import Text.Html hiding (method)
import qualified Text.Html as H (method)
page =
body << p << "Hello World"
main = simpleHTTP nullConf [
method GET $ ok $ toResponse $ page
]
You can also use ToMessage for your own data types, or method of
generating output. Here's a contrived example:
import HAppS.Server
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
data MyData = MyData { mdName :: String,
mdAddress :: String }
deriving (Show)
instance ToMessage MyData where
toContentType _ = B.pack "text/html"
toMessage mydata = L.pack $ "<html><body><p>" ++ (show mydata) ++ "</p></body></html>"
main = simpleHTTP nullConf [
method GET $ ok $ toResponse $ MyData { mdName = "John",
mdAddress = "Anywhere" }
]
So far we've dealt with HTTP GET requests. There are a couple of ways of handling POST requests containing form data. First we need to generate a page with form information and handle this POST request. The following example builds the form, returns it, but will not do anything with the form data in the POST request. We'll correct that later:
import HAppS.Server
import Text.Html hiding (method)
import qualified Text.Html as H (method)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
page :: Html
page = concatHtml [
header << thetitle << "Form Example",
body << [
form ! [ H.method "POST",
enctype "multipart/form-data"
] << [
textfield "name",
textarea ! [ name "address" ] << "Enter address here",
submit "submit" "Submit"
]
]
]
main = simpleHTTP nullConf [
method GET $ ok $ toResponse page,
method POST $ ok $ toResponse "Post received!"
]
This has two things that are slightly different from previous examples. The first is that the page function uses concatHtml to convert a list of Html objects into one single Html object. The second is that we use a method call with an argument of POST to handle the POST request.
To extract the form data we create a data type that will hold the decoded data from the POST request. We make this data type an instance of the FromData typeclass and implement the fromData function of that typeclass to do the marshalling. HAppS provides helper functions to retrieve the values from the POST request and store it in our data type.
So in the example above we have a name and address to store. The data type looks like:
data PostData = PostData { pdName :: String,
pdAddress :: String }
The HAppS function look is used to retrieve the value of an input field given that fields name. In this example we use mplus from Control.Monad to handle the case of the input field not existing and return a default value. The instance declaration for FromData looks like:
instance FromData PostData where
fromData = do
name <- look "name" `mplus` return ""
address <- look "address" `mplus` return ""
return $ PostData { pdName = name,
pdAddress = address }
If you're unsure of what mplus does, here's a couple of examples using ghci that might help clear it up:
Prelude Control.Monad> Just "Hello" `mplus` return "default"
Just "Hello"
Prelude Control.Monad> Nothing `mplus` return "default"
Just "default"
Here's a completed program that handles the POST data and displays the entered form elements on the result page:
import HAppS.Server
import Text.Html hiding (method)
import qualified Text.Html as H (method)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad
data PostData = PostData { pdName :: String,
pdAddress :: String }
instance FromData PostData where
fromData = do
name <- look "name" `mplus` return ""
address <- look "address" `mplus` return ""
return $ PostData { pdName = name,
pdAddress = address }
page :: Html
page = concatHtml [
header << thetitle << "Form Example",
body << [
form ! [ H.method "POST",
enctype "multipart/form-data"
] << [
textfield "name",
textarea ! [ name "address" ] << "Enter address here",
submit "submit" "Submit"
]
]
]
handleForm :: PostData -> [ServerPart Response]
handleForm (PostData name address ) =
[ method POST $ ok $ toResponse $ "Result: " ++ (show (name,address)) ]
main = simpleHTTP nullConf [
method GET $ ok $ toResponse page,
withData handleForm
]
Notice the change in the main function. Instead of using method to detect the POST, we use the withData function. This takes one parameter, which itself needs to be a function. That function takes as input the data structure we defined as wrapping our form data (PostData in this example) and returns a list of server parts. Here's the type signature of withData:
Prelude HApps.Server> :t withData
withData :: (Monad m, FromData a) => (a -> [ServerPartT m r]) -> ServerPartT m r
So what is basically happening is this example is that main first checks to see if we have a GET request. If so, it returns the HTML from page. If not, it wraps any form data that we might have in our data structure, PostData (using the fromData function we defined for marshalling) and calls the server parts in handleForm.
handleForm has one server part that checks if it is a POST request, and if it is, returns a string based on the form data that was entered.
One downside with this example is we call the marshalling function fromData for all requests that the GET server part doesn't handle. We can be more specific with code like this:
handleForm :: PostData -> [ServerPart Response]
handleForm (PostData name address ) =
[ anyRequest $ ok $ toResponse $ "Result: " ++ (show (name,address)) ]
main = simpleHTTP nullConf [
method GET $ ok $ toResponse page,
methodSP POST $ withData handleForm
]
handleForm has been changed to use anyRequest which means it will always run. In main we use methodSP with POST to only run our form data marshalling when a POST request occurs. methodSP is similar to method but expects a ServerPart to be passed to it rather than the result of running a server part. Since withData returns a server part we need to use the methodSP version.
You don't have to define a new data type and make it an instance of FromData to handle form data. Instead you can write a function that gets called when the marshalling needs to happen. This function, implemented exactly like fromData is implemented, is passed to withDataFn which is used instead of withData. Here's our previous example modified to do this:
import HAppS.Server
import Text.Html hiding (method)
import qualified Text.Html as H (method)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad
page :: Html
page = concatHtml [
header << thetitle << "Form Example",
body << [
form ! [ H.method "POST",
enctype "multipart/form-data"
] << [
textfield "name",
textarea ! [ name "address" ] << "Enter address here",
submit "submit" "Submit"
]
]
]
handleData = do
name <- look "name" `mplus` return ""
address <- look "address" `mplus` return ""
return (name, address)
handleForm :: (String, String) -> [ServerPart Response]
handleForm (name, address ) =
[ anyRequest $ ok $ toResponse $ "Result: " ++ (show (name,address)) ]
main = simpleHTTP nullConf [
method GET $ ok $ toResponse page,
methodSP POST $ withDataFn handleData handleForm
]
Handling file uploads using HAppS is an extension of dealing with form
data. An HTML form that accepts file uploads needs to use the encoding
type of multipart/form-data and include at least one input element
of type file. An example of such an HTML form is:
<html>
<body>
<form method="post" enctype="multipart/form-data">
<input type="file" name="myfile">
<input type="submit">
</form>
</body>
</html>
A direct translation of this into Text.Html is:
page :: Html
page = concatHtml [
header << thetitle << "File Upload Example",
body << [
form ! [ H.method "POST",
enctype "multipart/form-data"
] << [
afile "myfile"
submit "submit" "Submit"
]
]
]
The afile function from Text.Html inserts a file input element
with the given name (in this case, 'myfile').
A file element provides two pieces of information to the webserver.
The first is the filename of the file and the second is the binary
data contained within the file. These need to be marshalled from the
encoded form data into data we can deal with in Haskell. I'll use the
method we used previously of defining a function to do the
marshalling, rather than a FromData instance.
handleData = do
myfile <- lookInput "myfile"
let Just name = inputFilename myfile `mplus` Just ""
let contents = inputValue myfile
return (name, contents)
The lookInput function returns an Input object that we then query
the filename and file contents from it. The contents is stored in the
inputValue and it is a lazy ByteString containing the binary data
in the file.
For the example I'm going to have the server side compute the md5sum
of the uploaded file and display it on the page. The md5sum can be
computed using the Data.Digest.OpenSSL.MD5 package on hackage. It
can be installed easily via cabal:
$ cabal-install nano-md5
Once installed and Data.Digest.OpenSSL.MD5 imported you can get the
md5sum of a ByteString using the function md5sum. The type of the
file contents that we marshalled was a lazy ByteString. To strictify
this (ie. make it non-lazy) we use toChunks to get an array of
non-lazy ByteString and intercalate to join the array:
handleForm :: (String, L.ByteString) -> [ServerPart Response]
handleForm (name, contents) =
let
contents' = B.intercalate B.empty $ L.toChunks contents
in
[ anyRequest $ ok $ toResponse $ "Result: " ++ (show (name, md5sum contents')) ]
The complete program is now:
import HAppS.Server
import Text.Html hiding (method)
import qualified Text.Html as H (method)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Control.Monad
import Data.Maybe
import Data.Digest.OpenSSL.MD5
page :: Html
page = concatHtml [
header << thetitle << "File Upload Example",
body << [
form ! [ H.method "POST",
enctype "multipart/form-data"
] << [
afile "myfile",
submit "submit" "Submit"
]
]
]
handleData = do
myfile <- lookInput "myfile"
let Just name = inputFilename myfile `mplus` Just ""
let contents = inputValue myfile
return (name, contents)
handleForm :: (String, L.ByteString) -> [ServerPart Response]
handleForm (name, contents) =
let
contents' = B.intercalate B.empty $ L.toChunks contents
in
[ anyRequest $ ok $ toResponse $ "Result: " ++ (show (name, md5sum contents')) ]
main = simpleHTTP nullConf [
method GET $ ok $ toResponse page,
methodSP POST $ withDataFn handleData handleForm
]
Run the program, visit the page in the browser, upload a file, and you should see the filename and the md5sum displayed.