Eventually-decentralized project hosting and management platform
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/WvWbo
SSH:
darcs clone USERNAME@vervis.peers.community:WvWbo
Tags
TODO
Person.hs
{- This file is part of Vervis.
-
- Written in 2016, 2019, 2022 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.Widget.Person
( personLinkW
, personLinkFedW
, followW
, personNavW
)
where
import Data.Foldable
import Database.Persist
import Network.HTTP.Types.Method
import Yesod.Core
import Yesod.Persist.Core
import Network.FedURI
import Yesod.Auth.Unverified
import Yesod.Hashids
import Database.Persist.Local
import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Settings
import Vervis.Widget
personLinkW :: Entity Person -> Actor -> Widget
personLinkW (Entity personID person) actor = do
personHash <- encodeKeyHashid personID
[whamlet|
<a href=@{PersonR personHash}>
#{actorName actor} ~#{username2text $ personUsername person}
|]
personLinkFedW
:: Either (Entity Person, Actor) (Instance, RemoteObject, RemoteActor)
-> Widget
personLinkFedW (Left (ep, a)) = personLinkW ep a
personLinkFedW (Right (inztance, object, actor)) =
[whamlet|
<a href="#{renderObjURI uActor}">
$maybe name <- remoteActorName actor
#{name}
$nothing
#{renderAuthority $ instanceHost inztance}#{localUriPath $ remoteObjectIdent object}
|]
where
uActor = ObjURI (instanceHost inztance) (remoteObjectIdent object)
followW :: Route App -> Route App -> FollowerSetId -> Widget
followW followRoute unfollowRoute fsid = do
maybeUser <- maybeVerifiedAuth
for_ maybeUser $ \ (Entity _ user) -> do
mfollow <-
handlerToWidget $ runDB $
getBy $ UniqueFollow (personActor user) fsid
case mfollow of
Nothing -> buttonW POST "Follow" followRoute
Just _ -> buttonW POST "Unfollow" unfollowRoute
personNavW :: Entity Person -> Widget
personNavW (Entity personID person) = do
personHash <- encodeKeyHashid personID
$(widgetFile "person/widget/nav")
|