When POSTing an activity, protect remote actor DB insertion with withHostLock

This commit is contained in:
fr33domlover 2019-03-09 17:12:43 +00:00
parent e341f62587
commit fdbe46741b
4 changed files with 62 additions and 11 deletions

View file

@ -0,0 +1,40 @@
{- This file is part of Vervis.
-
- Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- Copying is an act of love. Please copy, reuse and share.
-
- The author(s) have dedicated all copyright and related and neighboring
- rights to this software to the public domain worldwide. This software is
- distributed without any warranty.
-
- You should have received a copy of the CC0 Public Domain Dedication along
- with this software. If not, see
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
module Database.Persist.Local
( idAndNew
, insertUnique_
)
where
import Prelude
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Database.Persist
idAndNew :: Either (Entity a) (Key a) -> (Key a, Bool)
idAndNew (Left (Entity iid _)) = (iid, False)
idAndNew (Right iid) = (iid, True)
insertUnique_
:: ( MonadIO m
, PersistRecordBackend record backend
, PersistUniqueWrite backend
)
=> record
-> ReaderT backend m ()
insertUnique_ = void . insertUnique

View file

@ -77,6 +77,7 @@ import Yesod.HttpSignature (verifyRequestSignature)
import qualified Network.HTTP.Signature as S (Algorithm (..)) import qualified Network.HTTP.Signature as S (Algorithm (..))
import Data.Aeson.Encode.Pretty.ToEncoding import Data.Aeson.Encode.Pretty.ToEncoding
import Database.Persist.Local
import Network.FedURI import Network.FedURI
import Web.ActivityPub import Web.ActivityPub
import Yesod.Auth.Unverified import Yesod.Auth.Unverified
@ -84,6 +85,7 @@ import Yesod.Auth.Unverified
import Vervis.ActorKey import Vervis.ActorKey
import Vervis.Foundation import Vervis.Foundation
import Vervis.Model import Vervis.Model
import Vervis.RemoteActorStore
import Vervis.Settings (AppSettings (appHttpSigTimeLimit)) import Vervis.Settings (AppSettings (appHttpSigTimeLimit))
getInboxR :: Handler Html getInboxR :: Handler Html
@ -248,11 +250,15 @@ postOutboxR = do
where where
fetchInboxURI :: Manager -> Text -> LocalURI -> Handler (Maybe LocalURI) fetchInboxURI :: Manager -> Text -> LocalURI -> Handler (Maybe LocalURI)
fetchInboxURI manager h lto = do fetchInboxURI manager h lto = do
mrs <- runDB $ runMaybeT $ do mrs <- runDB $ do
Entity iid _ <- MaybeT $ getBy $ UniqueInstance h mi <- getBy $ UniqueInstance h
MaybeT $ getBy $ UniqueRemoteSharer iid lto case mi of
Nothing -> return $ Left Nothing
Just (Entity iid _) ->
maybe (Left $ Just iid) Right <$>
getBy (UniqueRemoteSharer iid lto)
case mrs of case mrs of
Nothing -> do Left miid -> do
eres <- fetchAPID manager actorId h lto eres <- fetchAPID manager actorId h lto
case eres of case eres of
Left s -> do Left s -> do
@ -263,13 +269,19 @@ postOutboxR = do
, T.pack s , T.pack s
] ]
return Nothing return Nothing
Right actor -> do Right actor -> withHostLock h $ do
let inbox = actorInbox actor let inbox = actorInbox actor
runDB $ do runDB $ do
iid <- either entityKey id <$> insertBy (Instance h) (iid, inew) <-
insert_ $ RemoteSharer lto iid inbox case miid of
Just iid -> return (iid, False)
Nothing -> idAndNew <$> insertBy (Instance h)
let rs = RemoteSharer lto iid inbox
if inew
then insert_ rs
else insertUnique_ rs
return $ Just inbox return $ Just inbox
Just (Entity _rsid rs) -> return $ Just $ remoteSharerInbox rs Right (Entity _rsid rs) -> return $ Just $ remoteSharerInbox rs
getActorKey :: ((ActorKey, ActorKey, Bool) -> ActorKey) -> Route App -> Handler TypedContent getActorKey :: ((ActorKey, ActorKey, Bool) -> ActorKey) -> Route App -> Handler TypedContent
getActorKey choose route = do getActorKey choose route = do

View file

@ -49,6 +49,7 @@ import Yesod.Persist.Core
import qualified Crypto.PubKey.Ed25519 as E import qualified Crypto.PubKey.Ed25519 as E
import qualified Data.HashMap.Strict as M import qualified Data.HashMap.Strict as M
import Database.Persist.Local
import Network.FedURI import Network.FedURI
import Web.ActivityPub import Web.ActivityPub
@ -132,9 +133,6 @@ instanceAndActor host luActor luInbox = do
else do else do
(rsid, rsnew) <- idAndNew <$> insertBy rs (rsid, rsnew) <- idAndNew <$> insertBy rs
return (iid, rsid, Just rsnew) return (iid, rsid, Just rsnew)
where
idAndNew (Left (Entity iid _)) = (iid, False)
idAndNew (Right iid) = (iid, True)
actorRoom actorRoom
:: ( PersistQueryRead (YesodPersistBackend site) :: ( PersistQueryRead (YesodPersistBackend site)

View file

@ -72,6 +72,7 @@ library
Database.Esqueleto.Local Database.Esqueleto.Local
Database.Persist.Class.Local Database.Persist.Class.Local
Database.Persist.Sql.Local Database.Persist.Sql.Local
Database.Persist.Local
Database.Persist.Local.Class.PersistEntityHierarchy Database.Persist.Local.Class.PersistEntityHierarchy
Database.Persist.Local.RecursionDoc Database.Persist.Local.RecursionDoc
Diagrams.IntransitiveDAG Diagrams.IntransitiveDAG