On launch, fetch actors and fill PermitTopicExtendResource records

src/Vervis/Application.hs

@@ -148,6 +148,12 @@ import Vervis.Settings
 import Vervis.Ssh (runSsh)
 import Vervis.Web.Delivery
 
+-- Only for fillPermitRecords, so remove soon
+import qualified Web.ActivityPub as AP
+import Vervis.Persist.Collab
+import Data.Either.Local
+import Database.Persist.Local
+
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
 -- comments there for more details.
@@ -466,6 +472,54 @@ mailer foundation =
                 (loggingFunction foundation)
                 (readChan queue)
 
+fillPermitRecords :: Worker ()
+fillPermitRecords = do
+    extendIDs <- runSiteDB $ selectKeysList [] [Asc PermitTopicExtendId]
+    for_ extendIDs $ \ extendID -> do
+        lr <- runSiteDB $ (,)
+            <$> getBy (UniquePermitTopicExtendResourceLocal extendID)
+            <*> getBy (UniquePermitTopicExtendResourceRemote extendID)
+        case lr of
+            (Just _, Nothing) -> pure ()
+            (Nothing, Just _) -> pure ()
+            (Just _, Just _) -> error "PTER both"
+            (Nothing, Nothing) -> do
+                uResource <- runSiteDB $ do
+                    pte <-
+                        requireEitherAlt
+                            (getValBy $ UniquePermitTopicExtendLocal extendID)
+                            (getValBy $ UniquePermitTopicExtendRemote extendID)
+                            "PTE none"
+                            "PTE both"
+                    let ext = bimap permitTopicExtendLocalGrant permitTopicExtendRemoteGrant pte
+                    (_doc, g) <- getGrantActivityBody ext
+                    return $ AP.grantContext g
+                result <- runExceptT $ do
+                    a <- parseActorURI uResource
+                    case a of
+                        Left la -> runSiteDBExcept $ do
+                            actorID <-
+                                localActorID <$>
+                                    getLocalActorEntityE la "Extension-Grant resource not found in DB"
+                            lift $ insert_ $ PermitTopicExtendResourceLocal extendID actorID
+                        Right (ObjURI h lu) -> do
+                            actorID <- do
+                                manager <- asksSite appHttpManager
+                                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 "Resource @id mismatch"
+                                    Left (Just err) -> throwE $ T.pack $ displayException err
+                                    Right Nothing -> throwE "Resource isn't an actor"
+                                    Right (Just actor) -> return $ entityKey actor
+                            lift $ runSiteDB $ insert_ $ PermitTopicExtendResourceRemote extendID actorID
+                case result of
+                    Left e -> error $ "fillPermitRecords: " ++ show extendID ++ T.unpack e
+                    Right () -> $logInfo $ T.pack $ "fillPermitRecords: " ++ show extendID ++ " success"
+
 -- | The @main@ function for an executable running this site.
 appMain :: IO ()
 appMain = do
@@ -495,6 +549,9 @@ appMain = do
     -- have a key and insert to DB
     runWorker fillPerActorKeys foundation
 
+    -- Temporary setup - fill PermitTopicExtendResource* records
+    runWorker fillPermitRecords foundation
+
     -- Run periodic activity delivery retry runner
     -- Disabled because we're using the DeliveryTheater now
     {-