When verifying HTTPsig, return iid&rsid and remove duplicate shared usage check
* 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
parent
061c84349d
commit
72f96a0dff
4 changed files with 83 additions and 69 deletions
|
|
@ -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
|
||||
(iid, rsid) <-
|
||||
if valid1 && stillValid (vkdExpires vkd)
|
||||
then case inboxOrVkid of
|
||||
Left uinb -> ExceptT $ withHostLock host $ runDB $ runExceptT $ addVerifKey host uinb vkd
|
||||
Right _ids -> return ()
|
||||
Right (iid, _vkid, rsid) -> return (iid, rsid)
|
||||
else case inboxOrVkid of
|
||||
Left _uinb ->
|
||||
if stillValid $ vkdExpires vkd
|
||||
then errSig1
|
||||
else errTime
|
||||
Right (iid, vkid) -> do
|
||||
Right (iid, vkid, rsid) -> 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
|
||||
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 lift $ runDB $ updateVerifKey vkid vkd
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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,12 +329,14 @@ 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
|
||||
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
|
||||
|
|
@ -343,8 +344,9 @@ keyListedByActorShared iid vkid host luKey luActor = do
|
|||
Nothing -> do
|
||||
rsid <- insert $ RemoteSharer luActor iid luInbox
|
||||
when vkExists $ insert_ $ VerifKeySharedUsage vkid rsid
|
||||
return $ Right ()
|
||||
Just rsid -> runExceptT $ when vkExists $ do
|
||||
return $ Right rsid
|
||||
Just rsid -> runExceptT $ do
|
||||
when vkExists $ do
|
||||
case m of
|
||||
RoomModeNoLimit -> return ()
|
||||
RoomModeLimit limit -> do
|
||||
|
|
@ -354,6 +356,7 @@ keyListedByActorShared iid vkid host luKey luActor = do
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue