sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 18:04:53 +09:00
Code Issues Activity

Deck: Port Invite handler

Browse source
This commit is contained in:
Pere Lev 2023-06-08 15:38:09 +03:00
parent 9955a3c0ad
commit 85f77fcac4
No known key found for this signature in database
GPG key ID: 5252C5C863E5E57D
11 changed files with 315 additions and 179 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/Vervis/Actor.hs
View file

@ -96,6 +96,7 @@ import Data.Traversable
import Data.Typeable
import Database.Persist.Sql
import GHC.Generics
import Network.HTTP.Client
import UnliftIO.Exception
import Web.Hashids
import Yesod.Core
@ -124,6 +125,7 @@ import Data.List.NonEmpty.Local
import Vervis.FedURI
import Vervis.Model hiding (Actor, Message)
import Vervis.RemoteActorStore.Types
import Vervis.Settings
data LocalActorBy f
@ -329,6 +331,10 @@ data Event
-- ^ A local resource published a Reject on an Invite/Join, I'm receiving
-- it because I'm following the resource/target, or I'm the
-- inviter/rejecter/target
| EventRemoteInviteLocalTopicFwdToFollower RemoteActivityId
-- ^ An authorized remote actor sent an Invite-to-a-local-topic, and the
-- local topic is forwarding the Invite to me because I'm following the
-- topic
| EventUnknown
deriving Show
@ -368,6 +374,8 @@ data Env = forall y. (Typeable y, Yesod y) => Env
, envDeliveryTheater :: DeliveryTheater URIMode
--, envYesodSite :: y
, envYesodRender :: YesodRender y
, envHttpManager :: Manager
, envFetch :: ActorFetchShare
}
deriving Typeable

156
src/Vervis/Actor/Common.hs
View file

@ -19,10 +19,12 @@ module Vervis.Actor.Common
( actorFollow
, topicAccept
, topicReject
, topicInvite
)
where
import Control.Applicative
import Control.Exception.Base
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
@ -45,6 +47,7 @@ import Optics.Core
import Yesod.Persist.Core
import qualified Data.Text as T
import qualified Database.Esqueleto as E
import Control.Concurrent.Actor
import Network.FedURI
@ -70,10 +73,11 @@ import Vervis.FedURI
import Vervis.Federation.Util
import Vervis.Foundation
import Vervis.Model
import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers, renderLocalActor)
import Vervis.Persist.Actor
import Vervis.Persist.Collab
import Vervis.Persist.Discussion
import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localActorFollowers, renderLocalActor)
import Vervis.RemoteActorStore
import Vervis.Ticket
actorFollow
@ -667,3 +671,153 @@ topicReject topicActor topicResource now recipKey author body mfwd luReject reje
}
return (action, recipientSet, remoteActors, fwdHosts)
topicInvite
:: ( PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic
, PersistRecordBackend ct SqlBackend
)
=> (topic -> ActorId)
-> (forall f. f topic -> GrantResourceBy f)
-> EntityField ct (Key topic)
-> EntityField ct CollabId
-> (CollabId -> Key topic -> ct)
-> UTCTime
-> Key topic
-> RemoteAuthor
-> ActivityBody
-> Maybe (RecipientRoutes, ByteString)
-> LocalURI
-> AP.Invite URIMode
-> ActE (Text, Act (), Next)
topicInvite grabActor topicResource topicField topicCollabField collabTopicCtor now topicKey author body mfwd luInvite invite = do
-- Check capability
capability <- do
-- Verify that a capability is provided
uCap <- do
let muCap = AP.activityCapability $ actbActivity body
fromMaybeE muCap "No capability provided"
-- Verify the capability URI is one of:
-- * Outbox item URI of a local actor, i.e. a local activity
-- * A remote URI
cap <- nameExceptT "Invite capability" $ parseActivityURI' uCap
-- Verify the capability is local
case cap of
Left (actorByKey, _, outboxItemID) ->
return (actorByKey, outboxItemID)
_ -> throwE "Capability is remote i.e. definitely not by me"
-- Check invite
targetByKey <- do
(resource, recipient) <-
parseInvite (Right $ remoteAuthorURI author) invite
unless (Left (topicResource topicKey) == resource) $
throwE "Invite topic isn't me"
return recipient
-- If target is local, find it in our DB
-- If target is remote, HTTP GET it, verify it's an actor, and store in
-- our DB (if it's already there, no need for HTTP)
--
-- NOTE: This is a blocking HTTP GET done right here in the Invite handler,
-- which is NOT a good idea. Ideally, it would be done async, and the
-- handler result (approve/disapprove the Invite) would be sent later in a
-- separate (e.g. Accept) activity. But for the PoC level, the current
-- situation will hopefully do.
targetDB <-
bitraverse
(withDBExcept . flip getGrantRecip "Invitee not found in DB")
(\ u@(ObjURI h lu) -> do
instanceID <-
lift $ withDB $ either entityKey id <$> insertBy' (Instance h)
result <-
ExceptT $ first (T.pack . displayException) <$>
fetchRemoteActor' instanceID h lu
case result of
Left Nothing -> throwE "Target @id mismatch"
Left (Just err) -> throwE $ T.pack $ displayException err
Right Nothing -> throwE "Target isn't an actor"
Right (Just actor) -> return $ entityKey actor
)
targetByKey
maybeNew <- withDBExcept $ do
-- Grab topic from DB
(topicActorID, topicActor) <- lift $ do
recip <- getJust topicKey
let actorID = grabActor recip
(actorID,) <$> getJust actorID
-- Verify the specified capability gives relevant access
verifyCapability
capability
(Right $ remoteAuthorId author)
(topicResource topicKey)
-- Verify that target doesn't already have a Collab for me
existingCollabIDs <-
lift $ case targetDB of
Left (GrantRecipPerson (Entity personID _)) ->
E.select $ E.from $ \ (topic `E.InnerJoin` recipl) -> do
E.on $
topic E.^. topicCollabField E.==.
recipl E.^. CollabRecipLocalCollab
E.where_ $
topic E.^. topicField E.==. E.val topicKey E.&&.
recipl E.^. CollabRecipLocalPerson E.==. E.val personID
return $ recipl E.^. CollabRecipLocalCollab
Right remoteActorID ->
E.select $ E.from $ \ (topic `E.InnerJoin` recipr) -> do
E.on $
topic E.^. topicCollabField E.==.
recipr E.^. CollabRecipRemoteCollab
E.where_ $
topic E.^. topicField E.==. E.val topicKey E.&&.
recipr E.^. CollabRecipRemoteActor E.==. E.val remoteActorID
return $ recipr E.^. CollabRecipRemoteCollab
case existingCollabIDs of
[] -> pure ()
[_] -> throwE "I already have a Collab for the target"
_ -> error "Multiple collabs found for target"
mractid <- lift $ insertToInbox now author body (actorInbox topicActor) luInvite False
lift $ for mractid $ \ inviteID -> do
-- Insert Collab record to DB
insertCollab targetDB inviteID
-- Prepare forwarding Invite to my followers
sieve <- do
topicHash <- encodeKeyHashid topicKey
let topicByHash =
grantResourceLocalActor $ topicResource topicHash
return $ makeRecipientSet [] [localActorFollowers topicByHash]
return (topicActorID, inviteID, sieve)
case maybeNew of
Nothing -> done "I already have this activity in my inbox"
Just (topicActorID, inviteID, sieve) -> do
let topicByID = grantResourceLocalActor $ topicResource topicKey
lift $ for_ mfwd $ \ (localRecips, sig) -> do
forwardActivity
(actbBL body) localRecips sig topicActorID topicByID sieve
(EventRemoteInviteLocalTopicFwdToFollower inviteID)
done "Recorded and forwarded the Invite"
where
insertCollab recipient inviteID = do
collabID <- insert Collab
fulfillsID <- insert $ CollabFulfillsInvite collabID
insert_ $ collabTopicCtor collabID topicKey
let authorID = remoteAuthorId author
insert_ $ CollabInviterRemote fulfillsID authorID inviteID
case recipient of
Left (GrantRecipPerson (Entity personID _)) ->
insert_ $ CollabRecipLocal collabID personID
Right remoteActorID ->
insert_ $ CollabRecipRemote collabID remoteActorID

25
src/Vervis/Actor/Deck.hs
View file

@ -171,6 +171,29 @@ deckReject
-> ActE (Text, Act (), Next)
deckReject = topicReject deckActor GrantResourceDeck
-- Meaning: A remote actor A invited someone B to a resource
-- Behavior:
-- * Verify the resource is me
-- * Verify A isn't inviting themselves
-- * Verify A is authorized by me to invite actors to me
-- * Verify B doesn't already have an invite/join/grant for me
-- * Remember the invite in DB
-- * Forward the Invite to my followers
deckInvite
:: UTCTime
-> DeckId
-> RemoteAuthor
-> ActivityBody
-> Maybe (RecipientRoutes, ByteString)
-> LocalURI
-> AP.Invite URIMode
-> ActE (Text, Act (), Next)
deckInvite =
topicInvite
deckActor GrantResourceDeck
CollabTopicDeckDeck CollabTopicDeckCollab CollabTopicDeck
------------------------------------------------------------------------------
-- Ambiguous: Following/Resolving
------------------------------------------------------------------------------
@ -392,6 +415,8 @@ deckBehavior now deckID (Right (VerseRemote author body mfwd luActivity)) =
deckAccept now deckID author body mfwd luActivity accept
AP.FollowActivity follow ->
deckFollow now deckID author body mfwd luActivity follow
AP.InviteActivity invite ->
deckInvite now deckID author body mfwd luActivity invite
AP.RejectActivity reject ->
deckReject now deckID author body mfwd luActivity reject
AP.UndoActivity undo ->

13
src/Vervis/Actor/Person.hs
View file

@ -697,6 +697,19 @@ personBehavior now personID (Left event) =
(p,) <$> getJust (personActor p)
insertActivityToInbox now (personActor personRecip) rejectID
done "Inserted Reject to my inbox"
-- Meaning: An authorized remote actor sent an Invite on a local
-- resource, I'm being forwarded as a follower of the resource
--
-- Behavior: Insert the Invite to my inbox
EventRemoteInviteLocalTopicFwdToFollower inviteID -> do
lift $ withDB $ do
(_personRecip, actorRecip) <- do
p <- getJust personID
(p,) <$> getJust (personActor p)
let inboxID = actorInbox actorRecip
itemID <- insert $ InboxItem True now
insert_ $ InboxItemRemote inboxID inviteID itemID
done "Inserted Invite to inbox"
_ -> throwE $ "Unsupported event for Person: " <> T.pack (show event)
personBehavior now personID (Right (VerseRemote author body mfwd luActivity)) =
case AP.activitySpecific $ actbActivity body of

2
src/Vervis/Actor2.hs
View file

@ -69,7 +69,7 @@ import Vervis.Settings
instance StageWebRoute Env where
type StageRoute Env = Route App
askUrlRenderParams = do
Env _ _ _ _ _ render <- askEnv
Env _ _ _ _ _ render _ _ <- askEnv
case cast render of
Nothing -> error "Env site isn't App"
Just r -> pure r

2
src/Vervis/Application.hs
View file

@ -256,7 +256,7 @@ makeFoundation appSettings = do
let root = renderObjURI $ flip ObjURI topLocalURI $ appInstanceHost appSettings
--render :: Yesod y => y -> Route y -> [(Text, Text)] -> Text
render = yesodRender app root
env = Env appSettings pool hashidsCtx appActorKeys delivery render
env = Env appSettings pool hashidsCtx appActorKeys delivery render appHttpManager appActorFetchShare
actors <- flip runWorker app $ runSiteDB $ loadTheater env
theater <- startTheater logFunc actors

144
src/Vervis/Federation/Collab.hs
View file

@ -17,9 +17,9 @@
module Vervis.Federation.Collab
( --personInviteF
topicInviteF
--topicInviteF
, repoJoinF
repoJoinF
, deckJoinF
, loomJoinF
@ -90,146 +90,6 @@ import Vervis.Persist.Collab
import Vervis.Recipient
import Vervis.RemoteActorStore
topicInviteF
:: UTCTime
-> GrantResourceBy KeyHashid
-> RemoteAuthor
-> ActivityBody
-> Maybe (RecipientRoutes, ByteString)
-> LocalURI
-> AP.Invite URIMode
-> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text))
topicInviteF now recipByHash author body mfwd luInvite invite = do
error "Temporarily disabled due to switch to new actor system"
{-
-- Check input
uCap <- do
let muCap = AP.activityCapability $ actbActivity body
fromMaybeE muCap "No capability provided"
(resourceAndCap, recipient) <- do
-- Check the invite-specific data
(resource, recip) <-
parseInvite (Right $ remoteAuthorURI author) invite
-- Verify the capability URI is one of:
-- * Outbox item URI of a local actor, i.e. a local activity
-- * A remote URI
capability <- nameExceptT "Invite capability" $ parseActivityURI uCap
-- Verify that capability is either a local activity of a local
-- resource, or both resource and capability are of the same remote
-- instance
(,recip) <$> case (resource, capability) of
(Left r, Left (actor, _, item)) -> do
unless (grantResourceLocalActor r == actor) $
throwE "Local capability belongs to actor that isn't the resource"
return $ Left (r, item)
(Left _, Right _) ->
throwE "Remote capability obviously doesn't belong to local resource"
(Right _, Left _) ->
throwE "Local capability obviously doesn't belong to remote resource"
(Right (ObjURI h r), Right (ObjURI h' c)) -> do
unless (h == h') $
throwE "Capability and resource are on different remote instances"
return $ Right (ObjURI h r, c)
-- Find recipient topic in DB, returning 404 if doesn't exist because
-- we're in the topic's inbox post handler
recipByKey <- unhashGrantResource404 recipByHash
(_recipByEntity, recipActorID, recipActor) <- lift $ runDB $ do
recipE <- getGrantResource404 recipByKey
let actorID = grantResourceActorID $ bmap (Identity . entityVal) recipE
(recipE, actorID,) <$> getJust actorID
-- Verify that Invite's topic is me, otherwise I don't need this Invite
capability <-
case resourceAndCap of
Left (resource, item) | resource == recipByKey -> return item
_ -> throwE "I'm not the Invite's topic, don't need this Invite"
return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do
mhttp <- do
mractid <- lift $ runSiteDB $ insertToInbox now author body (actorInbox recipActor) luInvite False
for mractid $ \ inviteID -> do
-- Verify the specified capability gives relevant access to the
-- resource
let recipLocalActorByKey = grantResourceLocalActor recipByKey
runSiteDBExcept $
verifyCapability
(recipLocalActorByKey, capability)
(Right $ remoteAuthorId author)
recipByKey
-- If recipient is remote, HTTP GET it, make sure it's an
-- actor, and insert it to our DB. If recipient is local, find
-- it in our DB.
recipientDB <-
bitraverse
(runSiteDBExcept . flip getGrantRecip "Invitee not found in DB")
(\ u@(ObjURI h lu) -> do
instanceID <-
lift $ runSiteDB $ either entityKey id <$> insertBy' (Instance h)
result <-
ExceptT $ first (T.pack . displayException) <$>
fetchRemoteActor instanceID h lu
case result of
Left Nothing -> throwE "Recipient @id mismatch"
Left (Just err) -> throwE $ T.pack $ displayException err
Right Nothing -> throwE "Recipient isn't an actor"
Right (Just actor) -> return $ entityKey actor
)
recipient
lift $ runSiteDB $ do
-- Insert Collab record to DB
insertCollab recipByKey recipientDB inviteID
-- Forward the Invite activity to relevant local stages,
-- and schedule delivery for unavailable remote members of
-- them
for mfwd $ \ (localRecips, sig) -> do
let recipLocalActor =
grantResourceLocalActor recipByHash
sieve =
makeRecipientSet [] [localActorFollowers recipLocalActor]
forwardActivityDB
(actbBL body) localRecips sig recipActorID
recipLocalActor sieve inviteID
-- Launch asynchronous HTTP forwarding of the Invite activity
case mhttp of
Nothing -> return "I already have this activity in my inbox, doing nothing"
Just maybeForward -> do
traverse_ (forkWorker "topicInviteF inbox-forwarding") maybeForward
return $
case maybeForward of
Nothing -> "Inserted Collab to DB, no inbox-forwarding to do"
Just _ -> "Inserted Collab to DB and ran inbox-forwarding of the Invite"
where
insertCollab resource recipient inviteID = do
collabID <- insert Collab
fulfillsID <- insert $ CollabFulfillsInvite collabID
case resource of
GrantResourceRepo repoID ->
insert_ $ CollabTopicRepo collabID repoID
GrantResourceDeck deckID ->
insert_ $ CollabTopicDeck collabID deckID
GrantResourceLoom loomID ->
insert_ $ CollabTopicLoom collabID loomID
let authorID = remoteAuthorId author
insert_ $ CollabInviterRemote fulfillsID authorID inviteID
case recipient of
Left (GrantRecipPerson (Entity personID _)) ->
insert_ $ CollabRecipLocal collabID personID
Right remoteActorID ->
insert_ $ CollabRecipRemote collabID remoteActorID
-}
topicJoinF
:: (PersistRecordBackend topic SqlBackend, ToBackendKey SqlBackend topic)
=> (topic -> ActorId)

2
src/Vervis/Foundation.hs
View file

@ -131,7 +131,7 @@ data App = App
, appCapSignKey :: AccessTokenSecretKey
, appHashidsContext :: HashidsContext
, appHookSecret :: HookSecret
, appActorFetchShare :: ActorFetchShare App
, appActorFetchShare :: ActorFetchShare
, appTheater :: Theater
, appActivities :: Maybe (Int, TVar (Vector ActivityReport))

82
src/Vervis/RemoteActorStore.hs
View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2019, 2020, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
@ -26,6 +26,7 @@ module Vervis.RemoteActorStore
, addVerifKey
, actorFetchShareAction
, fetchRemoteActor
, fetchRemoteActor'
, deleteUnusedURAs
)
where
@ -59,14 +60,17 @@ import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import qualified Database.Esqueleto as E
import Control.Concurrent.Actor
import Crypto.PublicVerifKey
import Database.Persist.Local
import Network.FedURI
import Web.ActivityPub
import Yesod.MonadSite
import Vervis.Actor
import Vervis.FedURI
import Vervis.Model hiding (Actor (..))
import Vervis.RemoteActorStore.Types
newtype InstanceMutex = InstanceMutex (TVar (HashMap Host (MVar ())))
@ -81,15 +85,13 @@ data RoomMode
= RoomModeInstant
| RoomModeCached RoomModeDB
type ActorFetchShare site = ResultShare FedURI (Either (Maybe APGetError) (Maybe (Entity RemoteActor))) (site, InstanceId)
class Yesod site => YesodRemoteActorStore site where
siteInstanceMutex :: site -> InstanceMutex
siteInstanceRoomMode :: site -> Maybe Int
siteActorRoomMode :: site -> Maybe Int
siteRejectOnMaxKeys :: site -> Bool
siteActorFetchShare :: site -> ActorFetchShare site
siteActorFetchShare :: site -> ActorFetchShare
withHostLock
:: ( MonadHandler m
@ -466,36 +468,25 @@ addVerifKey h mname uinb vkd =
return (iid, rsid)
actorFetchShareAction
:: ( Yesod site
, YesodPersist site
, PersistUniqueWrite (YesodPersistBackend site)
, BaseBackend (YesodPersistBackend site) ~ SqlBackend
, HasHttpManager site
, Site site
, PersistConfigPool (SitePersistConfig site) ~ ConnectionPool
, PersistConfigBackend (SitePersistConfig site) ~ SqlPersistT
)
=> FedURI
-> (site, InstanceId)
:: FedURI
-> (ConnectionPool, Manager, InstanceId)
-> IO (Either (Maybe APGetError) (Maybe (Entity RemoteActor)))
actorFetchShareAction u (site, iid) = flip runWorkerT site $ do
let ObjURI h lu = u
mrecip <- runSiteDB $ runMaybeT $
MaybeT (getKeyBy $ UniqueRemoteObject iid lu) >>= \ roid ->
Left <$> MaybeT (getBy $ UniqueRemoteActor roid)
<|> Right <$> MaybeT (getBy $ UniqueRemoteCollection roid)
actorFetchShareAction u@(ObjURI h lu) (pool, manager, iid) = do
mrecip <- rundb $ runMaybeT $ do
roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid lu
Left <$> MaybeT (getBy $ UniqueRemoteActor roid) <|>
Right <$> MaybeT (getBy $ UniqueRemoteCollection roid)
case mrecip of
Just recip ->
return $ Right $
case recip of
Left ers -> Just ers
Left era -> Just era
Right _ -> Nothing
Nothing -> do
manager <- asksSite getHttpManager
erecip <- fetchRecipient manager h lu
for erecip $ \ recip ->
case recip of
RecipientActor (Actor local detail) -> runSiteDB $ do
for erecip $
\case
RecipientActor (Actor local detail) -> rundb $ do
roid <- either entityKey id <$> insertBy' (RemoteObject iid lu)
let ra = RemoteActor
{ remoteActorIdent = roid
@ -506,18 +497,19 @@ actorFetchShareAction u (site, iid) = flip runWorkerT site $ do
, remoteActorErrorSince = Nothing
}
Just . either id (flip Entity ra) <$> insertBy' ra
RecipientCollection _ -> runSiteDB $ do
RecipientCollection _ -> rundb $ do
mroid <- insertUnique $ RemoteObject iid lu
for_ mroid $ \ roid ->
insertUnique_ $ RemoteCollection roid
return Nothing
return (Nothing :: Maybe (Entity RemoteActor))
-- TODO see https://vervis.peers.community/decks/br6Go/tickets/r7dDo
where
rundb :: ReaderT SqlBackend IO a -> IO a
rundb = flip runSqlPool pool
fetchRemoteActor
:: ( YesodPersist site
, PersistUniqueRead (YesodPersistBackend site)
, BaseBackend (YesodPersistBackend site) ~ SqlBackend
, YesodRemoteActorStore site
:: ( YesodRemoteActorStore site
, HasHttpManager site
, MonadUnliftIO m
, MonadSite m
, SiteEnv m ~ site
@ -545,7 +537,31 @@ fetchRemoteActor iid host luActor = do
Right _ -> Nothing
Nothing -> do
site <- askSite
liftIO $ runShared (siteActorFetchShare site) (ObjURI host luActor) (site, iid)
liftIO $ runShared (siteActorFetchShare site) (ObjURI host luActor) (sitePersistPool site, getHttpManager site, iid)
fetchRemoteActor'
:: InstanceId
-> Host
-> LocalURI
-> Act
(Either
SomeException
(Either (Maybe APGetError) (Maybe (Entity RemoteActor)))
)
fetchRemoteActor' iid host luActor = do
mrecip <- withDB $ runMaybeT $
MaybeT (getKeyBy $ UniqueRemoteObject iid luActor) >>= \ roid ->
Left <$> MaybeT (getBy $ UniqueRemoteActor roid)
<|> Right <$> MaybeT (getBy $ UniqueRemoteCollection roid)
case mrecip of
Just recip ->
return $ Right $ Right $
case recip of
Left ers -> Just ers
Right _ -> Nothing
Nothing -> do
Env _ pool _ _ _ _ manager fetch <- askEnv
liftIO $ runShared fetch (ObjURI host luActor) (pool, manager, iid)
deleteUnusedURAs :: (MonadIO m, MonadLogger m) => ReaderT SqlBackend m ()
deleteUnusedURAs = do

59
src/Vervis/RemoteActorStore/Types.hs Normal file
View file

@ -0,0 +1,59 @@
{- This file is part of Vervis.
-
- Written in 2019, 2020, 2022, 2023 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.RemoteActorStore.Types
( ActorFetchShare
)
where
import Control.Applicative
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (MVar, newMVar)
import Control.Concurrent.ResultShare
import Control.Concurrent.STM.TVar
import Control.Exception
import Control.Monad
import Control.Monad.Logger.CallStack
import Control.Monad.STM
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Foldable
import Data.HashMap.Strict (HashMap)
import Data.Maybe
import Data.Text (Text)
import Data.Time.Clock
import Data.Traversable
import Database.Persist
import Database.Persist.Sql
import Network.HTTP.Client
import UnliftIO.MVar (withMVar)
import Yesod.Core hiding (logWarn, logError)
import Yesod.Persist.Core
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import qualified Database.Esqueleto as E
import Crypto.PublicVerifKey
import Database.Persist.Local
import Network.FedURI
import Web.ActivityPub
import Yesod.MonadSite
import Vervis.FedURI
import Vervis.Model hiding (Actor (..))
type ActorFetchShare = ResultShare FedURI (Either (Maybe APGetError) (Maybe (Entity RemoteActor))) (ConnectionPool, Manager, InstanceId)

1
vervis.cabal
View file

@ -240,6 +240,7 @@ library
Vervis.Readme
Vervis.Recipient
Vervis.RemoteActorStore
Vervis.RemoteActorStore.Types
--Vervis.Repo
--Vervis.Role
Vervis.Secure