More users thingy

[Rakka.git] / Rakka / Resource / Users.hs

diff --git a/Rakka/Resource/Users.hs b/Rakka/Resource/Users.hs
index 7eb0e136b0974dbc4121825cdb664e1c0084dc04..a4bf60204b047d54944afb08dadc62fd08386f13 100644 (file)
--- a/Rakka/Resource/Users.hs
+++ b/Rakka/Resource/Users.hs
@@ -7,12 +7,9 @@ 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)
 
 
@@ -31,17 +28,11 @@ resUsers 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
@@ -63,42 +54,20 @@ handleGet env
     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