forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Return keyid and digest after inbox verification, for use in forwarding

Browse source
This commit is contained in:
fr33domlover 2019-04-26 04:15:07 +00:00
parent f346da9106
commit 811217fd17
2 changed files with 22 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
src/Vervis/Foundation.hs
View file

@ -24,7 +24,7 @@ import Control.Monad.STM (atomically)
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Crypto.Error (CryptoFailable (..)) import Crypto.Error (CryptoFailable (..))
import Crypto.Hash.Algorithms import Crypto.Hash
import Data.Char import Data.Char
import Data.Either (isRight) import Data.Either (isRight)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
@ -663,8 +663,17 @@ data ActorDetail = ActorDetail
, actorDetailSharer :: RemoteActorId , actorDetailSharer :: RemoteActorId
} }
data ActivityDetail = ActivityDetail
{ _actdAuthorURI :: FedURI
, _actdInstance :: InstanceId
, _actdAuthorId :: RemoteActorId
, _actdRawBody :: BL.ByteString
, _actdSignKey :: KeyId
, _actdDigest :: Digest SHA256
}
instance YesodHttpSig App where instance YesodHttpSig App where
data HttpSigVerResult App = HttpSigVerResult (Either String (ActorDetail, BL.ByteString)) data HttpSigVerResult App = HttpSigVerResult (Either String ActivityDetail)
httpSigVerRequiredHeaders = const [hRequestTarget, hHost, hDigest] httpSigVerRequiredHeaders = const [hRequestTarget, hHost, hDigest]
httpSigVerWantedHeaders = const [hActivityPubActor] httpSigVerWantedHeaders = const [hActivityPubActor]
httpSigVerSeconds = httpSigVerSeconds =
@ -675,7 +684,7 @@ instance YesodHttpSig App where
httpVerifySig (Verification malgo (KeyId keyid) input (Signature signature)) = fmap HttpSigVerResult $ runExceptT $ do httpVerifySig (Verification malgo (KeyId keyid) input (Signature signature)) = fmap HttpSigVerResult $ runExceptT $ do
(host, luKey) <- f2l <$> parseKeyId keyid (host, luKey) <- f2l <$> parseKeyId keyid
checkHost host checkHost host
body <- verifyBodyDigest (body, digest) <- verifyBodyDigest
mluActorHeader <- getActorHeader host mluActorHeader <- getActorHeader host
manager <- getsYesod appHttpManager manager <- getsYesod appHttpManager
(inboxOrVkid, vkd) <- do (inboxOrVkid, vkd) <- do
@ -754,14 +763,14 @@ instance YesodHttpSig App where
return (iid, rsid) return (iid, rsid)
else errSig2 else errSig2
return return ActivityDetail
( ActorDetail { _actdAuthorURI = l2f host $ vkdActorId vkd
{ actorDetailId = l2f host $ vkdActorId vkd , _actdInstance = iid
, actorDetailInstance = iid , _actdAuthorId = rsid
, actorDetailSharer = rsid , _actdRawBody = body
} , _actdSignKey = KeyId keyid
, body , _actdDigest = digest
) }
where where
parseKeyId k = parseKeyId k =
case parseFedURI =<< (first displayException . decodeUtf8') k of case parseFedURI =<< (first displayException . decodeUtf8') k of
@ -786,7 +795,7 @@ instance YesodHttpSig App where
(digest', body) <- liftIO $ hashHttpBody SHA256 (requestBody req) (digest', body) <- liftIO $ hashHttpBody SHA256 (requestBody req)
unless (digest == digest') $ unless (digest == digest') $
throwE "Body digest verification failed" throwE "Body digest verification failed"
return body return (body, digest)
getActorHeader host = do getActorHeader host = do
bs <- lookupHeaders hActivityPubActor bs <- lookupHeaders hActivityPubActor
case bs of case bs of

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

@ -152,7 +152,7 @@ postSharerInboxR shrRecip = do
ExceptT $ ExceptT $
first (T.pack . displayException) <$> first (T.pack . displayException) <$>
verifyRequestSignature now verifyRequestSignature now
(ActorDetail uSender iid _raid, body) <- ExceptT $ pure $ first T.pack result ActivityDetail uSender iid _raid body _keyid _digest <- ExceptT $ pure $ first T.pack result
WithValue raw (Doc hActivity activity) <- WithValue raw (Doc hActivity activity) <-
case eitherDecode' body of case eitherDecode' body of
Left s -> throwE $ "Parsing activity failed: " <> T.pack s Left s -> throwE $ "Parsing activity failed: " <> T.pack s