From 4053f2f2b497d94e29a8a7d7f331c8ed86767fe4 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Tue, 19 Feb 2019 10:54:55 +0000 Subject: [PATCH] Record usage of instance keys in the DB When we verify an HTTP signature, * If we know the key, check in the DB whether we know the actor lists it. If it doesn't, and there's room left for keys, HTTP GET the actor and update the DB accordingly. * If we know the key but had to update it, do the same, check usage in DB and update DB if needed * If we don't know the key, record usage in DB However, * If we're GETing a key and discovering it's a shared key, we GET the actor to verify it lists the key. When we don't know the key at all yet, that's fine (can be further optimized but it's marginal), but if it's a key we do know, it means we already know the actor and for now it's enough for us to rely only on the DB to test usage. --- config/models | 6 + migrations/2019_02_03_verifkey.model | 6 + src/Vervis/Foundation.hs | 160 +++++++++++++++++++-------- 3 files changed, 125 insertions(+), 47 deletions(-) diff --git a/config/models b/config/models index 2b4c450..7f736ae 100644 --- a/config/models +++ b/config/models @@ -48,6 +48,12 @@ VerifKey UniqueVerifKey ident +VerifKeySharedUsage + key VerifKeyId + user RemoteSharerId + + UniqueVerifKeySharedUsage key user + RemoteSharer ident FedURI instance InstanceId diff --git a/migrations/2019_02_03_verifkey.model b/migrations/2019_02_03_verifkey.model index 4070d79..6a688d6 100644 --- a/migrations/2019_02_03_verifkey.model +++ b/migrations/2019_02_03_verifkey.model @@ -7,6 +7,12 @@ VerifKey UniqueVerifKey ident +VerifKeySharedUsage + key VerifKeyId + user RemoteSharerId + + UniqueVerifKeySharedUsage key user + RemoteSharer ident Text instance InstanceId diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index a5dda38..caca7a3 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -564,53 +564,114 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger -- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain -- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding -data AddVerifKey = AddVerifKey - { addvkHost :: Text - , addvkKeyId :: FedURI - , addvkExpires :: Maybe UTCTime - , addvkKey :: PublicKey - } - -addSharedKey :: AddVerifKey -> AppDB (Maybe String) -addSharedKey (AddVerifKey host uKey mexpires key) = do - (iid, new) <- idAndNew <$> insertBy (Instance host) - room <- - if new - then pure True - else - (< 2) <$> - count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing] - if room +sumUpTo :: Int -> AppDB Int -> AppDB Int -> AppDB Bool +sumUpTo limit action1 action2 = do + n <- action1 + if n <= limit then do - insert_ $ VerifKey uKey iid mexpires key Nothing - return Nothing - else return $ Just "We already store 2 keys" + m <- action2 + return $ n + m <= limit + else return False + +instanceAndActor + :: Text + -> FedURI + -> FedURI + -> AppDB (InstanceId, RemoteSharerId, Maybe Bool) +instanceAndActor host uActor uInbox = do + mrs <- getBy $ UniqueRemoteSharer uActor + case mrs of + Nothing -> do + (iid, inew) <- idAndNew <$> insertBy (Instance host) + rsid <- insert $ RemoteSharer uActor iid uInbox + return (iid, rsid, if inew then Nothing else Just True) + Just (Entity rsid rs) -> + return (remoteSharerInstance rs, rsid, Just False) where idAndNew (Left (Entity iid _)) = (iid, False) idAndNew (Right iid) = (iid, True) -data AddPersonalKey = AddPersonalKey - { addpkKey :: AddVerifKey - , addpkActorId :: FedURI - , addpkActorInbox :: FedURI +actorRoom :: RemoteSharerId -> AppDB Bool +actorRoom rsid = + sumUpTo 2 + (count [VerifKeySharedUsageUser ==. rsid]) + (count [VerifKeySharer ==. Just rsid]) + +keyListedByActor' + :: Manager + -> InstanceId + -> VerifKeyId + -> FedURI + -> FedURI + -> Handler (Either String ()) +keyListedByActor' manager iid vkid uKey uActor = do + mresult <- do + ments <- runDB $ do + mrs <- getBy $ UniqueRemoteSharer uActor + for mrs $ \ (Entity rsid _) -> + (rsid,) . isJust <$> + getBy (UniqueVerifKeySharedUsage vkid rsid) + return $ + case ments of + Nothing -> Just Nothing + Just (rsid, used) -> + if used + then Nothing + else Just $ Just rsid + runExceptT $ for_ mresult $ \ mrsid -> do + uInbox <- actorInbox <$> ExceptT (keyListedByActor manager uKey uActor) + ExceptT $ runDB $ case mrsid of + Nothing -> do + rsid <- insert $ RemoteSharer uActor iid uInbox + insert_ $ VerifKeySharedUsage vkid rsid + return $ Right () + Just rsid -> do + room <- actorRoom rsid + if room + then do + insert_ $ VerifKeySharedUsage vkid rsid + return $ Right () + else return $ Left "Actor already has at least 2 keys" + +data AddVerifKey = AddVerifKey + { addvkHost :: Text + , addvkKeyId :: FedURI + , addvkExpires :: Maybe UTCTime + , addvkKey :: PublicKey + , addvkActorId :: FedURI + , addvkActorInbox :: FedURI } -addPersonalKey :: AddPersonalKey -> AppDB (Maybe String) -addPersonalKey (AddPersonalKey avk uActor uInbox) = do - let AddVerifKey host uKey mexpires key = avk - (iid, rsid, new) <- do - mrs <- getBy $ UniqueRemoteSharer uActor - case mrs of - Nothing -> do - iid <- either entityKey id <$> insertBy (Instance host) - rsid <- insert $ RemoteSharer uActor iid uInbox - return (iid, rsid, True) - Just (Entity rsid rs) -> - return (remoteSharerInstance rs, rsid, False) +addSharedKey :: AddVerifKey -> AppDB (Maybe String) +addSharedKey (AddVerifKey host uKey mexpires key uActor uInbox) = do + (iid, rsid, inew) <- instanceAndActor host uActor uInbox room <- - if new - then pure True - else (< 2) <$> count [VerifKeySharer ==. Just rsid] + case inew of + Nothing -> pure True + Just rsnew -> do + iRoom <- instanceRoom iid + if iRoom + then if rsnew + then pure True + else actorRoom rsid + else return False + if room + then do + vkid <- insert $ VerifKey uKey iid mexpires key Nothing + insert_ $ VerifKeySharedUsage vkid rsid + return Nothing + else return $ Just "We already store 2 keys" + where + instanceRoom iid = + (< 2) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing] + +addPersonalKey :: AddVerifKey -> AppDB (Maybe String) +addPersonalKey (AddVerifKey host uKey mexpires key uActor uInbox) = do + (iid, rsid, inew) <- instanceAndActor host uActor uInbox + room <- + if inew == Just False + then actorRoom rsid + else pure True if room then do insert_ $ VerifKey uKey iid mexpires key (Just rsid) @@ -630,12 +691,12 @@ updateVerifKey (UpdateVerifKey vkid mexpires key) = do data VerifKeyUpdate = VKUAddSharedKey AddVerifKey - | VKUAddPersonalKey AddPersonalKey + | VKUAddPersonalKey AddVerifKey | VKUUpdateKey UpdateVerifKey updateVerifKeyInDB :: VerifKeyUpdate -> AppDB (Maybe String) updateVerifKeyInDB (VKUAddSharedKey avk) = addSharedKey avk -updateVerifKeyInDB (VKUAddPersonalKey apk) = addPersonalKey apk +updateVerifKeyInDB (VKUAddPersonalKey avk) = addPersonalKey avk updateVerifKeyInDB (VKUUpdateKey uvk) = updateVerifKey uvk data VerifKeyDetail = VerifKeyDetail @@ -652,10 +713,10 @@ makeVerifKeyUpdate :: VerifKeyDetail -> VerifKeyUpdate makeVerifKeyUpdate (VerifKeyDetail uKey iori key mexpires uActor host shared) = case iori of Left uInbox -> - let avk = AddVerifKey host uKey mexpires key + let avk = AddVerifKey host uKey mexpires key uActor uInbox in if shared then VKUAddSharedKey avk - else VKUAddPersonalKey $ AddPersonalKey avk uActor uInbox + else VKUAddPersonalKey avk Right vkid -> VKUUpdateKey $ UpdateVerifKey vkid mexpires key instance YesodHttpSig App where @@ -686,7 +747,11 @@ instance YesodHttpSig App where [] -> return Nothing [b] -> fmap Just . ExceptT . pure $ do t <- first displayException $ decodeUtf8' b - parseFedURI t + u <- parseFedURI t + if furiHost u == furiHost uKey + then Right () + else Left "Key and actor have different hosts" + Right u _ -> throwE "Multiple ActivityPub-Actor headers" vkd <- do ments <- lift $ runDB $ do @@ -709,9 +774,10 @@ instance YesodHttpSig App where ua <- case muActorHeader of Nothing -> throwE "Got a sig with an instance key, but actor header not specified!" Just u -> return u - _ <- do - manager <- getsYesod appHttpManager - ExceptT $ keyListedByActor manager uKey ua + manager <- getsYesod appHttpManager + let iid = verifKeyInstance vk + ExceptT $ + keyListedByActor' manager iid vkid uKey ua return (ua, True) return VerifKeyDetail { vkdKeyId = uKey