Skip to content

Commit

Permalink
Cleaning up usage of #bytes #utf8_bytes and moving such to modules.
Browse files Browse the repository at this point in the history 
Fixes #85
  • Loading branch information
@haf
haf committed Apr 19, 2014
1 parent c5d6d59 commit 6731c41
Show file tree
Hide file tree
Showing 5 changed files with 74 additions and 53 deletions.
2 changes: 1 addition & 1 deletion Experimental/Template.fs
View file
Expand Up @@ -117,6 +117,6 @@ let process_template (data : Map<string,Binder>) ({ request = http_request; runt
let str = new StringWriter(sb)
xml_to_string1 xml str
let output = sb.ToString()
ok (bytes_utf8 output) ctx
OK output ctx
with
| x -> INTERNAL_ERROR (x.ToString()) ctx
38 changes: 19 additions & 19 deletions Suave/Http.fs
View file
Expand Up @@ -156,15 +156,15 @@ module Http =

let ok s = response 200 "OK" s >> succeed

let OK a = ok (bytes_utf8 a)
let OK a = ok (UTF8.bytes a)

let created s = response 201 "Created" s >> succeed

let CREATED s = created (bytes_utf8 s)
let CREATED s = created (UTF8.bytes s)

let accepted s = response 202 "Accepted" s >> succeed

let ACCEPTED s = accepted (bytes_utf8 s)
let ACCEPTED s = accepted (UTF8.bytes s)

let no_content : WebPart =
response 204 "No Content" (Array.zeroCreate 0) >> succeed
Expand All @@ -190,7 +190,7 @@ module Http =
let redirect url =
set_header "Location" url
>> set_header "Content-Type" "text/html; charset=utf-8"
>> response 302 "Found" (bytes_utf8(sprintf "<html>
>> response 302 "Found" (UTF8.bytes(sprintf "<html>
<body>
<a href=\"%s\">Content Moved</a>
</body>
Expand All @@ -206,7 +206,7 @@ module Http =

let bad_request s = response 400 "Bad Request" s >> succeed

let BAD_REQUEST s = bad_request (bytes_utf8 s)
let BAD_REQUEST s = bad_request (UTF8.bytes s)

// 401: see http://stackoverflow.com/questions/3297048/403-forbidden-vs-401-unauthorized-http-responses/12675357

Expand All @@ -215,56 +215,56 @@ module Http =
>> response 401 "Unauthorized" s
>> succeed

let UNAUTHORIZED s = unauthorized (bytes_utf8 s)
let UNAUTHORIZED s = unauthorized (UTF8.bytes s)

let challenge = UNAUTHORIZED "401 Unauthorized."

let forbidden s = response 403 "Forbidden" s >> succeed

let FORBIDDEN s = forbidden (bytes_utf8 s)
let FORBIDDEN s = forbidden (UTF8.bytes s)

let not_found s = response 404 "Not Found" s >> succeed

let NOT_FOUND message = not_found (bytes_utf8 message)
let NOT_FOUND message = not_found (UTF8.bytes message)

let method_not_allowed s = response 405 "Method Not Allowed" s >> succeed

let METHOD_NOT_ALLOWED s = method_not_allowed (bytes_utf8 s)
let METHOD_NOT_ALLOWED s = method_not_allowed (UTF8.bytes s)

let not_acceptable s = response 406 "Not Acceptable" s >> succeed

let NOT_ACCEPTABLE message = not_acceptable (bytes_utf8 message)
let NOT_ACCEPTABLE message = not_acceptable (UTF8.bytes message)

let request_timeout = response 408 "Request Timeout" (Array.zeroCreate 0) >> succeed
// all-caps req.timeout elided intentionally

let conflict s = response 409 "Conflict" s >> succeed

let CONFLICT message = conflict (bytes_utf8 message)
let CONFLICT message = conflict (UTF8.bytes message)

let gone s = response 410 "Gone" s >> succeed

let GONE s = gone (bytes_utf8 s)
let GONE s = gone (UTF8.bytes s)

let unsupported_media_type s = response 415 "Unsupported Media Type" s >> succeed

let UNSUPPORTED_MEDIA_TYPE s = unsupported_media_type (bytes_utf8 s)
let UNSUPPORTED_MEDIA_TYPE s = unsupported_media_type (UTF8.bytes s)

let unprocessable_entity s = response 422 "Unprocessable Entity" s >> succeed

let UNPROCESSABLE_ENTITY s = unprocessable_entity (bytes_utf8 s)
let UNPROCESSABLE_ENTITY s = unprocessable_entity (UTF8.bytes s)

let precondition_required body = response 428 "Precondition Required" body >> succeed

let PRECONDITION_REQUIRED body = precondition_required (bytes_utf8 body)
let PRECONDITION_REQUIRED body = precondition_required (UTF8.bytes body)

let too_many_requests s = response 429 "Too Many Requests" s >> succeed

let TOO_MANY_REQUESTS s = too_many_requests (bytes_utf8 s)
let TOO_MANY_REQUESTS s = too_many_requests (UTF8.bytes s)

let internal_error message = response 500 "Internal Error" message >> succeed

let INTERNAL_ERROR a = internal_error (bytes_utf8 a)
let INTERNAL_ERROR a = internal_error (UTF8.bytes a)

let mk_mime_type a b =
{ name = a
Expand Down Expand Up @@ -425,13 +425,13 @@ module Http =
if Directory.Exists dirname then
let di = new DirectoryInfo(dirname)
(di.GetFileSystemInfos()) |> Array.sortBy (fun x -> x.Name) |> Array.iter buildLine
ok (bytes (result.ToString())) ctx
OK (result.ToString()) ctx
else fail

let parse_authentication_token (token : string) =
let parts = token.Split (' ')
let enc = parts.[1].Trim()
let decoded = decode_base64 enc
let decoded = ASCII.base64_decode enc
let indexOfColon = decoded.IndexOf(':')
(parts.[0].ToLower(), decoded.Substring(0,indexOfColon), decoded.Substring(indexOfColon+1))

Expand Down
2 changes: 1 addition & 1 deletion Suave/Proxy.fs
View file
Expand Up @@ -78,7 +78,7 @@ let forward (ip : IPAddress) (port : uint16) (ctx : HttpContext) =
| :? WebException as ex when ex.Response <> null ->
do! send_web_response (ex.Response :?> HttpWebResponse) ctx
| :? WebException as ex when ex.Response = null ->
do! response 502 "Bad Gateway" (bytes_utf8 "suave proxy: Could not connect to upstream") ctx
do! response 502 "Bad Gateway" (UTF8.bytes "suave proxy: Could not connect to upstream") ctx
} |> succeed

/// Proxy the HttpRequest 'r' with the proxy found with 'proxy_resolver'
Expand Down
69 changes: 45 additions & 24 deletions Suave/Utils.fs
View file
Expand Up @@ -83,29 +83,50 @@ let cond d f g a =
//- theorem: identity = (cnst |> warbler)
//(warbler cnst) x = cnst x x = fun _ -> x

/// Encode the string as ASCII encoded in Base64.
let inline encode_base64 (s : string) =
let bytes = System.Text.Encoding.ASCII.GetBytes s
System.Convert.ToBase64String bytes

/// Decode the string containing Base64-encoded ASCII string data to
/// a .Net string
let inline decode_base64 (s : string) =
let bytes = System.Convert.FromBase64String s
System.Text.Encoding.ASCII.GetString bytes

/// Get the ASCII bytes for the string
let inline bytes (s : string) =
System.Text.Encoding.ASCII.GetBytes s

/// Convert the byte array of ASCII-encoded chars to a string, starting at 'index' for 'count' characters
/// (each character is necessarily one byte)
let inline to_string (buff : byte[]) (index : int) (count : int) =
System.Text.Encoding.ASCII.GetString(buff, index, count)

/// Get the UTF-8 bytes for the string
let inline bytes_utf8 (s : string) =
System.Text.Encoding.UTF8.GetBytes s
[<RequireQualifiedAccess>]
module UTF8 =
open System
open System.Text

let inline to_string (b : byte []) (index : int) (count : int) =
Encoding.UTF8.GetString(b, index, count)

/// Get the UTF-8 bytes for the string
let inline bytes (s : string) =
Encoding.UTF8.GetBytes s

/// Encode the string as UTF8 encoded in Base64.
let inline base64_encode (s : string) =
let bytes = Encoding.UTF8.GetBytes s
Convert.ToBase64String bytes

let inline base64_decode s =
let bytes = Convert.FromBase64String s
Encoding.UTF8.GetString bytes

[<RequireQualifiedAccess>]
module ASCII =
open System
open System.Text

/// Get the ASCII bytes for the string
let inline bytes (s : string) =
Encoding.ASCII.GetBytes s

/// Convert the byte array of ASCII-encoded chars to a string, starting at 'index' for 'count' characters
/// (each character is necessarily one byte)
let inline to_string (buff : byte[]) (index : int) (count : int) =
Encoding.ASCII.GetString(buff, index, count)

/// Encode the string as ASCII encoded in Base64.
let inline base64_encode (s : string) =
let bytes = Encoding.ASCII.GetBytes s
Convert.ToBase64String bytes

/// Decode the string containing Base64-encoded ASCII string data to a string
let inline base64_decode (s : string) =
let bytes = Convert.FromBase64String s
Encoding.ASCII.GetString bytes

module Option =
let or_default value opt =
Expand Down Expand Up @@ -138,7 +159,7 @@ module Bytes =
let [<Literal>] eol = "\r\n"

/// The end-of-line 'literal' as bytes, the \r\n (CRLF) byte pair
let EOL = bytes eol
let EOL = ASCII.bytes eol

/// The corresponding EOL array segment
let eol_array_segment = new ArraySegment<_>(EOL, 0, 2)
Expand Down
16 changes: 8 additions & 8 deletions Suave/Web.fs
View file
Expand Up @@ -187,7 +187,7 @@ module ParsingAndControl =
let read_line (connection : Connection) ahead (buf : ArraySegment<byte>) = async {
let offset = ref 0
let! count, rem = read_till_EOL connection (fun a count -> Array.blit a.Array a.Offset buf.Array (buf.Offset + !offset) count; offset := !offset + count) ahead
let result = to_string buf.Array buf.Offset count
let result = ASCII.to_string buf.Array buf.Offset count
return result , rem
}

Expand All @@ -202,7 +202,7 @@ module ParsingAndControl =
offset := !offset + count)
rem
if count <> 0 then
let line = to_string buf.Array buf.Offset count
let line = ASCII.to_string buf.Array buf.Offset count
let indexOfColon = line.IndexOf(':')
headers.Add (line.Substring(0, indexOfColon).ToLower(), line.Substring(indexOfColon+1).TrimStart())
return! loop new_rem
Expand Down Expand Up @@ -278,7 +278,7 @@ module ParsingAndControl =
| Some(x) ->
let temp_file_name = Path.GetTempFileName()
use temp_file = new FileStream(temp_file_name, FileMode.Truncate)
let! a, b = read_until (bytes(eol + boundary)) (fun x y -> async { do! temp_file.AsyncWrite(x.Array, x.Offset, y) } ) connection rem
let! a, b = read_until (ASCII.bytes(eol + boundary)) (fun x y -> async { do! temp_file.AsyncWrite(x.Array, x.Offset, y) } ) connection rem
let file_length = temp_file.Length
temp_file.Close()
if file_length > int64(0) then
Expand All @@ -290,9 +290,9 @@ module ParsingAndControl =
return! loop boundary b
| None ->
use mem = new MemoryStream()
let! a, b = read_until (bytes(eol + boundary)) (fun x y -> async { do! mem.AsyncWrite(x.Array, x.Offset, y) } ) connection rem
let! a, b = read_until (ASCII.bytes(eol + boundary)) (fun x y -> async { do! mem.AsyncWrite(x.Array, x.Offset, y) } ) connection rem
let byts = mem.ToArray()
request.form.Add(fieldname, (to_string byts 0 byts.Length))
request.form.Add(fieldname, (ASCII.to_string byts 0 byts.Length))

return! loop boundary b
}
Expand Down Expand Up @@ -353,7 +353,7 @@ module ParsingAndControl =
match content_encoding with
| Some ce when ce.StartsWith("application/x-www-form-urlencoded") ->
let! (rawdata : ArraySegment<_>), rem = read_post_data connection content_length rem
let str = to_string rawdata.Array rawdata.Offset rawdata.Count
let str = ASCII.to_string rawdata.Array rawdata.Offset rawdata.Count
let _ = parse_data str request.form
// TODO: we can defer reading of body until we need it
let raw_form = Array.zeroCreate rawdata.Count
Expand Down Expand Up @@ -542,8 +542,8 @@ let default_error_handler (ex : Exception) msg (ctx : HttpContext) = async {
let request = ctx.request
msg |> Log.verbosee ctx.runtime.logger "Web.default_error_handler" ctx.request.trace ex
if IPAddress.IsLoopback ctx.connection.ipaddr then
do! (Http.response 500 "Internal Error" (bytes_utf8 (sprintf "<h1>%s</h1><br/>%A" ex.Message ex)) ctx)
else do! (Http.response 500 "Internal Error" (bytes_utf8 ("Internal Error")) ctx)
do! (Http.response 500 "Internal Error" (UTF8.bytes (sprintf "<h1>%s</h1><br/>%A" ex.Message ex)) ctx)
else do! (Http.response 500 "Internal Error" (UTF8.bytes ("Internal Error")) ctx)
}

/// Returns the webserver as a tuple of 1) an async computation the yields unit when
Expand Down

0 comments on commit 6731c41

Please sign in to comment.