{- This file is part of Vervis. - - Written in 2016 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} module Vervis.Handler.Person ( getPeopleR , postPeopleR , getPersonNewR , getPersonR ) where import Vervis.Import hiding ((==.)) --import Prelude import Database.Esqueleto hiding (isNothing) import Vervis.Form.Person --import Model import Text.Blaze.Html (toHtml) import Yesod.Auth.HashDB (setPassword) import Vervis.Model.Ident import Vervis.Widget (avatarW) -- | Get list of users getPeopleR :: Handler Html getPeopleR = do people <- runDB $ select $ from $ \ (sharer, person) -> do where_ $ sharer ^. SharerId ==. person ^. PersonIdent orderBy [asc $ sharer ^. SharerIdent] return $ sharer ^. SharerIdent defaultLayout $(widgetFile "people") -- | Create new user postPeopleR :: Handler Html postPeopleR = do regEnabled <- getsYesod $ appRegister . appSettings if regEnabled then do ((result, widget), enctype) <- runFormPost newPersonForm case result of FormSuccess np -> do now <- liftIO getCurrentTime runDB $ do let sharer = Sharer { sharerIdent = npLogin np , sharerName = npName np , sharerCreated = now } sid <- insert sharer let person = Person { personIdent = sid , personLogin = shr2text $ npLogin np , personHash = Nothing , personEmail = npEmail np } person' <- setPassword (npPass np) person insert_ person' redirectUltDest HomeR FormMissing -> do setMessage "Field(s) missing" defaultLayout $(widgetFile "person-new") FormFailure _l -> do setMessage "User registration failed, see errors below" defaultLayout $(widgetFile "person-new") else notFound getPersonNewR :: Handler Html getPersonNewR = do regEnabled <- getsYesod $ appRegister . appSettings if regEnabled then do ((_result, widget), enctype) <- runFormPost newPersonForm defaultLayout $(widgetFile "person-new") else notFound getPersonR :: ShrIdent -> Handler Html getPersonR ident = do person <- runDB $ do Entity sid _s <- getBy404 $ UniqueSharer ident Entity _pid p <- getBy404 $ UniquePersonIdent sid return p defaultLayout $(widgetFile "person")