Move hostIsLocal from Vervis.ActivityPub to Yesod.ActivityPub
This commit is contained in:
parent
2cddadd679
commit
4fc50f0870
3 changed files with 17 additions and 12 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue