Experimental changes to Vervis.

[[ 🗃 ^KrXYo vervis ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Changes]

Clone

HTTPS: darcs clone https://vervis.peers.community/repos/KrXYo

SSH: darcs clone USERNAME@vervis.peers.community:KrXYo

Tags

TODO

src / Vervis / Handler /

Person.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

{- This file is part of Vervis.
 -
 - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ 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
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Vervis.Handler.Person
    ( getResendVerifyEmailR
    , getPeopleR
    , postPeopleR
    , getPersonNewR
    , getPersonR
    , postPersonR
    , getPersonActivitiesR
    )
where

import Vervis.Import hiding ((==.))
--import Prelude

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 Yesod.Auth.Unverified (requireUnverifiedAuth)

import Text.Email.Local

import Vervis.ActivityStreams
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|
            <p>_{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
    ur <- getUrlRender
    selectRep $ do
        provideRep $ do
            secure <- getSecure
            defaultLayout $(widgetFile "person")
        provideAS2 $ ActivityPubActor $ makeActor ur shr

postPersonR :: ShrIdent -> Handler TypedContent
postPersonR _ = notFound

getPersonActivitiesR :: ShrIdent -> Handler TypedContent
getPersonActivitiesR _ = notFound
[See repo JSON]