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.
This commit is contained in:
fr33domlover 2019-02-19 10:54:55 +00:00
parent 312ccf6979
commit 4053f2f2b4
3 changed files with 125 additions and 47 deletions

View file

@ -48,6 +48,12 @@ VerifKey
UniqueVerifKey ident UniqueVerifKey ident
VerifKeySharedUsage
key VerifKeyId
user RemoteSharerId
UniqueVerifKeySharedUsage key user
RemoteSharer RemoteSharer
ident FedURI ident FedURI
instance InstanceId instance InstanceId

View file

@ -7,6 +7,12 @@ VerifKey
UniqueVerifKey ident UniqueVerifKey ident
VerifKeySharedUsage
key VerifKeyId
user RemoteSharerId
UniqueVerifKeySharedUsage key user
RemoteSharer RemoteSharer
ident Text ident Text
instance InstanceId instance InstanceId

View file

@ -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/Serve-static-files-from-a-separate-domain
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding -- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding
data AddVerifKey = AddVerifKey sumUpTo :: Int -> AppDB Int -> AppDB Int -> AppDB Bool
{ addvkHost :: Text sumUpTo limit action1 action2 = do
, addvkKeyId :: FedURI n <- action1
, addvkExpires :: Maybe UTCTime if n <= limit
, 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
then do then do
insert_ $ VerifKey uKey iid mexpires key Nothing m <- action2
return Nothing return $ n + m <= limit
else return $ Just "We already store 2 keys" 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 where
idAndNew (Left (Entity iid _)) = (iid, False) idAndNew (Left (Entity iid _)) = (iid, False)
idAndNew (Right iid) = (iid, True) idAndNew (Right iid) = (iid, True)
data AddPersonalKey = AddPersonalKey actorRoom :: RemoteSharerId -> AppDB Bool
{ addpkKey :: AddVerifKey actorRoom rsid =
, addpkActorId :: FedURI sumUpTo 2
, addpkActorInbox :: FedURI (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) addSharedKey :: AddVerifKey -> AppDB (Maybe String)
addPersonalKey (AddPersonalKey avk uActor uInbox) = do addSharedKey (AddVerifKey host uKey mexpires key uActor uInbox) = do
let AddVerifKey host uKey mexpires key = avk (iid, rsid, inew) <- instanceAndActor host uActor uInbox
(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)
room <- room <-
if new case inew of
then pure True Nothing -> pure True
else (< 2) <$> count [VerifKeySharer ==. Just rsid] 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 if room
then do then do
insert_ $ VerifKey uKey iid mexpires key (Just rsid) insert_ $ VerifKey uKey iid mexpires key (Just rsid)
@ -630,12 +691,12 @@ updateVerifKey (UpdateVerifKey vkid mexpires key) = do
data VerifKeyUpdate data VerifKeyUpdate
= VKUAddSharedKey AddVerifKey = VKUAddSharedKey AddVerifKey
| VKUAddPersonalKey AddPersonalKey | VKUAddPersonalKey AddVerifKey
| VKUUpdateKey UpdateVerifKey | VKUUpdateKey UpdateVerifKey
updateVerifKeyInDB :: VerifKeyUpdate -> AppDB (Maybe String) updateVerifKeyInDB :: VerifKeyUpdate -> AppDB (Maybe String)
updateVerifKeyInDB (VKUAddSharedKey avk) = addSharedKey avk updateVerifKeyInDB (VKUAddSharedKey avk) = addSharedKey avk
updateVerifKeyInDB (VKUAddPersonalKey apk) = addPersonalKey apk updateVerifKeyInDB (VKUAddPersonalKey avk) = addPersonalKey avk
updateVerifKeyInDB (VKUUpdateKey uvk) = updateVerifKey uvk updateVerifKeyInDB (VKUUpdateKey uvk) = updateVerifKey uvk
data VerifKeyDetail = VerifKeyDetail data VerifKeyDetail = VerifKeyDetail
@ -652,10 +713,10 @@ makeVerifKeyUpdate :: VerifKeyDetail -> VerifKeyUpdate
makeVerifKeyUpdate (VerifKeyDetail uKey iori key mexpires uActor host shared) = makeVerifKeyUpdate (VerifKeyDetail uKey iori key mexpires uActor host shared) =
case iori of case iori of
Left uInbox -> Left uInbox ->
let avk = AddVerifKey host uKey mexpires key let avk = AddVerifKey host uKey mexpires key uActor uInbox
in if shared in if shared
then VKUAddSharedKey avk then VKUAddSharedKey avk
else VKUAddPersonalKey $ AddPersonalKey avk uActor uInbox else VKUAddPersonalKey avk
Right vkid -> VKUUpdateKey $ UpdateVerifKey vkid mexpires key Right vkid -> VKUUpdateKey $ UpdateVerifKey vkid mexpires key
instance YesodHttpSig App where instance YesodHttpSig App where
@ -686,7 +747,11 @@ instance YesodHttpSig App where
[] -> return Nothing [] -> return Nothing
[b] -> fmap Just . ExceptT . pure $ do [b] -> fmap Just . ExceptT . pure $ do
t <- first displayException $ decodeUtf8' b 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" _ -> throwE "Multiple ActivityPub-Actor headers"
vkd <- do vkd <- do
ments <- lift $ runDB $ do ments <- lift $ runDB $ do
@ -709,9 +774,10 @@ instance YesodHttpSig App where
ua <- case muActorHeader of ua <- case muActorHeader of
Nothing -> throwE "Got a sig with an instance key, but actor header not specified!" Nothing -> throwE "Got a sig with an instance key, but actor header not specified!"
Just u -> return u Just u -> return u
_ <- do manager <- getsYesod appHttpManager
manager <- getsYesod appHttpManager let iid = verifKeyInstance vk
ExceptT $ keyListedByActor manager uKey ua ExceptT $
keyListedByActor' manager iid vkid uKey ua
return (ua, True) return (ua, True)
return VerifKeyDetail return VerifKeyDetail
{ vkdKeyId = uKey { vkdKeyId = uKey