key-value store hails

key-val-boiler

{-# LANGUAGE OverloadedStrings #-}
module SimpleApp2 (server) where

import Prelude hiding (lookup)
import Data.String
import Control.Monad
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy.Char8 as L8

import LIO
import Hails.Web
import qualified Hails.Web.Frank as Frank
import Hails.HttpServer
import Hails.Database

import SimplePolicyModule

server :: Application
server = mkRouter $ do
  Frank.post "/store" $ do
    doc <- include ["key","val"] `liftM` hsonRequest
    if length doc /= 2
      then respond badRequest
      else do liftLIO $ withStorePolicyModule $ insert "store" doc
              respond $ redirectTo $ "/store/" ++ ("key" `at` doc)
    where hsonRequest :: Controller Document
          hsonRequest = request >>= labeledRequestToHson >>= (liftLIO . unlabel)