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
Follow.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 | {- This file is part of Vervis.
-
- Written in 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.Persist.Follow
( getFollowee
, getFollowee'
, tryUnfollow
)
where
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Barbie
import Data.Bitraversable
import Data.Functor
import Data.Maybe
import Data.Text (Text)
import Data.Traversable
import Database.Persist
import Database.Persist.Sql
import qualified Data.Text as T
import qualified Database.Esqueleto as E
import Crypto.ActorKey
import Database.Persist.JSON
import Network.FedURI
import Yesod.ActivityPub
import Yesod.FedURI
import Yesod.Hashids
import Yesod.MonadSite
import qualified Web.ActivityPub as AP
import Control.Monad.Trans.Except.Local
import Data.Either.Local
import Database.Persist.Local
import Vervis.Cloth
import Vervis.Data.Actor
import Vervis.Data.Follow
import Vervis.Data.Ticket
import Vervis.FedURI
import Vervis.Foundation
import Vervis.Model
import Vervis.Persist.Actor
import Vervis.Persist.Ticket
import Vervis.Recipient
import Vervis.Settings
import Vervis.Ticket
getFollowee
:: MonadIO m
=> FolloweeBy Key
-> ExceptT Text (ReaderT SqlBackend m)
(LocalActorBy Key, ActorId, Maybe FollowerSetId)
getFollowee (FolloweeActor actorByKey) = do
actorByEntity <- do
maybeActor <- lift $ getLocalActorEntity actorByKey
fromMaybeE maybeActor "Actor not found in DB"
return (actorByKey, localActorID actorByEntity, Nothing)
getFollowee (FolloweeWorkItem wi) =
case wi of
WorkItemTicket deckID taskID -> do
actorID <- deckActor <$> getE deckID "No such deck in DB"
(_, _, Entity _ ticket, _, _) <- do
mticket <- lift $ getTicket deckID taskID
fromMaybeE mticket "No such ticket in DB"
return
( LocalActorDeck deckID
, actorID
, Just $ ticketFollowers ticket
)
WorkItemCloth loomID clothID -> do
actorID <- loomActor <$> getE loomID "No such loom in DB"
(_, _, Entity _ ticket, _, _, _) <- do
mcloth <- lift $ getCloth loomID clothID
fromMaybeE mcloth "No such MR in DB"
return
( LocalActorLoom loomID
, actorID
, Just $ ticketFollowers ticket
)
getFollowee' followerSetID = do
actorOrTicket <-
requireEitherAlt
(getKeyBy $ UniqueActorFollowers followerSetID)
(getKeyBy $ UniqueTicketFollowers followerSetID)
"Can't find who's using this FollowerSet"
"Multi use of FollowerSet"
either FolloweeActor FolloweeWorkItem <$>
bitraverse getLocalActor getWorkItem actorOrTicket
tryUnfollow (Left (_actorByKey, _actorEntity, itemID)) =
runMaybeT $
MaybeT forRemoteRequest <|> MaybeT forRemote <|> MaybeT forLocal
where
forRemoteRequest = do
maybeFollow <- getBy $ UniqueFollowRemoteRequestActivity itemID
for maybeFollow $ \ (Entity requestID request) -> do
actorID <-
personActor <$> getJust (followRemoteRequestPerson request)
let uTarget =
fromMaybe (followRemoteRequestTarget request) $
followRemoteRequestRecip request
return (delete requestID, actorID, Right uTarget)
forRemote = do
maybeFollow <- getBy $ UniqueFollowRemoteFollow itemID
for maybeFollow $ \ (Entity remoteID remote) -> do
let actorID = followRemoteActor remote
uTarget <- getRemoteActorURI =<< getJust (followRemoteRecip remote)
return (delete remoteID, actorID, Right uTarget)
forLocal = do
maybeFollow <- getBy $ UniqueFollowFollow itemID
return $ maybeFollow <&> \ (Entity followID follow) ->
let actorID = followActor follow
followerSetID = followTarget follow
in (delete followID, actorID, Left followerSetID)
tryUnfollow (Right _) = pure Nothing
|