| | 1 | module HttpClient |
| | 2 |
|
| | 3 | open System |
| | 4 | open System.IO |
| | 5 | open System.Net |
| | 6 | open System.Text |
| | 7 | open System.Web |
| | 8 | open Microsoft.FSharp.Control |
| | 9 | open Microsoft.FSharp.Control.CommonExtensions |
| | 10 | open Microsoft.FSharp.Control.WebExtensions |
| | 11 |
|
| | 12 | let private ISO_Latin_1 = "ISO-8859-1" |
| | 13 |
|
| | 14 | [<Measure>] type ms |
| | 15 |
|
| 0 | 16 | type HttpMethod = Options | Get | Head | Post | Put | Delete | Trace | Patch | Connect |
| | 17 |
|
| | 18 | // Same as System.Net.DecompressionMethods, but I didn't want to expose that |
| | 19 | type DecompressionScheme = |
| | 20 | | None = 0 |
| | 21 | | GZip = 1 |
| | 22 | | Deflate = 2 |
| | 23 |
|
| | 24 | // Defines mappings between encodings which might be specified and |
| | 25 | // the names which work with the .net encoder |
| | 26 | let private responseEncodingMappings = |
| | 27 | Map.empty |
| | 28 | .Add("utf8", "utf-8") |
| | 29 | .Add("utf16", "utf-16") |
| | 30 |
|
| 0 | 31 | type NameValue = { name:string; value:string } |
| 0 | 32 | type ContentRange = {start:int64; finish:int64 } |
| | 33 |
|
| 315 | 34 | type ResponseHeader = |
| | 35 | | AccessControlAllowOrigin |
| | 36 | | AcceptRanges |
| | 37 | | Age |
| | 38 | | Allow |
| | 39 | | CacheControl |
| | 40 | | Connection |
| | 41 | | ContentEncoding |
| | 42 | | ContentLanguage |
| | 43 | | ContentLength |
| | 44 | | ContentLocation |
| | 45 | | ContentMD5Response |
| | 46 | | ContentDisposition |
| | 47 | | ContentRange |
| | 48 | | ContentTypeResponse |
| | 49 | | DateResponse |
| | 50 | | ETag |
| | 51 | | Expires |
| | 52 | | LastModified |
| | 53 | | Link |
| | 54 | | Location |
| | 55 | | P3P |
| | 56 | | PragmaResponse |
| | 57 | | ProxyAuthenticate |
| | 58 | | Refresh |
| | 59 | | RetryAfter |
| | 60 | | Server |
| | 61 | | StrictTransportSecurity |
| | 62 | | Trailer |
| | 63 | | TransferEncoding |
| | 64 | | Vary |
| | 65 | | ViaResponse |
| | 66 | | WarningResponse |
| | 67 | | WWWAuthenticate |
| | 68 | | NonStandard of string |
| | 69 |
|
| | 70 | // some headers can't be set with HttpWebRequest, or are set automatically, so are not included. |
| | 71 | // others, such as transfer-encoding, just haven't been implemented. |
| 0 | 72 | type RequestHeader = |
| | 73 | | Accept of string |
| | 74 | | AcceptCharset of string |
| | 75 | | AcceptDatetime of string |
| | 76 | | AcceptLanguage of string |
| | 77 | | Authorization of string |
| | 78 | | Connection of string |
| | 79 | | ContentMD5 of string |
| | 80 | | ContentType of string |
| | 81 | | Date of DateTime |
| | 82 | | Expect of int |
| | 83 | | From of string |
| | 84 | | IfMatch of string |
| | 85 | | IfModifiedSince of DateTime |
| | 86 | | IfNoneMatch of string |
| | 87 | | IfRange of string |
| | 88 | | MaxForwards of int |
| | 89 | | Origin of string |
| | 90 | | Pragma of string |
| | 91 | | ProxyAuthorization of string |
| | 92 | | Range of ContentRange |
| | 93 | | Referer of string |
| | 94 | | Upgrade of string |
| | 95 | | UserAgent of string |
| | 96 | | Via of string |
| | 97 | | Warning of string |
| | 98 | | Custom of NameValue |
| | 99 |
|
| 0 | 100 | type UserDetails = { username:string; password:string } |
| | 101 |
|
| | 102 | [<RequireQualifiedAccess>] |
| 0 | 103 | type ProxyCredentials = |
| | 104 | | None |
| | 105 | | Default |
| | 106 | | Custom of UserDetails |
| | 107 |
|
| 0 | 108 | type Proxy = { |
| | 109 | Address: string |
| | 110 | Port: int |
| | 111 | Credentials: ProxyCredentials |
| | 112 | } |
| | 113 |
|
| 0 | 114 | type RequestBody = |
| | 115 | | NoBody |
| | 116 | | TextBody of string |
| | 117 | | BytesBody of byte[] |
| | 118 |
|
| 0 | 119 | type Request = { |
| | 120 | Url: string |
| | 121 | Method: HttpMethod |
| | 122 | CookiesEnabled: bool |
| | 123 | AutoFollowRedirects: bool |
| | 124 | AutoDecompression: DecompressionScheme |
| | 125 | Headers: RequestHeader list |
| | 126 | Body: RequestBody |
| | 127 | BodyCharacterEncoding: string option |
| | 128 | QueryStringItems: NameValue list |
| | 129 | Cookies: NameValue list option |
| | 130 | ResponseCharacterEncoding: string option |
| | 131 | Proxy: Proxy option |
| | 132 | KeepAlive: bool |
| | 133 | Timeout: int<ms> |
| | 134 | } |
| | 135 |
|
| 0 | 136 | type Response = { |
| | 137 | StatusCode: int |
| | 138 | EntityBody: string option |
| | 139 | ContentLength: int64 |
| | 140 | Cookies: Map<string,string> |
| | 141 | Headers: Map<ResponseHeader,string> |
| | 142 | /// A Uri that contains the URI of the Internet resource that responded to the request. |
| | 143 | /// <see cref="https://msdn.microsoft.com/en-us/library/system.net.httpwebresponse.responseuri%28v=vs.110%29.aspx"/> |
| | 144 | ResponseUri : System.Uri |
| | 145 | } |
| | 146 |
|
| | 147 | /// <summary>Creates the Request record which can be used to make an HTTP request</summary> |
| | 148 | /// <param name="httpMethod">The type of request to be made (Get, Post, etc.)</param> |
| | 149 | /// <param name="url">The URL of the resource including protocol, e.g. 'http://www.relentlessdevelopment.net'</param> |
| | 150 | /// <returns>The Request record</returns> |
| 48 | 151 | let createRequest httpMethod url = { |
| | 152 | Url = url; |
| | 153 | Method = httpMethod; |
| | 154 | CookiesEnabled = true; |
| | 155 | AutoFollowRedirects = true; |
| | 156 | AutoDecompression = DecompressionScheme.None; |
| | 157 | Headers = List.empty; |
| | 158 | Body = NoBody; |
| | 159 | BodyCharacterEncoding = None; |
| | 160 | QueryStringItems = List.empty; |
| | 161 | Cookies = None; |
| | 162 | ResponseCharacterEncoding = None; |
| | 163 | Proxy = None; |
| | 164 | KeepAlive = true; |
| | 165 | /// The default value is 100,000 milliseconds (100 seconds). |
| | 166 | /// <see cref="https://msdn.microsoft.com/en-us/library/system.net.httpwebrequest.timeout%28v=vs.110%29.aspx"/>. |
| | 167 | Timeout = 100000<ms> |
| | 168 | } |
| | 169 |
|
| | 170 | // Adds an element to a list which may be none |
| | 171 | let private append item listOption = |
| 4 | 172 | match listOption with |
| 2 | 173 | | None -> Some([item]) |
| 1 | 174 | | Some(existingList) -> Some(existingList@[item]) |
| | 175 |
|
| | 176 | // Checks if a header already exists in a list |
| | 177 | // (standard headers just checks type, custom headers also checks 'name' field). |
| | 178 | let private headerExists header headerList = |
| 38 | 179 | headerList |
| | 180 | |> List.exists ( |
| | 181 | fun existingHeader -> |
| 308 | 182 | match existingHeader, header with |
| | 183 | | Custom {name = existingName; value = existingValue }, |
| 2 | 184 | Custom {name = newName; value = newValue } -> existingName = newName |
| 306 | 185 | | _ -> existingHeader.GetType() = header.GetType()) |
| | 186 |
|
| | 187 | // Adds a header to the collection as long as it isn't already in it |
| | 188 | let private appendHeaderNoRepeat newHeader headerList = |
| 38 | 189 | if headerList |> headerExists newHeader then |
| 2 | 190 | failwithf "Header %A already exists" newHeader |
| 36 | 191 | headerList@[newHeader] |
| | 192 |
|
| | 193 | /// Disables cookies, which are enabled by default |
| | 194 | let withCookiesDisabled request = |
| 2 | 195 | {request with CookiesEnabled = false } |
| | 196 |
|
| | 197 | /// Disables automatic following of redirects, which is enabled by default |
| | 198 | let withAutoFollowRedirectsDisabled request = |
| 1 | 199 | {request with AutoFollowRedirects = false } |
| | 200 |
|
| | 201 | /// Adds a header, defined as a RequestHeader |
| | 202 | let withHeader header (request:Request) = |
| 36 | 203 | {request with Headers = request.Headers |> appendHeaderNoRepeat header} |
| | 204 |
|
| | 205 | /// Adds an HTTP Basic Authentication header, which includes the username and password encoded as a base-64 string |
| | 206 | let withBasicAuthentication username password (request:Request) = |
| 2 | 207 | let authHeader = Authorization ("Basic " + Convert.ToBase64String(Encoding.GetEncoding(ISO_Latin_1).GetBytes(usernam |
| 2 | 208 | {request with Headers = request.Headers |> appendHeaderNoRepeat authHeader} |
| | 209 |
|
| | 210 | /// Sets the accept-encoding request header to accept the decompression methods selected, |
| | 211 | /// and automatically decompresses the responses. |
| | 212 | /// |
| | 213 | /// Multiple schemes can be OR'd together, e.g. (DecompressionScheme.Deflate ||| DecompressionScheme.GZip) |
| | 214 | let withAutoDecompression decompressionSchemes request = |
| 2 | 215 | {request with AutoDecompression = decompressionSchemes} |
| | 216 |
|
| | 217 | /// Sets the the request body, using ISO Latin 1 character encoding. |
| | 218 | /// |
| | 219 | /// Only certain request types should have a body, e.g. Posts. |
| | 220 | let withBody body request = |
| 10 | 221 | {request with Body = TextBody(body); BodyCharacterEncoding = Some(ISO_Latin_1)} |
| | 222 |
|
| | 223 | /// Sets the request body, using the provided character encoding. |
| | 224 | let withBodyEncoded body characterEncoding request = |
| 5 | 225 | {request with Body = TextBody(body); BodyCharacterEncoding = Some(characterEncoding)} |
| | 226 |
|
| | 227 | /// Sets the request body using a byte array. |
| | 228 | let withBodyBytes body request = |
| 4 | 229 | {request with Body = BytesBody(body)} |
| | 230 |
|
| | 231 | /// Adds the provided QueryString record onto the request URL. |
| | 232 | /// Multiple items can be appended. |
| | 233 | let withQueryStringItem item request = |
| 4 | 234 | {request with QueryStringItems = request.QueryStringItems |> List.append [item]} |
| | 235 |
|
| | 236 | /// Adds a cookie to the request |
| | 237 | /// The domain will be taken from the URL, and the path set to '/'. |
| | 238 | /// |
| | 239 | /// If your cookie appears not to be getting set, it could be because the response is a redirect, |
| | 240 | /// which (by default) will be followed automatically, but cookies will not be re-sent. |
| | 241 | let withCookie cookie request = |
| 5 | 242 | if not request.CookiesEnabled then failwithf "Cannot add cookie %A - cookies disabled" cookie.name |
| 3 | 243 | {request with Cookies = request.Cookies |> append cookie} |
| | 244 |
|
| | 245 | /// Decodes the response using the specified encoding, regardless of what the response specifies. |
| | 246 | /// |
| | 247 | /// If this is not set, response character encoding will be: |
| | 248 | /// - taken from the response content-encoding header, if provided, otherwise |
| | 249 | /// - ISO Latin 1 |
| | 250 | /// |
| | 251 | /// Many web pages define the character encoding in the HTML. This will not be used. |
| | 252 | let withResponseCharacterEncoding encoding request:Request = |
| 3 | 253 | {request with ResponseCharacterEncoding = Some(encoding)} |
| | 254 |
|
| | 255 | /// Sends the request via the provided proxy. |
| | 256 | /// |
| | 257 | /// If this is no set, the proxy settings from IE will be used, if available. |
| | 258 | let withProxy proxy request = |
| 4 | 259 | {request with Proxy = Some proxy} |
| | 260 |
|
| | 261 | /// Sets the keep-alive header. Defaults to true. |
| | 262 | /// |
| | 263 | /// If true, Connection header also set to 'Keep-Alive' |
| | 264 | /// If false, Connection header also set to 'Close' |
| | 265 | /// |
| | 266 | /// NOTE: If true, headers only sent on first request. |
| | 267 | let withKeepAlive value request = |
| 3 | 268 | {request with KeepAlive = value} |
| | 269 |
|
| | 270 | /// Sets the request body, using the provided character encoding. |
| | 271 | let withTimeout value request = |
| 2 | 272 | {request with Timeout = value} |
| | 273 |
|
| | 274 | let private getMethodAsString request = |
| 43 | 275 | match request.Method with |
| 1 | 276 | | Options -> "OPTIONS" |
| 28 | 277 | | Get -> "GET" |
| 1 | 278 | | Head -> "HEAD" |
| 10 | 279 | | Post -> "POST" |
| 1 | 280 | | Put -> "PUT" |
| 1 | 281 | | Delete -> "DELETE" |
| 0 | 282 | | Trace -> "TRACE" |
| 0 | 283 | | Connect -> "CONNECT" |
| 1 | 284 | | Patch -> "PATCH" |
| | 285 |
|
| | 286 | let private getQueryString request = |
| 44 | 287 | match not(request.QueryStringItems.IsEmpty) with |
| 1 | 288 | | true -> request.QueryStringItems |
| | 289 | |> List.fold ( |
| | 290 | fun currentQueryString queryStringItem -> |
| 6 | 291 | (if currentQueryString = "?" then currentQueryString else currentQueryString + "&" ) |
| | 292 | + HttpUtility.UrlEncode(queryStringItem.name) |
| | 293 | + "=" |
| | 294 | + HttpUtility.UrlEncode(queryStringItem.value)) |
| | 295 | "?" |
| 43 | 296 | | false -> "" |
| | 297 |
|
| | 298 | // Sets headers on HttpWebRequest. |
| | 299 | // Mutates HttpWebRequest. |
| | 300 | let private setHeaders (headers:RequestHeader list) (webRequest:HttpWebRequest) = |
| | 301 |
|
| 43 | 302 | headers |
| | 303 | |> List.iter (fun header -> |
| 50 | 304 | match header with |
| 2 | 305 | | Accept(value) -> webRequest.Accept <- value |
| 1 | 306 | | AcceptCharset(value) -> webRequest.Headers.Add("Accept-Charset", value) |
| 1 | 307 | | AcceptDatetime(value) -> webRequest.Headers.Add("Accept-Datetime", value) |
| 1 | 308 | | AcceptLanguage(value) -> webRequest.Headers.Add("Accept-Language", value) |
| 1 | 309 | | Authorization(value) -> webRequest.Headers.Add("Authorization", value) |
| 1 | 310 | | RequestHeader.Connection(value) -> webRequest.Connection <- value |
| 1 | 311 | | RequestHeader.ContentMD5(value) -> webRequest.Headers.Add("Content-MD5", value) |
| 1 | 312 | | RequestHeader.ContentType(value) -> webRequest.ContentType <- value |
| 1 | 313 | | RequestHeader.Date(value) -> webRequest.Date <- value |
| 0 | 314 | | Expect(value) -> webRequest.Expect <- value.ToString() |
| 1 | 315 | | From(value) -> webRequest.Headers.Add("From", value) |
| 1 | 316 | | IfMatch(value) -> webRequest.Headers.Add("If-Match", value) |
| 1 | 317 | | IfModifiedSince(value) -> webRequest.IfModifiedSince <- value |
| 1 | 318 | | IfNoneMatch(value) -> webRequest.Headers.Add("If-None-Match", value) |
| 1 | 319 | | IfRange(value) -> webRequest.Headers.Add("If-Range", value) |
| 1 | 320 | | MaxForwards(value) -> webRequest.Headers.Add("Max-Forwards", value.ToString()) |
| 1 | 321 | | Origin(value) -> webRequest.Headers.Add("Origin", value) |
| 1 | 322 | | RequestHeader.Pragma(value) -> webRequest.Headers.Add("Pragma", value) |
| 1 | 323 | | ProxyAuthorization(value) -> webRequest.Headers.Add("Proxy-Authorization", value) |
| 1 | 324 | | Range(value) -> webRequest.AddRange(value.start, value.finish) |
| 1 | 325 | | Referer(value) -> webRequest.Referer <- value |
| 1 | 326 | | Upgrade(value) -> webRequest.Headers.Add("Upgrade", value) |
| 1 | 327 | | UserAgent(value) -> webRequest.UserAgent <- value |
| 1 | 328 | | RequestHeader.Via(value) -> webRequest.Headers.Add("Via", value) |
| 1 | 329 | | RequestHeader.Warning(value) -> webRequest.Headers.Add("Warning", value) |
| 1 | 330 | | Custom( {name=customName; value=customValue}) -> webRequest.Headers.Add(customName, customValue)) |
| | 331 |
|
| | 332 | // Sets cookies on HttpWebRequest. |
| | 333 | // Mutates HttpWebRequest. |
| | 334 | let private setCookies (cookies:NameValue list option) url (webRequest:HttpWebRequest) = |
| 43 | 335 | if cookies.IsSome then |
| 1 | 336 | let domain = Uri(url).Host |
| 1 | 337 | cookies.Value |
| | 338 | |> List.iter (fun cookie -> |
| 1 | 339 | webRequest.CookieContainer.Add(new System.Net.Cookie(cookie.name, cookie.value, Path="/", Domain=domain))) |
| | 340 |
|
| | 341 | // Sets proxy on HttpWebRequest. |
| | 342 | // Mutates HttpWebRequest. |
| | 343 | let private setProxy proxy (webRequest:HttpWebRequest) = |
| 43 | 344 | proxy |> Option.iter (fun proxy -> |
| 0 | 345 | let webProxy = WebProxy(proxy.Address, proxy.Port) |
| | 346 |
|
| 0 | 347 | match proxy.Credentials with |
| | 348 | | ProxyCredentials.Custom { username = name; password = pwd} -> |
| 0 | 349 | webProxy.Credentials <- NetworkCredential(name, pwd) |
| 0 | 350 | | ProxyCredentials.Default -> webProxy.UseDefaultCredentials <- true |
| 0 | 351 | | ProxyCredentials.None -> webProxy.Credentials <- null |
| | 352 |
|
| 0 | 353 | webRequest.Proxy <- webProxy) |
| | 354 |
|
| | 355 | // Sets the budy of the HttpWebRequest as bytes. |
| | 356 | // Mutates the HttpWebRequest. |
| | 357 | let private setBodyBytes (body:byte[]) (webRequest:HttpWebRequest) = |
| | 358 | // Getting the request stream seems to be actually connecting to the internet in some way |
| 8 | 359 | use requestStream = webRequest.GetRequestStream() |
| 8 | 360 | requestStream.AsyncWrite(body, 0, body.Length) |> Async.RunSynchronously |
| | 361 |
|
| | 362 | // Sets the body on the HttpWebRequest using the text or bytes specified in the Request (if any). |
| | 363 | // Mutates the HttpWebRequest. |
| | 364 | let private setBody body (encoding:string option) (webRequest:HttpWebRequest) = |
| | 365 |
|
| 53 | 366 | match body with |
| 33 | 367 | | NoBody -> () |
| 1 | 368 | | BytesBody(byteContent) -> webRequest |> setBodyBytes byteContent |
| | 369 | | TextBody(textContent) -> |
| 10 | 370 | if encoding.IsNone then failwith "Body Character Encoding not set" |
| 8 | 371 | let bodyAsBytes = Encoding.GetEncoding(encoding.Value).GetBytes(textContent) |
| 7 | 372 | webRequest |> setBodyBytes bodyAsBytes |
| | 373 |
|
| | 374 | // The nasty business of turning a Request into an HttpWebRequest |
| | 375 | let private toHttpWebRequest request = |
| | 376 |
|
| 44 | 377 | let url = request.Url + (request |> getQueryString) |
| 44 | 378 | let webRequest = HttpWebRequest.Create(url) :?> HttpWebRequest |
| | 379 |
|
| 43 | 380 | webRequest.Method <- (request |> getMethodAsString) |
| 43 | 381 | webRequest.ProtocolVersion <- HttpVersion.Version11 |
| | 382 |
|
| 43 | 383 | if request.CookiesEnabled then |
| 43 | 384 | webRequest.CookieContainer <- CookieContainer() |
| | 385 |
|
| 43 | 386 | webRequest.AllowAutoRedirect <- request.AutoFollowRedirects |
| | 387 |
|
| | 388 | // this relies on the DecompressionScheme enum values being the same as those in System.Net.DecompressionMethods |
| 43 | 389 | webRequest.AutomaticDecompression <- enum<DecompressionMethods> <| int request.AutoDecompression |
| | 390 |
|
| 43 | 391 | webRequest |> setHeaders request.Headers |
| 43 | 392 | webRequest |> setCookies request.Cookies request.Url |
| 43 | 393 | webRequest |> setProxy request.Proxy |
| 43 | 394 | webRequest |> setBody request.Body request.BodyCharacterEncoding |
| | 395 |
|
| 41 | 396 | webRequest.KeepAlive <- request.KeepAlive |
| 41 | 397 | webRequest.Timeout <- (int)request.Timeout |
| | 398 |
|
| 41 | 399 | webRequest |
| | 400 |
|
| | 401 | // Uses the HttpWebRequest to get the response. |
| | 402 | // HttpWebRequest throws an exception on anything but a 200-level response, |
| | 403 | // so we handle such exceptions and return the response. |
| 41 | 404 | let private getResponseNoException (request:HttpWebRequest) = async { |
| 46 | 405 | try |
| 77 | 406 | let! response = request.AsyncGetResponse() |
| 36 | 407 | return response :?> HttpWebResponse |
| | 408 | with |
| | 409 | | :? WebException as wex -> |
| 5 | 410 | if wex.Response <> null then |
| 4 | 411 | return wex.Response :?> HttpWebResponse |
| | 412 | else |
| 1 | 413 | return raise wex |
| | 414 | } |
| | 415 |
|
| | 416 | let private getCookiesAsMap (response:HttpWebResponse) = |
| 11 | 417 | let cookieArray = Array.zeroCreate response.Cookies.Count |
| 11 | 418 | response.Cookies.CopyTo(cookieArray, 0) |
| 13 | 419 | cookieArray |> Array.fold (fun map cookie -> map |> Map.add cookie.Name cookie.Value) Map.empty |
| | 420 |
|
| | 421 | // Get the header as a ResponseHeader option. Is an option because there are some headers we don't want to set. |
| | 422 | let private getResponseHeader headerName = |
| 76 | 423 | match headerName with |
| 0 | 424 | | null -> None |
| 1 | 425 | | "Access-Control-Allow-Origin" -> Some(AccessControlAllowOrigin) |
| 1 | 426 | | "Accept-Ranges" -> Some(AcceptRanges) |
| 1 | 427 | | "Age" -> Some(Age) |
| 1 | 428 | | "Allow" -> Some(Allow) |
| 1 | 429 | | "Cache-Control" -> Some(CacheControl) |
| 0 | 430 | | "Connection" -> Some(ResponseHeader.Connection) |
| 2 | 431 | | "Content-Encoding" -> Some(ContentEncoding) |
| 1 | 432 | | "Content-Language" -> Some(ContentLanguage) |
| 11 | 433 | | "Content-Length" -> None |
| 1 | 434 | | "Content-Location" -> Some(ContentLocation) |
| 1 | 435 | | "Content-MD5" -> Some(ResponseHeader.ContentMD5Response) |
| 1 | 436 | | "Content-Disposition" -> Some(ContentDisposition) |
| 1 | 437 | | "Content-Range" -> Some(ContentRange) |
| 11 | 438 | | "Content-Type" -> Some(ResponseHeader.ContentTypeResponse) |
| 11 | 439 | | "Date" -> Some(ResponseHeader.DateResponse) |
| 1 | 440 | | "ETag" -> Some(ETag) |
| 1 | 441 | | "Expires" -> Some(Expires) |
| 1 | 442 | | "Last-Modified" -> Some(LastModified) |
| 1 | 443 | | "Link" -> Some(Link) |
| 1 | 444 | | "Location" -> Some(Location) |
| 1 | 445 | | "P3P" -> Some(P3P) |
| 1 | 446 | | "Pragma" -> Some(ResponseHeader.PragmaResponse) |
| 1 | 447 | | "Proxy-Authenticate" -> Some(ProxyAuthenticate) |
| 1 | 448 | | "Refresh" -> Some(Refresh) |
| 1 | 449 | | "Retry-After" -> Some(RetryAfter) |
| 11 | 450 | | "Server" -> Some(Server) |
| 1 | 451 | | "Set-Cookie" -> None |
| 1 | 452 | | "Strict-Transport-Security" -> Some(StrictTransportSecurity) |
| 1 | 453 | | "Trailer" -> Some(Trailer) |
| 1 | 454 | | "Transfer-Encoding" -> Some(TransferEncoding) |
| 1 | 455 | | "Vary" -> Some(Vary) |
| 1 | 456 | | "Via" -> Some(ResponseHeader.ViaResponse) |
| 1 | 457 | | "Warning" -> Some(ResponseHeader.WarningResponse) |
| 1 | 458 | | "WWW-Authenticate" -> Some(WWWAuthenticate) |
| 2 | 459 | | _ -> Some(NonStandard headerName) |
| | 460 |
|
| | 461 | // Gets the headers from the passed response as a map of ResponseHeader and string. |
| | 462 | let private getHeadersAsMap (response:HttpWebResponse) = |
| | 463 | // TODO: Find a better way of dong this |
| 11 | 464 | let headerArray = Array.zeroCreate response.Headers.Count |
| 87 | 465 | for index = 0 to response.Headers.Count-1 do |
| 76 | 466 | headerArray.[index] <- |
| 76 | 467 | match getResponseHeader response.Headers.Keys.[index] with |
| 64 | 468 | | Some(headerKey) -> Some((headerKey, response.Headers.Item(response.Headers.Keys.[index]))) |
| 12 | 469 | | None -> None |
| 11 | 470 | headerArray |
| 76 | 471 | |> Array.filter (fun item -> item <> None) |
| 192 | 472 | |> Array.map Option.get |
| | 473 | |> Map.ofArray |
| | 474 |
|
| | 475 | let private mapEncoding (encoding:string) = |
| 12 | 476 | match responseEncodingMappings.TryFind(encoding.ToLower()) with |
| 2 | 477 | | Some(mappedEncoding) -> mappedEncoding |
| 10 | 478 | | None -> encoding |
| | 479 |
|
| 15 | 480 | let private readBody encoding (response:HttpWebResponse) = async { |
| 15 | 481 | let charset = |
| 17 | 482 | match encoding with |
| | 483 | | None -> |
| 25 | 484 | match response.CharacterSet with |
| 1 | 485 | | null | "" -> Encoding.GetEncoding(ISO_Latin_1) |
| 12 | 486 | | responseCharset -> Encoding.GetEncoding(responseCharset |> mapEncoding) |
| 2 | 487 | | Some(enc) -> Encoding.GetEncoding(enc:string) |
| 26 | 488 | use responseStream = new AsyncStreamReader(response.GetResponseStream(),charset) |
| 26 | 489 | let! body = responseStream.ReadToEnd() |
| 13 | 490 | return body |
| | 491 | } |
| | 492 |
|
| 2 | 493 | let private readAsRaw (response:HttpWebResponse) = async { |
| 4 | 494 | use ms = new MemoryStream() |
| 4 | 495 | do! response.GetResponseStream().CopyToAsync(ms) |> Async.AwaitIAsyncResult |> Async.Ignore |
| 2 | 496 | return ms.ToArray() |
| | 497 | } |
| | 498 |
|
| | 499 | /// Sends the HTTP request and returns the response code as an integer, asynchronously. |
| 24 | 500 | let getResponseCodeAsync request = async { |
| 87 | 501 | use! response = request |> toHttpWebRequest |> getResponseNoException |
| 21 | 502 | return response.StatusCode |> int |
| | 503 | } |
| | 504 |
|
| | 505 | /// Sends the HTTP request and returns the response code as an integer. |
| | 506 | let getResponseCode request = |
| 24 | 507 | getResponseCodeAsync request |> Async.RunSynchronously |
| | 508 |
|
| | 509 | /// Sends the HTTP request and returns the response body as a string, asynchronously. |
| | 510 | /// |
| | 511 | /// Gives an empty string if there's no response body. |
| 2 | 512 | let getResponseBodyAsync request = async { |
| 8 | 513 | use! response = request |> toHttpWebRequest |> getResponseNoException |
| 4 | 514 | let! body = response |> readBody request.ResponseCharacterEncoding |
| 2 | 515 | return body |
| | 516 | } |
| | 517 |
|
| | 518 | /// Sends the HTTP request and returns the response body as raw bytes, asynchronously. |
| | 519 | /// |
| | 520 | /// Gives an empty array if there's no response body. |
| 2 | 521 | let getResponseBytesAsync request = async { |
| 8 | 522 | use! response = request |> toHttpWebRequest |> getResponseNoException |
| 4 | 523 | let! raw = response |> readAsRaw |
| 2 | 524 | return raw |
| | 525 | } |
| | 526 |
|
| | 527 | /// Sends the HTTP request and returns the response body as raw bytes. |
| | 528 | /// |
| | 529 | /// Gives an empty array if there's no response body. |
| | 530 | let getResponseBytes request = |
| 2 | 531 | getResponseBytesAsync request |> Async.RunSynchronously |
| | 532 |
|
| | 533 | /// Sends the HTTP request and returns the response body as a string. |
| | 534 | /// |
| | 535 | /// Gives an empty string if there's no response body. |
| | 536 | let getResponseBody request = |
| 2 | 537 | getResponseBodyAsync request |> Async.RunSynchronously |
| | 538 |
|
| | 539 | /// Sends the HTTP request and returns the full response as a Response record, asynchronously. |
| 14 | 540 | let getResponseAsync request = async { |
| 53 | 541 | use! response = request |> toHttpWebRequest |> getResponseNoException |
| | 542 |
|
| 13 | 543 | let code = response.StatusCode |> int |
| 24 | 544 | let! body = response |> readBody request.ResponseCharacterEncoding |
| | 545 |
|
| 11 | 546 | let cookies = response |> getCookiesAsMap |
| 11 | 547 | let headers = response |> getHeadersAsMap |
| | 548 |
|
| 11 | 549 | let entityBody = |
| 11 | 550 | match body.Length > 0 with |
| 9 | 551 | | true -> Some(body) |
| 2 | 552 | | false -> None |
| | 553 |
|
| 11 | 554 | return { |
| | 555 | StatusCode = code |
| | 556 | EntityBody = entityBody |
| | 557 | ContentLength = response.ContentLength |
| | 558 | Cookies = cookies |
| | 559 | Headers = headers |
| | 560 | ResponseUri = response.ResponseUri |
| | 561 | } |
| | 562 | } |
| | 563 |
|
| | 564 | /// Sends the HTTP request and returns the full response as a Response record. |
| | 565 | let getResponse request = |
| 14 | 566 | getResponseAsync request |> Async.RunSynchronously |
| | 567 |
|
| | 568 | /// Passes the response stream to the passed consumer function. |
| | 569 | /// Useful if accessing a large file, as won't copy to memory. |
| | 570 | /// |
| | 571 | /// The response stream will be closed automatically, do not access it outside the function scope. |
| | 572 | let getResponseStream streamConsumer request = |
| 2 | 573 | use response = request |> toHttpWebRequest |> getResponseNoException |> Async.RunSynchronously |
| 2 | 574 | use responseStream = response.GetResponseStream() |
| 2 | 575 | streamConsumer (responseStream) |