sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 22:54:50 +09:00
Code Issues Activity

When GETing the keyId, set Accept header to JSON-LD/AS2

Browse source
This commit is contained in:
fr33domlover 2019-01-19 02:57:58 +00:00
parent 93def0dfc8
commit 393cce0ede
1 changed files with 9 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -40,7 +40,7 @@ import Data.Time.Clock (UTCTime, getCurrentTime)
import Data.Time.Interval (TimeInterval, toTimeUnit)
import Data.Time.Units (Second)
import Network.HTTP.Client (Manager, HttpException, requestFromURI)
import Network.HTTP.Simple (httpJSONEither, getResponseBody, setRequestManager)
import Network.HTTP.Simple (httpJSONEither, getResponseBody, setRequestManager, addRequestHeader)
import Network.URI (URI (uriFragment), parseURI)
import Text.Blaze.Html (Html)
import UnliftIO.Exception (try)
@ -156,7 +156,14 @@ postInboxR = do
Nothing -> Left "keyId in Sig header isn't a valid absolute URI"
Just uri -> Right uri
manager <- getsYesod appHttpManager
response <- ExceptT $ first (displayException :: HttpException -> String) <$> (try $ httpJSONEither . setRequestManager manager =<< requestFromURI u)
response <-
ExceptT $ first (displayException :: HttpException -> String) <$>
(try $
httpJSONEither .
addRequestHeader "Accept" "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\"" .
setRequestManager manager
=<< requestFromURI u
)
liftE $ do
actor <- first displayException $ getResponseBody response
let uActor = u { uriFragment = "" }