From 72f96a0dff84e7e91a69adc00b086b9e3c31e8d7 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Thu, 21 Mar 2019 21:38:59 +0000 Subject: [PATCH] When verifying HTTPsig, return iid&rsid and remove duplicate shared usage check * Adapt DB related code to return the InstanceId and RemoteSharerId * Previously, when fetching a known shared key, we were running a DB check/update for the shared usage record. I noticed - and hopefully I correctly noticed - that this check already runs when we discover the keyId points to a shared key we already know. So, after successful sig verification, there's no need to run the check again. So I removed it. --- src/Vervis/Foundation.hs | 85 ++++++++++++++++++++-------------- src/Vervis/Handler/Inbox.hs | 2 +- src/Vervis/RemoteActorStore.hs | 59 ++++++++++++----------- src/Web/ActivityPub.hs | 6 +-- 4 files changed, 83 insertions(+), 69 deletions(-) diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 452869b..96fb58b 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -611,8 +611,14 @@ instance YesodRemoteActorStore App where siteActorRoomMode = appMaxActorKeys . appSettings siteRejectOnMaxKeys = appRejectOnMaxKeys . appSettings +data ActorDetail = ActorDetail + { actorDetailId :: FedURI + , actorDetailInstance :: InstanceId + , actorDetailSharer :: RemoteSharerId + } + instance YesodHttpSig App where - data HttpSigVerResult App = HttpSigVerResult (Either String FedURI) + data HttpSigVerResult App = HttpSigVerResult (Either String ActorDetail) httpSigVerRequiredHeaders = const [hRequestTarget, hHost] httpSigVerWantedHeaders = const [hActivityPubActor] httpSigVerSeconds = @@ -631,28 +637,29 @@ instance YesodHttpSig App where Entity iid _ <- MaybeT $ getBy $ UniqueInstance host MaybeT $ getBy $ UniqueVerifKey iid luKey for mvk $ \ vk@(Entity _ verifkey) -> do - mremote <- traverse getJust $ verifKeySharer verifkey + mremote <- for (verifKeySharer verifkey) $ \ rsid -> + (rsid,) <$> getJust rsid return (vk, mremote) case ments of Just (Entity vkid vk, mremote) -> do - (ua, s) <- + (ua, s, rsid) <- case mremote of - Just remote -> do - let sharer = remoteSharerIdent remote + Just (rsid, rs) -> do + let sharer = remoteSharerIdent rs for_ mluActorHeader $ \ u -> if sharer == u then return () else throwE "Key's owner doesn't match actor header" - return (sharer, False) + return (sharer, False, rsid) Nothing -> do ua <- case mluActorHeader of Nothing -> throwE "Got a sig with an instance key, but actor header not specified!" Just u -> return u let iid = verifKeyInstance vk - withHostLock' host $ keyListedByActorShared iid vkid host luKey ua - return (ua, True) + rsid <- withHostLock' host $ keyListedByActorShared iid vkid host luKey ua + return (ua, True, rsid) return - ( Right (verifKeyInstance vk, vkid) + ( Right (verifKeyInstance vk, vkid, rsid) , VerifKeyDetail { vkdKeyId = luKey , vkdKey = verifKeyPublic vk @@ -671,34 +678,40 @@ instance YesodHttpSig App where stillValid (Just expires) = expires > now valid1 <- verify $ vkdKey vkd - if valid1 && stillValid (vkdExpires vkd) - then case inboxOrVkid of - Left uinb -> ExceptT $ withHostLock host $ runDB $ runExceptT $ addVerifKey host uinb vkd - Right _ids -> return () - else case inboxOrVkid of - Left _uinb -> - if stillValid $ vkdExpires vkd - then errSig1 - else errTime - Right (iid, vkid) -> do - let ua = vkdActorId vkd - listed = withHostLock' host $ keyListedByActorShared iid vkid host luKey ua - (newKey, newExp) <- - if vkdShared vkd - then fetchKnownSharedKey manager listed malgo host ua luKey - else fetchKnownPersonalKey manager malgo host ua luKey - if stillValid newExp - then return () - else errTime - valid2 <- verify newKey - if valid2 - then lift $ runDB $ updateVerifKey vkid vkd - { vkdKey = newKey - , vkdExpires = newExp - } - else errSig2 + (iid, rsid) <- + if valid1 && stillValid (vkdExpires vkd) + then case inboxOrVkid of + Left uinb -> ExceptT $ withHostLock host $ runDB $ runExceptT $ addVerifKey host uinb vkd + Right (iid, _vkid, rsid) -> return (iid, rsid) + else case inboxOrVkid of + Left _uinb -> + if stillValid $ vkdExpires vkd + then errSig1 + else errTime + Right (iid, vkid, rsid) -> do + let ua = vkdActorId vkd + (newKey, newExp) <- + if vkdShared vkd + then fetchKnownSharedKey manager malgo host ua luKey + else fetchKnownPersonalKey manager malgo host ua luKey + if stillValid newExp + then return () + else errTime + valid2 <- verify newKey + if valid2 + then do + lift $ runDB $ updateVerifKey vkid vkd + { vkdKey = newKey + , vkdExpires = newExp + } + return (iid, rsid) + else errSig2 - return $ l2f host $ vkdActorId vkd + return ActorDetail + { actorDetailId = l2f host $ vkdActorId vkd + , actorDetailInstance = iid + , actorDetailSharer = rsid + } where parseKeyId k = case parseFedURI =<< (first displayException . decodeUtf8') k of diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs index 3600742..08b609b 100644 --- a/src/Vervis/Handler/Inbox.hs +++ b/src/Vervis/Handler/Inbox.hs @@ -142,7 +142,7 @@ postInboxR = do _ -> Left "Unknown Content-Type" _ -> Left "More than one Content-Type given" HttpSigVerResult result <- ExceptT . fmap (first displayException) $ verifyRequestSignature now - (h, luActor) <- f2l <$> liftE result + (h, luActor) <- f2l . actorDetailId <$> liftE result d@(Doc h' a) <- requireJsonBody unless (h == h') $ throwE "Activity host doesn't match signature key host" diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs index 4b77930..db45b2e 100644 --- a/src/Vervis/RemoteActorStore.hs +++ b/src/Vervis/RemoteActorStore.hs @@ -310,7 +310,7 @@ keyListedByActorShared -> Text -> LocalURI -> LocalURI - -> ExceptT String (HandlerFor site) () + -> ExceptT String (HandlerFor site) RemoteSharerId keyListedByActorShared iid vkid host luKey luActor = do manager <- getsYesod getHttpManager reject <- getsYesod siteRejectOnMaxKeys @@ -319,10 +319,9 @@ keyListedByActorShared iid vkid host luKey luActor = do RoomModeInstant -> do when reject $ throwE "Actor key storage limit is 0 and set to reject" luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor) - _ <- lift $ runDB $ insertUnique $ RemoteSharer luActor iid luInbox - return () + lift $ runDB $ either entityKey id <$> insertBy (RemoteSharer luActor iid luInbox) RoomModeCached m -> do - mresult <- do + eresult <- do ments <- lift $ runDB $ do mrs <- getBy $ UniqueRemoteSharer iid luActor for mrs $ \ (Entity rsid _) -> @@ -330,30 +329,34 @@ keyListedByActorShared iid vkid host luKey luActor = do getBy (UniqueVerifKeySharedUsage vkid rsid) return $ case ments of - Nothing -> Just Nothing + Nothing -> Right Nothing Just (rsid, used) -> if used - then Nothing - else Just $ Just rsid - for_ mresult $ \ mrsid -> do - luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor) - ExceptT $ runDB $ do - vkExists <- isJust <$> get vkid - case mrsid of - Nothing -> do - rsid <- insert $ RemoteSharer luActor iid luInbox - when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid - return $ Right () - Just rsid -> runExceptT $ when vkExists $ do - case m of - RoomModeNoLimit -> return () - RoomModeLimit limit -> do - if reject - then do - room <- lift $ actorRoom limit rsid - unless room $ throwE "Actor key storage limit reached" - else lift $ makeActorRoomForUsage limit rsid - lift $ insert_ $ VerifKeySharedUsage vkid rsid + then Left rsid + else Right $ Just rsid + case eresult of + Left rsid -> return rsid + Right mrsid -> do + luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor) + ExceptT $ runDB $ do + vkExists <- isJust <$> get vkid + case mrsid of + Nothing -> do + rsid <- insert $ RemoteSharer luActor iid luInbox + when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid + return $ Right rsid + Just rsid -> runExceptT $ do + when vkExists $ do + case m of + RoomModeNoLimit -> return () + RoomModeLimit limit -> do + if reject + then do + room <- lift $ actorRoom limit rsid + unless room $ throwE "Actor key storage limit reached" + else lift $ makeActorRoomForUsage limit rsid + lift $ insert_ $ VerifKeySharedUsage vkid rsid + return rsid data VerifKeyDetail = VerifKeyDetail { vkdKeyId :: LocalURI @@ -372,7 +375,7 @@ addVerifKey => Text -> LocalURI -> VerifKeyDetail - -> ExceptT String (YesodDB site) () + -> ExceptT String (YesodDB site) (InstanceId, RemoteSharerId) addVerifKey h uinb vkd = if vkdShared vkd then addSharedKey h uinb vkd @@ -409,6 +412,7 @@ addVerifKey h uinb vkd = unless room $ throwE "Actor key storage limit reached" else when (inew == Just False) $ lift $ makeActorRoomForUsage limit rsid lift $ insert_ $ VerifKeySharedUsage vkid rsid + return (iid, rsid) where instanceRoom n iid = (< n) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing] @@ -429,3 +433,4 @@ addVerifKey h uinb vkd = unless room $ throwE "Actor key storage limit reached" else when (inew == Just False) $ lift $ makeActorRoomForPersonalKey limit rsid lift $ insert_ $ VerifKey luKey iid mexpires key (Just rsid) + return (iid, rsid) diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 7155d3b..9afa62a 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -827,9 +827,6 @@ fetchKnownSharedKey :: MonadIO m => Manager -- ^ Manager for making HTTP requests - -> ExceptT String m () - -- ^ Action which checks whether the actor from HTTP actor header lists the - -- key, potentually updating our local cache if needed. -> Maybe S.Algorithm -- ^ Signature algorithm possibly specified in the HTTP signature header -> Text @@ -839,7 +836,7 @@ fetchKnownSharedKey -> LocalURI -- ^ Key URI -> ExceptT String m (PublicVerifKey, Maybe UTCTime) -fetchKnownSharedKey manager listed malgo host luActor luKey = do +fetchKnownSharedKey manager malgo host luActor luKey = do obj <- fetchAPIDOrH manager publicKeyId host luKey pkey <- case obj :: Either PublicKey Actor of @@ -848,7 +845,6 @@ fetchKnownSharedKey manager listed malgo host luActor luKey = do case publicKeyOwner pkey of OwnerInstance -> return () OwnerActor _owner -> throwE "Shared key became personal" - listed let (material, mexpires) = keyDetail pkey ExceptT . pure $ verifyAlgo malgo material return (material, mexpires)