@@ -72,6 +72,7 @@ data XhrRequestConfig
7272 , _xhrRequestConfig_password :: Maybe String
7373 , _xhrRequestConfig_responseType :: Maybe XhrResponseType
7474 , _xhrRequestConfig_sendData :: Maybe String
75+ , _xhrRequestConfig_withCredentials :: Bool
7576 }
7677 deriving (Show, Read, Eq, Ord, Typeable)
7778
@@ -97,6 +98,7 @@ instance Default XhrRequestConfig where
9798 , _xhrRequestConfig_password = Nothing
9899 , _xhrRequestConfig_responseType = Nothing
99100 , _xhrRequestConfig_sendData = Nothing
101+ , _xhrRequestConfig_withCredentials = False
100102 }
101103
102104-- | Construct a request object from method, URL, and config record.
@@ -123,6 +125,7 @@ newXMLHttpRequestWithError req cb = do
123125 void $ liftIO $ forkIO $ flip catch (postGui . cb . Left) $ void $ do
124126 let c = _xhrRequest_config req
125127 rt = _xhrRequestConfig_responseType c
128+ creds = _xhrRequestConfig_withCredentials c
126129 xmlHttpRequestOpen
127130 xhr
128131 (_xhrRequest_method req)
@@ -132,6 +135,7 @@ newXMLHttpRequestWithError req cb = do
132135 (fromMaybe "" $ _xhrRequestConfig_password c)
133136 iforM_ (_xhrRequestConfig_headers c) $ xmlHttpRequestSetRequestHeader xhr
134137 maybe (return ()) (xmlHttpRequestSetResponseType xhr . fromResponseType) rt
138+ xmlHttpRequestSetWithCredentials xhr creds
135139 _ <- xmlHttpRequestOnreadystatechange xhr $ do
136140 readyState <- liftIO $ xmlHttpRequestGetReadyState xhr
137141 status <- liftIO $ xmlHttpRequestGetStatus xhr