Move hostIsLocal from Vervis.ActivityPub to Yesod.ActivityPub

This commit is contained in:
fr33domlover 2020-06-21 12:29:37 +00:00
parent 2cddadd679
commit 4fc50f0870
3 changed files with 17 additions and 12 deletions

View file

@ -15,8 +15,6 @@
module Vervis.ActivityPub module Vervis.ActivityPub
( NoteContext (..) ( NoteContext (..)
, hostIsLocal
, verifyHostLocal
, parseContext , parseContext
, parseParent , parseParent
, getLocalParentMessageId , getLocalParentMessageId
@ -137,16 +135,6 @@ data NoteContext
| NoteContextRepoPatch ShrIdent RpIdent LocalTicketId | NoteContextRepoPatch ShrIdent RpIdent LocalTicketId
deriving Eq 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 parseContext
:: (MonadSite m, SiteEnv m ~ App) :: (MonadSite m, SiteEnv m ~ App)
=> FedURI => FedURI

View file

@ -63,6 +63,7 @@ import qualified Database.Esqueleto as E
import Database.Persist.JSON import Database.Persist.JSON
import Network.FedURI import Network.FedURI
import Web.ActivityPub hiding (Ticket) import Web.ActivityPub hiding (Ticket)
import Yesod.ActivityPub
import Yesod.Auth.Unverified import Yesod.Auth.Unverified
import Yesod.FedURI import Yesod.FedURI
import Yesod.Hashids import Yesod.Hashids

View file

@ -24,11 +24,15 @@ module Yesod.ActivityPub
, provideHtmlAndAP' , provideHtmlAndAP'
, provideHtmlAndAP'' , provideHtmlAndAP''
, provideHtmlFeedAndAP , provideHtmlFeedAndAP
, hostIsLocal
, verifyHostLocal
) )
where where
import Control.Exception import Control.Exception
import Control.Monad
import Control.Monad.Logger.CallStack import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Except
import Control.Monad.Trans.Writer import Control.Monad.Trans.Writer
import Data.Aeson import Data.Aeson
import Data.Aeson.Encode.Pretty import Data.Aeson.Encode.Pretty
@ -292,3 +296,15 @@ provideHtmlFeedAndAP object feed widget = do
(Doc host object) (Doc host object)
widget widget
(Just feed) (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