Permalink
Browse files

Merge remote-tracking branch 'origin/i0031'

  • Loading branch information...
2 parents 443a83b + 0a51f46 commit 2bee71070c11048cedec5c1ce569e873938b4653 @cutsea110 committed Jan 30, 2012
Showing with 186 additions and 1 deletion.
  1. +1 −0 Application.hs
  2. +89 −0 Handler/Admin.hs
  3. +1 −0 bisocie.cabal
  4. +5 −1 config/routes
  5. +6 −0 templates/deleteUser.hamlet
  6. +38 −0 templates/newUser.hamlet
  7. +39 −0 templates/user.hamlet
  8. +7 −0 templates/users.hamlet
View
@@ -34,6 +34,7 @@ import Handler.Issue
import Handler.Participants
import Handler.User
import Handler.S3
+import Handler.Admin
-- This line actually creates our YesodSite instance. It is the second half
-- of the call to mkYesodData which occurs in BISocie.hs. Please see
View
@@ -0,0 +1,89 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
+module Handler.Admin where
+
+import Foundation
+import BISocie.Helpers.Auth.HashDB (encrypt)
+import BISocie.Helpers.Util
+
+import qualified Data.Text as T
+import Control.Applicative ((<$>),(<*>))
+
+getUsersR :: Handler RepHtml
+getUsersR = do
+ _ <- requireAuth
+ users <- runDB $ selectList [] [Asc UserIdent]
+ defaultLayout $ do
+ addWidget $(whamletFile "templates/users.hamlet")
+
+getUserR :: UserId -> Handler RepHtml
+getUserR uid = do
+ _ <- requireAuth
+ user <- runDB $ get404 uid
+ let roleIs r = r == userRole user
+ toInt = (+1) . fromEnum
+ defaultLayout $(whamletFile "templates/user.hamlet")
+ where
+ roles = [(T.pack $ show r, r) | r <- [minBound::Role .. maxBound]]
+
+
+postUserR :: UserId -> Handler ()
+postUserR uid = do
+ _ <- requireAuth
+ new <- runInputPost $ User
+ <$> ireq textField "ident"
+ <*> iopt passwordField "password"
+ <*> ireq (selectField roles) "role"
+ <*> ireq textField "familyName"
+ <*> ireq textField "givenName"
+ <*> ireq textField "email"
+ <*> fmap (fmap readText) (iopt textField "avatar") -- always Nothing
+ <*> ireq boolField "active"
+ runDB $ do
+ orig <- get404 uid
+ replace uid new { userPassword = pass orig new
+ , userAvatar = userAvatar orig
+ }
+ redirect RedirectSeeOther (UserR uid)
+ where
+ roles = [(T.pack $ show r, r) | r <- [minBound::Role .. maxBound]]
+ pass :: User -> User -> Maybe T.Text
+ pass old new = maybe (userPassword old) (return . encrypt) (userPassword new)
+
+getNewUserR :: Handler RepHtml
+getNewUserR = do
+ _ <- requireAuth
+ let toInt = (+1) . fromEnum
+ defaultLayout $ do
+ addWidget $(whamletFile "templates/newUser.hamlet")
+ where
+ roles = [(T.pack $ show r, r) | r <- [minBound::Role .. maxBound]]
+
+postNewUserR :: Handler ()
+postNewUserR = do
+ _ <- requireAuth
+ new <- runInputPost $ User
+ <$> ireq textField "ident"
+ <*> iopt passwordField "password"
+ <*> ireq (selectField roles) "role"
+ <*> ireq textField "familyName"
+ <*> ireq textField "givenName"
+ <*> ireq textField "email"
+ <*> fmap (fmap readText) (iopt textField "avatar") --always Nothing
+ <*> ireq boolField "active"
+ uid <- runDB $ insert new {userPassword = fmap encrypt (userPassword new)}
+ redirect RedirectSeeOther (UserR uid)
+ where
+ roles = [(T.pack $ show r, r) | r <- [minBound::Role .. maxBound]]
+
+getDeleteUserR :: UserId -> Handler RepHtml
+getDeleteUserR uid = do
+ _ <- requireAuth
+ user <- runDB $ get404 uid
+ defaultLayout $ do
+ addWidget $(whamletFile "templates/deleteUser.hamlet")
+
+postDeleteUserR :: UserId -> Handler ()
+postDeleteUserR uid = do
+ _ <- requireAuth
+ runDB $ delete uid
+ redirect RedirectSeeOther UsersR
View
@@ -38,6 +38,7 @@ library
Handler.Participants
Handler.User
Handler.S3
+ Handler.Admin
BISocie.Helpers.Auth.HashDB
BISocie.Helpers.Util
View
@@ -38,6 +38,10 @@
/system-batch SystemBatchR GET POST
/send-reminder-mail/#Year/#Month/#Date SendReminderMailR GET
+/admin UsersR GET
+/admin/edit/#UserId UserR GET POST
+/admin/add NewUserR GET POST
+/admin/delete/#UserId DeleteUserR GET POST
+
/s3/upload UploadR POST PUT
/s3/user/#UserId/file/#FileHeaderId FileR POST DELETE
--- /admin AdminR UserCrud userCrud
@@ -0,0 +1,6 @@
+<h1>Really delete?
+<form method=post action=@{DeleteUserR uid}
+ <p>Do you really want to delete #{userInfoOneline user}
+ <p
+ <input type=submit value=Yes
+ <a href=@{UsersR}>No
View
@@ -0,0 +1,38 @@
+<a href=@{UsersR}>Return to list
+<h1>Add new
+<form method=post action=@{NewUserR}
+ <table
+ <tr
+ <th>ident
+ <td
+ <input type=text name=ident
+ <tr
+ <th>password
+ <td
+ <input type=password name=password
+ <tr
+ <th>role
+ <td
+ <select name=role
+ $forall role <- roles
+ <option value=#{show $ toInt $ snd role}>#{fst role}
+ <tr
+ <th>familyName
+ <td
+ <input type=text name=familyName
+ <tr
+ <th>givenName
+ <td
+ <input type=text name=givenName
+ <tr
+ <th>email
+ <td
+ <input type=text name=email
+ <tr
+ <th>active or inactive
+ <td
+ <input #active type=radio name=active value=yes checked
+ <label for=active>active
+ <input #inactive type=radio name=active value=no
+ <label for=active>inactive
+ <input type=submit
View
@@ -0,0 +1,39 @@
+<a href=@{UsersR}>Return to list
+<h1>Edit item
+<form method=post action=@{UserR uid}
+ <table
+ <tr
+ <th>ident
+ <td
+ <input type=text name=ident value=#{userIdent user}
+ <tr
+ <th>password
+ <td
+ <input type=password name=password
+ <tr
+ <th>role
+ <td
+ <select name=role
+ $forall role <- roles
+ <option value=#{show $ toInt $ snd role} :roleIs $ snd role:selected>#{fst role}
+ <tr
+ <th>familyName
+ <td
+ <input type=text name=familyName value=#{userFamilyName user}
+ <tr
+ <th>givenName
+ <td
+ <input type=text name=givenName value=#{userGivenName user}
+ <tr
+ <th>email
+ <td
+ <input type=text name=email value=#{userEmail user}
+ <tr
+ <th>active or inactive
+ <td
+ <input #active type=radio name=active value=yes :userActive user:checked
+ <label for=active>active
+ <input #inactive type=radio name=active value=no :not $ userActive user:checked
+ <label for=active>inactive
+ <input type=submit
+ <a href=@{DeleteUserR uid}>Delete
View
@@ -0,0 +1,7 @@
+<h1>Items
+<ul
+ $forall user <- users
+ <li
+ <a href=@{UserR $ fst user}>#{userInfoOneline $ snd user}
+<p
+ <a href=@{NewUserR}>Add new item

0 comments on commit 2bee710

Please sign in to comment.