c647f8f · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Merge pull request #57 from kadoban/with-creds

c647f8fRyan Trinkle11 years ago

src/Reflex/Dom/Xhr.hs+4

compare with develop

unifiedsplit

@@ -72,6 +72,7 @@ data XhrRequestConfig

72 , _xhrRequestConfig_password :: Maybe String

73 , _xhrRequestConfig_responseType :: Maybe XhrResponseType

74 , _xhrRequestConfig_sendData :: Maybe String

75+ , _xhrRequestConfig_withCredentials :: Bool

75 }

76 }

76 deriving (Show, Read, Eq, Ord, Typeable)

77 deriving (Show, Read, Eq, Ord, Typeable)

@@ -97,6 +98,7 @@ instance Default XhrRequestConfig where

97 , _xhrRequestConfig_password = Nothing

98 , _xhrRequestConfig_password = Nothing

98 , _xhrRequestConfig_responseType = Nothing

99 , _xhrRequestConfig_responseType = Nothing

99 , _xhrRequestConfig_sendData = Nothing

100 , _xhrRequestConfig_sendData = Nothing

101+ , _xhrRequestConfig_withCredentials = False

100 }

102 }

101

103

102-- | Construct a request object from method, URL, and config record.

104-- | Construct a request object from method, URL, and config record.

@@ -123,6 +125,7 @@ newXMLHttpRequestWithError req cb = do

123 void $ liftIO $ forkIO $ flip catch (postGui . cb . Left) $ void $ do

125 void $ liftIO $ forkIO $ flip catch (postGui . cb . Left) $ void $ do

124 let c = _xhrRequest_config req

126 let c = _xhrRequest_config req

125 rt = _xhrRequestConfig_responseType c

127 rt = _xhrRequestConfig_responseType c

128+ creds = _xhrRequestConfig_withCredentials c

126 xmlHttpRequestOpen

129 xmlHttpRequestOpen

127 xhr

130 xhr

128 (_xhrRequest_method req)

131 (_xhrRequest_method req)

@@ -132,6 +135,7 @@ newXMLHttpRequestWithError req cb = do

132 (fromMaybe "" $ _xhrRequestConfig_password c)

135 (fromMaybe "" $ _xhrRequestConfig_password c)

133 iforM_ (_xhrRequestConfig_headers c) $ xmlHttpRequestSetRequestHeader xhr

136 iforM_ (_xhrRequestConfig_headers c) $ xmlHttpRequestSetRequestHeader xhr

134 maybe (return ()) (xmlHttpRequestSetResponseType xhr . fromResponseType) rt

137 maybe (return ()) (xmlHttpRequestSetResponseType xhr . fromResponseType) rt

138+ xmlHttpRequestSetWithCredentials xhr creds

135 _ <- xmlHttpRequestOnreadystatechange xhr $ do

139 _ <- xmlHttpRequestOnreadystatechange xhr $ do

136 readyState <- liftIO $ xmlHttpRequestGetReadyState xhr

140 readyState <- liftIO $ xmlHttpRequestGetReadyState xhr

137 status <- liftIO $ xmlHttpRequestGetStatus xhr

141 status <- liftIO $ xmlHttpRequestGetStatus xhr