[Fencommits] fenserve: make edit-demo access the resources it edits through simple 'wget'/'wput' (web get, web put) functions, so that they work just like manual GET/PUT

[Benja Fallenstein]

Thu Mar 22 19:43:04 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * make edit-demo access the resources it edits through simple 'wget'/'wput' (web get, web put) functions, so that they work just like manual GET/PUT
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs	2007-03-22 19:49:04.000000000 +0200
+++ new-fenserve/FenServe.hs	2007-03-22 19:49:04.000000000 +0200
@@ -44,7 +44,7 @@
 
 import Language.Haskell.Hsx as Hsx
 
-import Network.URI (uriToString)
+import Network.URI (uriToString, parseURIReference)
 
 import System.Directory (removeFile)
 import System.Environment (getEnv)
@@ -188,13 +188,28 @@
 updateData :: (FromRDF a, ToRDF a, StormMonad m) => EndoM m a -> EndoM m Node
 updateData f node = readData node >>= f >>= writeData (bURI $ bID node)
 
-handlePath :: [String] -> Request -> FenServe Result
-handlePath path req = do 
-    e <- getEntry path
+handleRequest :: Request -> FenServe Result
+handleRequest req = let p = splitPath $ path $ rqURI req in do
+    e <- getEntry p
     case e of Right (ExecutableEntry code) -> execute code req
-              _ -> case rqMethod req of GET -> getURI path req
-                                        PUT -> putURI path req
-      
+              _ -> case rqMethod req of GET -> getURI p req
+                                        PUT -> putURI p req
+                                        
+wget :: String -> FenServe ByteString
+wget uri = liftM (ByteString.concat . rsBody) $
+               handleRequest $ wrequest uri GET
+
+wput :: String -> ByteString -> FenServe ()
+wput uri body = do handleRequest $ (wrequest uri PUT) { rqBody=Body body }
+                   return ()
+
+wrequest :: String -> Method -> Request
+wrequest uri method = case parseURIReference uri of
+    Nothing -> error $ "FenServe.wrequest: not a legal URI: " ++ uri
+    Just u -> Request { rqURI=SURI u, rqVersion=Version 1 0, 
+                        rqHeaders=Headers Map.empty, rqBody=NoBody,
+                        rqMethod=method, rqPeer=("localhost",-1234) }
+
 getURI :: [String] -> Request -> FenServe Result
 getURI path req = getEntry path >>= \entry -> case entry of
         Left err -> return $ mkResult 404 "text/html" (toUTF err)
diff -rN -u old-fenserve/Main.hs new-fenserve/Main.hs
--- old-fenserve/Main.hs	2007-03-22 19:49:04.000000000 +0200
+++ new-fenserve/Main.hs	2007-03-22 19:49:04.000000000 +0200
@@ -39,9 +39,9 @@
     if fst (rqPeer req) == "localhost" then request req else respond $ return $
         mkResult 403 "text/html" $ toUTF "403 Forbidden: Try from localhost"
         
-fenserveHandler hdl = Handle $ \req -> do
-    state <- get; rq <- getEvent; let pa = splitPath (path $ rqURI req)
-    let (result, state') = runFenServe (hdl pa rq) state
+fenserveHandler = Handle $ \req -> do
+    state <- get; rq <- getEvent
+    let (result, state') = runFenServe (handleRequest rq) state
     when (not $ rqMethod req `elem` [GET,HEAD]) $ put state'
     respond $ return result
 
@@ -49,5 +49,5 @@
 main = stdHTTP
   [ debugFilter
   , localhostOnlyFilter
-  , fenserveHandler handlePath
+  , fenserveHandler
   ]
diff -rN -u old-fenserve/edit-demo.page new-fenserve/edit-demo.page
--- old-fenserve/edit-demo.page	2007-03-22 19:49:04.000000000 +0200
+++ new-fenserve/edit-demo.page	2007-03-22 19:49:04.000000000 +0200
@@ -5,26 +5,22 @@
 import Data.Maybe (fromMaybe)
 
 handler req = do
-    let path0 = fromMaybe "/testdata/foo" $ lookM req "path"
-        path' = splitPath path0
+    let uri = fromMaybe "/testdata/foo" $ lookM req "uri"
 
     if rqMethod req == POST
         then case lookM req "contents" of
-                Just contents -> do b <- liftM bIRI $ addBlock $ toUTF contents
-                                    putEntry path' (FileEntry b); return ()
+                Just contents -> wput uri (toUTF contents)
                 _ -> return ()
         else return ()
 
-    e <- getEntry path'; contents <- case e of
-        Right (FileEntry r) -> liftM fromUTF $ getBlock (bID r)
-        _ -> return ""
+    contents <- liftM fromUTF $ wget uri
         
     return $ mkResult 200 "text/html" $ toUTF $
         <html>
-        <h1>Edit: <% path0 %></h1>
+        <h1>Edit: <% uri %></h1>
         <form action="" method="POST">
         <textarea name="contents" rows="15" cols="80"><% contents %></textarea>
-        <input name="path" type="hidden" value=path0/>
+        <input name="uri" type="hidden" value=uri/>
         <p><input type="submit" value="Save"/></p>
         </form>
         </html>