Simple synchronous HTTP Server

Needed to receive an OAuth 2 response so used simple http listener

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84:

(*
[CONTEXT] Trying to access box.com for file storage 
          (in interactive console app)
  Concept could be used for other OAuth providers
Box.com has the following info:
  To complete an OAuth 2.0 flow the following steps need to be completed.

    1. Configure the Box SDK
    2. Redirect the user to the Box website (with REDIRECT_URI)
    3. The user grants the application access
    4. Exchange the authorization code for an access token

Step 4: "The user is redirected to your application's redirect URL 
with a query parameter containing a short-lived authorization code."
Needed to receive that request to exchange the code
So have the console app create a 'webserver' and capture code [this script]. 

*)

open System
open System.Net

let host = "http://localhost:8888/"

let hl = new HttpListener()
hl.Prefixes.Add host
hl.Start()
printfn "Listening for HTTP on %s ..." host

// Note: The GetContext method blocks while waiting for a request.
let context = hl.GetContext()

///incoming request
let request = context.Request
///querystring code key for OAuth2
let code = request.QueryString.["code"]

//printfn "Url.OriginalString: %O" request.Url.OriginalString
//printfn "RawUrl: %O" request.RawUrl
//printfn "%s" code

// Obtain a response object to make outgoing response.
//Already have what is needed (querystring code)
//the response lets the sending server know I got it
let response = context.Response

let responseString = 
  """
  <!DOCTYPE html>
  <html lang="en">
    <head>
      <meta charset="utf-8">
      <title>OAuth2 Code Page</title>
    </head>
    <body>
      <!-- page content -->
      Got the code! @ """ + DateTime.Now.ToString() + """
    </body>
  </html>
  """

let encoding = System.Text.Encoding.UTF8
let txt = encoding.GetBytes responseString

//each are optional header options. Actually works ok without them
response.ContentEncoding  <- encoding
response.ContentLength64  <- Convert.ToInt64( txt.Length )
response.ContentType      <- System.Net.Mime.MediaTypeNames.Text.Html
response.KeepAlive        <- false

//send response
response.OutputStream.Write (txt, 0, txt.Length)
//must close
response.OutputStream.Close()

//stop the HTTP listener
hl.Stop();

//the value I was wanting 
//as part of a client side OAuth 2 ping pong
printfn "%s" code


//next use this to send new http request for exchange for Access Token

namespace System

namespace System.Net

val host : string

val hl : HttpListener

Multiple items
type HttpListener =
  new : unit -> HttpListener
  member Abort : unit -> unit
  member AuthenticationSchemeSelectorDelegate : AuthenticationSchemeSelector with get, set
  member AuthenticationSchemes : AuthenticationSchemes with get, set
  member BeginGetContext : callback:AsyncCallback * state:obj -> IAsyncResult
  member Close : unit -> unit
  member DefaultServiceNames : ServiceNameCollection
  member EndGetContext : asyncResult:IAsyncResult -> HttpListenerContext
  member ExtendedProtectionPolicy : ExtendedProtectionPolicy with get, set
  member ExtendedProtectionSelectorDelegate : ExtendedProtectionSelector with get, set
  ...
  nested type ExtendedProtectionSelector

--------------------
HttpListener() : HttpListener

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

val context : HttpListenerContext

val request : HttpListenerRequest

incoming request

val code : string

querystring code key for OAuth2

val response : HttpListenerResponse

val responseString : string

Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

--------------------
DateTime ()
   (+0 other overloads)
DateTime(ticks: int64) : DateTime
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : DateTime
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : DateTime
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : DateTime
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : DateTime
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : DateTime
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : DateTime
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : DateTime
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : DateTime
   (+0 other overloads)

property DateTime.Now: DateTime with get

val encoding : Text.Encoding

namespace System.Text

type Encoding =
  member BodyName : string
  member Clone : unit -> obj
  member CodePage : int
  member DecoderFallback : DecoderFallback with get, set
  member EncoderFallback : EncoderFallback with get, set
  member EncodingName : string
  member Equals : value:obj -> bool
  member GetByteCount : chars:char[] -> int + 5 overloads
  member GetBytes : chars:char[] -> byte[] + 7 overloads
  member GetCharCount : bytes:byte[] -> int + 3 overloads
  ...

property Text.Encoding.UTF8: Text.Encoding with get

val txt : byte []

type Convert =
  static val DBNull : obj
  static member ChangeType : value:obj * typeCode:TypeCode -> obj + 3 overloads
  static member FromBase64CharArray : inArray:char[] * offset:int * length:int -> byte[]
  static member FromBase64String : s:string -> byte[]
  static member GetTypeCode : value:obj -> TypeCode
  static member IsDBNull : value:obj -> bool
  static member ToBase64CharArray : inArray:byte[] * offsetIn:int * length:int * outArray:char[] * offsetOut:int -> int + 1 overload
  static member ToBase64String : inArray:byte[] -> string + 4 overloads
  static member ToBoolean : value:obj -> bool + 17 overloads
  static member ToByte : value:obj -> byte + 18 overloads
  ...

Convert.ToInt64(value: DateTime) : int64
   (+0 other overloads)
Convert.ToInt64(value: string) : int64
   (+0 other overloads)
Convert.ToInt64(value: decimal) : int64
   (+0 other overloads)
Convert.ToInt64(value: float) : int64
   (+0 other overloads)
Convert.ToInt64(value: float32) : int64
   (+0 other overloads)
Convert.ToInt64(value: int64) : int64
   (+0 other overloads)
Convert.ToInt64(value: uint64) : int64
   (+0 other overloads)
Convert.ToInt64(value: uint32) : int64
   (+0 other overloads)
Convert.ToInt64(value: int) : int64
   (+0 other overloads)
Convert.ToInt64(value: uint16) : int64
   (+0 other overloads)

namespace System.Net.Mime

type MediaTypeNames =
  nested type Application
  nested type Image
  nested type Text

type Text =
  static val Plain : string
  static val Html : string
  static val Xml : string
  static val RichText : string

field Mime.MediaTypeNames.Text.Html: string = "text/html"

Raw view Test code New version

More information

Link:	http://fssnip.net/7ZZ
Posted:	4 years ago
Author:	Ivan Rainbolt
Tags:	http , httplistener , oauth , server , web