Commit 0cc80a62 authored by Nicolas Lenz's avatar Nicolas Lenz

User Management Interface

parent 0c476c68
......@@ -8,4 +8,6 @@
/log LogR GET
/user/#Text UserR PUT DELETE
/user UsersR GET
/user UsersR GET POST
/control ControlR GET
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, DeriveGeneric, QuasiQuotes, LambdaCase #-}
module Handler.Misc where
......@@ -9,7 +7,7 @@ import Auth
postAddR :: Handler Value
postAddR = do
allocation <- (requireCheckJsonBody :: Handler Allocation)
allocation <- requireCheckJsonBody :: Handler Allocation
let amount = allocationAmount allocation
let container = allocationContainer allocation
let location = allocationLocation allocation
......@@ -45,3 +43,42 @@ putUserR username = do
deleteUserR :: Text -> Handler ()
deleteUserR username = runDB $ deleteBy (UniqueUser username)
postUsersR :: Handler ()
postUsersR = lookupPostParam "request" >>= \case
Just "put" -> do
username <- lookupPostParam "username"
password <- lookupPostParam "password"
case (username, password) of
(Just username', Just password') -> runDB $ Auth.addUser username' password' >> redirect ("/control" :: Text)
_ -> invalidArgs ["username", "password"]
Just "delete" -> do
username <- lookupPostParam "username"
case username of
Just username' -> deleteUserR username' >> redirect ("/control" :: Text)
_ -> invalidArgs ["username"]
_ -> invalidArgs ["request"]
getControlR :: Handler Html
getControlR = do
usersE <- runDB $ selectList [] []
let users = entityVal <$> (usersE :: [Entity User])
defaultLayout [whamlet|
<h1>User Control
<h2>User List
<ul>
$forall user <- users
<li>#{userName user}
<h2>Add User or Change Password
<form action="/user" method="post">
Username: <input type="text" name="username"><br/>
Password: <input type="password" name="password"><br/>
<input type="hidden" name="request" value="put">
<input type="submit" value="Add">
<h2>Delete User
<form action="/user" method="post">
Username: <input type="text" name="username"><br/>
<input type="hidden" name="request" value="delete">
<input type="submit" value="Delete">
|]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment