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:
parent
312ccf6979
commit
4053f2f2b4
3 changed files with 125 additions and 47 deletions
|
@ -48,6 +48,12 @@ VerifKey
|
|||
|
||||
UniqueVerifKey ident
|
||||
|
||||
VerifKeySharedUsage
|
||||
key VerifKeyId
|
||||
user RemoteSharerId
|
||||
|
||||
UniqueVerifKeySharedUsage key user
|
||||
|
||||
RemoteSharer
|
||||
ident FedURI
|
||||
instance InstanceId
|
||||
|
|
|
@ -7,6 +7,12 @@ VerifKey
|
|||
|
||||
UniqueVerifKey ident
|
||||
|
||||
VerifKeySharedUsage
|
||||
key VerifKeyId
|
||||
user RemoteSharerId
|
||||
|
||||
UniqueVerifKeySharedUsage key user
|
||||
|
||||
RemoteSharer
|
||||
ident Text
|
||||
instance InstanceId
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue