forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Record usage of instance keys in the DB

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

6
config/models
View file

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

6
migrations/2019_02_03_verifkey.model
View file

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

140
src/Vervis/Foundation.hs
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/i18n-messages-in-the-scaffolding
sumUpTo :: Int -> AppDB Int -> AppDB Int -> AppDB Bool
sumUpTo limit action1 action2 = do
n <- action1
if n <= limit
then do
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)
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
}
addSharedKey :: AddVerifKey -> AppDB (Maybe String)
addSharedKey (AddVerifKey host uKey mexpires key) = do
(iid, new) <- idAndNew <$> insertBy (Instance host)
addSharedKey (AddVerifKey host uKey mexpires key uActor uInbox) = do
(iid, rsid, inew) <- instanceAndActor host uActor uInbox
room <-
if new
case inew of
Nothing -> pure True
Just rsnew -> do
iRoom <- instanceRoom iid
if iRoom
then if rsnew
then pure True
else
(< 2) <$>
count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing]
else actorRoom rsid
else return False
if room
then do
insert_ $ VerifKey uKey iid mexpires key Nothing
vkid <- insert $ VerifKey uKey iid mexpires key Nothing
insert_ $ VerifKeySharedUsage vkid rsid
return Nothing
else return $ Just "We already store 2 keys"
where
idAndNew (Left (Entity iid _)) = (iid, False)
idAndNew (Right iid) = (iid, True)
instanceRoom iid =
(< 2) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing]
data AddPersonalKey = AddPersonalKey
{ addpkKey :: AddVerifKey
, addpkActorId :: FedURI
, addpkActorInbox :: 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)
addPersonalKey :: AddVerifKey -> AppDB (Maybe String)
addPersonalKey (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]
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
let iid = verifKeyInstance vk
ExceptT $
keyListedByActor' manager iid vkid uKey ua
return (ua, True)
return VerifKeyDetail
{ vkdKeyId = uKey