Personal tools

HAppS tutorial

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
(update whole program examples for the new API)
Line 12: Line 12:
 
* stm ( Software Transactional Memory, comes with GHC 6.6 )
 
* stm ( Software Transactional Memory, comes with GHC 6.6 )
 
* template-haskell ( http://www.haskell.org/th, comes with GHC 6.6 )
 
* template-haskell ( http://www.haskell.org/th, comes with GHC 6.6 )
 
   
 
The quick way to see what's missing is to get the darcs repository, change into that directory, and run <code>runghc Setup.hs configure</code>. If you don't get an error, try <code>runghc Setup.hs build</code> and then as root <code>runghc Setup.hs install</code>.
 
The quick way to see what's missing is to get the darcs repository, change into that directory, and run <code>runghc Setup.hs configure</code>. If you don't get an error, try <code>runghc Setup.hs build</code> and then as root <code>runghc Setup.hs install</code>.
Line 57: Line 56:
 
noState : -- handler that defines application to have no persistent state
 
noState : -- handler that defines application to have no persistent state
 
[
 
[
h "/$" GET $ ok plain helloWorld -- GET / returns 200 OK\ncontent-type: text/plain\n\nHello World
+
h () GET $ ok helloWorld -- GET / returns 200 OK\ncontent-type: text/plain\n\nHello World
 
]
 
]
 
</haskell>
 
</haskell>
Line 87: Line 86:
 
<haskell>
 
<haskell>
 
import HAppS
 
import HAppS
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
+
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
 
noState : -- our application has no state
 
noState : -- our application has no state
 
[
 
[
h "$/" GET $ ok plain $ val "Hello world" -- any request will return "Hello"
+
h () GET $ ok $ val "Hello world" -- any request will return "Hello"
 
]
 
]
 
</haskell>
 
</haskell>
Line 102: Line 101:
 
<haskell>
 
<haskell>
 
import HAppS
 
import HAppS
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
+
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
 
noState : -- our application has no state
 
noState : -- our application has no state
 
[
 
[
h "/$" GET $ ok plain $ val "Hello World"
+
h [""] GET $ ok $ val "Hello World"
,h "/getPost$" [GET,POST] $ ok plain $ val "either GET or POST will result in this response"
+
,h ["getPost"] [GET,POST] $ ok $ val "either GET or POST will result in this response"
,h '/directory/" () $ ok plain $ val "Hello" -- any method to /dir/subdir will return "Hello"
+
,h ["dir"] () $ ok $ \lst () -> respond (unwords lst) -- any method to /dir/subdir will return "Hello"
,h '/methods$" () $ ok plain $ val "Hello" -- any method to /methods will return "Hello"
+
,h ["methods"] () $ ok $ val "Hello" -- any method to /methods will return "Hello"
,h () () $ ok plain $ val "default" -- any method and any reqURI not matched above gets this
+
,h () () $ ok $ val "default" -- any method and any reqURI not matched above gets this
   
 
--these two are automatically added by stdHTTP so you don't have to unless you want to override
 
--these two are automatically added by stdHTTP so you don't have to unless you want to override
 
--notice that the responses are not "ok" they are notFound and notImplemented!
 
--notice that the responses are not "ok" they are notFound and notImplemented!
,h () [GET,POST] $ notFound plain $ val "not found"
+
,h () [GET,POST] $ notFound $ val "not found"
,h () () $ notImplemented plain $ val "not implemented"
+
,h () () $ notImplemented $ val "not implemented"
 
]
 
]
 
</haskell>
 
</haskell>
Line 122: Line 121:
 
<haskell>
 
<haskell>
 
import HAppS
 
import HAppS
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
+
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
 
noState : -- our application has no state
 
noState : -- our application has no state
 
[
 
[
h "/$" GET $ ok plain $ val "GETting root hello"
+
h [""] GET $ ok $ val "GETting root hello"
,h "/s/" GET $ fileServe2 mimeTypes staticPath
+
, hs ["s"] GET $ basicFileServe staticPath
 
]
 
]
 
</haskell>
 
</haskell>
Line 141: Line 140:
 
<haskell>
 
<haskell>
 
import HAppS
 
import HAppS
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
+
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
 
noState : -- our application has no state
 
noState : -- our application has no state
[
+
[
h "/$" GET $ ok plain $ val "GETting root hello"
+
h [""] GET $ ok $ val "GETting root hello"
,h "/s/" GET $ forbidden plain $ \path req -> if isDot path then respond "Dot files not alloed" else req
+
,h ["s"] GET $ forbidden $ \path () -> if isDot path then respond "Dot files not allowed" else pass
,h "/s/" GET $ fileServe2 mimeTypes staticPath
+
,hs ["s"] GET $ basicFileServe staticPath
]
+
]
  +
  +
isDot name = (take 1 (concat name) == ".")
 
</haskell>
 
</haskell>
   
Line 154: Line 153:
 
basicFileServe staticPath path meth= multi
 
basicFileServe staticPath path meth= multi
 
[
 
[
,h path meth GET $ forbidden plain $ \path req -> if isDot path then respond "Dot files not alloed" else req
+
h path meth GET $ forbidden plain $ \path req -> if isDot path then respond "Dot files not alloed" else req
 
,h path meth $ fileServe2 mimeTypes staticPath
 
,h path meth $ fileServe2 mimeTypes staticPath
 
]
 
]
Line 197: Line 196:
   
 
<haskell>
 
<haskell>
 
 
{-# OPTIONS -fglasgow-exts -fth #-}
 
{-# OPTIONS -fglasgow-exts -fth #-}
 
module Main where
 
module Main where
Line 296: Line 294:
 
</code>
 
</code>
 
and then change one line in the example code above.
 
and then change one line in the example code above.
<haskell> ,h () () $ ok plain $ val "fallthrough"</haskell>
+
<code> ,h () () $ ok plain $ val "fallthrough"</code>
 
becomes
 
becomes
 
<haskell> ,h () () $ seeOther plain $ val ("/s/error.html","hmm") -- when all else fails, complain</haskell>
 
<haskell> ,h () () $ seeOther plain $ val ("/s/error.html","hmm") -- when all else fails, complain</haskell>
Line 309: Line 307:
 
myenvelope = Envelope {
 
myenvelope = Envelope {
 
relay = "localhost",
 
relay = "localhost",
sender = Address "tutorial-reader" "happs.org"
+
sender = Address "tutorial-reader" "happs.org",
 
recipients = [Address "shae.erisson" "gmail.com"],
 
recipients = [Address "shae.erisson" "gmail.com"],
 
contents = "Hello shapr!"
 
contents = "Hello shapr!"
Line 321: Line 319:
   
 
To set a cookie, modify the response as in <code>setsomecookie</code>. To get a cookie, look in the request as in <code>showallcookies</code>.
 
To set a cookie, modify the response as in <code>setsomecookie</code>. To get a cookie, look in the request as in <code>showallcookies</code>.
  +
  +
To see output from this example, first go to /setcookie, and then to /showcookie.
   
 
<haskell>
 
<haskell>
Line 360: Line 360:
 
==== Sessions ====
 
==== Sessions ====
   
...
+
Sessions are much like
  +
  +
autoexpire state, and hook that expire event.
  +
  +
something can happen when state expiresxp
  +
  +
==== Blocking IO ====

Revision as of 17:35, 2 March 2007


Contents

1 Installing

To install HAppS the following packages are needed:

  • HaXml 1.13.X ( http://www.haskell.org/HaXml, libghc6-haxml-dev in Debian )
  • base
  • cabal (for installation)
  • mtl ( Monad Template Library, libghc6-mtl-dev in Debian )
  • network ( libghc6-network-dev in Debian )
  • stm ( Software Transactional Memory, comes with GHC 6.6 )
  • template-haskell ( http://www.haskell.org/th, comes with GHC 6.6 )

The quick way to see what's missing is to get the darcs repository, change into that directory, and run runghc Setup.hs configure. If you don't get an error, try runghc Setup.hs build and then as root runghc Setup.hs install.

2 Overview

The application model in HAppS is to help separate state, application logic, wire formats, protocols, and presentation layer:

2.1 State

State is just a haskell data type you define. ACID [2] Consistency enforced by Haskell's type system. ACID Durability is handled by MACID write-ahead logging and checkpointing.

2.2 Application

Incoming events are gathered in individual haskell threads and then pushed onto a single application queue for processing. The queue model gives you ACID Atomicity and Isolation and lets your app be simply a set of functions with types like:

SomeInputType -> MACID SomeOutputType


The MACID monad lets you update your state and *schedule* side-effects. To be clear, MACID is not in the IO monad so you cannot execute side effects, you can only schedule them. The framework takes care of making sure they are executed at-least-once (if they can be completed by a deadline you specify).

2.3 Wire formats

Since your app consists of a set of functions with various haskell input and output types, somewhere you need a place to convert between those internal haskell types and external protocol event types; e.g. from URL Encoded HTTP requests to SomeInputType and from SomeOutputType to XML encoded HTTP responses.

2.4 Protocols

HAppS currently provides support for HTTP Requests/Responses and SMTP Envelopes. To be clear HAppS provides ACID Atomicity at the protocol event level. So if you write a protocol with SMTP envelopes being the arriving event type then your app will have atomicity in processing incoming SMTP envelopes. If you write a protocol with SMTP commands being the arriving event type, then your app will have atomicity at the level of individual smtp commands.

2.5 Presentation

If your application outputs XML as its wire format, HAppS provides a lot of support for using XSLT to transform it for presentation purposes. For example, you can send XML mail and HAppS will take care of applying the relevant XSLT stylesheet before it is delivered. If you output XML HTTP responses, HAppS takes care of applying the XSLT stylesheet server side for user-agents that don't support doing so on the client. The value here is that you can have designer types who know XSLT modify presentation stuff without touching your application code.

3 First steps

This chapter will run you through some first simple programs written in HAppS. For other programs have a look at the directory named 'examples'.

First of all, default HAppS applications run their own webserver on port 8000, so you probably want to try out these examples at http://localhost:8000/

If you'd rather access these applications on some other port, use ./myapp --default-port=8001 obviously substituting the name of your binary for myapp.

3.1 How to build these examples

Cut'n'paste this into a file named Hello.hs and run ghc --make Hello.hs -o hello to compile and then ./hello to execute the resulting binary.

3.1.1 Hello World

import HAppS 
 
helloWorld () () = respond "Hello World" 
 
main = stdHTTP -- stdHTTP takes a list of handlers to process.  
	 $ debugFilter : -- handler that prints all requests and responses on console
       noState : -- handler that defines application to have no persistent state
       [
        h () GET $ ok helloWorld -- GET / returns 200 OK\ncontent-type: text/plain\n\nHello World
       ]

handlers are functions that produce either a request or a response. stdHTTP runs forward through the list of handlers transforming requests into requests until it hits a handler that produces a response. It then runs backward up the list transforming responses into responses.

debugFilter actually consists of two handlers, one that prints the request to console and then returns it and another that prints the response to console and then returns it. It is defined in HAppS.Protocols.SimpleHTTP2 as

debugFilter = multi [Handle (\req -> (debugM $ show req) >> debugM "\n" >> request req)
                    ,ModResp (\res -> return (debugM "\n" >> res >>= debugM . show >> debugM "\n=======\n" >> res))]

h is a wrapper around Handle that simplifies matching on uris and methods and structuring responses. It only executes the handler if the URI matches the regex in its first argument and the method specification in its second. A "^" is automatically added to the URI because that is the 99% case.

Notice in this example that any request other than GET / will produce an error!

3.1.2 add "val" for simplicity

The concept of just returning a value is so common that we defined a function "val" so you don't have to define a function just to return a simple value.

import HAppS
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
                  noState : -- our application has no state
       [
        h () GET $ ok $ val "Hello world" -- any request will return "Hello"
       ]

3.1.3 Methods and Paths

URI arguments to h are by default regular expression strings to which ^ is prepended and (.*) is appended.

Method arguments can be individual methods, lists of methods or () to mean all methods.

import HAppS
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
                  noState : -- our application has no state
       [
         h [""] GET $ ok $ val "Hello World"
	,h ["getPost"] [GET,POST] $ ok $ val "either GET or POST will result in this response"
        ,h ["dir"] () $ ok $ \lst () -> respond (unwords lst) -- any method to /dir/subdir  will return "Hello"
        ,h ["methods"] () $ ok $ val "Hello" -- any method to /methods will return "Hello"
        ,h () () $ ok $ val "default" -- any method and any reqURI not matched above gets this
 
       --these two are automatically added by stdHTTP so you don't have to unless you want to override
       --notice that the responses are not "ok" they are notFound and notImplemented!
        ,h () [GET,POST] $ notFound $ val "not found"
        ,h () () $ notImplemented $ val "not implemented"
       ]

3.1.4 Simple File Serving

import HAppS
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
                  noState : -- our application has no state
       [
         h [""]   GET $ ok $ val "GETting root hello"
       , hs ["s"] GET $ basicFileServe staticPath
       ]

3.1.5 block dot files

But observe that we don't want to serve all paths in the filesystem. So we want to preempt certain requests that reach the fileServe line:

Now we observe that we actually want to block dot files as well so we do. (There's probably a nicer way to do this using regex). Notice that the fileServe code actually does IO. So you can write responses that do IO. Conceptually you can serve content out of an external database or a proxy server.

import HAppS
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
                  noState : -- our application has no state
       [
        h [""] GET $ ok $ val "GETting root hello"
       ,h ["s"] GET  $ forbidden $ \path () -> if isDot path then respond "Dot files not allowed" else pass
       ,hs ["s"] GET $ basicFileServe staticPath
       ]
 
isDot name = (take 1 (concat name) == ".")

hs let us consolidate these. SimpleHTTP2 defines basicFileServe as:

   basicFileServe staticPath path meth= multi
    [
     h path meth  GET  $ forbidden plain $ \path req -> if isDot path then respond "Dot files not alloed" else req
    ,h path       meth $ fileServe2 mimeTypes staticPath
    ]

We can then use this in our application using "hs" to call a function that produces a list of handlers:

  main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
                  noState : -- our application has no state
    [
     h "/$" GET $ ok plain $ val "GETting root hello"
     hs clientPath  GET $ basicFileServe staticPath
   ]

3.1.6 saved state

Now lets add some state and a function that does something with state. Notice that we now get rid of the noState directive.

{-# OPTIONS -fglasgow-exts -fth #-}
import HAppS
import Data.Typeable
import Control.Monad.State
 
data MyState = MySt { appVal :: Int } deriving (Read,Show,Typeable)
$(inferStartState ''MyState) -- boilerplate that will eventually be SYB
 
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
       [
        h "/$" GET $ ok plain $ val "GETting root hello"
       ,hs clientPath  GET $ basicFileServe staticPath
       ,h "/val$" GET $ ok plain $ \() () -> do (MySt val) <- get; respond (show val);
       ]

3.1.7 Haskell to XML with ToElement, XML to Haskell with FromMessage

HAppS supports turning Haskell values into XML values with the ToElement typeclass.

(this example needs to be trimmed)

{-# OPTIONS -fglasgow-exts -fth #-}
module Main where 
 
import HAppS
import Data.Typeable
import Control.Monad.State
 
data Something = Thing { appVal :: String } deriving (Read, Show, Typeable)
$(inferStartState ''Something)
 
-- to return Something values as xml, implement ToElement
instance ToElement Something where toElement = textElem "something" [] . show . appVal
-- to turn 
instance FromMessage Something where fromMessageM m = maybeM $ lookMbRead m "something" >>= return . Thing
 
exampleGetVal x () = do (Thing y) <- get; respond $ Thing (x++y)
examplePostVal () (Thing x) = modify (\ (Thing y) -> Thing (y++x)) >> get >>= respond
 
-- Ambiguous type variable `st' in the constraints: `StartStateEx st st' ... `Serialize st'
-- Means your code isn't specific enough for GHC to infer a type
-- You need to either specify a type, or have other cases that require more specific types.
examplePostVal' () (Thing x) = respond $ show x
 
exampleHello () () = respond "Hello world"
 
 
main = stdHTTP $ debugFilter : -- we want to see debug messages in the console
       [
        hs clientPath  GET $ basicFileServe staticPath
       ,h "/val" POST $ ok plain_xml examplePostVal -- $ val "the request ends with plain"
       ,h "/status" GET $ ok plain_xml examplePostVal'
       ,h () () $ ok plain $ val "fallthrough" -- any request will return "Hello"
       ]

3.1.8 XML with Style

We can format the status output of the example above with XSLT. Save the following xsl source as style.xsl in a 'static' subdirectory.

<?xml version="1.0"?> <!DOCTYPE xsl:stylesheet PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "libxslt/xslt2.dtd">

<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0" xmlns:html='http://www.w3.org/TR/REC-html40' >

 <xsl:template match="/">
   <html>
     <head>
     </head>
     <body>
       1. view source to see server output.
2. make templates for each of your output types.
3.use the xsl lib that handles all sorts of standard template issues to make it all nice!
The value of the element <something> is <xsl:value-of select="something"/>
   </body>
 </html>
 </xsl:template>

</xsl:stylesheet>

And then change one line and add one line for the example code above.


        ,h "/status" GET $ ok plain_xml examplePostVal'

to

        ,h "/status" GET $ ok xml exampleDumpVal

and add this to get the state and dump it to the browser:

exampleDumpVal () () = get >>= respond

3.1.9 Redirection

Next we'll demonstrate redirection by creating a static error page and redirection to it in the fallthrough case.

You can use this shockingly complex error page. <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html>

 <head>
   <title>Error!</title>
 </head>
 <body>
   There's been an ERROR!
 </body>

</html> and then change one line in the example code above. ,h () () $ ok plain $ val "fallthrough" becomes

       ,h () () $ seeOther plain $ val ("/s/error.html","hmm") -- when all else fails, complain

3.1.10 Send Email

Sending email is straightforward. Create the message value, then hand it to send. If you don't have an SMTP server running on localhost, you'll need to change the relay value. This program shows lots of interesting debug output when executed.

import HAppS
myenvelope = Envelope {
                       relay = "localhost",
                       sender = Address "tutorial-reader" "happs.org",
                       recipients = [Address "shae.erisson" "gmail.com"],
                       contents = "Hello shapr!"
                      }
main = send myenvelope

3.1.11 Get and Set Cookies

At some point you'll want to get and set cookies in the browser.

To set a cookie, modify the response as in setsomecookie. To get a cookie, look in the request as in showallcookies.

To see output from this example, first go to /setcookie, and then to /showcookie.

{-# OPTIONS -fglasgow-exts -fth #-}
module Main where 
 
import HAppS
import Data.Typeable
import Data.Maybe
import Control.Monad.State
 
main = stdHTTP $ debugFilter :
       noState :
       [
        hs clientPath  GET $ basicFileServe staticPath
       ,h "/hello" GET $ ok plain $ val "Hello World"
       ,h "/setcookie" GET $ setsomecookie -- sets a cookie
       ,h "/showcookie" GET $ ok plain showallcookies
       ,h () () $ ok plain $ val "fallthrough"
       ]
 
exampleHello () () = respond "Hello World"
 
setsomecookie () () 
    = do resp <- ok html (val "cookie now set") () ()
         return $ liftM (testCookie =<<) resp
 
showallcookies () req
    = respond $ allcookies req
 
testCookie :: Monad m => Result -> m Result
testCookie = setCookieEx maxBound $ Cookie "1" "/" "" "cookieName" "cookieValue"
 
allcookies    :: Request -> String
allcookies rq = unlines $ map show $ concat (getCookies rq)

3.1.12 Sessions

Sessions are much like

autoexpire state, and hook that expire event.

something can happen when state expiresxp

3.1.13 Blocking IO