forge/Vervis
1
0
Fork 0
Code Pull requests Activity

When verifying HTTPsig, return iid&rsid and remove duplicate shared usage check

Browse source 
* 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.
This commit is contained in:
fr33domlover 2019-03-21 21:38:59 +00:00
parent 061c84349d
commit 72f96a0dff
4 changed files with 83 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
src/Vervis/Foundation.hs
View file

@ -611,8 +611,14 @@ instance YesodRemoteActorStore App where
siteActorRoomMode = appMaxActorKeys . appSettings siteActorRoomMode = appMaxActorKeys . appSettings
siteRejectOnMaxKeys = appRejectOnMaxKeys . appSettings siteRejectOnMaxKeys = appRejectOnMaxKeys . appSettings
data ActorDetail = ActorDetail
{ actorDetailId :: FedURI
, actorDetailInstance :: InstanceId
, actorDetailSharer :: RemoteSharerId
}
instance YesodHttpSig App where instance YesodHttpSig App where
data HttpSigVerResult App = HttpSigVerResult (Either String FedURI) data HttpSigVerResult App = HttpSigVerResult (Either String ActorDetail)
httpSigVerRequiredHeaders = const [hRequestTarget, hHost] httpSigVerRequiredHeaders = const [hRequestTarget, hHost]
httpSigVerWantedHeaders = const [hActivityPubActor] httpSigVerWantedHeaders = const [hActivityPubActor]
httpSigVerSeconds = httpSigVerSeconds =
@ -631,28 +637,29 @@ instance YesodHttpSig App where
Entity iid _ <- MaybeT $ getBy $ UniqueInstance host Entity iid _ <- MaybeT $ getBy $ UniqueInstance host
MaybeT $ getBy $ UniqueVerifKey iid luKey MaybeT $ getBy $ UniqueVerifKey iid luKey
for mvk $ \ vk@(Entity _ verifkey) -> do for mvk $ \ vk@(Entity _ verifkey) -> do
mremote <- traverse getJust $ verifKeySharer verifkey mremote <- for (verifKeySharer verifkey) $ \ rsid ->
(rsid,) <$> getJust rsid
return (vk, mremote) return (vk, mremote)
case ments of case ments of
Just (Entity vkid vk, mremote) -> do Just (Entity vkid vk, mremote) -> do
(ua, s) <- (ua, s, rsid) <-
case mremote of case mremote of
Just remote -> do Just (rsid, rs) -> do
let sharer = remoteSharerIdent remote let sharer = remoteSharerIdent rs
for_ mluActorHeader $ \ u -> for_ mluActorHeader $ \ u ->
if sharer == u if sharer == u
then return () then return ()
else throwE "Key's owner doesn't match actor header" else throwE "Key's owner doesn't match actor header"
return (sharer, False) return (sharer, False, rsid)
Nothing -> do Nothing -> do
ua <- case mluActorHeader of ua <- case mluActorHeader 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
let iid = verifKeyInstance vk let iid = verifKeyInstance vk
withHostLock' host $ keyListedByActorShared iid vkid host luKey ua rsid <- withHostLock' host $ keyListedByActorShared iid vkid host luKey ua
return (ua, True) return (ua, True, rsid)
return return
( Right (verifKeyInstance vk, vkid) ( Right (verifKeyInstance vk, vkid, rsid)
, VerifKeyDetail , VerifKeyDetail
{ vkdKeyId = luKey { vkdKeyId = luKey
, vkdKey = verifKeyPublic vk , vkdKey = verifKeyPublic vk
@ -671,34 +678,40 @@ instance YesodHttpSig App where
stillValid (Just expires) = expires > now stillValid (Just expires) = expires > now
valid1 <- verify $ vkdKey vkd valid1 <- verify $ vkdKey vkd
if valid1 && stillValid (vkdExpires vkd) (iid, rsid) <-
then case inboxOrVkid of if valid1 && stillValid (vkdExpires vkd)
Left uinb -> ExceptT $ withHostLock host $ runDB $ runExceptT $ addVerifKey host uinb vkd then case inboxOrVkid of
Right _ids -> return () Left uinb -> ExceptT $ withHostLock host $ runDB $ runExceptT $ addVerifKey host uinb vkd
else case inboxOrVkid of Right (iid, _vkid, rsid) -> return (iid, rsid)
Left _uinb -> else case inboxOrVkid of
if stillValid $ vkdExpires vkd Left _uinb ->
then errSig1 if stillValid $ vkdExpires vkd
else errTime then errSig1
Right (iid, vkid) -> do else errTime
let ua = vkdActorId vkd Right (iid, vkid, rsid) -> do
listed = withHostLock' host $ keyListedByActorShared iid vkid host luKey ua let ua = vkdActorId vkd
(newKey, newExp) <- (newKey, newExp) <-
if vkdShared vkd if vkdShared vkd
then fetchKnownSharedKey manager listed malgo host ua luKey then fetchKnownSharedKey manager malgo host ua luKey
else fetchKnownPersonalKey manager malgo host ua luKey else fetchKnownPersonalKey manager malgo host ua luKey
if stillValid newExp if stillValid newExp
then return () then return ()
else errTime else errTime
valid2 <- verify newKey valid2 <- verify newKey
if valid2 if valid2
then lift $ runDB $ updateVerifKey vkid vkd then do
{ vkdKey = newKey lift $ runDB $ updateVerifKey vkid vkd
, vkdExpires = newExp { vkdKey = newKey
} , vkdExpires = newExp
else errSig2 }
return (iid, rsid)
else errSig2
return $ l2f host $ vkdActorId vkd return ActorDetail
{ actorDetailId = l2f host $ vkdActorId vkd
, actorDetailInstance = iid
, actorDetailSharer = rsid
}
where where
parseKeyId k = parseKeyId k =
case parseFedURI =<< (first displayException . decodeUtf8') k of case parseFedURI =<< (first displayException . decodeUtf8') k of

2
src/Vervis/Handler/Inbox.hs
View file

@ -142,7 +142,7 @@ postInboxR = do
_ -> Left "Unknown Content-Type" _ -> Left "Unknown Content-Type"
_ -> Left "More than one Content-Type given" _ -> Left "More than one Content-Type given"
HttpSigVerResult result <- ExceptT . fmap (first displayException) $ verifyRequestSignature now HttpSigVerResult result <- ExceptT . fmap (first displayException) $ verifyRequestSignature now
(h, luActor) <- f2l <$> liftE result (h, luActor) <- f2l . actorDetailId <$> liftE result
d@(Doc h' a) <- requireJsonBody d@(Doc h' a) <- requireJsonBody
unless (h == h') $ unless (h == h') $
throwE "Activity host doesn't match signature key host" throwE "Activity host doesn't match signature key host"

59
src/Vervis/RemoteActorStore.hs
View file

@ -310,7 +310,7 @@ keyListedByActorShared
-> Text -> Text
-> LocalURI -> LocalURI
-> LocalURI -> LocalURI
-> ExceptT String (HandlerFor site) () -> ExceptT String (HandlerFor site) RemoteSharerId
keyListedByActorShared iid vkid host luKey luActor = do keyListedByActorShared iid vkid host luKey luActor = do
manager <- getsYesod getHttpManager manager <- getsYesod getHttpManager
reject <- getsYesod siteRejectOnMaxKeys reject <- getsYesod siteRejectOnMaxKeys
@ -319,10 +319,9 @@ keyListedByActorShared iid vkid host luKey luActor = do
RoomModeInstant -> do RoomModeInstant -> do
when reject $ throwE "Actor key storage limit is 0 and set to reject" when reject $ throwE "Actor key storage limit is 0 and set to reject"
luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor) luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
_ <- lift $ runDB $ insertUnique $ RemoteSharer luActor iid luInbox lift $ runDB $ either entityKey id <$> insertBy (RemoteSharer luActor iid luInbox)
return ()
RoomModeCached m -> do RoomModeCached m -> do
mresult <- do eresult <- do
ments <- lift $ runDB $ do ments <- lift $ runDB $ do
mrs <- getBy $ UniqueRemoteSharer iid luActor mrs <- getBy $ UniqueRemoteSharer iid luActor
for mrs $ \ (Entity rsid _) -> for mrs $ \ (Entity rsid _) ->
@ -330,30 +329,34 @@ keyListedByActorShared iid vkid host luKey luActor = do
getBy (UniqueVerifKeySharedUsage vkid rsid) getBy (UniqueVerifKeySharedUsage vkid rsid)
return $ return $
case ments of case ments of
Nothing -> Just Nothing Nothing -> Right Nothing
Just (rsid, used) -> Just (rsid, used) ->
if used if used
then Nothing then Left rsid
else Just $ Just rsid else Right $ Just rsid
for_ mresult $ \ mrsid -> do case eresult of
luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor) Left rsid -> return rsid
ExceptT $ runDB $ do Right mrsid -> do
vkExists <- isJust <$> get vkid luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
case mrsid of ExceptT $ runDB $ do
Nothing -> do vkExists <- isJust <$> get vkid
rsid <- insert $ RemoteSharer luActor iid luInbox case mrsid of
when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid Nothing -> do
return $ Right () rsid <- insert $ RemoteSharer luActor iid luInbox
Just rsid -> runExceptT $ when vkExists $ do when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid
case m of return $ Right rsid
RoomModeNoLimit -> return () Just rsid -> runExceptT $ do
RoomModeLimit limit -> do when vkExists $ do
if reject case m of
then do RoomModeNoLimit -> return ()
room <- lift $ actorRoom limit rsid RoomModeLimit limit -> do
unless room $ throwE "Actor key storage limit reached" if reject
else lift $ makeActorRoomForUsage limit rsid then do
lift $ insert_ $ VerifKeySharedUsage vkid rsid 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 data VerifKeyDetail = VerifKeyDetail
{ vkdKeyId :: LocalURI { vkdKeyId :: LocalURI
@ -372,7 +375,7 @@ addVerifKey
=> Text => Text
-> LocalURI -> LocalURI
-> VerifKeyDetail -> VerifKeyDetail
-> ExceptT String (YesodDB site) () -> ExceptT String (YesodDB site) (InstanceId, RemoteSharerId)
addVerifKey h uinb vkd = addVerifKey h uinb vkd =
if vkdShared vkd if vkdShared vkd
then addSharedKey h uinb vkd then addSharedKey h uinb vkd
@ -409,6 +412,7 @@ addVerifKey h uinb vkd =
unless room $ throwE "Actor key storage limit reached" unless room $ throwE "Actor key storage limit reached"
else when (inew == Just False) $ lift $ makeActorRoomForUsage limit rsid else when (inew == Just False) $ lift $ makeActorRoomForUsage limit rsid
lift $ insert_ $ VerifKeySharedUsage vkid rsid lift $ insert_ $ VerifKeySharedUsage vkid rsid
return (iid, rsid)
where where
instanceRoom n iid = instanceRoom n iid =
(< n) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing] (< n) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing]
@ -429,3 +433,4 @@ addVerifKey h uinb vkd =
unless room $ throwE "Actor key storage limit reached" unless room $ throwE "Actor key storage limit reached"
else when (inew == Just False) $ lift $ makeActorRoomForPersonalKey limit rsid else when (inew == Just False) $ lift $ makeActorRoomForPersonalKey limit rsid
lift $ insert_ $ VerifKey luKey iid mexpires key (Just rsid) lift $ insert_ $ VerifKey luKey iid mexpires key (Just rsid)
return (iid, rsid)

6
src/Web/ActivityPub.hs
View file

@ -827,9 +827,6 @@ fetchKnownSharedKey
:: MonadIO m :: MonadIO m
=> Manager => Manager
-- ^ Manager for making HTTP requests -- ^ 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 -> Maybe S.Algorithm
-- ^ Signature algorithm possibly specified in the HTTP signature header -- ^ Signature algorithm possibly specified in the HTTP signature header
-> Text -> Text
@ -839,7 +836,7 @@ fetchKnownSharedKey
-> LocalURI -> LocalURI
-- ^ Key URI -- ^ Key URI
-> ExceptT String m (PublicVerifKey, Maybe UTCTime) -> 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 obj <- fetchAPIDOrH manager publicKeyId host luKey
pkey <- pkey <-
case obj :: Either PublicKey Actor of case obj :: Either PublicKey Actor of
@ -848,7 +845,6 @@ fetchKnownSharedKey manager listed malgo host luActor luKey = do
case publicKeyOwner pkey of case publicKeyOwner pkey of
OwnerInstance -> return () OwnerInstance -> return ()
OwnerActor _owner -> throwE "Shared key became personal" OwnerActor _owner -> throwE "Shared key became personal"
listed
let (material, mexpires) = keyDetail pkey let (material, mexpires) = keyDetail pkey
ExceptT . pure $ verifyAlgo malgo material ExceptT . pure $ verifyAlgo malgo material
return (material, mexpires) return (material, mexpires)