open FSharp.Data
open FSharp.Data.JsonExtensions

open System.Xml
open System.Net
open System.Web
open System.IO
open System.Text

(*

# WHAT IS THIS?

An F# script to import Fogbugz tickets into Phabricator.

Feel free to port the logic if you can't get F# running on your platform.

## Usage:

- Update the constants below.
- Run on a per-project basis like:

  `FogbugzToPhabricator.exe "FogbugzUser" "FogbugzPassword" "Fogbugz Project Name" "Phabricator Project Name"`


## Notes:

- No warranty.
- You will want to change constants and debug first and THEN have it actually import.
- You will need to put this in a Program.fs in a project with FSharp.Data added, 
  and reference the above assemblies.
- There are a lot of constants. You should probably look at what they do before you run this.

This script does a few environment-tuned and project-specific things:

- Things in a milestone "Future" will get added to the #Future project in Phabricator
- It assumes usernames are LDAP - should work fine if not, but if you have trouble,
  change DOMAIN because I am lazy
- I arbitrarily truncate the import at 30 comments, configurable.
  We have error reporting tickets that have hundredddds.



This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.

For more information, please refer to <http://unlicense.org/>

*)


// Debugging is fun!
let DEBUG = false
let DEBUG_MULTIPART = false

// Fogbugz settings
let FOGBUGZ_URL = "http://fogbugz/api.asp"
let DOMAIN = "WISLEG"

// Phabricator settings
let PHABRICATOR_URL = "https://phab.wisleg.root.local/"
let PHABRICATOR_USER = "Bob"
let CONDUIT_TOKEN = "api-zs6inn5omfwoppfn5hqwyhsalqv7"

// Useful for testing small numbers of tickets before the real import
let MAX_TICKETS = 2000

// Truncates the imported comments at a certain sane limit
let MAX_COMMENTS = 30

let FOGBUGZ_CASE_FIELDS = "ixBug,sEvent,sTitle,sLatestTextSummary,sProject,sArea,sTags,ixPriority,ixPersonAssignedTo,sFixFor,sCategory"


let stringToXml s =
    let doc = new XmlDocument()
    doc.LoadXml s
    doc

let xfind (elem:System.Xml.XmlNode) x = 
    let inner = elem.Item(x,"")
    if inner = null then "" else
    inner.InnerText

let fetchMultipart (url:string) args =
    let encoding = new ASCIIEncoding()
    let utf8encoding = new UTF8Encoding()
    let http = HttpWebRequest.Create(url) :?> HttpWebRequest
    http.Method <- "POST";
    http.AllowWriteStreamBuffering <- true

    let boundaryString = "----------------DEADBEEFHOORAY"
    let boundary = "--" + boundaryString

    http.ContentType <- "multipart/form-data; boundary=" + boundaryString

    let writeAscii (s:string) =
        encoding.GetBytes s 

    let writeUTF8 (s:string) =
        utf8encoding.GetBytes s 

    let cr = System.Environment.NewLine

    let output = 
        args 
        |> List.map (fun (k,v) ->
            [
                boundary + cr 
                |> writeAscii
                
                "Content-Type: text/plain; charset=\"utf-8\"" + cr 
                |> writeAscii

                "Content-Disposition: form-data; name=\"" + k + "\"" + cr + cr 
                |> writeAscii

                writeUTF8 v
                writeAscii cr
            ]
        )
        |> List.concat

    let finalOutput =
        output @ [writeAscii (boundary + "--")]

    let length = finalOutput |> List.fold (fun total b -> total + b.Length) 0

    if DEBUG_MULTIPART then 
        printfn "Got length %i" length
        printfn "Sending args %A" args
        printfn "Sending output:"
        (finalOutput |> List.iter (fun b -> printf "%s" <| encoding.GetString(b)) )

    http.ContentLength <- int64 length

    let stream = http.GetRequestStream()
    for x in finalOutput do
        stream.Write(x, 0, x.Length)
    stream.Close()

    let response = http.GetResponse().GetResponseStream()
    let reader = new StreamReader(response)
    let returnString = reader.ReadToEnd()
    reader.Close()
    returnString



let fogbugzFetch args =
    fetchMultipart FOGBUGZ_URL args

let fogbugzXml args = fogbugzFetch args |> stringToXml

let addToken token args = args @ ["token", token]


type Fogbugz = {
    Token: string
    Users: (string * string) list
    Projects: (string * string) list
} with
    static member Connect(username, password) = 
        let doc = fogbugzXml [ ("email", username); ("password", password); ("cmd", "logon") ]
        let tokens = doc.SelectNodes("//token")
        if (tokens.Count < 1) then failwith (sprintf "Unexpected result from FogBugz: %s" doc.InnerXml)
        let token = tokens.[0].InnerText 

        let fetch = addToken token >> fogbugzXml

        let doc = fetch [ ("cmd", "listPeople") ]
        let users = 
            [ for p in doc.SelectNodes("//person") do
                let find = xfind p
                yield ( find "ixPerson",
                        (find "sLDAPUid").Replace(DOMAIN + "\\","") )
            ]

        let doc = fetch [ ("cmd", "listProjects") ]
        let projects = 
            [ for p in doc.SelectNodes("//project") do
                let find = xfind p
                yield ( find "ixProject",
                        find "sProject" )
            ]

        { 
            Token = token
            Users = users
            Projects = projects
        }


    member self.Fetch =
        addToken self.Token >> fogbugzXml

    member self.Search(q, cols, max) =
        let cols = defaultArg cols "ixBug,sEvent,sTitle,ixProject"
        self.Fetch [
            ("q", q)
            ("cols", cols)
            ("max", string max)
            ("cmd", "search")
        ]

    member self.LookupUser ixPerson =
        self.Users 
        |> List.tryPick (fun (i,n) -> if i = ixPerson then Some n else None)
        


type PhabUser = JsonProvider<"""
[ {
    "phid": "PHID-USER-3fstcq463si2mqwbhg3d",
    "userName": "JDoe",
    "realName": "John Doe",
    "image": "https:\/\/phab.wisleg.root.local\/res\/phabricator\/3eb28cd9\/rsrc\/image\/avatar.png",
    "uri": "https:\/\/phab.wisleg.root.local\/p\/JDoe\/",
    "roles": [
      "verified",
      "approved",
      "activated"
    ]
} ]
""">


type PhabProject = JsonProvider<"""
{
  "id": "1",
  "phid": "PHID-PROJ-7k3ihejmysfbrinsjssu",
  "name": "Name",
  "profileImagePHID": "PHID-FILE-wpx363l4xiu76te7z2jq",
  "icon": "cloud",
  "color": "red",
  "members": [
    "PHID-USER-yrmohaxcwbumgouvdyio"
  ],
  "slugs": [
    "projectname"
  ],
  "dateCreated": "1432234693",
  "dateModified": "1432310731"
}
""">


let fetch (url:string) (args: (string * string) list) =
    let http = HttpWebRequest.Create(url) :?> HttpWebRequest
    http.Method <- "POST";
    http.AllowWriteStreamBuffering <- true
    http.ContentType <- "application/json"

    let concatArgs =
        args
        |> List.map ( fun (k,v) -> sprintf "%s=%s" (HttpUtility.UrlEncode k) (HttpUtility.UrlEncode v) )
        |> String.concat "&"

    let output = Encoding.UTF8.GetBytes concatArgs

    if DEBUG then printfn "Posting to %s, %A" url concatArgs

    http.ContentLength <- int64 output.Length

    let stream = http.GetRequestStream()
    stream.Write(output, 0, output.Length)
    stream.Close()

    let response = http.GetResponse().GetResponseStream()
    let reader = new StreamReader(response)
    let returnString = reader.ReadToEnd()
    reader.Close()
    returnString


let phabricatorFetch methodName (args: (string * string) list) =
    let url = PHABRICATOR_URL + "api/" + methodName + "?api.token=" + CONDUIT_TOKEN
    let response = fetch url args
    let json = JsonValue.Parse response
    match json?result with
    | JsonValue.Null -> failwithf "Could not parse Phabricator response %s" response
    | x -> x

let stringsEqual (a:string) (b:string) =
    a.ToLowerInvariant() = b.ToLowerInvariant()

let toString x = sprintf "%O" x


type Phabricator = {
    Users: (string * string * PhabUser.Root) list
    Projects: (string * string * PhabProject.Root) list
} with
    static member Connect() =
        { 
            Users =
                phabricatorFetch "user.query" []
                |> toString
                |> PhabUser.Parse
                |> Array.toList
                |> List.map (fun x -> x.UserName, x.Phid, x)

            Projects =
                phabricatorFetch "project.query" []
                |> toString
                |> JsonValue.Parse
                |> fun x -> x?data.Properties
                |> Array.toList
                |> List.map (fun (key,thing) -> 
                    let stuff = thing.ToString() |> PhabProject.Parse
                    stuff.Name, stuff.Phid, stuff)
        }

    member self.LookupProject name =
        self.Projects
        |> List.tryPick (fun (n,_,p) -> if stringsEqual n name then Some p else None)

    member self.LookupUser name =
        self.Users
        |> List.tryPick (fun (n,_,u) -> if stringsEqual n name then Some u else None)

    member self.Run command args =
        phabricatorFetch command args

    member self.CreateTask args =
        self.Run "maniphest.createtask" args

    member self.UpdateTask args =
        self.Run "maniphest.update" args

    member self.SearchTask args =
        self.Run "maniphest.query" args
        |> function 
        | JsonValue.Array [| |] -> [| |]
        | JsonValue.Record x -> x
        | f -> failwithf "Expected array from search, got %A" f
         


type Comment = {
    Description: string
    Username: string option
    Date: System.DateTime option
} with
    static member Create x =
        { Description = x; Username = None; Date = None}

/// The bucket we'll hold information in
type Ticket = {
    OriginalId: string
    Title: string
    Project: string
    Area: string
    Category: string
    Tags: string
    Priority: string
    LatestSummary: string
    Comments: Comment list
    FixFor: string
    AssignedUsername: string option
} with
    member self.PhabricatorPriority = 
        match self.Priority with
        | "1" -> 100
        | "2" -> 80
        | "3" | "4" -> 50
        | "5" | "6" -> 25
        | _ -> 90



let import user pass fbProjectName phabProjectName =
    let phab = Phabricator.Connect()
    let fb = Fogbugz.Connect(user, pass)
    let phabricatorProjectId = 
        match phab.LookupProject phabProjectName with
        | None -> failwithf "Can't find phabricator project named %s" phabProjectName
        | Some p -> p.Phid

    let phabricatorFuture = phab.LookupProject "Future"

    let convert (elem:System.Xml.XmlNode) =
        let find = xfind elem
        let ixBug = find "ixBug"

        let comments = 
            if ixBug = "" then [] else
            let events = fb.Search(ixBug, Some "events,ixPerson,dt", MAX_COMMENTS + 1).SelectNodes("//event");
            [ for e in events do
                let text = e.SelectNodes("s")
                let date = e.SelectNodes("dt")
                let ixPerson = e.SelectNodes("ixPerson")
                yield {
                    Description = 
                        [
                            for t in text do
                                let trimmed = t.InnerText.Trim()
                                if trimmed <> "" then
                                    yield trimmed
                        ] |> String.concat "\n\n"

                    Username = 
                        if ixPerson.Count > 0 then
                            fb.LookupUser ixPerson.[0].InnerText
                        else
                            None
                    
                    Date = 
                        if date.Count > 0 then
                            Some (System.DateTime.Parse(date.[0].InnerText))
                        else
                            None
                }
            ]

        { 
            OriginalId = find "ixBug"
            Title = find "sTitle"
            Project = find "sProject"
            FixFor = find "sFixFor"
            Area = find "sArea"
            Category = find "sCategory"
            Tags = find "sTags"
            Priority = find "ixPriority"
            LatestSummary = find "sLatestTextSummary"
            Comments = comments
            AssignedUsername = fb.LookupUser (find "ixPersonAssignedTo")
        }



    let jsonString (x:string) =
        //x.Replace("\"", "\\\"")
        x
        |> JsonValue.String

    let jsonEscape (x:string) =
        (jsonString x).ToString()
        
    let toManiphestArgs t = 
        let originalUrl = sprintf "http://fogbugz/default.asp?%s" t.OriginalId
        let comments =
            if t.Comments.Length > MAX_COMMENTS then
                (
                    Seq.truncate MAX_COMMENTS t.Comments
                    |> List.ofSeq
                )
                @ [ Comment.Create <| sprintf "[[ %s | Comments have been TRUNCATED. Please go to the original fogbugz ticket to see more comments. ]]" originalUrl ]
            else
                t.Comments
            |> List.choose 
                (fun c ->
                    let phabUser = phab.LookupUser (defaultArg c.Username "")
                    let userName = phabUser |> Option.map (fun x -> "@" + x.UserName)
                    if c.Description.Trim() = "" then None else
                    let date = c.Date |> Option.map (fun x -> x.ToLocalTime().ToString("**yyyy-MM-dd** HH:mm"))
                    Some <|
                    sprintf "**%s** %s\n%s" 
                        (defaultArg userName "Unknown user")
                        (defaultArg date "Unknown date")
                        c.Description
                )
            |> String.concat "\n\n-----\n\n"

        let description =
            (sprintf "# [[ %s | From Fogbugz: %s ]]\n\n" originalUrl t.OriginalId)
            + (sprintf "FB Milestone: **%s**\n\n" t.FixFor)
            + (sprintf "FB Area: **%s**\n\n" t.Area)
            + (if t.Tags.Equals "" then "" else (sprintf "FB Tags: **%s**\n\n" t.Tags))
            + (sprintf "# Description:\n\n %s" comments)

        let projects = [|
            yield phabricatorProjectId
            match t.FixFor with
            | "Future" ->
                match phabricatorFuture with
                | Some i -> yield i.Phid
                | _ -> failwith "Couldn't find future project"
            | _ -> ()
        |]

        let projectsStupidPhpEncoding =
            projects
            |> Seq.mapi (fun i p -> sprintf "projectPHIDs[%i]" i, p)

        [
            yield "title", t.Title
            yield "description", description
            yield "priority", string t.PhabricatorPriority
            yield! projectsStupidPhpEncoding
            match t.AssignedUsername with
            | Some name ->
                match phab.LookupUser name with
                | Some user ->
                    yield "ownerPHID", user.Phid
                | _ -> ()
            | _ -> ()
        ]
        |> List.map (fun (k,v) -> k, v.ToString())

    let xml = 
        fb.Search(
            sprintf """ project:"%s" AND status:"Open" """ fbProjectName,
            Some FOGBUGZ_CASE_FIELDS,
            MAX_TICKETS
        ).SelectNodes("/response/cases/case");

    for x in xml do
        let ticket = convert x
        let args = toManiphestArgs ticket

        // Find existing imported "from fogbugz" task if it exists
        let existing =
            phab.SearchTask [ ("fullText", jsonEscape ticket.Title) ]
            |> Array.tryFind 
                ( fun (phid,v) ->
                    match v?description with
                    | JsonValue.String desc ->
                        desc.Contains(sprintf "From Fogbugz: %s" ticket.OriginalId)
                    | _ -> false
                )

        match existing with
        | Some (phid, existingTicket) ->
            // pass in the existing Phid so we edit the existing ticket
            let editedArgs = ("phid", phid) :: args
            let result = phab.UpdateTask editedArgs
            printfn "Task updated for ticket %s %s: %A" ticket.OriginalId ticket.Title result

        | None ->
            let result = phab.CreateTask args
            printfn "Task created for ticket %s %s: %A" ticket.OriginalId ticket.Title result



[<EntryPoint>]
let main argv = 
    import argv.[0] argv.[1] argv.[2] argv.[3] 
    0