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
+ }
{-
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
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 ()
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