From 393cce0ede1e5fda3ac240095afb60ced73ec764 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Sat, 19 Jan 2019 02:57:58 +0000
Subject: [PATCH] When GETing the keyId, set Accept header to JSON-LD/AS2

---
 src/Vervis/Handler/Inbox.hs | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs
index f627327..fe97ec1 100644
--- a/src/Vervis/Handler/Inbox.hs
+++ b/src/Vervis/Handler/Inbox.hs
@@ -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 = "" }