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

59
src/Vervis/RemoteActorStore.hs
View file

@ -310,7 +310,7 @@ keyListedByActorShared
-> Text
-> LocalURI
-> LocalURI
-> ExceptT String (HandlerFor site) ()
-> ExceptT String (HandlerFor site) RemoteSharerId
keyListedByActorShared iid vkid host luKey luActor = do
manager <- getsYesod getHttpManager
reject <- getsYesod siteRejectOnMaxKeys
@ -319,10 +319,9 @@ keyListedByActorShared iid vkid host luKey luActor = do
RoomModeInstant -> do
when reject $ throwE "Actor key storage limit is 0 and set to reject"
luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
_ <- lift $ runDB $ insertUnique $ RemoteSharer luActor iid luInbox
return ()
lift $ runDB $ either entityKey id <$> insertBy (RemoteSharer luActor iid luInbox)
RoomModeCached m -> do
mresult <- do
eresult <- do
ments <- lift $ runDB $ do
mrs <- getBy $ UniqueRemoteSharer iid luActor
for mrs $ \ (Entity rsid _) ->
@ -330,30 +329,34 @@ keyListedByActorShared iid vkid host luKey luActor = do
getBy (UniqueVerifKeySharedUsage vkid rsid)
return $
case ments of
Nothing -> Just Nothing
Nothing -> Right Nothing
Just (rsid, used) ->
if used
then Nothing
else Just $ Just rsid
for_ mresult $ \ mrsid -> do
luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
ExceptT $ runDB $ do
vkExists <- isJust <$> get vkid
case mrsid of
Nothing -> do
rsid <- insert $ RemoteSharer luActor iid luInbox
when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid
return $ Right ()
Just rsid -> runExceptT $ when vkExists $ do
case m of
RoomModeNoLimit -> return ()
RoomModeLimit limit -> do
if reject
then do
room <- lift $ actorRoom limit rsid
unless room $ throwE "Actor key storage limit reached"
else lift $ makeActorRoomForUsage limit rsid
lift $ insert_ $ VerifKeySharedUsage vkid rsid
then Left rsid
else Right $ Just rsid
case eresult of
Left rsid -> return rsid
Right mrsid -> do
luInbox <- actorInbox <$> ExceptT (keyListedByActor manager host luKey luActor)
ExceptT $ runDB $ do
vkExists <- isJust <$> get vkid
case mrsid of
Nothing -> do
rsid <- insert $ RemoteSharer luActor iid luInbox
when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid
return $ Right rsid
Just rsid -> runExceptT $ do
when vkExists $ do
case m of
RoomModeNoLimit -> return ()
RoomModeLimit limit -> do
if reject
then do
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
{ vkdKeyId :: LocalURI
@ -372,7 +375,7 @@ addVerifKey
=> Text
-> LocalURI
-> VerifKeyDetail
-> ExceptT String (YesodDB site) ()
-> ExceptT String (YesodDB site) (InstanceId, RemoteSharerId)
addVerifKey h uinb vkd =
if vkdShared vkd
then addSharedKey h uinb vkd
@ -409,6 +412,7 @@ addVerifKey h uinb vkd =
unless room $ throwE "Actor key storage limit reached"
else when (inew == Just False) $ lift $ makeActorRoomForUsage limit rsid
lift $ insert_ $ VerifKeySharedUsage vkid rsid
return (iid, rsid)
where
instanceRoom n iid =
(< n) <$> count [VerifKeyInstance ==. iid, VerifKeySharer ==. Nothing]
@ -429,3 +433,4 @@ addVerifKey h uinb vkd =
unless room $ throwE "Actor key storage limit reached"
else when (inew == Just False) $ lift $ makeActorRoomForPersonalKey limit 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
=> Manager
-- ^ 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
-- ^ Signature algorithm possibly specified in the HTTP signature header
-> Text
@ -839,7 +836,7 @@ fetchKnownSharedKey
-> LocalURI
-- ^ Key URI
-> 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
pkey <-
case obj :: Either PublicKey Actor of
@ -848,7 +845,6 @@ fetchKnownSharedKey manager listed malgo host luActor luKey = do
case publicKeyOwner pkey of
OwnerInstance -> return ()
OwnerActor _owner -> throwE "Shared key became personal"
listed
let (material, mexpires) = keyDetail pkey
ExceptT . pure $ verifyAlgo malgo material
return (material, mexpires)