[Fencommits] fenserve: something you can PUT to and GET from

[Benja Fallenstein]

Thu Mar 15 17:52:19 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * something you can PUT to and GET from
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs	1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/FenServe.hs	2007-03-22 19:49:43.000000000 +0200
@@ -0,0 +1,60 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+module Main where
+
+-- Copyright (c) 2006-2007, Benja Fallenstein, Tuukka Hastrup
+-- This file is part of Fenfire.
+-- 
+-- Fenfire is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by
+-- the Free Software Foundation; either version 2 of the License, or
+-- (at your option) any later version.
+-- 
+-- Fenfire is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
+-- Public License for more details.
+-- 
+-- You should have received a copy of the GNU General
+-- Public License along with Fenfire; if not, write to the Free
+-- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+-- MA  02111-1307  USA
+
+import HAppS
+
+import Control.Monad.State (get, modify)
+
+import qualified Data.ByteString as ByteString
+import Data.ByteString (ByteString)
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Typeable
+
+import Network.URI (uriToString)
+
+data Representation = Representation { mimeType :: String, body :: ByteString }
+         deriving (Read, Show, Typeable)
+type State = Map String Representation
+
+instance StartState State where startStateM = return $ Map.empty
+instance Serialize  State where
+    typeString _  = "FenServe.State"
+    decodeStringM = defaultDecodeStringM
+    encodeStringM = defaultEncodeStringM
+
+instance ToMessage ByteString where
+    toMessageBodyM = return
+
+uriToString' uri = uriToString id uri ""
+
+just :: SURI -> Maybe String
+just = Just . uriToString' . suri
+
+main :: IO ()
+main = stdHTTP
+  [ h just GET $ ok $ \uri () -> do (state :: State) <- get
+                                    return $ Right $ body $ state Map.! uri
+  , h just PUT $ ok $ \uri () -> do Request { rqBody=Body body } <- getEvent
+                                    modify $ Map.insert uri $
+                                        Representation "text/html" body
+                                    return $ Right "Ok, put"
+  ]