{- This file is part of Vervis. - - Written in 2016, 2018, 2019 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 ( getResendVerifyEmailR , getPeopleR , getPerson ) where import Vervis.Import hiding ((==.)) --import Prelude import Data.List.NonEmpty (NonEmpty (..)) import Database.Esqueleto hiding (isNothing, count) import Vervis.Form.Person --import Model import Text.Blaze.Html (toHtml) import Yesod.Auth.Account (newAccountR, resendVerifyEmailWidget, username) import Yesod.Auth.Account.Message (AccountMsg (MsgEmailUnverified)) import qualified Data.Text as T (unpack) import Yesod.Auth.Unverified (requireUnverifiedAuth) import Text.Email.Local import Network.FedURI import Web.ActivityPub import Yesod.FedURI --import Vervis.ActivityStreams import Vervis.ActorKey import Vervis.Model.Ident import Vervis.Secure import Vervis.Widget (avatarW) -- | Account verification email resend form getResendVerifyEmailR :: Handler Html getResendVerifyEmailR = do person <- requireUnverifiedAuth defaultLayout $ do setTitleI MsgEmailUnverified [whamlet|

_{MsgEmailUnverified} ^{resendVerifyEmailWidget (username person) AuthR} |] -- | 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 = redirect $ AuthR newAccountR settings <- getsYesod appSettings if appRegister settings then do room <- case appAccounts settings of Nothing -> return True Just cap -> do current <- runDB $ count ([] :: [Filter Person]) return $ current < cap if room 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 do setMessage "Maximal number of registered users reached" redirect PeopleR else do setMessage "User registration disabled" redirect PeopleR -} {- getPersonNewR :: Handler Html getPersonNewR = redirect $ AuthR newAccountR regEnabled <- getsYesod $ appRegister . appSettings if regEnabled then do ((_result, widget), enctype) <- runFormPost newPersonForm defaultLayout $(widgetFile "person-new") else notFound -} getPerson :: ShrIdent -> Sharer -> Person -> Handler TypedContent getPerson shr sharer person = do route2fed <- getEncodeRouteFed route2local <- getEncodeRouteLocal let (host, me) = f2l $ route2fed $ SharerR shr selectRep $ do provideRep $ do secure <- getSecure defaultLayout $(widgetFile "person") provideAP $ pure $ Doc host Actor { actorId = me , actorType = ActorTypePerson , actorUsername = Just $ shr2text shr , actorName = sharerName sharer , actorSummary = Nothing , actorInbox = route2local $ SharerInboxR shr , actorPublicKeys = [ Left $ route2local ActorKey1R , Left $ route2local ActorKey2R ] }