From 25fcceabdea2068685ae8ac497c3a63ae04b24ad Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Tue, 16 Apr 2019 14:34:17 +0000
Subject: [PATCH] postOutboxR: Use ResultShare for fetching recipient actor

---
 src/Vervis/Handler/Inbox.hs | 44 ++++++++++---------------------------
 1 file changed, 12 insertions(+), 32 deletions(-)

diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs
index a543a80..ece0859 100644
--- a/src/Vervis/Handler/Inbox.hs
+++ b/src/Vervis/Handler/Inbox.hs
@@ -293,38 +293,18 @@ postOutboxR shr = do
     where
     fetchInboxURI :: Manager -> Text -> LocalURI -> Handler (Maybe LocalURI)
     fetchInboxURI manager h lto = do
-        mrs <- runDB $ do
-            mi <- getBy $ UniqueInstance h
-            case mi of
-                Nothing -> return $ Left Nothing
-                Just (Entity iid _) ->
-                    maybe (Left $ Just iid) Right <$>
-                        getBy (UniqueRemoteActor iid lto)
-        case mrs of
-            Left miid -> do
-                eres <- fetchAPID manager actorId h lto
-                case eres of
-                    Left s -> do
-                        setMessage $ toHtml $ T.concat
-                            [ "Tried to fetch recipient actor <"
-                            , renderFedURI $ l2f h lto
-                            , "> and got an error: "
-                            , T.pack s
-                            ]
-                        return Nothing
-                    Right actor -> withHostLock h $ do
-                        let inbox = actorInbox actor
-                        runDB $ do
-                            (iid, inew) <-
-                                case miid of
-                                    Just iid -> return (iid, False)
-                                    Nothing -> idAndNew <$> insertBy (Instance h)
-                            let rs = RemoteActor lto iid inbox Nothing
-                            if inew
-                                then insert_ rs
-                                else insertUnique_ rs
-                        return $ Just inbox
-            Right (Entity _rsid rs) -> return $ Just $ remoteActorInbox rs
+        iid <- runDB $ either entityKey id <$> insertBy' (Instance h)
+        result <- fetchRemoteActor iid h lto
+        case result of
+            Left err -> do
+                setMessage $ toHtml $ T.concat
+                    [ "Tried to fetch recipient actor <"
+                    , renderFedURI $ l2f h lto
+                    , "> and got an error: "
+                    , T.pack (show err)
+                    ]
+                return Nothing
+            Right (Entity _ ra) -> return $ Just $ remoteActorInbox ra
 
 getActorKey :: ((ActorKey, ActorKey, Bool) -> ActorKey) -> Route App -> Handler TypedContent
 getActorKey choose route = selectRep $ provideAP $ do