git.iko.soy/typeable/servant
on master help sign in
servant-client-ghcjs: Fixed Accept and Content-Type headers not being set
commit74bde0a73d1ea6a00e606c3a852f4f553336083a authorFalco Peijnenburg <falco@lumiguide.nl> dateWed 4 Oct 2017, 23:54 (9 years ago) parent7b38e77
2 files changed+20−5
compare with master
unifiedsplit
servant-client-ghcjs/servant-client-ghcjs.cabal+1−1 servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+19−4
servant-client-ghcjs/servant-client-ghcjs.cabal+1−1
@@ -38,6 +38,7 @@ library
3838 , exceptions >= 0.8 && < 0.9
3939 , ghcjs-base >= 0.2.0.0 && < 0.3.0.0
4040 , ghcjs-prim >= 0.1.0.0 && < 0.2.0.0
41+ , http-media >= 0.6.2 && < 0.8
4142 , http-types >= 0.8.6 && < 0.10
4243 , monad-control >= 1.0.0.4 && < 1.1
4344 , mtl >= 2.1 && < 2.3
@@ -51,4 +52,3 @@ library
5152 ghc-options: -Wall
5253 if impl(ghc >= 8.0)
5354 ghc-options: -Wno-redundant-constraints
54− include-dirs: include
servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+19−4
@@ -38,6 +38,7 @@ import GHC.Generics
3838import GHCJS.Foreign.Callback
3939import GHCJS.Prim
4040import Network.HTTP.Types
41+import Network.HTTP.Media (renderHeader)
4142import Servant.Client.Core
4243
4344newtype JSXMLHttpRequest = JSXMLHttpRequest JSVal
@@ -117,7 +118,7 @@ performXhr xhr burl request = do
117118 s <- newStablePtr t
118119
119120 openXhr xhr (cs $ requestMethod request) (toUrl burl request) True
120− setHeaders xhr $ toList $ requestHeaders request
121+ setHeaders xhr request
121122 sendXhr xhr (toBody request)
122123 takeMVar waiter
123124
@@ -161,9 +162,23 @@ toUrl burl request =
161162 requestQueryString request
162163 in showBaseUrl burl ++ pathS ++ queryS
163164
164−setHeaders :: JSXMLHttpRequest -> RequestHeaders -> IO ()
165−setHeaders xhr headers = forM_ headers $ \ (key, value) ->
166− js_setRequestHeader xhr (toJSString $ cs $ original key) (toJSString $ cs value)
165+setHeaders :: JSXMLHttpRequest -> Request -> IO ()
166+setHeaders xhr request = do
167+ forM_ (toList $ requestAccept request) $ \mediaType ->
168+ js_setRequestHeader
169+ xhr
170+ (toJSString "Accept")
171+ (toJSString $ cs $ renderHeader mediaType)
172+
173+ forM_ (requestBody request) $ \(_, mediaType) ->
174+ js_setRequestHeader
175+ xhr
176+ (toJSString "Content-Type")
177+ (toJSString $ cs $ renderHeader mediaType)
178+
179+ forM_ (toList $ requestHeaders request) $ \(key, value) ->
180+ js_setRequestHeader xhr (toJSString $ cs $ original key) (toJSString $ cs value)
181+
167182foreign import javascript unsafe "$1.setRequestHeader($2, $3)"
168183 js_setRequestHeader :: JSXMLHttpRequest -> JSVal -> JSVal -> IO ()
169184