When GETing the keyId, set Accept header to JSON-LD/AS2
This commit is contained in:
parent
93def0dfc8
commit
393cce0ede
1 changed files with 9 additions and 2 deletions
|
@ -40,7 +40,7 @@ import Data.Time.Clock (UTCTime, getCurrentTime)
|
||||||
import Data.Time.Interval (TimeInterval, toTimeUnit)
|
import Data.Time.Interval (TimeInterval, toTimeUnit)
|
||||||
import Data.Time.Units (Second)
|
import Data.Time.Units (Second)
|
||||||
import Network.HTTP.Client (Manager, HttpException, requestFromURI)
|
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 Network.URI (URI (uriFragment), parseURI)
|
||||||
import Text.Blaze.Html (Html)
|
import Text.Blaze.Html (Html)
|
||||||
import UnliftIO.Exception (try)
|
import UnliftIO.Exception (try)
|
||||||
|
@ -156,7 +156,14 @@ postInboxR = do
|
||||||
Nothing -> Left "keyId in Sig header isn't a valid absolute URI"
|
Nothing -> Left "keyId in Sig header isn't a valid absolute URI"
|
||||||
Just uri -> Right uri
|
Just uri -> Right uri
|
||||||
manager <- getsYesod appHttpManager
|
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
|
liftE $ do
|
||||||
actor <- first displayException $ getResponseBody response
|
actor <- first displayException $ getResponseBody response
|
||||||
let uActor = u { uriFragment = "" }
|
let uActor = u { uriFragment = "" }
|
||||||
|
|
Loading…
Reference in a new issue