{- 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 , postPeopleR , getPersonNewR , getPersonR , postPersonR , getPersonActivitiesR ) where import Vervis.Import hiding ((==.)) --import Prelude import Data.PEM (PEM (..)) import Database.Esqueleto hiding (isNothing, count) import Network.URI (uriFragment, parseAbsoluteURI) 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 Web.ActivityPub --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 -} getPersonR :: ShrIdent -> Handler TypedContent getPersonR shr = do person <- runDB $ do Entity sid _s <- getBy404 $ UniqueSharer shr Entity _pid p <- getBy404 $ UniquePersonIdent sid return p renderUrl <- getUrlRender let route2uri route = case parseAbsoluteURI $ T.unpack $ renderUrl route of Nothing -> error "getRenderUrl produced invalid URI!!!" Just u -> u me = route2uri $ PersonR shr actorKey <- liftIO . fmap actorKeyPublicBin . readTVarIO =<< getsYesod appActorKey selectRep $ do provideRep $ do secure <- getSecure defaultLayout $(widgetFile "person") provideAP Actor { actorId = me , actorType = ActorTypePerson , actorUsername = shr2text shr , actorInbox = route2uri InboxR , actorPublicKeys = PublicKeySet { publicKey1 = Right PublicKey { publicKeyId = me { uriFragment = "#key" } , publicKeyOwner = me , publicKeyPem = PEM "PUBLIC KEY" [] actorKey , publicKeyAlgo = Just AlgorithmEd25519 , publicKeyShared = False } , publicKey2 = Nothing } } postPersonR :: ShrIdent -> Handler TypedContent postPersonR _ = notFound getPersonActivitiesR :: ShrIdent -> Handler TypedContent getPersonActivitiesR _ = notFound