admin interface added incl. profilemanipulation

Application.hs

@@ -41,6 +41,8 @@ import Handler.MediumSettings
 import Handler.Reactivate
 import Handler.ProfileSettings
 import Handler.ProfileDelete
+import Handler.Admin
+import Handler.AdminProfileSettings
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

Handler/Admin.hs

@@ -0,0 +1,21 @@
+module Handler.Admin where
+
+import Import
+
+getAdminR :: Handler Html
+getAdminR = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          defaultLayout $ do
+            $(widgetFile "adminBase")
+        False -> do
+          setMessage "You have no admin rights"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You are not logged in"
+      redirect $ LoginR

Handler/AdminProfileSettings.hs

@@ -0,0 +1,132 @@
+module Handler.AdminProfileSettings where
+
+import Import
+import qualified Data.Text as T
+import System.Directory
+import System.FilePath
+
+getAdminProfiles :: Handler Html
+getAdminProfiles = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          profiles <- runDB $ selectList [] [Desc UserName]
+          defaultLayout $ do
+            $(widgetFile "adminProfiles")
+        False -> do
+          setMessage "You are no admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You must be logged in"
+      redirect $ LoginR
+
+
+getAdminProfileSettingsR :: UserId -> Handler Html
+getAdminProfileSettingsR ownerId = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          tempOwner <- runDB $ get ownerId
+          case tempOwner of
+            Just owner -> do
+              (adminProfileSetWidget, enctype) <- generateFormPost $ adminProfileForm owner
+              defaultLayout $ do
+                $(widgetFile "adminProfileSettings")
+            Nothing -> do
+              setMessage "This user does not exist"
+              redirect $ AdminR
+        False -> do
+          setMessage "You are not an admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You are not logged in"
+      redirect $ LoginR
+      
+
+postAdminProfileSettingsR :: UserId -> Handler Html
+postAdminProfileSettingsR ownerId = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          tempOwner <- runDB $ get ownerId
+          case tempOwner of
+            Just owner -> do
+              ((result, adminProfileSetWidget), enctype) <- runFormPost $ adminProfileForm owner
+              case result of
+                FormSuccess temp -> do
+                  runDB $ update ownerId 
+                    [ UserName =. (userName temp)
+                    , UserSlug =. (userSlug temp)
+                    , UserEmail =. (userEmail temp)
+                    , UserAdmin =. (userAdmin temp)
+                    ]
+                  setMessage "User data updated successfully"
+                  redirect $ AdminR
+                _ -> do
+                  setMessage "There was an error"
+                  redirect $ AdminProfileSettingsR ownerId
+            Nothing -> do
+              setMessage "This user does not exist"
+              redirect $ AdminR
+        False -> do
+          setMessage "You are not an admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You are not logged in"
+      redirect $ LoginR
+
+
+adminProfileForm :: User -> Form User
+adminProfileForm owner = renderDivs $ User
+  <$> areq textField "Username" (Just $ userName owner)
+  <*> areq textField "Userslug" (Just $ userSlug owner)
+  <*> areq emailField "Email" (Just $ userEmail owner)
+  <*> pure (userSalt owner)
+  <*> pure (userSalted owner)
+  <*> pure (userAlbums owner)
+  <*> areq boolField "Admin" (Just $ userAdmin owner)
+
+getAdminProfileDeleteR :: UserId -> Handler Html
+getAdminProfileDeleteR ownerId = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          tempOwner <- runDB $ get ownerId
+          case tempOwner of
+            Just owner -> do
+              albumList <- return $ userAlbums owner
+              mapM (\albumId -> do
+                album <- runDB $ getJust albumId
+                mediaList <- return $ albumContent album
+                mapM (\med -> runDB $ delete med) mediaList
+                runDB $ delete albumId
+                ) albumList
+              runDB $ delete ownerId
+              liftIO $ removeDirectoryRecursive $ "static" </> "data" </> (T.unpack $ extractKey ownerId)
+              setMessage "User successfully deleted"
+              redirect $ AdminR
+            Nothing -> do
+              setMessage "This user does not exist"
+              redirect $ AdminR
+        False -> do
+          setMessage "You are no admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You must be logged in"
+      redirect $ LoginR

Handler/ProfileSettings.hs

@@ -71,3 +71,4 @@ profileSettingsForm user = renderDivs $ User
   <*> pure (userSalt user)
   <*> pure (userSalted user)
   <*> pure (userAlbums user)
+  <*> pure (userAdmin user)

Handler/Signup.hs

@@ -39,7 +39,13 @@ postSignupR = do
   case namesakes of
     [] -> do
       salt <- liftIO generateSalt
-      newUser <- return $ User newUserName newUserName (fromJust mEmail) salt "" []
+      newUser <- return $ User newUserName
+        newUserName
+        (fromJust mEmail)
+        salt
+        ""
+        []
+        False
       activatorText <- liftIO generateString
       aId <- runDB $ insert $ Activator activatorText newUser
       tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing

Import.hs

@@ -18,6 +18,7 @@ import           Settings.StaticFiles as Import
 -- custom imports
 
 import           Helper               as Import
+import           Data.Bool            as Import
 
 -- end custom imports
 

Model.hs

@@ -6,6 +6,7 @@ import Database.Persist.Quasi
 import Data.Typeable (Typeable)
 import Data.Time (UTCTime)
 import Data.ByteString
+import Data.Bool
 import System.FilePath (FilePath)
 
 -- You can define all of your database entities in the entities file.

config/models

@@ -5,6 +5,7 @@ User
     salt ByteString
     salted ByteString
     albums [AlbumId]
+    admin Bool
     deriving Typeable
 Activator
     token Text

config/routes

@@ -22,3 +22,7 @@
 /reactivate			ReactivateR		GET POST
 /profile/#UserId/settings	ProfileSettingsR	GET POST
 /profile/#UserId/delete		ProfileDeleteR		GET POST
+/admin				AdminR			GET
+/admin/profile			AdminProfiles		GET
+/admin/profile/#UserId		AdminProfileSettingsR	GET POST
+/admin/profile/#UserId/delete	AdminProfileDeleteR	GET

eidolon.cabal

@@ -34,6 +34,8 @@ library
                      Handler.Reactivate
                      Handler.ProfileSettings
                      Handler.ProfileDelete
+                     Handler.Admin
+                     Handler.AdminProfileSettings
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT

templates/adminBase.hamlet

@@ -0,0 +1,5 @@
+$newline always
+<h3>Admin interface
+
+<p>
+  Be careful with your actions here, every click will perform directly the advertised action.

templates/adminProfileSettings.hamlet

@@ -0,0 +1,9 @@
+$newline always
+<h3>Profile settings
+
+<form method="post" enctype=#{enctype}>
+  ^{adminProfileSetWidget}
+  <div>
+    <input type=submit value="Change settings">
+
+<a href=@{AdminProfileDeleteR userId}>Delete user

templates/adminProfiles.hamlet

@@ -0,0 +1,10 @@
+$newline always
+<h3>User profiles
+
+$if null profiles
+  There are no profiles yet (How can you even see this?)
+$else
+  $forall (Entity uId u) <- profiles
+    <ul>
+      <li>
+        <a href=@{AdminProfileSettingsR uId}>#{userSlug u}