Return keyid and digest after inbox verification, for use in forwarding
This commit is contained in:
parent
f346da9106
commit
811217fd17
2 changed files with 22 additions and 13 deletions
|
@ -24,7 +24,7 @@ import Control.Monad.STM (atomically)
|
|||
import Control.Monad.Trans.Except
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Crypto.Error (CryptoFailable (..))
|
||||
import Crypto.Hash.Algorithms
|
||||
import Crypto.Hash
|
||||
import Data.Char
|
||||
import Data.Either (isRight)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
|
@ -663,8 +663,17 @@ data ActorDetail = ActorDetail
|
|||
, actorDetailSharer :: RemoteActorId
|
||||
}
|
||||
|
||||
data ActivityDetail = ActivityDetail
|
||||
{ _actdAuthorURI :: FedURI
|
||||
, _actdInstance :: InstanceId
|
||||
, _actdAuthorId :: RemoteActorId
|
||||
, _actdRawBody :: BL.ByteString
|
||||
, _actdSignKey :: KeyId
|
||||
, _actdDigest :: Digest SHA256
|
||||
}
|
||||
|
||||
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]
|
||||
httpSigVerWantedHeaders = const [hActivityPubActor]
|
||||
httpSigVerSeconds =
|
||||
|
@ -675,7 +684,7 @@ instance YesodHttpSig App where
|
|||
httpVerifySig (Verification malgo (KeyId keyid) input (Signature signature)) = fmap HttpSigVerResult $ runExceptT $ do
|
||||
(host, luKey) <- f2l <$> parseKeyId keyid
|
||||
checkHost host
|
||||
body <- verifyBodyDigest
|
||||
(body, digest) <- verifyBodyDigest
|
||||
mluActorHeader <- getActorHeader host
|
||||
manager <- getsYesod appHttpManager
|
||||
(inboxOrVkid, vkd) <- do
|
||||
|
@ -754,14 +763,14 @@ instance YesodHttpSig App where
|
|||
return (iid, rsid)
|
||||
else errSig2
|
||||
|
||||
return
|
||||
( ActorDetail
|
||||
{ actorDetailId = l2f host $ vkdActorId vkd
|
||||
, actorDetailInstance = iid
|
||||
, actorDetailSharer = rsid
|
||||
return ActivityDetail
|
||||
{ _actdAuthorURI = l2f host $ vkdActorId vkd
|
||||
, _actdInstance = iid
|
||||
, _actdAuthorId = rsid
|
||||
, _actdRawBody = body
|
||||
, _actdSignKey = KeyId keyid
|
||||
, _actdDigest = digest
|
||||
}
|
||||
, body
|
||||
)
|
||||
where
|
||||
parseKeyId k =
|
||||
case parseFedURI =<< (first displayException . decodeUtf8') k of
|
||||
|
@ -786,7 +795,7 @@ instance YesodHttpSig App where
|
|||
(digest', body) <- liftIO $ hashHttpBody SHA256 (requestBody req)
|
||||
unless (digest == digest') $
|
||||
throwE "Body digest verification failed"
|
||||
return body
|
||||
return (body, digest)
|
||||
getActorHeader host = do
|
||||
bs <- lookupHeaders hActivityPubActor
|
||||
case bs of
|
||||
|
|
|
@ -152,7 +152,7 @@ postSharerInboxR shrRecip = do
|
|||
ExceptT $
|
||||
first (T.pack . displayException) <$>
|
||||
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) <-
|
||||
case eitherDecode' body of
|
||||
Left s -> throwE $ "Parsing activity failed: " <> T.pack s
|
||||
|
|
Loading…
Reference in a new issue