X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FUsers.hs;h=ccf677c8ec24cf2646bf2bc3b6c3a95815d7628d;hb=88747f2;hp=7eb0e136b0974dbc4121825cdb664e1c0084dc04;hpb=547fd6221931c8025085db91f7424db850156129;p=Rakka.git

diff --git a/Rakka/Resource/Users.hs b/Rakka/Resource/Users.hs
index 7eb0e13..ccf677c 100644
--- a/Rakka/Resource/Users.hs
+++ b/Rakka/Resource/Users.hs
@@ -2,46 +2,35 @@ module Rakka.Resource.Users
     ( resUsers
     )
     where
-
 import           Control.Monad
 import           Control.Monad.Trans
 import           Data.Maybe
 import           Network.HTTP.Lucu
-import           Network.URI hiding (path)
 import           Rakka.Authorization
 import           Rakka.Environment
 import           Rakka.Resource
-import           Rakka.SystemConfig
-import           System.FilePath
-import           Text.XML.HXT.Arrow hiding (when)
 
 
 resUsers :: Environment -> ResourceDef
 resUsers env
     = ResourceDef {
-		   resUsesNativeThread = False
-		  , resIsGreedy        = True
-		  , resGet             = Just $ handleGet env
-		  , resHead            = Nothing
-		  , resPost            = Nothing
-		  , resPut             = Just $ handlePut env
-		  , resDelete          = Just $ handleDelete env
-		  }
+	resUsesNativeThread = False
+      , resIsGreedy        = True
+      , resGet             = Just $ handleGet env
+      , resHead            = Nothing
+      , resPost            = Nothing
+      , resPut             = Just $ handlePut env
+      , resDelete          = Just $ handleDelete env
+      }
 
 
 {-
   [GET /users]
-  <rdf:RDF>
-    <rdf:Description rdf:about="http://.../users">
-      <users>
-        <rdf:Bag>
-          <rdf:li rdf:resource="http://.../users/foo" />
-	  <rdf:li rdf:resource="http://.../users/bar" />
-    	  ...
-	</rdf:Bag>
-      </users>
-    </rdf:Description>
-  </rdf:RDF>
+  <users>
+    <user id="foo" />
+    <user id="bar" />
+    ...
+  </users>
 
   [GET /users/foo]
   204 No Content
@@ -53,52 +42,30 @@ handleGet :: Environment -> Resource ()
 handleGet env
     = do userID <- getUserID env
 	 when (isNothing userID)
-		  $ abort Forbidden [] Nothing
+                  $ abort Forbidden [] Nothing
 
 	 path <- getPathInfo
 	 case path of
-		   []     -> returnUserList
-		   [name] -> returnUser name
-		   _      -> foundNoEntity Nothing
+	   []     -> returnUserList
+	   [name] -> returnUser name
+	   _      -> foundNoEntity Nothing
     where
     returnUserList :: Resource ()
     returnUserList
-	= do BaseURI baseURI <- getSysConf (envSysConf env)
-	     users           <- liftIO $ getUserList $ envAuthDB env
+	= do users <- liftIO $ getUserList $ envAuthDB env
 	     runIdempotentA' $ proc ()
 		 -> do tree <- ( eelem "/"
-				 += ( eelem "rdf:RDF"
-				      += sattr "xmlns"     "http://cielonegro.org/terms/"
-				      += sattr "xmlns:rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
-				      += ( eelem "rdf:Description"
-					   += sattr "rdf:about" (uriToString id (mkUserURI baseURI Nothing) "")
-					   += ( eelem "users"
-						+= ( eelem "rdf:Bag"
-						     += ( constL users
-							  >>>
-							  ( eelem "rdf:li"
-							    += attr "rdf:resource" ( arr ( \ name ->
-											   uriToString
-											   id
-											   (mkUserURI baseURI $ Just name)
-											   ""
-											 )
-										     >>>
-										     mkText
-										   )
-							  )
-							)
-						   )
-					      )
+				 += ( eelem "users"
+				      += ( constL users
+					   >>>
+					   ( eelem "user"
+					     += attr "id" mkText
+					   )
 					 )
 				    )
 			       ) -< ()
 		       returnA -< outputXml tree
 
-    mkUserURI :: URI -> Maybe String -> URI
-    mkUserURI baseURI Nothing  = baseURI { uriPath = uriPath baseURI </> "users" }
-    mkUserURI baseURI (Just x) = baseURI { uriPath = uriPath baseURI </> "users" </> x }
-
     returnUser :: String -> Resource ()
     returnUser name
 	= do users <- liftIO $ getUserList $ envAuthDB env
@@ -123,17 +90,17 @@ handlePut env
 
 	 path <- getPathInfo
 	 case path of
-		   [name] -> do mimeType <- getContentType
-				case mimeType of
-					      Nothing
-						  -> abort BadRequest [] (Just "Missing Content-Type")
-					      Just (MIMEType "text" "plain" _)
-						  -> do pass <- input defaultLimit
-							addUser (envAuthDB env) name pass
-					      Just t
-						  -> abort UnsupportedMediaType [] (Just $ "Unsupported media type: " ++ show t)
-				setStatus Created
-		   _      -> abort BadRequest [] (Just "Invalid URI")
+	   [name] -> do mimeType <- getContentType
+			case mimeType of
+			  Nothing
+			      -> abort BadRequest [] (Just "Missing Content-Type")
+			  Just (MIMEType "text" "plain" _)
+			      -> do pass <- input defaultLimit
+				    addUser (envAuthDB env) name pass
+			  Just t
+			      -> abort UnsupportedMediaType [] (Just $ "Unsupported media type: " ++ show t)
+                        setStatus Created
+	   _      -> abort BadRequest [] (Just "Invalid URI")
 
 
 handleDelete :: Environment -> Resource ()
@@ -144,6 +111,6 @@ handleDelete env
 
 	 path <- getPathInfo
 	 case path of
-		   [name] -> delUser (envAuthDB env) name
-		   _      -> abort BadRequest [] (Just "Invalid URI")
+	   [name] -> delUser (envAuthDB env) name
+	   _      -> abort BadRequest [] (Just "Invalid URI")
 	 setStatus NoContent