using Programming;

A Blog about some of the intrinsics related to programming and how one can get the best out of various languages.

F# Advent Day of Code: Modeling types to prevent bugs

F# Advent Day of Code: Taking advantage of the F# Type-System

Today is my date for F# Advent, and I want to discuss as pretty large topic, which happens to be domain modeling with F# types, and how to model the types to prevent bugs.

One of the "going jokes" in the F# community is that "if it compiles, it works and bug free." This is obviously not entirely true, there's always a possibility that it won't work properly, but it is actually proven fairly often. Part of this is because of F#'s type system, the strong-typing requisite, and the fact that it does not implicitly convert them. The problem, and often the source of bugs that do manifest, is that without a little thinking, it's hard to build a type-structure that creates this "bug free" scenario. It can be done, but you have to forget about how you think about types.

In this lesson we're going to take a library I'm preparing to open-source, and discuss how to build a type-system that is mostly flawless, and doesn't allow us to model incorrect structure or state.

Step 1: same as usual, identify the problem

The first step of any program is to identify the problem. In our situation, the problem I'm proposing to solve is the enormous problem of generating HTML code from a non-HTML language, and not writing it by hand. More often than not I'm forced to look up intricacies of HTML, and subtleties that really ought to be a lot easier. We're also going to see how we can generate HTML that is 100% conformant to the HTML specification, and how we can even embed compiler warnings into our system, such that if it compiles, it's valid HTML.

Remember that F# is a functional language, and uses an algebraic type-system. The language itself is designed to support these types of ideas natively and out of the box, so we're going to go over the basics of building this system, and we'll cover what the type-system gives us that enables compile-time safety of a generated system.

Step 2: solve the problem

This is the last heading, and it's going to be long, so buckle-up and enjoy the ride.

HTML is a language that is used predominantly to generate markup for websites and web-based applications. It's used to define a structure which a browser or device can use to render and organize content. A basic, perfectly valid, HTML page might look as follows:

A Page Title

To a normal developer like myself, there's nothing to this. We define the "DOCTYPE" first, then define the HTML content. This is a basic HTML5 compliant page, that only has a title and no content. HTML does not require content, but it does, interestingly, require the <title> element.

Now from this we can begin extracting some types. We can start to define how we want to model the type-system to make sure that we always generate a perfectly compliant page. We see that HTML has a few characteristics:

  • A DOCTYPE defining the document;
  • A <head> including the meta-data of the document;
  • A <title> in the head defining the title of the document;
  • A <body> including the content of the document;

With this, we'll actually build a quick type:

type DocType_V1 = | Html5
type Head_V1 = { Title : string }
type Document_V1 = { Doctype : DocType_V1; Head : Head_V1; Body : string }

let html5Document_v1 = { Document_V1.Doctype = Html5; Head = { Head_V1.Title = "A Test Document" }; Body = "" }

While this is a perfectly valid type, this doesn't solve our problem yet. All we have accomplished here is defining the "basics" of HTML, we can actually have a completely invalid <body> at this point. We also have none of the additional features available in the <head> element, such as <meta> tags, style-sheets, JavaScript, etc. Because I'm pragmatic, we're going to work from top-to-bottom, so we'll start with defining a better document.

The biggest issue here is that there are 7 major document types in modern HTML:

  1. HTML 5 (the newest);
  2. HTML 4.01 Frameset (very loose definition);
  3. HTML 4.01 Transitional (less loose, but still not very strict);
  4. HTML 4.01 Strict (very strict, compliant definition);
  5. XHTML 1.0 Frameset (a loose XHTML definition);
  6. XHTML 1.0 Transitional (less loose, but still not very strict XHTML definition);
  7. XHTML 1.0 Strict (very strict, compliant XHTML definition);

Knowing this, there's actually very different aspects to each document type. Therefore, it doesn't make sense to use an enum for it, it instead makes sense to use a outer union for it:

type Head_V2 = { Title : string }
type StrictDocument_V2 = { Head : Head_V2; Body : string }
type TransitionalDocument_V2 = { Head : Head_V2; Body : string }
type FramesetDocument_V2 = { Head : Head_V2; Body : string }
type DocumentForm_V2 = | Strict of StrictDocument_V2 | Transitional of TransitionalDocument_V2 | Frameset of FramesetDocument_V2
type Document_V2 = | Html5Document of StrictDocument_V2 | Html4Document of DocumentForm_V2 | XhtmlDocument of DocumentForm_V2

let html5Document_v2 = Document_V2.Html5Document { StrictDocument_V2.Head = { Head_V2.Title = "A Test Document" }; Body = "" }

What just became quite interesting is that it's actually impossible to model an unsupported document type now. Previously, we would actually hit an issue where it would become possible to model a document that was not a StrictDocument, which would create an invalid HTML document.

The next step is to model some of the <meta> tags that are often placed inside a <head> element. These are things like the document character-set, linked-resources, language, description, keywords, etc. The <meta> tags can also be free-form, meaning they can be a tag to support things like Facebook descriptions and identifiers which help with creating pages that are more friendly to the social-network, etc. To support this we'll actually build mutliple meta-tag models.

To model this, we'll start with the "standard" meta-data's to be supported. This is easily modeled following the requirements in the HTML5 specification which is freely (and easily) accessible:

type StandardMeta_V3 = | ApplicationName of Lang : string option | Author | Description | Generator | Keywords | Referrer

The interesting tag here is ApplicationName, which allows you to specify between zero and one, inclusive, tags with the same "language". These would be included in the document as follows:

The kicker is that lang is optional, and there may be only one of each lang value in a document.

Another important aspect of a <head> element is the charset, or character-set. Every HTML page is allowed to declare a <meta> tag with a name="charset" attribute exactly once, and this charset should be the encoding used to send the page from server to browser. We'll actually define an enum type for this:

type Charset_V3 = | Utf8

And we'll include this and the standard <meta> tags in the new Head element:

type Head_V3 = { Title : string; Charset : Charset_V3 option; StandardMetas : Map<StandardMeta_V3, string> }

Still quite simple, and we'll use our previous model with a few minor modifications:

type StrictDocument_V3 = { Head : Head_V3; Body : string option }
type TransitionalDocument_V3 = { Head : Head_V3; Body : string option }
type FramesetDocument_V3 = { Head : Head_V3; Body : string option }
type DocumentForm_V3 = | Strict of StrictDocument_V3 | Transitional of TransitionalDocument_V3 | Frameset of FramesetDocument_V3
type Document_V3 = | Html5Document of StrictDocument_V3 | Html4Document of DocumentForm_V3 | XhtmlDocument of DocumentForm_V3

let html5Document_v3 =
    Document_V3.Html5Document
      { StrictDocument_V3.Head =
          { Head_V3.Title = "A Test Document"
            Charset = Some Charset_V3.Utf8
            StandardMetas = [(StandardMeta_V3.ApplicationName (Some "en"), "Test Application"); (StandardMeta_V3.Description, "A test application.")] |> Map.ofList }
        Body = None }

Side note: we used Map, but as there's currently no syntax to construct a map natively, it's possible to create a situation where the compiler will not stop us from creating an invalid list, this is something the F# team has on the list, and hopefully it's resolved sooner rather than later.

So now that we have a document created and modeled, it's time to generate. Fortunately, generating HTML is actually really easy if you follow the rules / guidelines. For XHTML that means always lower-case the attribute and tag names, for regular HTML it's not as strict, but still has rules.

The first rule of HTML and XHTML alike is the DOCTYPE, which is (fortunately) a static list. For us, we care about the following:

let getDoctype_v3 document =
    match document with
    | Document_V3.XhtmlDocument (Strict _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
    | XhtmlDocument (Transitional _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
    | XhtmlDocument (Frameset _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">"
    | Html4Document (Strict _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"
    | Html4Document (Transitional _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
    | Html4Document (Frameset _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\" \"http://www.w3.org/TR/html4/frameset.dtd\">"
    | Html5Document _ -> "<!DOCTYPE HTML>"

With this single function, we can get every DOCTYPE we need for all our supported models.

let html5Document_v3_doctype = html5Document_v3 |> getDoctype_v3

This ought to return <!DOCTYPE HTML>. You'll notice that for all three of the XHTML DOCTYPE results, html is lower-case. That's part of the spec I mentioned.

As usual, I want to declare a couple functions we'll use for the whole project:

let joinStrings sep (strs : string array) = System.String.Join(sep, strs)
let prependIfText sep str = if str |> Seq.isEmpty |> not then sprintf "%s%s" sep str else ""

They just make life easier.

Next, we need to think about our document. Our document is made up of "elements" which are represented as "tags", and tags have a couple rules about them:

  • Some tags are allowed to self-close, or <tag /> vs <tag></tag> (the <script> tag for example cannot self-close);
  • Some tags are "inline" tags, that is, we don't want to break lines inside the tag (like <title>, we want to do <title>...</title>, without a line-break);
  • Some tags have attributes, and some do not;
  • Some tags will have content, and some will not;
  • All tags have a name;

With this, we can begin to define a function that will fulfill these requirements. We'll always know ahead-of-time whether the tag will allow self-closing, and whether or not we want to include line-breaks, so we want to start defining an API:

let renderTag_v3_1 (selfClose : bool) (includeBreaks : bool) (tagName : string) = ()

Obviously we need to add a body to the function, but this starts us off. We can then define functions which will alias to this function. The next item should probably be attributes, because sometimes we'll have those and sometimes we won't.

We probably want to include content as well, so our final API might look like:

let renderTag_v3_2 (selfClose : bool) (includeBreaks : bool) (tagName : string) (attrs : Map<string, string>) (content : string) = ()

Finally, we want to define a body. The first part of any tag is starting it, or the <tagName bit. (Notice I excluded the closing bracket: this is going to be dealt with momentarily.) The <tagName bit should also have attributes if there are any, so we'll want <tagName attr="value". To do this, we can actually map our attributes to an array, then map them to key=\"value\", then join them on a space, then add space if there are any, then finally we can print the starting tag:

let renderTag_v3_3 (selfClose : bool) (includeBreaks : bool) (tagName : string) (attrs : Map<string, string>) (content : string) =
    let tagStart =
        attrs
        |> Map.toArray
        |> Array.map (fun ((k : string), (v : string)) -> sprintf "%s=\"%s\"" (k.ToLower()) (v.Replace("\"", "\\\"")))
        |> joinStrings " "
        |> prependIfText " "
        |> sprintf "<%s%s" tagName
    tagStart

Once again, we're making decent progress. We've followed the XHTML convention, of lower-casing the key, which is also entirely valid for HTML. (Conveniently.)

Next, if the content is empty, we want to either self-close or explictly close the tag. This is accomplished by a simple if.

let renderTag_v3_4 (selfClose : bool) (includeBreaks : bool) (tagName : string) (attrs : Map<string, string>) (content : string) =
    let tagStart =
        attrs
        |> Map.toArray
        |> Array.map (fun ((k : string), (v : string)) -> sprintf "%s=\"%s\"" (k.ToLower()) (v.Replace("\"", "\\\"")))
        |> joinStrings " "
        |> prependIfText " "
        |> sprintf "<%s%s" tagName
    if content |> System.String.IsNullOrEmpty then
        if selfClose then sprintf "%s />" tagStart
        else sprintf "%s></%s>" tagStart tagName
    else 
        tagStart

In our else branch, when there is content, we want to test it for any line-breaks, and if we should include them do so:

let renderTag_v3_5 selfClose includeBreaks tagName attrs content =
    let tagStart =
        attrs
        |> Map.toArray
        |> Array.map (fun ((k : string), (v : string)) -> sprintf "%s=\"%s\"" (k.ToLower()) (v.Replace("\"", "\\\"")))
        |> joinStrings " "
        |> prependIfText " "
        |> sprintf "<%s%s" tagName
    if content |> System.String.IsNullOrEmpty then
        if selfClose then sprintf "%s />" tagStart
        else sprintf "%s></%s>" tagStart tagName
    else
        let tagStart = sprintf "%s>" tagStart
        let breakV = if includeBreaks then System.Environment.NewLine else ""
        let tagEnd = sprintf "</%s>" tagName
        sprintf "%s%s%s%s%s%s" tagStart breakV content breakV tagEnd breakV

So now that gets our main tag-rendering started. The next bit is to actually build prototypes for each main tag:

let renderTitle_v3 = renderTag_v3_5 false false "title" Map.empty<string, string>
let renderHead_v3 = renderTag_v3_5 false true "head" Map.empty<string, string>
let renderBody_v3 = renderTag_v3_5 false true "body"

As you can see, each tag has specific expectations. Our <title> tag has no line-breaks, and does not allow attributes, whereas our <head> tag has line-breaks, and does not allow attributes. Our <body> tag has both.

We have another utility method to define:

let stringOrBlank = function | Some s -> s | None -> ""

Which will make sense in a moment.

The next step is to render the actual document. This is relatively easy, render the <head>, render the <body>, and render the <!DOCTYPE>. Because we have 3 major HTML document-types, and each has different rules, we'll define a function for each:

let getStrictBody_v3 (document : StrictDocument_V3) =
    let sb = System.Text.StringBuilder()
    document.Head.Title |> renderTitle_v3 |> renderHead_v3 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()
let getTransitionalBody_v3 (document : TransitionalDocument_V3) =
    let sb = System.Text.StringBuilder()
    document.Head.Title |> renderTitle_v3 |> renderHead_v3 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()
let getFramesetBody_v3 (document : FramesetDocument_V3) =
    let sb = System.Text.StringBuilder()
    document.Head.Title |> renderTitle_v3 |> renderHead_v3 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()

Now we see how things start to fit together, and we still have to return one more larger document for the full <html> bit:

let getBody_v3 document =
    match document with
    | XhtmlDocument (Strict d) | Html4Document (Strict d) | Html5Document d -> d |> getStrictBody_v3
    | XhtmlDocument (Transitional d) | Html4Document (Transitional d) -> d |> getTransitionalBody_v3
    | XhtmlDocument (Frameset d) | Html4Document (Frameset d) -> d |> getFramesetBody_v3

Of course, it's obvious this isn't handling the <html> bit, this just calls the next renderer.

let printDocument_v3 document =
    let doctype = document |> getDoctype_v3
    let sb = System.Text.StringBuilder()
    doctype |> sb.Append |> ignore
    System.Environment.NewLine |> sb.Append |> ignore
    let attrs =
        match document with
        | Html4Document _ | Html5Document _ -> [] |> Map.ofList
        | XhtmlDocument _ -> [("xmlns", "http://www.w3.org/1999/xhtml")] |> Map.ofList
    document |> getBody_v3 |> renderTag_v3_5 false true "html" attrs |> sb.Append |> ignore
    sb.ToString()

While this is a great start, we haven't fully supported our model. We don't render the <meta> tags I promised. To do that, we have to add a little more code (though not much). For these we'll abstract up our <head> rendering another level, because we need to render sequences in the <head> tag.

let renderMetaTag_v4 = renderTag_v3_5 true false "meta"
let getCharset_v4 c =
    match c with
    | Charset_V3.Utf8 -> "utf-8"

let getStandardMetaAttrs_v4 m =
    let result s = [("name", s)]
    match m with
    | StandardMeta_V3.ApplicationName lang -> lang |> (function | Some l -> [("lang", l)] | _ -> []) |> List.append [("name", "application-name")]
    | Author -> "author" |> result
    | Description -> "description" |> result
    | Generator -> "generator" |> result
    | Keywords -> "keywords" |> result
    | Referrer -> "referrer" |> result

let getHead_v4 head =
    let sb = System.Text.StringBuilder()
    head.Title |> renderTitle_v3 |> sb.Append |> ignore
    match head.Charset with
    | Some c ->
        let charset = c |> getCharset_v4
        renderMetaTag_v4 ([("content", (sprintf "text/html; charset=%s" charset)); ("http-equiv", "Content-Type")] |> Map.ofList) "" |> sb.Append |> ignore
    | None -> ()
    head.StandardMetas |> Map.toArray |> Array.map (fun (k, v) -> renderMetaTag_v4 ([("content", v)] |> List.append (k |> getStandardMetaAttrs_v4) |> Map.ofList) "") |> Array.iter (sb.Append >> ignore)
    sb.ToString() |> renderHead_v3

let getStrictBody_v4 (document : StrictDocument_V3) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHead_v4 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()
let getTransitionalBody_v4 (document : TransitionalDocument_V3) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHead_v4 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()
let getFramesetBody_v4 (document : FramesetDocument_V3) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHead_v4 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()

With all that done, we should get the apporpriate result with our "standard" meta-tags returned in the result output. This demonstrates how truly easy it is to modify this system to add features.

Now we haven't even come close to finishing with the <head> section, nor even close to fulfilling even the most common elements of it. For that, we'll actually add a couple more properties to our record type.

A <head> section in an (X)HTML page often consists of stylesheets and JavaScript as well as the items we've already included. Fortunately, including support for those two sections is bewilderingly easy. We'll just create two new properties on our Head type, and we'll also add a new Union type to indicate if they're a file, or the actual script.

There are two ways to include stylesheets and JavaScript: you can include a reference to a file that holds the information, or you can include the raw information. Supporting both here is extremely easy:

type Resource_V5 = | File of Name : string | Data of RawData : string

So now, we could actually create a JavaScript section to our Head:

type Head_V5 = { Title : string; Charset : Charset_V3 option; StandardMetas : Map<StandardMeta_V3, string>; Scripts : Resource_V5 list; Stylesheets : Resource_V5 list }

That's easy enough. I also included the stylesheets, because both will use the same union type, with different values. Now we can create a new document with these specified:

type StrictDocument_V5 = { Head : Head_V5; Body : string option }
type TransitionalDocument_V5 = { Head : Head_V5; Body : string option }
type FramesetDocument_V5 = { Head : Head_V5; Body : string option }
type DocumentForm_V5 = | Strict of StrictDocument_V5 | Transitional of TransitionalDocument_V5 | Frameset of FramesetDocument_V5
type Document_V5 = | Html5Document of StrictDocument_V5 | Html4Document of DocumentForm_V5 | XhtmlDocument of DocumentForm_V5
let html5Document_v5 =
    Document_V5.Html5Document
      { StrictDocument_V5.Head =
          { Head_V5.Title = "A Test Document"
            Charset = Some Charset_V3.Utf8
            StandardMetas = [(StandardMeta_V3.ApplicationName (Some "en"), "Test Application"); (StandardMeta_V3.Description, "A test application.")] |> Map.ofList
            Scripts = [Resource_V5.File "somepath/file.js"; Resource_V5.Data "alert(\"Test script!\");"]
            Stylesheets = [] }
        Body = None }

Now we just have to render these, which is only a slight change to our getHead function:

let renderScript_v5 s =
    match s with
    | Resource_V5.File f -> renderTag_v3_5 false false "script" ([("type", "text/javascript"); ("src", f)] |> Map.ofList) ""
    | Data d -> renderTag_v3_5 false true "script" ([("type", "text/javascript")] |> Map.ofList) d
let renderStyle_v5 s =
    match s with
    | Resource_V5.File f -> renderTag_v3_5 true false "link" ([("rel", "stylesheet"); ("type", "text/css"); ("href", f)] |> Map.ofList) ""
    | Data d -> renderTag_v3_5 true true "style" ([("type", "text/css")] |> Map.ofList) d
let getHead_v5 head =
    let sb = System.Text.StringBuilder()
    let render (s : string) =
        s |> sb.Append |> ignore
        System.Environment.NewLine |> sb.Append |> ignore
    head.Title |> renderTitle_v3 |> render
    match head.Charset with
    | Some c ->
        let charset = c |> getCharset_v4
        "" |> render
        renderMetaTag_v4 ([("content", (sprintf "text/html; charset=%s" charset)); ("http-equiv", "Content-Type")] |> Map.ofList) "" |> sb.Append |> ignore
    | None -> ()
    match head.StandardMetas with
    | m when m.IsEmpty -> ()
    | m ->
        "" |> render
        m |> Map.toArray |> Array.map (fun (k, v) -> renderMetaTag_v4 ([("content", v)] |> List.append (k |> getStandardMetaAttrs_v4) |> Map.ofList) "") |> Array.iter render
    match head.Stylesheets with
    | [] -> ()
    | s ->
        "" |> render
        s |> List.map renderStyle_v5 |> List.iter render
    match head.Scripts with
    | [] -> ()
    | s ->
        "" |> render
        s |> List.map renderScript_v5 |> List.iter render
    sb.ToString() |> renderHead_v3

let getStrictBody_v5 (document : StrictDocument_V5) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHead_v5 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()
let getTransitionalBody_v5 (document : TransitionalDocument_V5) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHead_v5 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()
let getFramesetBody_v5 (document : FramesetDocument_V5) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHead_v5 |> sb.Append |> ignore
    document.Body |> stringOrBlank |> renderBody_v3 ([] |> Map.ofList) |> sb.Append |> ignore
    sb.ToString()

let getBody_v5 document =
    match document with
    | XhtmlDocument (Strict d) | Html4Document (Strict d) | Html5Document d -> d |> getStrictBody_v5
    | XhtmlDocument (Transitional d) | Html4Document (Transitional d) -> d |> getTransitionalBody_v5
    | XhtmlDocument (Frameset d) | Html4Document (Frameset d) -> d |> getFramesetBody_v5

let getDoctype_v5 document =
    match document with
    | Document_V5.XhtmlDocument (Strict _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
    | XhtmlDocument (Transitional _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
    | XhtmlDocument (Frameset _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">"
    | Html4Document (Strict _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"
    | Html4Document (Transitional _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
    | Html4Document (Frameset _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\" \"http://www.w3.org/TR/html4/frameset.dtd\">"
    | Html5Document _ -> "<!DOCTYPE HTML>"

let printDocument_v5 (document : Document_V5) =
    let doctype = document |> getDoctype_v5
    let sb = System.Text.StringBuilder()
    doctype |> sb.Append |> ignore
    System.Environment.NewLine |> sb.Append |> ignore
    let attrs =
        match document with
        | Html4Document _ | Html5Document _ -> [] |> Map.ofList
        | XhtmlDocument _ -> [("xmlns", "http://www.w3.org/1999/xhtml")] |> Map.ofList
    document |> getBody_v5 |> renderTag_v3_5 false true "html" attrs |> sb.Append |> ignore
    sb.ToString()

let writeFile f c = System.IO.File.WriteAllText(System.IO.Path.Combine(__SOURCE_DIRECTORY__, f), c)
html5Document_v5 |> printDocument_v5 |> writeFile "TestFile.html"

With all of this, our work starts to come together nicely. We want to test it with an XHTML document as well, which is just as easy:

let xhtml1Document_v5 =
    Document_V5.XhtmlDocument
      (DocumentForm_V5.Strict
          { StrictDocument_V5.Head =
              { Head_V5.Title = "A Test Document"
                Charset = Some Charset_V3.Utf8
                StandardMetas = [(StandardMeta_V3.ApplicationName (Some "en"), "Test Application"); (StandardMeta_V3.Description, "A test application.")] |> Map.ofList
                Scripts = [Resource_V5.File "somepath/file.js"; Resource_V5.Data "alert(\"Test script!\");"]
                Stylesheets = [] }
            Body = None } )
xhtml1Document_v5 |> printDocument_v5 |> writeFile "TestFile.html"

Next, we want to add support for non-standard <meta> tags, which is extremely easy:

type Head_V6 = { Title : string; Charset : Charset_V3 option; StandardMetas : Map<StandardMeta_V3, string>; AdditionalMetas : Map<string, string>; Scripts : Resource_V5 list; Stylesheets : Resource_V5 list }

let getHead_v6 head =
    let sb = System.Text.StringBuilder()
    let render (s : string) =
        s |> sb.Append |> ignore
        System.Environment.NewLine |> sb.Append |> ignore
    head.Title |> renderTitle_v3 |> render
    match head.Charset with
    | Some c ->
        let charset = c |> getCharset_v4
        "" |> render
        renderMetaTag_v4 ([("content", (sprintf "text/html; charset=%s" charset)); ("http-equiv", "Content-Type")] |> Map.ofList) "" |> sb.Append |> ignore
    | None -> ()
    match head.StandardMetas with
    | m when m.IsEmpty -> ()
    | m ->
        "" |> render
        m |> Map.toArray |> Array.map (fun (k, v) -> renderMetaTag_v4 ([("content", v)] |> List.append (head.AdditionalMetas |> Map.toList) |> List.append (k |> getStandardMetaAttrs_v4) |> Map.ofList) "") |> Array.iter render
    match head.Stylesheets with
    | [] -> ()
    | s ->
        "" |> render
        s |> List.map renderStyle_v5 |> List.iter render
    match head.Scripts with
    | [] -> ()
    | s ->
        "" |> render
        s |> List.map renderScript_v5 |> List.iter render
    sb.ToString() |> renderHead_v3

You'll notice the only thing I changed is to add a List.append (head.AdditionalMetas |> Map.toList) in our standard meta printing, because the standard metas are, at that point, string * string. This means we can guarantee it works because we used the exact same code to do both. By taking the combined list back to a Map, we guarantee that each key is specified exactly once even among the combined lists.

We have one more part of the <head> tag I want to go over, and that's the presence of a <base> tag. This is where we'll see a divide between the XHTML and HTML specifications, as they have different allowable options.

For XHTML 1.0, the <base> tag is allowed to have an href attribute, that specifies what the base URL is for relative navigation. (I.e. if you provide a link to somepage.html, the <base href="http://www.example.com/"> tag will make that a link to http://www.example.com/somepage.html.)

In HTML, the following unions would satisfy our <base> tag requirements:

type HrefTarget_V7 = | SameContextWindow | NewCleanContext | ParentContext | TopMostContext
type HtmlBaseElement_V7 = | Href of string | Target of HrefTarget_V7 | HrefTarget of string * HrefTarget_V7

In XHTML, it's only allowed to be a Href or not specified. For that, we'll define some new <head> models:

type HtmlHead_V7 = {
    Title : string
    Base : HtmlBaseElement_V7 option
    Charset : Charset_V3 option
    StandardMetas : Map<StandardMeta_V3, string>
    AdditionalMetas : Map<string, string>
    Stylesheets : Resource_V5 list
    Scripts : Resource_V5 list }
type XhtmlHead_V7 = {
    Title : string
    Base : string option
    Charset : Charset_V3 option
    StandardMetas : Map<StandardMeta_V3, string>
    AdditionalMetas : Map<string, string>
    Stylesheets : Resource_V5 list
    Scripts : Resource_V5 list }

Obviously this means we will now have two different head models, which means we will need two different renderers, and two different sets of document types, etc. While we're at it, we may-as-well start defining the Body type, which will hold our main content.

type Body_V7 = { Attributes : Map<string, string>; Children : string option }
type HtmlFramesetDocument_V7 = { Head : HtmlHead_V7; Body : Body_V7 }
type HtmlTransitionalDocument_V7 = { Head : HtmlHead_V7; Body : Body_V7 }
type HtmlStrictDocument_V7 = { Head : HtmlHead_V7; Body : Body_V7 }
type XhtmlFramesetDocument_V7 = { Head : XhtmlHead_V7; Body : Body_V7 }
type XhtmlTransitionalDocument_V7 = { Head : XhtmlHead_V7; Body : Body_V7 }
type XhtmlStrictDocument_V7 = { Head : XhtmlHead_V7; Body : Body_V7 }
type HtmlDocumentForm_V7 = | Frameset of HtmlFramesetDocument_V7 | Transitional of HtmlTransitionalDocument_V7 | Strict of HtmlStrictDocument_V7
type XhtmlDocumentForm_V7 = | Frameset of XhtmlFramesetDocument_V7 | Transitional of XhtmlTransitionalDocument_V7 | Strict of XhtmlStrictDocument_V7
type WebDocument_V7 = | Html5Document of HtmlStrictDocument_V7 | Html4Document of HtmlDocumentForm_V7 | XhtmlDocument of XhtmlDocumentForm_V7
let getDoctype_v7 document =
    match document with
    | XhtmlDocument (XhtmlDocumentForm_V7.Strict _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
    | XhtmlDocument (XhtmlDocumentForm_V7.Transitional _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
    | XhtmlDocument (XhtmlDocumentForm_V7.Frameset _) -> "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">"
    | Html4Document (HtmlDocumentForm_V7.Strict _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">"
    | Html4Document (HtmlDocumentForm_V7.Transitional _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"
    | Html4Document (HtmlDocumentForm_V7.Frameset _) -> "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\" \"http://www.w3.org/TR/html4/frameset.dtd\">"
    | Html5Document _ -> "<!DOCTYPE HTML>"

As is obvious here, we're forcing the different between the document types to be more obvious. This is mostly due to our <head> tag issue, but we would have needed to do this anyway (and will do so for the <body> eventually). Now, fortunately, most of our boiler-plate will stay the same, except for the first couple steps of rendering:

let getTarget_v7 = function | SameContextWindow -> "_self" | NewCleanContext -> "_blank" | ParentContext -> "_parent" | TopMostContext -> "_top"

let getHtmlHead (head : HtmlHead_V7) =
    let sb = System.Text.StringBuilder()
    let render (s : string) =
        s |> sb.Append |> ignore
        System.Environment.NewLine |> sb.Append |> ignore
    head.Title |> renderTitle_v3 |> render
    match head.Charset with
    | Some c ->
        "" |> render
        renderMetaTag_v4 ([("content", c |> getCharset_v4 |> sprintf "text/html; charset=%s"); ("http-equiv", "Content-Type")] |> Map.ofList) "" |> render
    | None -> ()
    match head.Base with
    | Some b ->
        let attrs = 
            let href =
                match b with
                | Href h | HrefTarget (h, _) -> [("href", h)]
                | _ -> []
            let target = 
                match b with
                | Target t | HrefTarget (_, t) -> [("target", t |> getTarget_v7)]
                | _ -> []
            target |> List.append href |> Map.ofList
        "" |> render
        renderTag_v3_5 true false "base" attrs "" |> render
    | None -> ()
    match head.StandardMetas with
    | m when m.IsEmpty -> ()
    | m ->
        "" |> render
        m |> Map.toArray |> Array.map (fun (k, v) -> renderMetaTag_v4 ([("content", v)] |> List.append (head.AdditionalMetas |> Map.toList) |> List.append (k |> getStandardMetaAttrs_v4) |> Map.ofList) "") |> Array.iter render
    match head.Stylesheets with
    | [] -> ()
    | s ->
        "" |> render
        s |> List.map renderStyle_v5 |> List.iter render
    match head.Scripts with
    | [] -> ()
    | s ->
        "" |> render
        s |> List.map renderScript_v5 |> List.iter render
    sb.ToString() |> renderHead_v3

Now, interestingly, we can make XHTML head rendering really easy by converting it to an HTML head, at least for now.

let getXhtmlHead (head : XhtmlHead_V7) =
    { HtmlHead_V7.Title = head.Title
      Charset = head.Charset
      AdditionalMetas = head.AdditionalMetas
      Base = head.Base |> Option.map Href
      StandardMetas = head.StandardMetas
      Stylesheets = head.Stylesheets
      Scripts = head.Scripts }
    |> getHtmlHead

Then we need to define some new get___Body and such functions, which are going to be just as trivial as before.

let getHtmlStrictBody_v7 (document : HtmlStrictDocument_V7) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHtmlHead |> sb.Append |> ignore
    document.Body.Children |> stringOrBlank |> sprintf "<div>%s</div>" |> renderBody_v3 document.Body.Attributes |> sb.Append |> ignore
    sb.ToString()
let getHtmlTransitionalBody_v7 (document : HtmlTransitionalDocument_V7) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHtmlHead |> sb.Append |> ignore
    document.Body.Children |> stringOrBlank |> sprintf "<div>%s</div>" |> renderBody_v3 document.Body.Attributes |> sb.Append |> ignore
    sb.ToString()
let getHtmlFramesetBody_v7 (document : HtmlFramesetDocument_V7) =
    let sb = System.Text.StringBuilder()
    document.Head |> getHtmlHead |> sb.Append |> ignore
    document.Body.Children |> stringOrBlank |> sprintf "<div>%s</div>" |> renderBody_v3 document.Body.Attributes |> sb.Append |> ignore
    sb.ToString()
let getXhtmlStrictBody_v7 (document : XhtmlStrictDocument_V7) =
    let sb = System.Text.StringBuilder()
    document.Head |> getXhtmlHead |> sb.Append |> ignore
    document.Body.Children |> stringOrBlank |> sprintf "<div>%s</div>" |> renderBody_v3 document.Body.Attributes |> sb.Append |> ignore
    sb.ToString()
let getXhtmlTransitionalBody_v7 (document : XhtmlTransitionalDocument_V7) =
    let sb = System.Text.StringBuilder()
    document.Head |> getXhtmlHead |> sb.Append |> ignore
    document.Body.Children |> stringOrBlank |> sprintf "<div>%s</div>" |> renderBody_v3 document.Body.Attributes |> sb.Append |> ignore
    sb.ToString()
let getXhtmlFramesetBody_v7 (document : XhtmlFramesetDocument_V7) =
    let sb = System.Text.StringBuilder()
    document.Head |> getXhtmlHead |> sb.Append |> ignore
    document.Body.Children |> stringOrBlank |> sprintf "<div>%s</div>" |> renderBody_v3 document.Body.Attributes |> sb.Append |> ignore
    sb.ToString()

We also added a sprintf "<div>%s</div>" to maintain (X)HTML compliance in the <body> section while we develop. Then getBody becomes pretty simple:

let getBody_v7 document =
    match document with
    | Html4Document (HtmlDocumentForm_V7.Strict d) | Html5Document d -> d |> getHtmlStrictBody_v7
    | XhtmlDocument (XhtmlDocumentForm_V7.Strict d) -> d |> getXhtmlStrictBody_v7
    | Html4Document (HtmlDocumentForm_V7.Transitional d) -> d |> getHtmlTransitionalBody_v7
    | XhtmlDocument (XhtmlDocumentForm_V7.Transitional d) -> d |> getXhtmlTransitionalBody_v7
    | Html4Document (HtmlDocumentForm_V7.Frameset d) -> d |> getHtmlFramesetBody_v7
    | XhtmlDocument (XhtmlDocumentForm_V7.Frameset d) -> d |> getXhtmlFramesetBody_v7

But our printDocument doesn't change:

let printDocument_v7 document =
    let doctype = document |> getDoctype_v7
    let sb = System.Text.StringBuilder()
    doctype |> sb.Append |> ignore
    System.Environment.NewLine |> sb.Append |> ignore
    let attrs =
        match document with
        | Html4Document _ | Html5Document _ -> [] |> Map.ofList
        | XhtmlDocument _ -> [("xmlns", "http://www.w3.org/1999/xhtml")] |> Map.ofList
    document |> getBody_v7 |> renderTag_v3_5 false true "html" attrs |> sb.Append |> ignore
    sb.ToString()

let xhtmlDocument_v7 =
    XhtmlDocument (
        Strict {
            XhtmlStrictDocument_V7.Head =
              { Title = "Test"
                Base = Some "http://example.com/"
                Charset = Some Utf8
                StandardMetas = [(ApplicationName None, "Test Application"); (Description, "A test application."); (Keywords, "test, application")] |> Map.ofList
                AdditionalMetas = [] |> Map.ofList
                Scripts = [File "test.js"]
                Stylesheets = [File "style.css"] }
            Body = { Attributes = [] |> Map.ofList; Children = Some "Test" }
        })

let html5Document_v7 =
    Html5Document {
        HtmlStrictDocument_V7.Head =
          { Title = "Test"
            Base = NewCleanContext |> Target |> Some
            Charset = Some Utf8
            StandardMetas = [(ApplicationName None, "Test Application"); (Description, "A test application."); (Keywords, "test, application")] |> Map.ofList
            AdditionalMetas = [] |> Map.ofList
            Scripts = [File "test.js"]
            Stylesheets = [File "style.css"] }
        Body = { Attributes = [] |> Map.ofList; Children = None }
    }

[xhtmlDocument_v7; html5Document_v7] |> List.map printDocument_v7 |> List.iter (writeFile "TestFile.html")

Ok, ok, so I've gone through a whole bunch of stuff here, but haven't really described what it all means. Here's the thing: the purpose of this post is to show you exactly what is possible with the F# type system. It's designed to show you that we can actually define and use types which create a safe environment to generate a completely different language. We described the basic types and processes which are used to generate HTML (at least in my solution) from F#. I'll be making this whole library (which is far better written than my poor examples here) open source in the coming weeks, but the basic idea is something I've been meaning to describe for some time. With the definitions we have, the next step would be to define parts that can be assembled, so that we could take an html5Document and add the appropriate master style-sheets or templating to it. We could take a document and convert it to a different type, with minimal issue. The goal of this library was to generate HTML, and offer compile-time safety of that generated HTML, and as you can see we are already accomplishing that for our <head>.

You also might be asking yourself what the advantage to something like this really is. "Elliott, it's not all that hard to write HTML, really." And you're absolutely correct, HTML is a pretty easy markup language to write, and browsers are quite forgiving, which means that even when you mess up it still works out mostly-OK, but why don't we try to do better? I use this system to generate my HTML because it gives me three major benefits:

  1. Generate partial templates to be combined in later stages with ease;
  2. Ensure compliance with the HTML specification and that we don't forget to close the appropriate tags;
  3. Allow layout swaps and transitions with a much higher ease;

And I'm not sure about you, but these are the same reasons I use F# when I can, it gives me these same benefits.

Now I could continue to go on about how we would design this templating system, but I won't. It's overly excessive explanation for not-a-lot of benefit. Instead, I'll conclude our discussion here and when this is released, then I'll go through more of how-to-use it and why you might want to.

Until then, farewell, and I hope everyone enjoys the holiday season! ☃☃☃

Getting started with programming and getting absolutely nowhere (Part 21)

Building a Twitter Bot: Part 2 (Finish it all up)

Lesson 20: Building a Twitter Bot

Today I want to finish up our Twitter Bot. There's really not a lot left to do, we just have to tie a bunch of loose-ends up, parameterize some stuff and make it reusable. (Remember our previous discussion: write good, readable, usable code.)

Identify Dependencies

There are always dependencies in code, you'll never get around this. I want to identify the ones in our code today, and use them to push us to the next stage of development.

  • Dependency 1: the Consumer Key and Secret (hell, include the Access Token and Secret);
  • Dependency 2: the text file (our lyric file);
  • Dependency 3: the directory for said text file;
  • Dependency 4: what to split on (\r\n\r\n in our case, but it could be anything);
  • Dependency 5: the account ID;

This actually sums our dependencies up quite nicely. Now I want to define them in some sort of "configuration" file, in our case I'm going to use JSON because it's just so damn convenient. Let's define the aforementioned JSON config file:

{
      "ConsumerKey": "abcd1234",
      "ConsumerSecret": "abcd1234",
      "AccessToken": "1234-abcd1234",
      "AccessTokenSecret": "abcd1234",
      "AccountId": 9223372036854775807,
      "TextFile": "File.txt",
      "Split": "\r\n",
      "BaseDir": "."
}

Too easy. We can define the entire thing as 8 lines, that describe the type of data we expect. These are all the dependencies we have. All of them. Wrapped up with a nice little bow.

The next step is to bring those dependencies into our code. This is bewilderingly easy with F#: we're going to Install-Package FSharp.Data if you're using NuGet (just type that in the Package Manager Console), if you use packet then you're smarter than me and know exactly how to install it. (I know nothing of packet, but I hear it's nice.)

Now I save the config JSON above in a file called Config.sample.json, we'll need it to pull into F# so that we can define a type for the configuration. This is literally one line (well two, with the open):

open FSharp.Data
type Parameters = JsonProvider<"Config.sample.json">

And done. The JsonProvider will read our Config.sample.json file, and define an entire type for us to use. We can read something in as follows:

let parameters = configFile |> File.ReadAllText |> Parameters.Parse

Easy enough. The configFile will be a filename, I default to Config.json but you can use whatever you like.

Fix our Percent Encoding

If you follow me on Twitter, you'll notice that I built a bot at the request of a good friend / colleague of mine, and I recently tweeted that I broke it. (Which I did, but I fixed it.)

This issue was entirely in our percentEncode, and as I mentioned way back in the last lesson, we didn't account for Unicode characters. This was bad, at least for this new bot (for the Don McLean bot it was a non-issue). This is fixed easily enough, and I want to give you the code to do so:

open System.Text
let encoding = Encoding.UTF8
let percentEncode : string -> string =
    encoding.GetBytes
    >> Array.collect (fun x -> 
        match x with
        | cint when cint = 0x2Duy
                 || cint = 0x2Euy
                 || cint = 0x5Fuy
                 || cint = 0x7Euy
                 || (cint >= 0x30uy && cint <= 0x39uy)
                 || (cint >= 0x41uy && cint <= 0x5Auy)
                 || (cint >= 0x61uy && cint <= 0x7Auy) -> [|cint|]
        | cint -> sprintf "%%%s" (cint.ToString("X")) |> Seq.toArray |> Array.map byte)
    >> Array.map char
    >> String

So our previous code relied on analyzing the char, which is completely inappropriate for Twitter when dealing with non-ASCII text. The char in .NET is a UTF-16 character, whereas Twitter works with UTF-8. So, we have to make an adjustment for that. Instead of using the char, we just use the System.Text.Encoding.UTF8.GetBytes(str) function to get a byte-array for the text we need to encode, then we iterate through it, test each char for the necessity of encoding (because UTF-8 is full ASCII-128 compatible, we don't need to do anything special, our same character codes will work), and return the same resultant String. So nothing comsuming percentEncode has to change (awesome!)._Activator

Analyze a Timeline

So now we get to the hard part. For the bot to be successful I wanted it to be capable of analyzing it's timeline and determining what position it was in to tweet next. This would mean no state has to be retained anywhere, you could in fact run the .exe from any computer and it would still continue the correct sequence.

To do this, we have to read a timeline. To do that, we have to abstract our OAuth / API handling code. UGH

Alright, so this isn't actually that hard. We want to build a composition chain that goes through the full API request.

If you lost our sign function, I have it right here:

let sign httpMethod endpoint oauthParams queryParams postParams =
    Array.concat [|oauthParams; queryParams; postParams|]
    |> Array.sortBy fst
    |> Array.map keyValueToStr
    |> stringJoin "&"
    |> Array.singleton
    |> Array.append [|httpMethod |> httpMethodToStr; endpoint|]
    |> Array.map percentEncode
    |> stringJoin "&"
    |> hasher

You'll see it's slightly different. I have this httpMethodToStr function which, by the looks of things, takes something called httpMethod and converts it to a string. Ah right, I should share that!

type HttpMethod = | Get | Post
let httpMethodToStr = function | Get -> "GET" | Post -> "POST"

Because I like having the help of the compiler, I built a quick HttpMethod type which is just a Get or Post, and the httpMethodToStr converts that to the capital-case value.

The other helper there:

let keyValueToStr (key, value) = sprintf "%s=%s" key (value |> percentEncode)

Again, pretty simple. So now we can see that our sign function is really just some chains. You'll also see I have a hasher, which we didn't have last time.

let hmacSha1Hash (encoding : Encoding) (key : string) (str : string) : string =
    use hmacSha1 = new HMACSHA1(key |> encoding.GetBytes)
    str |> encoding.GetBytes |> hmacSha1.ComputeHash |> Convert.ToBase64String
let baseOauthParams = [|("oauth_signature_method", "HMAC-SHA1"); ("oauth_version", "1.0"); ("oauth_consumer_key", parameters.ConsumerKey); ("oauth_token", parameters.AccessToken)|]
let hasher = hmacSha1Hash encoding ([|parameters.ConsumerSecret; parameters.AccessTokenSecret|] |> stringJoin "&")

Here we see our parameters from the config come into play. We pull the appropriate static OAuth parameters (signature method, version, etc.) into a standard array, then we build a hasher which is a partially-applied function which will only require us to add the final string to hash. The key and encoding are embedded.

For ease of use, I built a sendRequest, which looks as follows:

let sendRequest (submitMethod, oauthString, url : string, postParams) =
    try
        use wc = new WebClient()
        wc.Headers.Add(HttpRequestHeader.Authorization, oauthString)
        match submitMethod with
        | Post -> wc.UploadString(url, postParams)
        | Get -> wc.DownloadString(url)
        |> Some
    with
    | :? WebException as ex ->
        use sr = new StreamReader(ex.Response.GetResponseStream())
        printfn "Failure (%s): %A" ex.Message (sr.ReadToEnd())
        None
    | ex ->
        printfn "Failure: %A" ex
        None

This was really quite simple. Add headers, determine submit method, send the request, return. If it errors, print the error and return None.

Now we previously had a buildTweetRequest which would do a lot of work to create a signed OAuth request. Today we took a lot of that away and instead created a buildBaseRequest, which can be a more abstract version:

let baseBuildRequest submitMethod path postParams queryParams =
    let url = [baseUrl; path] |> stringJoin ""
    let timestamp = DateTime.Now |> timeToEpoch
    let nonce = Guid.NewGuid().ToString("N")
    let oauthParams =
        [|("oauth_timestamp", timestamp.ToString()); ("oauth_nonce", nonce)|]
        |> Array.append baseOauthParams
    let oauthString =
        [|("oauth_signature", sign submitMethod url oauthParams queryParams postParams)|]
        |> Array.append oauthParams
        |> formOAuthString
    let queryString = queryParams |> Array.map keyValueToStr |> stringJoin "&"
    let queryString = if queryString.Length > 0 then sprintf "?%s" queryString else queryString
    let postString = postParams |> Array.map keyValueToStr |> stringJoin "&"
    (submitMethod, oauthString, (sprintf "%s%s" url queryString), postString)

You'll notice that it does a lot of the boilerplate, but it requires quite a few parameters to function properly. This will create the base request, which can be directly piped to sendRequest. This means our new buildTweetRequest looks as follows:

let buildTweetRequest tweet =
    baseBuildRequest Post "statuses/update.json" [||] [|("status", tweet)|]

Again, nothing complex, we just build a base request with the appropriate parameters, and then return it.

Consumption of sending a tweet at this point is literally tweet |> buildTweetRequest |> sendRequest. You can even check if it succeeeded or failed.

Of course, we aren't worried about that yet. We want to get a timeline first:

let buildGetTimeline (userid : int64) =
    baseBuildRequest Get "statuses/user_timeline.json" [||] [|("user_id", userid.ToString()); ("count", "25"); ("tweet_mode", "extended")|]

Oh yeah, getting a timeline is super smooth. Adding new API support, in fact, is very simple and easy. We might be in the home stretch.

let getTimelineTweets = buildGetTimeline >> sendRequest

OK, maybe not. We have the timeline now, but we have to build out the ability to read it.

I have a Twitter Timeline.sample.json which I'll upload as an attachment to this post, which I use to create a type-provider type:

type Timeline = JsonProvider<"Twitter Timeline.sample.json">

I also created a Tweet type where I only care about the important things:

type Tweet = { TId : int64; Text : string; Truncated : bool; CreatedAt : DateTime }

Because I don't give a hoot about the rest of the data, I made it a slimmed down version of an actual tweet.

We're also going to need to consume statuses/show.json, which I'm providing below:

let buildShowRequest (id : int64) =
    baseBuildRequest Get "statuses/show.json" [||] [|("id", id.ToString()); ("tweet_mode", "extended")|]

This is another pretty basic function, it takes a tweet ID and gives us the request to send to get that tweet.

Finally, to get the timeline into memory, we need a timelineToTweets function:

let timelineToTweets (timeline : string) : Tweet array option =
    let mapFn (x : Timeline.Root) = { TId = x.Id; Text = x.FullText; Truncated = x.Truncated; CreatedAt = DateTime.ParseExact(x.CreatedAt.Substring(0, 19), "ddd MMM dd HH:mm:ss", null) }
    let idsEqual t1 t2 = t1.TId = t2.TId
    let tweets = timeline |> Timeline.Parse |> Array.map mapFn
    let idsLookup = tweets |> Array.filter (fun x -> x.Truncated) |> Array.map (fun x -> x.TId)
    idsLookup
    |> Array.choose (buildShowRequest >> sendRequest >> Option.map (Timeline.Parse >> Array.map mapFn))
    |> Array.concat
    |> Some
    |> Option.map (fun x ->
        tweets |> Array.map (fun t1 ->
            x |> Array.filter (idsEqual t1) |> function | [|t|] -> t | _ -> t1))

It should be easy to see that we're just loading a timeline JSON into memory, checking what tweets are "truncated", then looking those up, and mapping them to a new tweet array. (If we had to get a new tweet, we'll use it, otherwise we keep the original.)

Alright, so we have an array of tweets (timeline) in memory, what do we do next? Well, we need to calculate what index we were most recently at, so we can find the next one in the list.

Because our lyric program has several tweets that will be identical in the same sequence, we need to look at more than one tweet in a row. I pulled 25 tweets from the timeline (look at the count parameter in buildGetTimeline), then make sure that we get as many matches as possible.

let getIndex (tweets : Tweet array) (comparisons : string array) =
    let comparisons = comparisons |> Array.rev |> Array.map newLineReplace
    let tweets =
        tweets
        |> Array.sortByDescending (fun x -> x.CreatedAt)
        |> Array.map (fun x -> x.Text)
        |> Array.filter (fun x -> comparisons |> Array.contains x)
    let rec alg skip =
        if skip >= comparisons.Length then 0
        else
            let si = comparisons |> Array.skip skip |> Array.findIndex ((=) tweets.[0]) |> (+) skip
            let matches = tweets |> Array.fold (fun (r, i) t -> (r && (comparisons.[i % comparisons.Length] = t), i + 1)) (true, si) |> fst
            if matches then si else alg (si + 1)
    if tweets.Length = 0 then 0 else alg 0

This is a somewhat convoluted function, but it basically starts at a tweet, then determines if it matched from there on in the comparisons (reference) array. If it does, then that's our current index.

Consume it all

Consuming this whole thing is done by the following function:

member this.run send =
    let path = [rootDir; parameters.TextFile] |> stringJoin ""
    let file = File.ReadAllText(path)
    let parts = file.Split([|parameters.Split|], StringSplitOptions.RemoveEmptyEntries) |> Array.filter (Seq.length >> (>=) 280) |> Array.map (fun x -> x.Trim())

    let existingTweets =
        parameters.AccountId
        |> getTimelineTweets
        |> Option.map timelineToTweets
        |> Option.flatten
        |> function | None -> [||] | Some v -> v
    let newStatus = parts.[(parts.Length - getIndex existingTweets parts) % parts.Length] |> newLineReplace
    let req = buildTweetRequest newStatus

    if send then (req, newStatus, req |> sendRequest)
    else (req, newStatus, None)

Wait, member? That's new.

So F# allows us to define types with members, and in fact, I defined almost all the functions above as let definitions in the type, and then the only necessary member is the single function above. This can be run by a client to either send the next tweet, or just load and return it. I built that in for the case when we want to debug, and see what it's going to send next without actually doing so.

All in all, the entire TwitterBot is 150 lines of F#:

module TwitterBot
open System
open System.IO
open System.Net
open System.Security.Cryptography
open System.Text
open FSharp.Data

type HttpMethod = | Get | Post
type Tweet = { TId : int64; Text : string; Truncated : bool; CreatedAt : DateTime }
type Parameters = JsonProvider<"Config.sample.json">
type Timeline = JsonProvider<"Twitter Timeline.sample.json">

let encoding = Encoding.UTF8
let percentEncode : string -> string =
    encoding.GetBytes
    >> Array.collect (fun x -> 
        match x with
        | cint when cint = 0x2Duy
                 || cint = 0x2Euy
                 || cint = 0x5Fuy
                 || cint = 0x7Euy
                 || (cint >= 0x30uy && cint <= 0x39uy)
                 || (cint >= 0x41uy && cint <= 0x5Auy)
                 || (cint >= 0x61uy && cint <= 0x7Auy) -> [|cint|]
        | cint -> sprintf "%%%s" (cint.ToString("X")) |> Seq.toArray |> Array.map byte)
    >> Array.map char
    >> String

let httpMethodToStr = function | Get -> "GET" | Post -> "POST"
let newLineReplace (str : string) = str.Replace("\r\n", " / ")
let stringJoin sep (strs : string seq) = String.Join(sep, strs)
let keyValueToStr (key, value) = sprintf "%s=%s" key (value |> percentEncode)
let keyValueToQuotedStr (key, value) = sprintf "%s=\"%s\"" key (value |> percentEncode)
let timeToEpoch (time : DateTime) =
    let epoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc)
    (time.ToUniversalTime() - epoch).TotalSeconds |> bigint
let hmacSha1Hash (encoding : Encoding) (key : string) (str : string) : string =
    use hmacSha1 = new HMACSHA1(key |> encoding.GetBytes)
    str |> encoding.GetBytes |> hmacSha1.ComputeHash |> Convert.ToBase64String

type Bot(configFile) =
    let parameters = configFile |> File.ReadAllText |> Parameters.Parse
    let baseUrl = "https://api.twitter.com/1.1/"
    let rootDir = sprintf "%s%s" parameters.BaseDir "\\"
    let baseOauthParams = [|("oauth_signature_method", "HMAC-SHA1"); ("oauth_version", "1.0"); ("oauth_consumer_key", parameters.ConsumerKey); ("oauth_token", parameters.AccessToken)|]
    let hasher = hmacSha1Hash encoding ([|parameters.ConsumerSecret; parameters.AccessTokenSecret|] |> stringJoin "&")

    let formOAuthString : (string * string) array -> string =
        Array.sortBy fst
        >> Array.map keyValueToQuotedStr
        >> stringJoin ", "
        >> sprintf "OAuth %s"

    let sign httpMethod endpoint oauthParams queryParams postParams =
        Array.concat [|oauthParams; queryParams; postParams|]
        |> Array.sortBy fst
        |> Array.map keyValueToStr
        |> stringJoin "&"
        |> Array.singleton
        |> Array.append [|httpMethod |> httpMethodToStr; endpoint|]
        |> Array.map percentEncode
        |> stringJoin "&"
        |> hasher

    let sendRequest (submitMethod, oauthString, url : string, postParams) =
        try
            use wc = new WebClient()
            wc.Headers.Add(HttpRequestHeader.Authorization, oauthString)
            match submitMethod with
            | Post -> wc.UploadString(url, postParams)
            | Get -> wc.DownloadString(url)
            |> Some
        with
        | :? WebException as ex ->
            use sr = new StreamReader(ex.Response.GetResponseStream())
            printfn "Failure (%s): %A" ex.Message (sr.ReadToEnd())
            None
        | ex ->
            printfn "Failure: %A" ex
            None

    let baseBuildRequest submitMethod path postParams queryParams =
        let url = [baseUrl; path] |> stringJoin ""
        let timestamp = DateTime.Now |> timeToEpoch
        let nonce = Guid.NewGuid().ToString("N")
        let oauthParams =
            [|("oauth_timestamp", timestamp.ToString()); ("oauth_nonce", nonce)|]
            |> Array.append baseOauthParams
        let oauthString =
            [|("oauth_signature", sign submitMethod url oauthParams queryParams postParams)|]
            |> Array.append oauthParams
            |> formOAuthString
        let queryString = queryParams |> Array.map keyValueToStr |> stringJoin "&"
        let queryString = if queryString.Length > 0 then sprintf "?%s" queryString else queryString
        let postString = postParams |> Array.map keyValueToStr |> stringJoin "&"
        (submitMethod, oauthString, (sprintf "%s%s" url queryString), postString)

    let buildShowRequest (id : int64) =
        baseBuildRequest Get "statuses/show.json" [||] [|("id", id.ToString()); ("tweet_mode", "extended")|]
    let buildGetTimeline (userid : int64) =
        baseBuildRequest Get "statuses/user_timeline.json" [||] [|("user_id", userid.ToString()); ("count", "25"); ("tweet_mode", "extended")|]
    let buildTweetRequest tweet =
        baseBuildRequest Post "statuses/update.json" [||] [|("status", tweet)|]
    let getTimelineTweets = buildGetTimeline >> sendRequest

    let timelineToTweets (timeline : string) : Tweet array option =
        let mapFn (x : Timeline.Root) = { TId = x.Id; Text = x.FullText; Truncated = x.Truncated; CreatedAt = DateTime.ParseExact(x.CreatedAt.Substring(0, 19), "ddd MMM dd HH:mm:ss", null) }
        let idsEqual t1 t2 = t1.TId = t2.TId
        let tweets = timeline |> Timeline.Parse |> Array.map mapFn
        let idsLookup = tweets |> Array.filter (fun x -> x.Truncated) |> Array.map (fun x -> x.TId)
        idsLookup
        |> Array.choose (buildShowRequest >> sendRequest >> Option.map (Timeline.Parse >> Array.map mapFn))
        |> Array.concat
        |> Some
        |> Option.map (fun x ->
            tweets |> Array.map (fun t1 ->
                x |> Array.filter (idsEqual t1) |> function | [|t|] -> t | _ -> t1))

    let getIndex (tweets : Tweet array) (comparisons : string array) =
        let comparisons = comparisons |> Array.rev |> Array.map newLineReplace
        let tweets =
            tweets
            |> Array.sortByDescending (fun x -> x.CreatedAt)
            |> Array.map (fun x -> x.Text)
            |> Array.filter (fun x -> comparisons |> Array.contains x)
        let rec alg skip =
            if skip >= comparisons.Length then 0
            else
                let si = comparisons |> Array.skip skip |> Array.findIndex ((=) tweets.[0]) |> (+) skip
                let matches = tweets |> Array.fold (fun (r, i) t -> (r && (comparisons.[i % comparisons.Length] = t), i + 1)) (true, si) |> fst
                if matches then si else alg (si + 1)
        if tweets.Length = 0 then 0 else alg 0

    member this.run send =
        let path = [rootDir; parameters.TextFile] |> stringJoin ""
        let file = File.ReadAllText(path)
        let parts = file.Split([|parameters.Split|], StringSplitOptions.RemoveEmptyEntries) |> Array.filter (Seq.length >> (>=) 280) |> Array.map (fun x -> x.Trim())

        let existingTweets =
            parameters.AccountId
            |> getTimelineTweets
            |> Option.map timelineToTweets
            |> Option.flatten
            |> function | None -> [||] | Some v -> v
        let newStatus = parts.[(parts.Length - getIndex existingTweets parts) % parts.Length] |> newLineReplace
        let req = buildTweetRequest newStatus

        if send then (req, newStatus, req |> sendRequest)
        else (req, newStatus, None)

This is almost everything necessary, the only thing left to do is run it.

Build a robust client

Because I want robust bot, and I want to be able to hot-swap config files, I set our bot up so that it takes two command line arguments (if you want):

  • a boolean to indicate whether or not to send;
  • a string to indicate the configuration file to load;

Basically, I want to specify the following:

type Parms = { Send : bool; Config : string }

Well that's easy. I've demonstrated this before, but my default pattern for this type of situation is as follows:

let stripQuotes (s : string) = if s.StartsWith "\"" && s.EndsWith "\"" then s.Substring(1, s.Length - 2) else s
let defParms = { Send = false; Config = "Config.json" }
let parms = 
    match argv with
    | [|s; c|] -> { defParms with Send = (s = "true"); Config = c |> stripQuotes }
    | [|s|] -> { defParms with Send = (s = "true") }
    | _ -> defParms
printfn "%A" parms

Essentially, I specify reasonable defaults, then when a command-line interface calls it, you can send arguments to override.

Then, the basic setup:

let bot = parms.Config |> TwitterBot.Bot
let request, tweet, response = bot.run parms.Send
let encodedTweet = tweet |> percentEncode
printfn "Request: %A" request
printfn "Tweet: (%i chars) %A" tweet.Length tweet
printfn "Encoded: (%i chars) %A" encodedTweet.Length encodedTweet
printfn "Response: %A" response

If the Parms.Send was true, the tweet sent, so in the case it's not then I do some human prompting:

if parms.Send |> not then
    let rec getResponse () =
        printfn "Send tweet? (Y for yes, N for no)"
        let key = Console.ReadKey().Key
        printfn ""
        match key with
        | ConsoleKey.Y -> true
        | ConsoleKey.N -> false
        | k ->
            printfn "Invalid key: %A" k
            () |> getResponse

    match () |> getResponse with
    | true -> 
        let request, tweet, response = bot.run true
        let encodedTweet = tweet |> percentEncode
        printfn "Request: %A" request
        printfn "Tweet: (%i chars) %A" tweet.Length tweet
        printfn "Encoded: (%i chars) %A" encodedTweet.Length encodedTweet
        printfn "Response: %A" response
        printfn "Press enter to exit..."
        Console.ReadLine() |> ignore
    | false -> ()

This means we get the best of both worlds: human-interface compatibility, and argument compatibility. Overall, the whole file is 47 lines:

open System
open TwitterBot

type Parms = { Send : bool; Config : string }

[<EntryPoint>]
let main argv =
    let stripQuotes (s : string) = if s.StartsWith "\"" && s.EndsWith "\"" then s.Substring(1, s.Length - 2) else s
    let defParms = { Send = false; Config = "Config.json" }
    let parms = 
        match argv with
        | [|s; c|] -> { defParms with Send = (s = "true"); Config = c |> stripQuotes }
        | [|s|] -> { defParms with Send = (s = "true") }
        | _ -> defParms
    printfn "%A" parms

    let bot = parms.Config |> TwitterBot.Bot
    let request, tweet, response = bot.run parms.Send
    let encodedTweet = tweet |> percentEncode
    printfn "Request: %A" request
    printfn "Tweet: (%i chars) %A" tweet.Length tweet
    printfn "Encoded: (%i chars) %A" encodedTweet.Length encodedTweet
    printfn "Response: %A" response

    if parms.Send |> not then
        let rec getResponse () =
            printfn "Send tweet? (Y for yes, N for no)"
            let key = Console.ReadKey().Key
            printfn ""
            match key with
            | ConsoleKey.Y -> true
            | ConsoleKey.N -> false
            | k ->
                printfn "Invalid key: %A" k
                () |> getResponse

        match () |> getResponse with
        | true -> 
            let request, tweet, response = bot.run true
            let encodedTweet = tweet |> percentEncode
            printfn "Request: %A" request
            printfn "Tweet: (%i chars) %A" tweet.Length tweet
            printfn "Encoded: (%i chars) %A" encodedTweet.Length encodedTweet
            printfn "Response: %A" response
            printfn "Press enter to exit..."
            Console.ReadLine() |> ignore
        | false -> ()
    0

I include the stripQuotes as when we send a path from argument -> program we may need to quote it, which will be included in the argv element. So, we just need to strip them when we expect them.

And that's it, we've built the whole bot, and we can now automate it entirely in one tight, self-contained program. There's only one external dependency, and even that is only for easy of development. We built all the functionality we wanted, and then some, and did it without any major pain points.


Shoutout to Janelle Shane, who's work inspired the second bot written with this script, and who's work also encouraged me to finish it up and tie this two-section blog post series up. I'll be continuing on with the next installment of "Getting Started with Programming and Getting Absolutely Nowhere" in the next post.

Files: Twitter Timeline.sample.json (70.11 kb)Config.sample.json (245.00 bytes)TwitterBot.fs (7.23 kb)Program.fs (1.76 kb)

Getting started with programming and getting absolutely nowhere (Part 20)

Building a Twitter Bot

Lesson 19: Cleaning up our previous work

So today I want to do something fun. Periodically, when developing software, it's nice to do something that's not a regular-old-business-problem every once in a while. Recently, I learned there was a bot that only tweeted portions of "Africa" by "Toto". This is a grand idea, but there's just one slightly better song to use: American Pie by Don McLean.

Now another interesting point is that Twitter recently doubled the character limit for tweets: 140 -> 280 characters. So we could actually build our Don McLean's American Pie bot to tweet up to that length of characters. So we're going to go through the entire development lifecycle here, and we'll do it all in F# rather quickly.

Step 1: identify the problem (plus solution in this case)

The first step is to identify what our "problem" to be solved is. Well, isn't it obvious? No one has built a bot for American Pie by Don McLean yet! That's a real problem! Our solution will be to build said bot, and allow it to tweet the lyrics to American Pie on a regular basis.

One might think the first step is to browse the Twitter API, but not yet. We'll get to that in a moment, the first step is to analyze the song and determine how we want to split it.

I have heard this song so many times I happen to be able to type it from memory, which I did, then I evaluated the lyrics for accuracy.

Now usually we would take this time to design a solution, but there really isn't much to design, we basically need the following:

  • Provide groupings of lyrics to the bot;
  • Provide the timing / delay to the bot;
  • Get it credentials;
  • Periodically send a tweet of the next lyric group;

In larger software you would make this multiple steps, here we just make it one because of how simple it is.

Step 2: provide groupings of lyrics to the bot

This is easy, and literally three lines of code in F#:

let path = @"C:\Users\Elliott Brown\Desktop\American Pie Lyrics.txt"
let file = System.IO.File.ReadAllText(path)
let parts = file.Split([|"\r\n\r\n"|], System.StringSplitOptions.None)

We literally load the file with the lyrics (attached to this post), and then split it on double line breaks. That's it, we now have our lyric "parts". We can verify that each part will fit into a tweet by testing:

let partLengths = parts |> Array.map Seq.length

We should verify that the largest group we have is 212 characters. This will fit well within a tweet, so we should be good to continue.

Step 3: provide the timings / delays to the bot

For this, we want to check the Twitter API limiting information. We will see that it tells us that we're limited to 2,400 tweets per day, for those not keen on the math, that's 100 tweets an hour, which means we could send: 1.667 tweets per minute or 0.6 minutes between each tweet. We won't come near that limit, we'll go with 5 minutes between each tweet, for a total of 20 per hour. This should be well within the API limitations, and it should allow us to do exactly what we want.

Initially, we'll define this as follows:

let minutesBetweenTweets = 5.0

Step 4: get it credentials / API tokens

This is a little harder, we actually have to mess with Twitter for a moment now. What we're going to do is head over to http://apps.twitter.com and register an application. The rules have changed a while ago, and you now need a phone number attached to your account to register an application. For whatever reason twitter flagged the account I created and locked it, but it was easy to unlock. (Not sure why, plenty of examples of folks doing something like this.)

Alright, so once all that is done, we'll want to get a Consumer Key, Consumer Secret, and generate an Access Token and Access Token Secret. I'm going to use mine as the examples, but only for signature validation and I'm going to be regenerating them afterwards.

let consumerKey = "AMbmXRe0nKymYOv23rzpBkggN";
let consumerSecret = "LIzIQNW79G5p8EyNbGjgxgkzvnjp7OImc6AdNKvbDPIPfReK5B";
let accessToken = "934423086732075008-qWUnoqnWByTTYJzKNrK8GT50MMYXE5B";
let accessTokenSecret = "fT1bo6TMVgLjLf74b16OIkdUAeyPamhk62si8QR1Xb2KJ";

Step 5: sign a request

The first thing we need to know when accessing the Twitter API is that all requests are REST with special HTTP authorization headers. We also need to "sign" requests, as documented on the Twitter Developers website.

To sign the request we need to know a few things:

  • The HTTP Method (POST in our case);
  • The raw endpoint URL (https://api.twitter.com/1.1/statuses/update.json in our case);
  • The query-string and OAuth parameters and values:
    • Query string: status
    • OAuth Parameters:
    • oauth_consumer_key (consumerKey);
    • oauth_nonce (we'll generate this);
    • oauth_signature_method (HMAC-SHA1);
    • oauth_timestamp (Unix Epoch current time);
    • oauth_token (accessToken);
    • oauth_version (1.0);

Once we have all that, we can begin the signing process. The next thing we have to do is "percent encode" the invalid characters. Twitter has a handy guide on doing this, which I have written code for below:

let percentEncode (str : string) =
str
    |> Seq.collect (fun x -> 
        let cint = x |> int
        match cint with
        | 0x2D | 0x2E | 0x5F | 0x7E -> [|x|]
        | cint when (cint >= 0x30 && cint <= 0x39)
                 || (cint >= 0x41 && cint <= 0x5A)
                 || (cint >= 0x61 && cint <= 0x7A) -> [|x|]
        | cint -> (sprintf "%%%s" (cint.ToString("X"))).ToCharArray())
    |> Seq.toArray
    |> System.String

Now I didn't account for any Unicode symbols, but the top three examples on that page should be properly encoded.

After we build this percent encoding, we need to sign our request. Signing is not nearly as hard as it could be here, we actually have some examples to fall back on. Basically, the process is as follows:

  • Append the POST, Query String, and OAUTH parameters together;
  • Sort alphabetically by key, then value (Twitter does not allow duplicate keys across the three, so sorting by key will be the only requirement here);
  • Percent encode all values (not keys, since keys have nothing requiring encoding);
  • Join the key and value into key=value;
  • Join all the key=value strings into key=value&key2=value2...;
  • Build the base string: `method&URL (percent encoded)&parameters (percent encoded again);
  • Build the signing key: consumerSecret&accessTokenSecret, if accessTokenSecret is a blank string, leave the & in the result;
  • Using HMAC-SHA1 with the singing key, hash the base string;
  • Base-64 encode the result;

This is actually surprisingly easy with F#, we can do each step on it's own, or do a couple at a time. The key/value array sorting and such is pretty simple, so I do them in a quick chain.

let sign method endpoint oauthParams queryParams postParams =
    let keyValues =
        oauthParams
        |> Array.append queryParams
        |> Array.append postParams
        |> Array.sortBy fst
        |> Array.map (fun (k, v) -> (k, v |> percentEncode))
    let concatedStr =
        ("&", keyValues |> Array.map (fun (key, value) -> sprintf "%s=%s" key value))
        |> System.String.Join
    let baseStr = sprintf "%s&%s&%s" method (endpoint |> percentEncode) (concatedStr |> percentEncode)
    let signKey =
        sprintf "%s&%s" consumerSecret accessTokenSecret
        |> System.Text.Encoding.ASCII.GetBytes
    use hmacSha1 = new System.Security.Cryptography.HMACSHA1(signKey)
    baseStr
    |> System.Text.Encoding.ASCII.GetBytes
    |> hmacSha1.ComputeHash
    |> System.Convert.ToBase64String

As you can see, we do everything as best we can to maintain ease of readability and follow what best-practices we must. This makes the entire process quite painless, we pass in our parameters and get the signature result.

Step 6: form a request

If we look at the status update API documentation, we'll see that the status update in general is actually pretty simple. We just POST to https://api.twitter.com/1.1/statuses/update.json with a query-string parameter of status={{StatusText}}, this is trivial with F#.

The first step is forming our OAuth string:

let formOAuthString p =
    let paramsStr =
        (", ", p
        |> Array.sortBy fst
        |> Array.map (fun (k, v) -> sprintf "%s=\"%s\"" (k |> percentEncode) (v |> percentEncode)))
        |> System.String.Join
    sprintf "OAuth %s" paramsStr

We know the values in this section won't have double-quotes, so there's no need to guard here.

When dealing with F# (.NET) dates and times, we need to convert them to the 'unix epoch' times (which Twitter expects):

let timeToEpoch (time : System.DateTime) =
    (time.ToUniversalTime() - System.DateTime(1970, 1, 1, 0, 0, 0)).TotalSeconds

Next, we form up our parameters and such for signing:

let url = "https://api.twitter.com/1.1/statuses/update.json"

let newStatus = parts.[0]
let newStatus = newStatus.Replace("\r\n", " / ")
printfn "%s" (newStatus |> percentEncode)

let timestamp = System.DateTime.Now |> timeToEpoch |> bigint
let nonce = System.Guid.NewGuid().ToString("N")
let oauthParams =
    [|("oauth_signature_method", "HMAC-SHA1")
      ("oauth_version", "1.0")
      ("oauth_consumer_key", consumerKey)
      ("oauth_timestamp", timestamp.ToString())
      ("oauth_token", accessToken)
      ("oauth_nonce", nonce)|]
let postParams = [||]
let queryParams = [|("status", newStatus)|]
let signature = sign "POST" url oauthParams queryParams postParams

let oauthParams = [|("oauth_signature", signature)|] |> Array.append oauthParams
let oauthString = oauthParams |> formOAuthString

And that's it, we have the request formed. The final part is to do the POST itself.

Step 7: POST the request

To POST the request to Twitter we basically do three things: create a WebClient, add the Authorization header; send the request. F# with .NET makes this trivial, and we can even handle failure cases really easily.

try
    use wc = new System.Net.WebClient()
    wc.Headers.Add("Authorization", oauthString)
    let response = wc.UploadData(sprintf "%s?status=%s" url (newStatus |> percentEncode), [||]) |> System.Text.Encoding.UTF8.GetString
    printfn "Success: %s" response
with
| :? System.Net.WebException as ex ->
    use sr = new System.IO.StreamReader(ex.Response.GetResponseStream())
    printfn "Failure (HTTP %A): %A" ex.Status (sr.ReadToEnd())
| ex -> printfn "Failure: %A" ex

And that's it. Our Twitter bot now works. You'll also notice that I included a .Replace("\r\n", " / "), Twitter is funky in how it treats line-breaks, and if you actually include the real line breaks it doesn't respect them properly. It also fails OAuth verification, so we have to do something about that. My solution: replace them with a slash indicating line breaks, which is somewhat frequently used in lyric sharing. I made this a separate call for a reason: we're going to see in the next post how to turn that initial parts.[0] into a calculation as to which portion of the lyrics we are currently in. (Such that we don't need the application to run constantly, we can just run it once, and it will decide what the next lyric to post is.)

Step 8: clean things up

Now this entire application is about 90 lines for me, and works great, but there's a lot of ugly there, because we don't import (see: open) anything from .NET, and we have to use the String.Join which is just ugly. Let's fix that up a bit:

module TwitterBot =
    open System
    open System.IO
    open System.Net
    open System.Security.Cryptography
    open System.Text

    let private consumerKey = "AMbmXRe0nKymYOv23rzpBkggN"
    let private consumerSecret = "LIzIQNW79G5p8EyNbGjgxgkzvnjp7OImc6AdNKvbDPIPfReK5B"
    let private accessToken = "934423086732075008-qWUnoqnWByTTYJzKNrK8GT50MMYXE5B"
    let private accessTokenSecret = "fT1bo6TMVgLjLf74b16OIkdUAeyPamhk62si8QR1Xb2KJ"

    let private url = "https://api.twitter.com/1.1/statuses/update.json"
    let private encoding = Encoding.ASCII

    let stringJoin sep (strs : string seq) = String.Join(sep, strs)

    let timeToEpoch (time : DateTime) =
        let epoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc)
        (time.ToUniversalTime() - epoch).TotalSeconds |> bigint

    let percentEncode : string -> string =
        Seq.collect (fun x -> 
            match x |> int with
            | 0x2D | 0x2E | 0x5F | 0x7E -> [|x|]
            | cint when (cint >= 0x30 && cint <= 0x39)
                     || (cint >= 0x41 && cint <= 0x5A)
                     || (cint >= 0x61 && cint <= 0x7A) -> [|x|]
            | cint -> (sprintf "%%%s" (cint.ToString("X"))).ToCharArray())
        >> Seq.toArray
        >> String

    let hmacSha1Hash (key : string) (str : string) : string =
        use hmacSha1 = new HMACSHA1(key |> encoding.GetBytes)
        str |> encoding.GetBytes |> hmacSha1.ComputeHash |> Convert.ToBase64String

    let sign method endpoint oauthParams queryParams postParams =
        let concatedStr =
            Array.concat [|oauthParams; queryParams; postParams|]
            |> Array.sortBy fst
            |> Array.map (fun (key, value) -> sprintf "%s=%s" key (value |> percentEncode))
            |> stringJoin "&"
        [|method; endpoint; concatedStr|]
        |> Array.map percentEncode
        |> stringJoin "&"
        |> hmacSha1Hash ([|consumerSecret; accessTokenSecret|] |> stringJoin "&")

    let formOAuthString : (string * string) array -> string =
        Array.sortBy fst
        >> Array.map (fun (k, v) -> sprintf "%s=\"%s\"" (k |> percentEncode) (v |> percentEncode))
        >> stringJoin ", "
        >> sprintf "OAuth %s"

    let buildTweetRequest tweet =
        let timestamp = DateTime.Now |> timeToEpoch
        let nonce = Guid.NewGuid().ToString("N")
        let oauthParams =
            [|("oauth_signature_method", "HMAC-SHA1")
              ("oauth_version", "1.0")
              ("oauth_consumer_key", consumerKey)
              ("oauth_timestamp", timestamp.ToString())
              ("oauth_token", accessToken)
              ("oauth_nonce", nonce)|]
        let postParams = [||]
        let queryParams = [|("status", tweet)|]
        let oauthString =
            [|("oauth_signature", sign "POST" url oauthParams queryParams postParams)|]
            |> Array.append oauthParams
            |> formOAuthString
        (oauthString, sprintf "%s?status=%s" url (tweet |> percentEncode), String.Empty)

    let run () =
        let path = @"C:\Users\Elliott Brown\Desktop\American Pie Lyrics.txt"
        let file = File.ReadAllText(path)
        let parts = file.Split([|"\r\n\r\n"|], StringSplitOptions.RemoveEmptyEntries)

        let newStatus = parts.[0]
        let newStatus = newStatus.Replace("\r\n", " / ")
        let oauthString, url, postParams = buildTweetRequest newStatus

    try
            use wc = new WebClient()
            wc.Headers.Add("Authorization", oauthString)
            let response = wc.UploadString(url, postParams)
            printfn "Success: %s" response
        with
        | :? WebException as ex ->
            use sr = new StreamReader(ex.Response.GetResponseStream())
            printfn "Failure (%s): %A" ex.Message (sr.ReadToEnd())
        | ex -> printfn "Failure: %A" ex

After all this rewriting, and making everything much clearer, my total line count did not change. It literally didn't change at all (even with new open statements), I did change total line-count during this change, that's huge. I guess my point here is that you should never worry about the line count, always write code readable and understandable first. Then deal with trimming lines down if absolutely necessary. (I usually don't worry about it until it's become unreasonable — several thousand lines, that is.)

Step 9: admire our handiwork

You can see the result of our handiwork on Twitter, you'll start seeing more and more tweets pop in there after we do the next lesson, when I demonstrate how we can build a "smart algorithm" to decide what to Tweet next.


The takeaway from this lesson should be two things: 1. We can actually do some fun / entertaining things in programming; 2. We always have another opportunity to practice;

I really want you to try to find something to do with programming that you enjoy, then try to learn how to do it. You can pick anything, easy, hard, whatever you want, just pick something that you like. The easiest way to convince yourself to keep learning is to find something you enjoy, and work towards it.

Also, worry not about the "security" issue of me sharing keys and secrets, I regenerated all four before this post.

Getting started with programming and getting absolutely nowhere (Part 19)

Cleaning up our previous work

Lesson 18: Documentation: it's really important

Developing software has a lot of fun parts: solving problems, designing a system, experimenting with what you have finished so far...it has a lot of interesting and delightful things to be done. Unfortunately (or fortunately, depending on how you look at it), developing software also has a couple less delightful parts: debugging, testing, and least of all, cleaning your implementation.

Today we're going to cover cleaning up our previous (mess) of code, I'm going to post the file I've been working with below, but if you've been following along you probably have one just as big of a mess:

#I "bin\\Release\\"
#r "Extensions.dll"
open System.Net

type UnicodeConfusables = { Original : int; Replacement : int array; Field3 : string }

let mapToConfusable =
    function
    | [|a; b; c|] ->
        { Original = a |> String.trim |> Int.fromHex
          Replacement = b |> String.trim |> String.split ' ' |> Array.map Int.fromHex
          Field3 = c |> String.trim } |> Some
    | _ -> None

let file = "http://www.unicode.org/Public/security/10.0.0/confusables.txt"
let data =
    use wc = new WebClient()
    wc.DownloadString(file)

let unicodeConfusables =
    data
    |> String.split '\n'
    |> Seq.filter (String.startsWith "#" >> not)
    |> Seq.map (Seq.takeWhile ((<>) '#') >> Seq.toArray >> String.implode >> String.split ';')
    |> Seq.choose mapToConfusable
    |> Seq.toArray
let obsfucationConfusables =
    let itemToConfusable (orig, repl) =
        { Original = (orig, 0) ||> Char.toCodePoint
          Replacement = repl |> String.toCodePoints |> Seq.toArray
          Field3 = "OBS" }
    [|("1", "i"); ("1", "l")
      ("2", "z"); ("2", "s")
      ("3", "e")
      ("4", "a")
      ("5", "s"); ("5", "z")
      ("6", "g"); ("6", "b")
      ("7", "t")
      ("8", "b")
      ("9", "g")
      ("0", "o")
      ("\\", "i"); ("\\", "l")
      ("/", "i"); ("/", "l")
      ("|", "i"); ("|", "l")
      ("!", "i"); ("!", "l")
      ("+", "t")
      ("@", "a")
      ("$", "s")
      ("&", "b")
      ("(", "c")
      ("[", "c")|]
    |> Array.map itemToConfusable

let confusables =
    obsfucationConfusables
    |> Array.append unicodeConfusables

let listToCodePoints = List.map (String.toCodePoints >> Seq.toArray)

let filters = ["nope"; "fail"; "leet"] |> listToCodePoints
let terms = ["ℕope"; "𝑵ope"; "ռope"; "nope"; "𝕱ail"; "𝓕ail"; "pass"; "𝕿rue"; "𝓽𝓻𝓾𝒆"; "l33t"; "1337"; "noope"; "failing"] |> listToCodePoints

let findCandidates codePoint = confusables |> Array.filter (fun x -> x.Original = codePoint)

let any = (<) 0

let rec getCombinations<'a> (input : 'a array array) : 'a array array =
    let currentArray = input |> Array.head
    let tail = input |> Array.tail
    if tail |> Array.length |> any then
        tail
        |> getCombinations
        |> Array.map (fun ia ->
            currentArray
            |> Array.map (fun ca ->
                [|[|ca|]; ia|]
                |> Array.flatten))
        |> Array.flatten
    else currentArray |> Array.map Array.initOne

let transformTerm =
    Array.map (fun codePoint ->
        match codePoint |> findCandidates with
        | [||] -> [|[|codePoint|]|]
        | candidates -> candidates |> Array.map (fun x -> x.Replacement) |> Array.append [|[|codePoint|]|])
    >> getCombinations
    >> Array.map Array.flatten

let lowerCaseTerm = Array.map (function | c when [('A' |> int)..('Z' |> int)] |> List.contains c -> c + 32 | c -> c)

//let transformToLowerTerm = transformTerm >> lowerCaseTerm
let transformToLowerTerm = transformTerm >> Array.map lowerCaseTerm
//let matchedFilters term = filters |> List.filter (term |> transformToLowerTerm |> (=))
//let matchedFilters term =
//    filters
//    |> List.filter (fun filter ->
//        let transformations = term |> transformToLowerTerm
//        let anyMatch = transformations |> Array.filter ((=) filter)
//        anyMatch |> Array.length |> any)

let matchFilters filters (term : int[]) =
    let matchFilter (filter : int[]) =
        let concated = term |> Array.append filter
        let grouped = concated |> Array.groupBy id |> Array.map (fun (c, a) -> (c, a |> Array.length))
        let sum = grouped |> Array.fold (fun acc (c, i) -> acc + i / 2) 0 |> float
        if sum <= 0.0 then None
        else (filter, sum / (max (term.Length |> float) (filter.Length |> float))) |> Some
    filters
    |> Seq.ofList
    |> Seq.choose matchFilter
let bestFilter filters =
    matchFilters filters >> Seq.sortByDescending snd >> Seq.tryHead
let meetsThreshold threshold (filter, percent) = percent > threshold

let matchedFilters term =
    term
    |> transformToLowerTerm
    |> Array.map (bestFilter filters >> Option.bindNone ([||], 0.0))
    |> Array.sortByDescending snd
    |> Array.filter (meetsThreshold 0.5)
    |> Array.tryHead
    |> (function | None -> [] | Some a -> [a])

let combinationTest = [|[|'g'|]; [|'r'|]; [|'e'; 'a'|]; [|'y'|]|] |> getCombinations |> Array.map String.implode

let matchedTerms =
    terms
    |> List.map (fun t -> (t, t |> matchedFilters))
    |> List.filter (snd >> List.length >> any)
    |> List.map (fun (t, f) -> (t |> String.fromCodePoints, f |> List.map (fun (f, s) -> (f |> String.fromCodePoints, s))))
//terms |> List.map (transformToLowerTerm >> String.fromCodePoints)
terms |> List.map (transformToLowerTerm >> Array.map String.fromCodePoints)

module Tests =
    module Assert =
        let private fn fn msg expected actual =
            if fn expected actual then None
            else (msg expected actual) |> Some
        let equal expected actual = fn (=) (sprintf "expected: %A; actual: %A") expected actual
        let notEqual expected actual = fn (<>) (sprintf "expected not: %A; actual: %A") expected actual
        let largerThan expected actual = fn (>) (sprintf "expected greater than: %A; actual %A") expected actual
        let largerEqual expected actual = fn (>=) (sprintf "expected greater than / equal to: %A; actual %A") expected actual
        let smallerThan expected actual = fn (<) (sprintf "expected smaller than: %A; actual %A") expected actual
        let smallerEqual expected actual = fn (<=) (sprintf "expected smaller than / equal to: %A; actual %A") expected actual
        let print = function | None -> printfn "Pass" | Some msg -> printfn "Fail: %s" msg

    let matchFilters filters (term : string) =
        let matchFilter (filter : string) =
            let termChars = term.ToCharArray()
            let filterChars = filter.ToCharArray()
            let concated = termChars |> Array.append filterChars
            let grouped = concated |> Array.groupBy id |> Array.map (fun (c, a) -> (c, a |> Array.length))
            let sum = grouped |> Array.fold (fun acc (c, i) -> acc + i / 2) 0 |> float |> (*) 2.0
            if sum <= 0.0 then None
            else (filter, sum / (term.Length + filter.Length |> float)) |> Some
        filters
        |> Seq.ofList
        |> Seq.choose matchFilter
    let bestFilter filters =
        matchFilters filters >> Seq.sortByDescending snd >> Seq.tryHead >> Option.map snd
    let meetsThreshold threshold (filter, percent) = percent > threshold

    let testFn filters = bestFilter filters >> Option.bindNone 0.0

    let ``A term that exactly matches a word in the filter should return 1.0 as match`` () =
        let expected = 1.0
        let inputTerm = "nope"
        let inputFilter = ["nope"]
        let actual = (inputFilter, inputTerm) ||> testFn
        Assert.equal expected actual

    let ``A term that does not match any words in the filter should return no matches`` () =
        let expected = 0.0
        let inputTerm = "abcd"
        let inputFilter = ["nope"]
        let actual = (inputFilter, inputTerm) ||> testFn
        Assert.equal expected actual

    let ``A term that partially matches a word in the filter should return 0.* as match`` () =
        let expected = 0.25
        let inputTerm = "true"
        let inputFilter = ["nope"]
        let actual = (inputFilter, inputTerm) ||> testFn
        Assert.equal expected actual

    let ``A term that mostly matches a word in the filter should return 0.* as match`` () =
        let expected = 0.75
        let inputTerm = "mope"
        let inputFilter = ["nope"]
        let actual = (inputFilter, inputTerm) ||> testFn
        Assert.equal expected actual

    let runTests () =
        let tests = [``A term that exactly matches a word in the filter should return 1.0 as match``
                     ``A term that does not match any words in the filter should return no matches``
                     ``A term that partially matches a word in the filter should return 0.* as match``
                     ``A term that mostly matches a word in the filter should return 0.* as match``]
        tests |> List.iter ((|>) () >> Assert.print)

Now, this file I've been working in is 194 lines or so, with several bits of commented code (no longer used, kept it because why not?), things that really should have been extracted away a while ago. Today, we're going to do that.

Because it's extremely important to do this (and on a regular basis), I'm going to go through the entire process, which I usually perform as the following steps:

  1. Identify related, stable bits of code that make sense together;
  2. Extract these to a new module/function/what-have-you;
  3. Test your implementation again, refactor anything necessary;
  4. Extract these to a new file in a .dll, build the .dll and reference it in the FSX (script) file;
  5. Test your implementation again, refactor anything necessary;
  6. Repeat for the next section of code;

By the time we get done we'll have this FSX file down to a few lines (40 or so), we're going to parameterize everything necessary, and build a new .dll solution.

Let's get started

So we'll begin with the easiest section: our Tests module. This is really already setup exactly how we want: a module with independent parts that we can import together or in whole.

To do this we'll create an F# Library project, I've added references to my F# Extensions project from GitHub, as we'll use some of the things in it.

Once we have the F# project created, we'll delete Library1.fs — it's unnecessary, we'll add a new .fs (F# Source File) and call it Tests, then finally, we'll cut and paste our module Tests code from our script. We only need to delete the equal sign after the word Tests and then everything is done for this part.

The other portions won't be so easy — we'll have to rewrite some of our code to work. Our next step is to take some of the Unicode stuff we did and move it to a new module. We want to define a module Unicode = in our current script file, and begin moving stuff in there, starting with type UnicodeConfusables.

By the time we finish with the Unicode stuff we should end up with something like:

module Unicode =
    type UnicodeConfusables = { Original : int; Replacement : int array; Field3 : string }

    let private file = "http://www.unicode.org/Public/security/10.0.0/confusables.txt"
    let private getData url =
        let file = url |> Option.bindNone file
        use wc = new WebClient()
        wc.DownloadString(file)

    let private mapToConfusable =
        function
        | [|a; b; c|] ->
            { Original = a |> String.trim |> Int.fromHex
              Replacement = b |> String.trim |> String.split ' ' |> Array.map Int.fromHex
              Field3 = c |> String.trim } |> Some
        | _ -> None

    let getConfusables url =
        getData url
        |> String.split '\n'
        |> Seq.filter (String.startsWith "#" >> not)
        |> Seq.map (Seq.takeWhile ((<>) '#') >> Seq.toArray >> String.implode >> String.split ';')
        |> Seq.choose mapToConfusable
        |> Seq.toArray

Now I've modified this to allow us to specify an alternate URL to download if we decide, which means we can use a new version of the confusables.txt if/when there is one, or we can cache it locally.

Next step: terms and filters

Whenever we have a bunch of functions that have the same prefix or suffix, there's a good chance they belong together. If we look at our code, we have transformTerm, lowerCaseTerm, and transformToLowerTerm. All three of these are transformations on a Term, so let's modularize them:

module Term =
    let transform =
        Array.map (fun codePoint ->
            match codePoint |> findCandidates with
            | [||] -> [|[|codePoint|]|]
            | candidates -> candidates |> Array.map (fun x -> x.Replacement) |> Array.append [|[|codePoint|]|])
        >> getCombinations
        >> Array.map Array.concat

    let lowerCase = Array.map (function | c when [('A' |> int)..('Z' |> int)] |> List.contains c -> c + 32 | c -> c)
    let transformToLower = transform >> Array.map lowerCase

Now we're getting somewhere. A lot of this stuff no longer needs touched, so it's easier on us if we just put it in a .fs file and push it out of our current working area.

Of course, now we realize we need the findCandidates function in the Term module, as well as getCombinations. So the next thing we'll do is move those to more usable locations.

The findCandidates function can belong in Term, as the module interacts with the confusables to find candidate confusable. It really doesn't belong in the Unicode module...or does it? As we look at it, we realize that findCandidates can totally belong in the Unicode module: it needs to know all about confusables, and it cares only about that.

It doesn't matter (much) where you put it, but I put it in my Term module. Often times you'll have several choices of what to do with something, and it's up to you to make the right choice.

Next we need getCombinations, which we built to be pretty generic. I'm actually going to put an almost identical version of this in my F# Extensions project (linked above), which you can use. You can also drop this into your own project if you like.

Filters, which are actually quite easy

Just like before we'll want to create a Filter module and drop the appropriate bits in there. Here's what you'll want to do:

  • Rename the functions to fit better;
  • Modify matchedFilters to take confusables, filters, and the threshold as parameters, in that order, then the term itself;

We do the second point because it makes the most sense, if term is the last parameter we can curry this very well:

let filter = Filter.matched confusables filters 0.5
let matchedTerms =
    terms
    |> List.map (fun t -> (t, t |> filter))
    |> List.filter (snd >> List.length >> any)
    |> List.map (fun (t, f) -> (t |> String.fromCodePoints, f |> List.map (fun (f, s) -> (f |> String.fromCodePoints, s))))

We set the confusables as the first parameter because they're likely to want to be swapped the least. Then, between threshold and filters, I can see changing threshold more often than filters.

Finally, we should be down to a 50-or-so line script:

#I "bin\\Release\\"
#r "FSharpExtensions.dll"
#r "FSharpExtensions.Applications.dll"

#load "Unicode.fs"
#load "Term.fs"
#load "Filter.fs"
#load "Tests.fs"

let listToCodePoints = List.map (String.toCodePoints >> Seq.toArray)

let obsfucationConfusables =
    let itemToConfusable (orig, repl) =
        { Unicode.UnicodeConfusables.Original = (orig, 0) ||> Char.toCodePoint
          Unicode.UnicodeConfusables.Replacement = repl |> String.toCodePoints |> Seq.toArray
          Unicode.UnicodeConfusables.Field3 = "OBS" }
    [|("1", "i"); ("1", "l")
      ("2", "z"); ("2", "s")
      ("3", "e")
      ("4", "a")
      ("5", "s"); ("5", "z")
      ("6", "g"); ("6", "b")
      ("7", "t")
      ("8", "b")
      ("9", "g")
      ("0", "o")
      ("\\", "i"); ("\\", "l")
      ("/", "i"); ("/", "l")
      ("|", "i"); ("|", "l")
      ("!", "i"); ("!", "l")
      ("+", "t")
      ("@", "a")
      ("$", "s")
      ("&", "b")
      ("(", "c")
      ("[", "c")|]
    |> Array.map itemToConfusable

let confusables = obsfucationConfusables |> Array.append (Unicode.getConfusables None)
let filters = ["nope"; "fail"; "leet"] |> listToCodePoints
let terms = ["ℕope"; "𝑵ope"; "ռope"; "nope"; "𝕱ail"; "𝓕ail"; "pass"; "𝕿rue"; "𝓽𝓻𝓾𝒆"; "l33t"; "1337"; "noope"; "failing"] |> listToCodePoints

let any = (<) 0

let combinationTest = [|[|'g'|]; [|'r'|]; [|'e'; 'a'|]; [|'y'|]|] |> Array.getCombinations |> Array.map String.implode

let filter = Filter.matched confusables filters 0.5

let matchedTerms =
    terms
    |> List.map (fun t -> (t, t |> filter))
    |> List.filter (snd >> List.length >> any)
    |> List.map (fun (t, f) -> (t |> String.fromCodePoints, f |> List.map (fun (f, s) -> (f |> String.fromCodePoints, s))))
terms |> List.map (Term.transformToLower confusables >> Array.map String.fromCodePoints)

What bothers me here are the obsfucationConfusables, we really ought to have a better way to do that, and as it turns out, we do.

This is where having url as a parameter in the Unicode.getConfusables function is very useful: we can build a file out for our obsfucationConfusables and map them with the same getConfusables function. We'll create a text file with the following content:

0031 ; 0069 ; OBS
0031 ; 006C ; OBS
0032 ; 007A ; OBS
0032 ; 0073 ; OBS
0033 ; 0065 ; OBS
0034 ; 0061 ; OBS
0035 ; 0073 ; OBS
0035 ; 007A ; OBS
0036 ; 0067 ; OBS
0036 ; 0062 ; OBS
0037 ; 0074 ; OBS
0038 ; 0062 ; OBS
0039 ; 0067 ; OBS
0030 ; 006F ; OBS
005C ; 0069 ; OBS
005C ; 006C ; OBS
002F ; 0069 ; OBS
002F ; 006C ; OBS
007C ; 0069 ; OBS
007C ; 006C ; OBS
0021 ; 0069 ; OBS
0021 ; 006C ; OBS
002B ; 0074 ; OBS
0040 ; 0061 ; OBS
0024 ; 0073 ; OBS
0026 ; 0062 ; OBS
0028 ; 0063 ; OBS
005B ; 0063 ; OBS

Finally, we make all this work in our new script file, and we should have something like the following:

#I "bin\\Release\\"
#r "FSharpExtensions.dll"
#r "FSharpExtensions.Applications.dll"

#load "Unicode.fs"
#load "Term.fs"
#load "Filter.fs"
#load "Tests.fs"

let listToCodePoints = List.map (String.toCodePoints >> Seq.toArray)

let confusables =
    __SOURCE_DIRECTORY__ + "\\ObsfucationConfusables.txt"
    |> Some
    |> Unicode.getConfusables
    |> Array.append (Unicode.getConfusables None)
let filters = ["nope"; "fail"; "leet"] |> listToCodePoints
let terms = ["ℕope"; "𝑵ope"; "ռope"; "nope"; "𝕱ail"; "𝓕ail"; "pass"; "𝕿rue"; "𝓽𝓻𝓾𝒆"; "l33t"; "1337"; "noope"; "failing"] |> listToCodePoints

let any = (<) 0
let filter = Filter.matched confusables filters 0.5

let matchedTerms =
    terms
    |> List.map (fun t -> (t, t |> filter))
    |> List.filter (snd >> List.length >> any)
    |> List.map (fun (t, f) -> (t |> String.fromCodePoints, f |> List.map (fun (f, s) -> (f |> String.fromCodePoints, s))))
terms |> List.map (Term.transformToLower confusables >> Array.map String.fromCodePoints)

Isn't that much cleaner? I think so. It also prepares us for making an actual program out of this, we know what points can be built out more, what needs parameterized further, and how to continue down our road.

Finally, fix the tests (homework)

At the moment our Tests module uses the functions inside it, and doesn't test our live implementations — we really out to fix that.

I leave the majority of the implementation up to you, but you'll want to start by rewriting testFn to work with Filter.best, and move from there. It's not hard, you only have to redefine testFn, and optionally define an additional function. I'll give you that one for free (since it's so simple):

let mapStr = String.toCodePoints >> Seq.toArray

This takes string -> int []. (To convert the sample term / filter into codepoints.)


So that was it — we gave ourselves a code-review and I obviously failed, but the new, corrected version should pass. Our next step will be to start modifying this to post an actual message. We want to make sure that we can take a message in and process it, match each word against a term, and then filter everything down to "Spam" or "Not Spam". This is a lot harder than it sounds, so be aware that it will not be an easy task. We'll also gradually expand our filter to support more features, and eventually have an enterprise-grade filter ready to use.

Getting started with programming and getting absolutely nowhere (Part 17)

How close are two words?

Lesson 16: Increasing the level of de-obsfucation

Today's lesson is going to continue on our "spam filter" adventure, but the next step it to start supporting similar-but-not-quite-identical words.

Anyone who's ever typed or written text has most assuredly spelled a word or two wrong, probably more than once. (In fact, I spell 'appropriate' wrong every day — for some reason I always end up with 'apporpriate', I think it's the speed at which I type.) These may be mistakes, or they may be intentional. Sometimes we spell something wrong for a reason.

Often times "spammers" will spell words wrong on-purpose — instead of just swapping letters out for other, similar letters, they'll actually mis-spell something knowing the filter is searching for the correctly spelled term. Of course, a good spam-filter (which is what we plan to build) can detect some of this and make decisions based on that fact itself.

As of right now we're testing several cases of our filters against the following terms: "nope"; "fail"; "leet", today we're going to add some more cases, such as "noope", and "failing". These are going to be two more words we match against, but we're also now going to return how effectively the filter matched the term. That is, "nope" would match against "nope" for a 100% match, but "noope" would not, so we'll devise a manner of indicating what the success-rate is.

We're also going to try to prevent some false-alarms. A word like "true" doesn't really match any of our filters, but it's fair to say that it shares letters with two of them: it shares one letter with "nope", and two letters with "leet". We know that it's not even close, but we'll have to tell the computer that before we continue.

This can also be the basis of a 'spell-checker'

At this moment we're devising a piece of code that could serve as a trivial spell-checker, we're going to have to design it that way because we have to support mis-spellings, and the easiest way to do so is to design it as a spell-checker.

We're also going to do some TDD here — for those unfamiliar, TDD is simply "test-driven development", or the idea that you build tests that have an input and expected output, and then start writing the code to get there. We would write a test such as:

let expected = 1.0
let inputTerm = "nope"
let inputFilter = ["nope"]
let actual = inputTerm |> matchFilters inputFilter |> Seq.tryHead |> Option.map snd |> (function | None -> 0.0 | Some v -> v)
printfn "%s" (if actual = expected then "Pass" else "Fail")

This uses the AAA pattern, or "Arrange, Act, Assert". That is:

  • Arrange: prepare the conditions for the test, this is the input and output. What are we looking for? What are we given?
  • Act: perform the operation for the test, this maps the input(s) to the output(s). What do we get?
  • Assert: determine whether the expected output and actual output match. What really happened?

When I do TDD I always write a test, then write the function being tested, and repeat. I want to start with the main "framework" that we'll use (though this is a basic testing framework, there are others that are far better than this, I recommend using one of them):

module Tests =
    module Assert =
        let private fn fn msg expected actual =
            if fn expected actual then None
            else (msg expected actual) |> Some
        let equal expected actual = fn (=) (sprintf "expected: %A; actual: %A") expected actual
        let notEqual expected actual = fn (<>) (sprintf "expected not: %A; actual: %A") expected actual
        let largerThan expected actual = fn (>) (sprintf "expected greater than: %A; actual %A") expected actual
        let largerEqual expected actual = fn (>=) (sprintf "expected greater than / equal to: %A; actual %A") expected actual
        let smallerThan expected actual = fn (<) (sprintf "expected smaller than: %A; actual %A") expected actual
        let smallerEqual expected actual = fn (<=) (sprintf "expected smaller than / equal to: %A; actual %A") expected actual
        let print assertion =
            match assertion with
            | None -> printfn "Pass"
            | Some msg -> printfn "Fail: %s" msg

    // Define tests

    let runTests () =
        let tests =
            [ // List tests
              ]
        tests |> List.iter ((|>) () >> Assert.print)

This is obviously not the easiest solution to use, but it works. Drop all your test methods in the tests list, and define them before runTests, and life should be good. As an example, our first test would look like:

let ``A term that exactly matches a word in the filter should return 1.0 as match`` () =
    let expected = 1.0
    let inputTerm = "nope"
    let inputFilter = ["nope"]
    let actual = inputTerm |> matchFilters inputFilter |> Seq.tryHead |> Option.map snd |> (function | None -> 0.0 | Some v -> v)
    Assert.equal expected actual

let runTests =
    let tests = [``A term that exactly matches a word in the filter should return 1.0 as match``]
    tests |> List.iter ((|>) () >> Assert.print)

Pretty easy, right?

Write the matchFilters function

Now we start writing the matchFilters function. We know what our inputs should be: a list of filters and a term to test, and we expect that it returns some sort of sequenced tuple. Specifically, we're going to return every term matched, and the "accuracy" of that match.

Initially, we can obviously define this pretty easily to pass our test:

let matchFilters filters term = filters |> List.choose (fun filter -> if term = filter then (filter, 1.0) |> Some else None)

If we run our tests now we should get Pass printed out. Pretty easy, right? Now we could have actually written let matchFilters filters term = ("", 1.0), and that would have been completely valid and satisfied our tests. It's not wrong. We still made all our tests pass. The version I wrote just happens to satisfy what the next test we'll write is as well.

Next we should probably test that a word like "abcd" doesn't accidentally return 1.0. If we write matchFilters as the version in the previous paragraph, it would do so, so we want a test for it:

let ``A term that does not match any words in the filter should return no matches`` () =
    let expected = 0.0
    let inputTerm = "abcd"
    let inputFilter = ["nope"]
    let actual = inputTerm |> matchFilters inputFilter |> Seq.tryHead |> Option.map snd |> (function | None -> 0.0 | Some v -> v)
    Assert.equal expected actual

Now we are forced to write a version that will at the very least return 1.0 for the first test, and 0.0 for this second one. You should now get the idea of TDD: write a test, build the method to make the test pass, repeat. Ideally, you don't trust a test until you've proven that the current version of the method made it change. That is: the test should fail first, then build a version of the method that passes. Think of it as a red light turning green: you can truly trust the traffic light once you've seen that happen, because you know the basic "is it just stuck on green?" test completed, and told you "nope, it's cycling like normal."

Now, interestingly, our second test isn't actually quite right, but I'm going to leave it as is. We said it should return no matches, but we tested it in a manner that loses that idea. It doesn't matter in the end, because no matches is synonymous with 0% match, but it's a good point to keep in mind.

Before we continue, let's make life a little easier on us. We should remember from previous lessons that our goal is always to write clear, concise, informative code. We can make matchFilters slightly better with that in mind:

let matchFilters filters term =
    let matchFilter filter =
        if term = filter then (filter, 1.0) |> Some
        else None
    filters
    |> Seq.ofList
    |> Seq.choose matchFilter

Now when we're ready to build better criteria, we just have to swap out matchFilter. Much easier than dealing with that silly lambda.

Build our spell-checking algorithm (sort-of)

Alright, on to the hard part. For the first iteration of the algorithm, we're simply going to test what letters are in both terms, then divide that by the total letters from both terms for the percentage. This will return 100% for "nope"/"nope", and 0% for "nope"/"abcd". This will also return a partial match for "nope"/"true" and "nope"/"leet".

Doing this is actually quite simple, we have a few options, the one I'll use is to create a concatenated array of both the strings, and then group them, and divide each group size by 2. As an example, consider we have "nope"/"true", when we concat we'll get [|'n'; 'o'; 'p'; 'e'; 't'; 'r'; 'u'; 'e'|], when we group the characters and get the counts we'll have [|('n', 1); ('o', 1); ('p', 1); ('e', 2); ('t', 1); ('r', 1); ('u', 1)|], if we sum floor(group.Count / 2) we get 1, which we then double and find that 2 of the total 8 characters were in each string, or 25%.

let matchFilters filters (term : string) =
    let matchFilter (filter : string) =
        let termChars = term.ToCharArray()
        let filterChars = filter.ToCharArray()
        let concated = termChars |> Array.append filterChars
        let grouped = concated |> Array.groupBy id |> Array.map (fun (c, a) -> (c, a |> Array.length))
        let sum = grouped |> Array.fold (fun acc (c, i) -> acc + i / 2) 0 |> float |> (*) 2.0
        if sum <= 0.0 then None
        else (filter, sum / (term.Length + filter.Length |> float)) |> Some
    filters
    |> Seq.ofList
    |> Seq.choose matchFilter
    |> Seq.sortByDescending snd

So that's what we end up with, for now. (We'll probably improve this in a later lesson.) We added the Seq.sortByDescending snd to order them by best match first. If we run our two existing tests we should get "Pass" and "Pass". We didn't create tests for this yet (well, I did, you probably haven't) so I recommend that before dumping this in your code you build a couple basic tests.

let testFn filters = matchFilters filters >> Seq.tryHead >> Option.map snd >> (function | None -> 0.0 | Some v -> v)

let ``A term that partially matches a word in the filter should return 0.* as match`` () =
    let expected = 0.25
    let inputTerm = "true"
    let inputFilter = ["nope"]
    let actual = (inputFilter, inputTerm) ||> testFn
    Assert.equal expected actual

let ``A term that mostly matches a word in the filter should return 0.* as match`` () =
    let expected = 0.75
    let inputTerm = "mope"
    let inputFilter = ["nope"]
    let actual = (inputFilter, inputTerm) ||> testFn
    Assert.equal expected actual

This method, of course, assumes that we only care about what characters are present and that the order is irrelevant. We'll (at some point) want to redefine it to support matching terms such that terms that have the same letters but not in the same position are not exactly a 1.0, etc. For now, this will do.

Finally, come up with a "threshold" for acceptance

When we do a "heuristic" match like this, we need to define a threshold of tolerance. We don't want "true" to match the "nope" filter because it only shares an e, we wnat to define a minimum-level-of-acceptability. For this, I usually start with a somewhat middle-ground value, knowing that 0.5 means 50% of our words were a match, I go with 0.75, or 75%. This gives us an initial feeling for where we stand, and we can tune that later.

Now I'm going to redefine things a little, don't fear, just to keep it a little cleaner:

let matchFilters filters (term : string) =
    let matchFilter (filter : string) =
        let termChars = term.ToCharArray()
        let filterChars = filter.ToCharArray()
        let concated = termChars |> Array.append filterChars
        let grouped = concated |> Array.groupBy id |> Array.map (fun (c, a) -> (c, a |> Array.length))
        let sum = grouped |> Array.fold (fun acc (c, i) -> acc + i / 2) 0 |> float |> (*) 2.0
        if sum <= 0.0 then None
        else (filter, sum / (term.Length + filter.Length |> float)) |> Some
    filters
    |> Seq.ofList
    |> Seq.choose matchFilter
let bestFilter filters =
    matchFilters filters >> Seq.sortByDescending snd >> Seq.tryHead >> Option.map snd

Pretty simple, we just moved our Seq.sortByDescending out, and now we'll go ahead and add a function for meetsThreshold which takes our "filter" and threshold:

let meetsThreshold threshold (filter, percent) = percent > threshold

Time to modify our previous matchedFilters

Finally, the fun part. We'll modify the matchedFilters to use our new algorithm. I'm only going to pick the best-matched filter, and we're only going to pick which transformation of the term it was that best-matched the filter, so we'll end up with the following:

let matchedFilters term =
    term
    |> transformToLowerTerm
    |> Array.map (bestFilter filters >> (function | None -> ([||], 0.0) | Some f -> f))
    |> Array.sortByDescending snd
    |> Array.filter (meetsThreshold 0.75)
    |> Array.tryHead
    |> (function | None -> [] | Some a -> [a])

I did make one modification to matchFIlters: the inner-function was defined to use strings, we want to use our int-arrays, so we'll change:

let matchFilters filters (term : string) =
    let matchFilter (filter : string) =
        let termChars = term.ToCharArray()
        let filterChars = filter.ToCharArray()
        let concated = termChars |> Array.append filterChars

To:

let matchFilters filters (term : int[]) =
    let matchFilter (filter : int[]) =
        let concated = term |> Array.append filter

And we should have the new algorithm. We should get some matched terms:

val matchedTerms : (string * string list) list =
  [("ℕope", ["nope"]); ("𝑵ope", ["nope"]); ("ռope", ["nope"]);
   ("nope", ["nope"]); ("𝕱ail", ["fail"]); ("𝓕ail", ["fail"]);
   ("l33t", ["leet"]); ("1337", ["leet"]); ("noope", ["nope"])]

We notice that "failing" is not in there - we can add it by tuning that 0.75 threshold from before. And, finally, if you want to include the percent that it matched the filter in your matchedTerms, replace it with the following:

let matchedTerms =
    terms
    |> List.map (fun t -> (t, t |> matchedFilters))
    |> List.filter (snd >> List.length >> any)
    |> List.map (fun (t, f) -> (t |> String.fromCodePoints, f |> List.map (fun (f, s) -> (f |> String.fromCodePoints, s))))

We just change the fst >> String.fromCodePoints to a lambda, which maps the first item to the string, and the second item as the value still.


Alright, so that sums up todays lesson. I know it got a bit rambly towards the end but that's what happens when you have absolutely no sleep and write this over a 5-day period. I actually have a plan for the next one, which involves more spreadsheet stuff, so tune-in next time for another fabulous adventure in learning how to program (but the hard way). Good luck and enjoy!