@@ -50,6 +50,9 @@ import Data.Map (Map)
50import qualified Data.Map as Map
50import qualified Data.Map as Map
51import Data.Maybe
51import Data.Maybe
52import Data.Text (Text)
52import Data.Text (Text)
53+import qualified Data.Text as T
54+import GHCJS.DOM.XMLHttpRequest (getAllResponseHeaders)
53import Data.Text.Encoding
56import Data.Text.Encoding
54import Data.Traversable
57import Data.Traversable
55import Reflex
58import Reflex
@@ -81,6 +84,7 @@ data XhrResponse
81 , _xhrResponse_statusText :: Text
84 , _xhrResponse_statusText :: Text
82 , _xhrResponse_response :: Maybe XhrResponseBody
85 , _xhrResponse_response :: Maybe XhrResponseBody
83 , _xhrResponse_responseText :: Maybe Text
86 , _xhrResponse_responseText :: Maybe Text
87+ , _xhrResponse_headers :: Map Text Text
85 deriving (Typeable)
89 deriving (Typeable)
@@ -146,11 +150,19 @@ newXMLHttpRequestWithError req cb = do
146 then liftIO $ xmlHttpRequestGetResponseText xhr
150 then liftIO $ xmlHttpRequestGetResponseText xhr
147 else return Nothing
151 else return Nothing
148 r <- liftIO $ xmlHttpRequestGetResponse xhr
152 r <- liftIO $ xmlHttpRequestGetResponse xhr
153+ hdrsTxt <- liftIO $ xmlHttpRequestGetAllResponseHeaders xhr
154+ let stripBoth (txt1, txt2) = (T.strip txt1, T.strip $ T.drop 1 txt2)
155+ -- XMLHttpRequest return all the response headers separated by CRLF
156+ let hdrs = Map.fromList
157+ $ fmap (stripBoth . (T.span (/=':')))
158+ $ dropWhileEnd T.null
159+ $ T.splitOn (T.pack "\r\n") hdrsTxt
149 _ <- liftIO $ postGui $ cb $ Right $
160 _ <- liftIO $ postGui $ cb $ Right $
150 XhrResponse { _xhrResponse_status = status
161 XhrResponse { _xhrResponse_status = status
151 , _xhrResponse_statusText = statusText
162 , _xhrResponse_statusText = statusText
152 , _xhrResponse_response = r
163 , _xhrResponse_response = r
153 , _xhrResponse_responseText = t
164 , _xhrResponse_responseText = t
165+ , _xhrResponse_headers = hdrs
155 return ()
167 return ()
156 else return ()
168 else return ()