1 module Rakka.Resource.Users
7 import Control.Monad.Trans
9 import Network.HTTP.Lucu
10 import Rakka.Authorization
11 import Rakka.Environment
13 import Text.XML.HXT.Arrow hiding (when)
16 resUsers :: Environment -> ResourceDef
19 resUsesNativeThread = False
21 , resGet = Just $ handleGet env
24 , resPut = Just $ handlePut env
25 , resDelete = Just $ handleDelete env
40 [GET /users/nonexistent]
43 handleGet :: Environment -> Resource ()
45 = do userID <- getUserID env
46 when (isNothing userID)
47 $ abort Forbidden [] Nothing
52 [name] -> returnUser name
53 _ -> foundNoEntity Nothing
55 returnUserList :: Resource ()
57 = do users <- liftIO $ getUserList $ envAuthDB env
58 runIdempotentA' $ proc ()
59 -> do tree <- ( eelem "/"
69 returnA -< outputXml tree
71 returnUser :: String -> Resource ()
73 = do users <- liftIO $ getUserList $ envAuthDB env
74 if any (== name) users
75 then setStatus NoContent
76 else foundNoEntity Nothing
80 > PUT /users/foo HTTP/1.1
81 > Content-Type: text/plain
85 < HTTP/1.1 201 Created
87 handlePut :: Environment -> Resource ()
89 = do userID <- getUserID env
90 when (isNothing userID)
91 $ abort Forbidden [] Nothing
95 [name] -> do mimeType <- getContentType
98 -> abort BadRequest [] (Just "Missing Content-Type")
99 Just (MIMEType "text" "plain" _)
100 -> do pass <- input defaultLimit
101 addUser (envAuthDB env) name pass
103 -> abort UnsupportedMediaType [] (Just $ "Unsupported media type: " ++ show t)
105 _ -> abort BadRequest [] (Just "Invalid URI")
108 handleDelete :: Environment -> Resource ()
110 = do userID <- getUserID env
111 when (isNothing userID)
112 $ abort Forbidden [] Nothing
116 [name] -> delUser (envAuthDB env) name
117 _ -> abort BadRequest [] (Just "Invalid URI")