Fixing build breakage...

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

diff --git a/Rakka/Resource/Users.hs b/Rakka/Resource/Users.hs
index 7eb0e136b0974dbc4121825cdb664e1c0084dc04..ccf677c8ec24cf2646bf2bc3b6c3a95815d7628d 100644 (file)
--- 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