Editing HAppS tutorial (section)

== First-step examples ==

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 <code>./myapp --default-port=8001</code> obviously substituting the name of your binary for myapp.

=== How to build these examples ===

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

=== Simple stateless examples ===

==== Hello World ====

<haskell>
import HAppS
import HAppS.Protocols.SimpleHTTP2

helloWorld () () = respond "Hello World"

main = stdHTTP
       [
        debugFilter -- we want to be able to see debug messages in the console
       ,noState -- our application has no state
       ,h () GET $ ok helloWorld -- GET / returns "HTTP/1.0 200 OK\nContent-Type: text/html; charset=utf-8\n\nHello World"
       ]
</haskell>

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. 

<code>debugFilter</code> 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

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

'''Note:''' The darcs version of 2007-07 uses hslogger, and is no longer able to log the incoming request.  (''What is the point in including debugFilter in every example in this tutorial now that it doesn't actually do anything?  Can references to it be removed?  And replaced with what?'')

<code>h</code> 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.

<code>noState</code> is just there to properly establish the state type for the 
MACID monad, since nothing else is doing so.

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

==== 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.  

<haskell>
import HAppS
import HAppS.Protocols.SimpleHTTP2

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 world"
       ]
</haskell>

==== Methods and paths ====

The first argument to h must be a suitable type to be used by the class FromReqURI that is in charge of parsing the URI. Whatever a match
returns is then passed on as the first argument of the method, so the
type of this argument also controls what happens. Note the use of the Prefix constructor below, whose corresponding class instance dumps the rest of the URI into the lst argument.

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

<haskell>
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 (Prefix ["dir"]) () $ ok $ \lst () -> respond (unwords lst) -- any method to /dir/sub/dir  will return "sub dir"
        ,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"
       ]
</haskell>

In addition to

<haskell>
(Prefix ["dir"])
</haskell>

to match paths, you may also use regular expressions:

<haskell>
(re ["dir", "([0-9]+)"])
</haskell>

for more specific path matching.

==== Simple file serving ====

<haskell>
import HAppS -- 0.8.4
import HAppS.Protocols.SimpleHTTP2 -- 0.8.8

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 (Prefix ["s"]) GET $ respIO $ fileServe staticPath -- 0.8.4
         , hs (Prefix ["s"]) GET $ basicFileServe staticPath -- 0.8.8
       ]
</haskell>

Note that to try this out with some static files you should create a directory named "static" in the directory where you are running the tutorial code, and put any files you wish to serve in there.

==== 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.

<haskell>
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 (Prefix ["s"]) GET  $ forbidden $ \path () -> if isDot path then respond "Dot files not allowed" else pass
       , h (Prefix ["s"]) GET $ respIO $ fileServe staticPath
       ]

isDot name = (head name) == '.'
</haskell>

<code>hs</code> let us consolidate these. SimpleHTTP2 defines basicFileServe as 

NOTE: basicFileServe is in the 0.8.8 stable .tar.gz download.  It is not available in the latest darcs. It is also not in the earlier 0.8.4 on hackage.

<haskell>
   basicFileServe staticPath path meth= multi
    [
     ,h path      meth $ forbidden $ \path req -> if isDot path then respond "Dot files not allowed" else request req
    ,h path       meth $ fileServe2 mimeTypes staticPath
    ]
</haskell>

We can then use this in our application using "hs" to call a function that produces a list of handlers:
<haskell>
  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 (Prefix ["s"])  GET $ basicFileServe staticPath
   ]
</haskell>

=== Saved state examples ===

Note on clearing the State Cache

When working through the following bits of code it may happen that you get the error 

<haskell>
*** Exception: user error (decodeStringM: parsing length field failed @ "")
</haskell>

when monkeying with happs code involving state. This seems to happen when you add state, remove state, or change the way state is being use. At startup, happs attempts to read state information from the state cache (a subdirectory of your working directory) and if this disagrees with what it is is expecting you get that error.  I clear my state cache (and logs) with the following command.

<haskell>
rm -rf '<interactive>_error.log' '<interactive>_state'
</haskell>
Of course if you do this you will lose state information, so this is not recommended for a production application. Probably okay for while you are learning though.

(See http://www.haskell.org/pipermail/web-devel/2007/000020.html )

==== Getting the URL itself ====
Now lets add some state and a function that does something with state. Notice that we now get rid of the noState
directive. In this example, we write an instance for FromReqURI that tries to read the next part after the url as an
value of type Int.

<haskell>
{-# OPTIONS -fglasgow-exts -fth #-}
import HAppS
import HAppS.Protocols.SimpleHTTP2
import Data.Monoid
import Control.Monad.State (get, put)
--import Data.Typeable
--data MyState = MySt { appVal :: Int } deriving (Read, Show, Typeable)

data MyState = MySt { appVal :: Int } deriving (Read, Show)

instance Serialize MyState where
  encodeStringM = defaultEncodeStringM
  decodeStringM = defaultDecodeStringM

-- Question: why does my state have to be a monoid?
-- instance Monoid MyState where
--   mempty = MySt 0
--   mappend (MySt x) (MySt y) = MySt (x+y)

-- State needs to be an instance of the class StartState, to define
-- a default initial value to be used when there is no saved state.
-- There seems to be a default instance for Monoid => StartState,
-- meaning that a warning about Monoid is produced if no StartState instance
-- is given. I guess this is a bug. Also, the below template Haskell
-- is broken too.

-- code will work without this line
-- $(inferStartState ''MyState) -- boilerplate that will eventually be SYB

instance StartState MyState where
    startStateM = return $ MySt 0

-- You wouldn't normally expect to get an entire state type out
-- as the return value from fromReqURI, and would instead
-- use a separate type to represent the information extracted from
-- the URI.

instance FromReqURI [String] MyState where
  fromReqURI expr uri = do
    [val] <- fromReqURI (Prefix expr) uri
    fmap MySt $ mbRead val

main = stdHTTP
       [debugFilter -- we want to see debug messages in the console
       ,h [""] GET $ ok $ val "GETting root hello"
       -- /val shows us the current value
       ,h ["val"] GET $ ok $ \() () -> do (MySt val) <- get; respond (show val)
       -- /set/56 would set the value to 56
       ,h ["set"] GET $ ok $ \newVal () -> do put newVal; respond ("New value is " ++ show newVal)
       -- notice that newVal here gets type MyState which invokes the FromReqURI instance above.
       ]

</haskell>

==== Getting from a POST'd value ====

Here, we replace parsing information from the URI with parsing information
from the headers and content. This uses the class FromMessage to extract the information, and its return value turns into the second argument to the method.

<haskell>
{-# OPTIONS -fglasgow-exts -fth #-}
import HAppS
import HAppS.Protocols.SimpleHTTP2

import Data.Monoid
import Data.Typeable
import Control.Monad.State (get, put)

data MyState = MySt { appVal :: Int } deriving (Read, Show, Typeable)

instance Serialize MyState where
  encodeStringM = defaultEncodeStringM
  decodeStringM = defaultDecodeStringM

instance Monoid MyState where
  mempty = MySt 0
  mappend (MySt x) (MySt y) = MySt (x+y)

$(inferStartState ''MyState) -- boilerplate that will eventually be SYB

-- You wouldn't normally expect to get an entire state type out
-- as the return value from fromMessageM, and would instead
-- use a separate type to represent the information extracted from
-- the post.

instance FromMessage MyState where
  fromMessageM m = do
    val <- maybeM $ lookMbRead m "val"
    return $ MySt val

-- Note that fromMessageM is monadic, and can fail. If it fails, then
-- the entire parse is counted as failing, and we drop through to
-- the next handler. This can lead to spurious 404s, when what
-- it really means is badly formatted form data. (or parse code)

main :: IO ()
main = stdHTTP
       [debugFilter -- we want to see debug messages in the console
       ,h [""] GET $ ok $ val "GETting root hello"
       --, h (Prefix ["s"]) GET $ respIO $ fileServe staticPath -- 0.8.4
       , hs (Prefix ["s"]) GET $ basicFileServe staticPath -- 0.8.8
       -- /val shows us the current value
       ,h ["val"] GET $ ok $ \() () -> do (MySt val) <- get; respond (show val)
       -- /set with the POST data "val"=56 would set the value to 56
       ,h ["set"] POST $ ok $ \() newVal -> do put newVal; respond ("New value is " ++ show newVal)
       -- The first one is FromReqURI and the second one is FromMessage
       -- The cryptic comment about is referring to the arguments () and newVal
       -- to the method. The type of newVal being MyState is what
       -- invokes our custom FromMessage instance above.
       ]
</haskell>

This example reads POST data, such as from the following HTML form:

<pre><nowiki>
<html>
<head><title>HAppS POST example</title></head>
<body>
<form method="POST" action="http://localhost:8000/set">
<input name="val">
<input name="Submit" type="submit">
</form>
</body>
</html>
</nowiki></pre>

==== 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)

<haskell>
{-# 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'

       -- there's no plain method in happs 0.8.8 stable
       -- ,h () () $ ok plain $ val "fallthrough" -- any request will return "Hello"
       ]

</haskell>

Above code does not compile against 0.8.8 stable, it seems the xml functions
have moved into the monad. This means we need to use code like
<haskell>
    ,h ["listincidents"] GET $ ok $ \() () -> do st <- get; style_xml (XSL "/s/incidents.xsl") (stIncidents st) >>= respond
</haskell>

The second arguments of the <code>style_xml</code> needs to be an instance of class <code>ToElement</code>

==== 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.

<pre><nowiki>
<?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>
      <!-- template goes here -->
      </body>
    </html>
  </xsl:template>
</xsl:stylesheet>
</nowiki></pre>

Where the comment 'template goes here' is located:
        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 &lt;something&gt; is &lt;xsl:value-of select="something"/&gt;)


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


<haskell>
        ,h "/status" GET $ ok plain_xml examplePostVal'
</haskell>

to

<haskell>
        ,h "/status" GET $ ok xml exampleDumpVal
</haskell>

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

<haskell>
exampleDumpVal () () = get >>= respond 
</haskell>

==== 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.
<code>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
  <head>
    <title>Error!</title>
  </head>
  <body>
    There's been an ERROR!
  </body>
</html>
</code>
and then change one line in the example code above.
<code>       ,h () () $ ok plain $ val "fallthrough"</code>
becomes
<haskell>       ,h () () $ seeOther plain $ val ("/s/error.html","hmm") -- when all else fails, complain</haskell>

If you want to dynamically choose the page to redirect to, as from
a form posting you might want code like
<haskell>
seeOther $ \fromurlarg frommessagearg -> do
        -- Do MACID stuff here.
        respond ("/somewhere","redirecting")
        -- respond is just return.Right. seeOther picks up the pair
        -- and converts it to a proper response.
</haskell>

==== Send email ====

Sending email is straightforward. Create the message value, then hand it to <code>send</code>, which first tries to send it via SMTP_RELAY then directly. Alternatives are the more specific <code>autoSend</code> for direct delivery, <code>envSend</code> for relay via SMTP_RELAY, and <code>sendHost host port</code> for relay via a given server. Often in fear of spam, the recipient will accept your message only if you relay it via your ISP's outgoing SMTP server.

<haskell>
import HAppS
myenvelope = Envelope {
                       relay = "localhost", -- your name at HELO, not the recipient's!
                       sender = Address "tutorial-reader" "happs.org",
                       recipients = [Address "shae.erisson" "gmail.com"],
                       contents = "\r\nHello shapr!"
                      }
main = send myenvelope
</haskell>

The <code>contents</code> field of the Envelope is the actual message, which should conform to the RFC 2822 SMTP standard. That is, the message body is preceded by header lines and a blank line (lines separated by "\r\n"). According to the standard, <code>Date</code> and <code>From</code> lines are obligatory. Other lines that probably should be in the messages are <code>To</code> and <code>Subject</code>. For attachments, and messages that are not plain US-ASCII text, see the RFC 2046 MIME standard.

If the SMTP server is temporarily unavailable or uses graylisting, the message should be saved for a retry later. Sending the message using <code>queueMessage</code> (uses <code>send</code>) achieves this.

==== 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 <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>
{-# 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 $ val "Hello World"
       ,h ["setcookie"] GET $ setsomecookie -- sets a cookie
       ,h ["showcookie"] GET $ ok showallcookies
       ,h () () $ ok $ val "fallthrough"
       ]

exampleHello () () = respond "Hello World"

setsomecookie () () 
    = do resp <- ok (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)

</haskell>

==== Sessions ====

Sessions are much like 

autoexpire state, and hook that expire event.

something can happen when state expiresxp

==== Blocking IO ====

There's a way to do blocking IO within HAppS, ...