-- eidolon -- A simple gallery in Haskell and Yesod -- Copyright (C) 2015 Amedeo Molnár -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU Affero General Public License as published -- by the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU Affero General Public License for more details. -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . module Handler.AdminAlbumSettings where import Import import Handler.Commons import qualified Data.Text as T import qualified Data.List as L import Data.Maybe import System.FilePath import System.Directory getAdminAlbumsR :: Handler Html getAdminAlbumsR = do adminCheck <- loginIsAdmin case adminCheck of Right _ -> do albums <- runDB $ selectList [] [Asc AlbumTitle] defaultLayout $ do setTitle "Administration: Albums" $(widgetFile "adminAlbums") Left (errorMsg, route) -> do setMessage errorMsg redirect route getAdminAlbumMediaR :: AlbumId -> Handler Html getAdminAlbumMediaR albumId = do adminCheck <- loginIsAdmin case adminCheck of Right _ -> do tempAlbum <- runDB $ get albumId case tempAlbum of Just album -> do media <- runDB $ selectList [MediumAlbum ==. albumId] [Asc MediumTitle] defaultLayout $ do setTitle "Administration: Album media" $(widgetFile "adminAlbumMedia") Nothing -> do setMessage "This album does not exist" redirect AdminR Left (errorMsg, route) -> do setMessage errorMsg redirect route getAdminAlbumSettingsR :: AlbumId -> Handler Html getAdminAlbumSettingsR albumId = do adminCheck <- loginIsAdmin case adminCheck of Right _ -> do tempAlbum <- runDB $ get albumId case tempAlbum of Just album -> do entities <- runDB $ selectList [UserId !=. albumOwner album] [Desc UserName] let users = map (\u -> (userName $ entityVal u, entityKey u)) entities (adminAlbumSettingsWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ adminAlbumSettingsForm album albumId users formLayout $ do setTitle "Administration: Album settings" $(widgetFile "adminAlbumSet") Nothing -> do setMessage "This album does not exist" redirect AdminR Left (errorMsg, route) -> do setMessage errorMsg redirect route postAdminAlbumSettingsR :: AlbumId -> Handler Html postAdminAlbumSettingsR albumId = do adminCheck <- loginIsAdmin case adminCheck of Right _ -> do tempAlbum <- runDB $ get albumId case tempAlbum of Just album -> do entities <- runDB $ selectList [UserId !=. albumOwner album] [Desc UserName] let users = map (\u -> (userName $ entityVal u, entityKey u)) entities ((res, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ adminAlbumSettingsForm album albumId users case res of FormSuccess temp -> do _ <- runDB $ update albumId [ AlbumTitle =. albumTitle temp , AlbumShares =. albumShares temp , AlbumSamplePic =. albumSamplePic temp ] setMessage "Album settings changed successfully" redirect AdminR _ -> do setMessage "There was an error while changing the settings" redirect $ AdminAlbumSettingsR albumId Nothing -> do setMessage "This album does not exist" redirect AdminR Left (errorMsg, route) -> do setMessage errorMsg redirect route adminAlbumSettingsForm :: Album -> AlbumId -> [(Text, UserId)] -> AForm Handler Album adminAlbumSettingsForm album albumId users = Album <$> areq textField (bfs ("Title" :: T.Text)) (Just $ albumTitle album) <*> pure (albumOwner album) <*> areq (userField users) (bfs ("This album shared with" :: T.Text)) (Just $ albumShares album) <*> pure (albumContent album) <*> aopt (selectField media) (bfs ("Sample picture" :: T.Text)) (Just $ albumSamplePic album) <* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text) where media = do entities <- runDB $ selectList [MediumAlbum ==. albumId] [Asc MediumTitle] optionsPairs $ map (\med -> (mediumTitle $ entityVal med, mediumThumb (entityVal med))) entities getAdminAlbumDeleteR :: AlbumId -> Handler Html getAdminAlbumDeleteR albumId = do adminCheck <- loginIsAdmin case adminCheck of Right _ -> do tempAlbum <- runDB $ get albumId case tempAlbum of Just album -> do -- remove reference from owner let ownerId = albumOwner album owner <- runDB $ getJust ownerId let albumList = userAlbums owner let newAlbumList = removeItem albumId albumList runDB $ update ownerId [UserAlbums =. newAlbumList] -- delete album content and its comments _ <- mapM (\a -> do -- delete files medium <- runDB $ getJust a liftIO $ removeFile (normalise $ L.tail $ mediumPath medium) liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium) liftIO $ removeFile (normalise $ L.tail $ mediumPreview medium) -- delete comments commEnts <- runDB $ selectList [CommentOrigin ==. a] [] _ <- mapM (\c -> do -- delete comment children <- runDB $ selectList [CommentParent ==. (Just $ entityKey c)] [] _ <- mapM (\child -> do -- delete comment children from db runDB $ delete $ entityKey child ) children runDB $ delete $ entityKey c) commEnts -- delete album database entry runDB $ delete a ) (albumContent album) -- delete album runDB $ delete albumId -- delete files liftIO $ removeDirectoryRecursive $ "static" "data" T.unpack (extractKey ownerId) T.unpack (extractKey albumId) -- outro setMessage "Album deleted successfully" redirect AdminR Nothing -> do setMessage "This album dies not exist" redirect AdminR Left (errorMsg, route) -> do setMessage errorMsg redirect route