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)
{-
[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
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