From 4fc50f0870ad0ead1773f8a865e447257a16d058 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Sun, 21 Jun 2020 12:29:37 +0000
Subject: [PATCH] Move hostIsLocal from Vervis.ActivityPub to Yesod.ActivityPub

---
 src/Vervis/ActivityPub.hs    | 12 ------------
 src/Vervis/Handler/Client.hs |  1 +
 src/Yesod/ActivityPub.hs     | 16 ++++++++++++++++
 3 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/src/Vervis/ActivityPub.hs b/src/Vervis/ActivityPub.hs
index 3f64265..f5fcece 100644
--- a/src/Vervis/ActivityPub.hs
+++ b/src/Vervis/ActivityPub.hs
@@ -15,8 +15,6 @@
 
 module Vervis.ActivityPub
     ( NoteContext (..)
-    , hostIsLocal
-    , verifyHostLocal
     , parseContext
     , parseParent
     , getLocalParentMessageId
@@ -137,16 +135,6 @@ data NoteContext
     | NoteContextRepoPatch ShrIdent RpIdent LocalTicketId
     deriving Eq
 
-hostIsLocal :: (MonadSite m, SiteEnv m ~ App) => Host -> m Bool
-hostIsLocal h = asksSite $ (== h) . appInstanceHost . appSettings
-
-verifyHostLocal
-    :: (MonadSite m, SiteEnv m ~ App)
-    => Host -> Text -> ExceptT Text m ()
-verifyHostLocal h t = do
-    local <- hostIsLocal h
-    unless local $ throwE t
-
 parseContext
     :: (MonadSite m, SiteEnv m ~ App)
     => FedURI
diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs
index a1265ff..776028b 100644
--- a/src/Vervis/Handler/Client.hs
+++ b/src/Vervis/Handler/Client.hs
@@ -63,6 +63,7 @@ import qualified Database.Esqueleto as E
 import Database.Persist.JSON
 import Network.FedURI
 import Web.ActivityPub hiding (Ticket)
+import Yesod.ActivityPub
 import Yesod.Auth.Unverified
 import Yesod.FedURI
 import Yesod.Hashids
diff --git a/src/Yesod/ActivityPub.hs b/src/Yesod/ActivityPub.hs
index 2650509..02b3342 100644
--- a/src/Yesod/ActivityPub.hs
+++ b/src/Yesod/ActivityPub.hs
@@ -24,11 +24,15 @@ module Yesod.ActivityPub
     , provideHtmlAndAP'
     , provideHtmlAndAP''
     , provideHtmlFeedAndAP
+    , hostIsLocal
+    , verifyHostLocal
     )
 where
 
 import Control.Exception
+import Control.Monad
 import Control.Monad.Logger.CallStack
+import Control.Monad.Trans.Except
 import Control.Monad.Trans.Writer
 import Data.Aeson
 import Data.Aeson.Encode.Pretty
@@ -292,3 +296,15 @@ provideHtmlFeedAndAP object feed widget = do
         (Doc host object)
         widget
         (Just feed)
+
+hostIsLocal
+    :: (MonadSite m, SiteEnv m ~ site, YesodActivityPub site)
+    => Authority (SiteFedURIMode site) -> m Bool
+hostIsLocal h = asksSite $ (== h) . siteInstanceHost
+
+verifyHostLocal
+    :: (MonadSite m, SiteEnv m ~ site, YesodActivityPub site)
+    => Authority (SiteFedURIMode site) -> Text -> ExceptT Text m ()
+verifyHostLocal h t = do
+    local <- hostIsLocal h
+    unless local $ throwE t