Eventually-decentralized project hosting and management platform

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

Clone

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

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

Tags

TODO

src / Vervis / Handler /

Sharer.hs

{- This file is part of Vervis.
 -
 - Written in 2016, 2019, 2020, 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.Handler.Sharer
    ( getSharersR
    , getSharerFollowersR
    , getSharerFollowingR
    )
where

import Control.Applicative ((<|>))
import Control.Exception (throwIO)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger (logWarn)
import Control.Monad.Trans.Maybe
import Data.Monoid ((<>))
import Database.Persist
import Text.Blaze.Html (Html)
import Yesod.Core (defaultLayout)
import Yesod.Core.Content (TypedContent)
import Yesod.Core.Handler (redirect, notFound)
import Yesod.Persist.Core (runDB, getBy404)

import qualified Database.Esqueleto as E

import Web.ActivityPub
import Yesod.ActivityPub
import Yesod.FedURI
import Yesod.Hashids

import Database.Persist.Local
import Yesod.Persist.Local

import Vervis.API
import Vervis.Foundation
import Vervis.Handler.Person
import Vervis.Handler.Group
import Vervis.Model
import Vervis.Model.Ident (ShrIdent, shr2text)
import Vervis.Paginate
import Vervis.Settings (widgetFile)
import Vervis.Widget.Sharer (sharerLinkW)

getSharersR :: Handler Html
getSharersR = do
    (_, _, sharers, navModel) <- getPageAndNavTop $ \ off lim ->
        runDB $ do
            total <- count ([] :: [Filter Sharer])
            ss <- selectList [] [OffsetBy off, LimitTo lim, Asc SharerIdent]
            return (total, ss)
    let pageNav = navWidget navModel
    defaultLayout $(widgetFile "sharer/list")

getSharerFollowersR :: ShrIdent -> Handler TypedContent
getSharerFollowersR shr = getFollowersCollection here getFsid
    where
    here = SharerFollowersR shr
    getFsid = do
        sid <- getKeyBy404 $ UniqueSharer shr
        mval <- runMaybeT
            $   Left  <$> MaybeT (getValBy $ UniquePersonIdent sid)
            <|> Right <$> MaybeT (getValBy $ UniqueGroup sid)
        case mval of
            Nothing -> do
                $logWarn $ "Found non-person non-group sharer: " <> shr2text shr
                notFound
            Just val ->
                case val of
                    Left person -> return $ personFollowers person
                    Right _group -> notFound
[See repo JSON]