#load "sync.fsx"

open System
open System.Collections.Generic
open System.Net
open System.Net.Http
open System.Text
open System.Text.Json
open System.Threading.Tasks
open Sync

let unwrap =
    function
    | Ok value -> value
    | Error error -> failwith error

let config =
    { Vault = Uri "https://synthetic.invalid/v1/"
      Role = "ca-sync"
      TokenFile = "synthetic-token"
      Mount = "secret"
      Sources =
        sources [| "pki=ca/internal"; "pki_postgres=ca/postgres"; "pki_opnsense=ca/opnsense" |]
        |> unwrap }


type Fixture() =
    inherit HttpMessageHandler()
    let source = Dictionary<string, string>()
    let stored = Dictionary<string, string>()
    let versions = Dictionary<string, int>()
    let requests = ResizeArray<string>()
    let mutable reject = None
    let mutable jwt = "synthetic-jwt"
    let mutable afterRead: (string -> unit) = ignore
    let mutable afterSource: (string -> unit) = ignore

    do
        for value in config.Sources do
            source.Add(value.Pki, "synthetic-" + value.Pki)
            stored.Add(value.Kv, "PLACEHOLDER")
            versions.Add(value.Kv, 1)

    member _.AfterRead
        with set value = afterRead <- value

    member _.AfterSource
        with set value = afterSource <- value

    member _.Source = source
    member _.Stored = stored
    member _.Versions = versions
    member _.Requests = requests

    member _.Reject
        with get () = reject
        and set value = reject <- value

    member _.Jwt
        with set value = jwt <- value

    member private _.Handle(request: HttpRequestMessage) =
        let path = request.RequestUri.AbsolutePath.Substring("/v1/".Length)
        let key = request.Method.Method + " " + path
        requests.Add key

        let response status payload =
            new HttpResponseMessage(
                status,
                Content = new StringContent(JsonSerializer.Serialize payload, Encoding.UTF8, "application/json")
            )

        if reject = Some key then
            response HttpStatusCode.ServiceUnavailable {| errors = [| "synthetic outage" |] |}
        elif path = "auth/kubernetes/login" then
            use body =
                JsonDocument.Parse(request.Content.ReadAsStringAsync().GetAwaiter().GetResult())

            if
                request.Method <> HttpMethod.Post
                || body.RootElement.GetProperty("role").GetString() <> config.Role
                || body.RootElement.GetProperty("jwt").GetString() <> jwt
            then
                response HttpStatusCode.Forbidden {| errors = [| "synthetic authentication denied" |] |}
            else
                response HttpStatusCode.OK {| auth = {| client_token = "synthetic-vault-token" |} |}
        elif
            not (request.Headers.Contains "X-Vault-Token")
            || request.Headers.GetValues("X-Vault-Token") |> Seq.exactlyOne
               <> "synthetic-vault-token"
        then
            response HttpStatusCode.Forbidden {| errors = [| "synthetic authorization denied" |] |}
        elif path.EndsWith "/cert/ca" then
            let mount = path.Substring(0, path.Length - "/cert/ca".Length)

            let snapshot =
                response HttpStatusCode.OK {| data = {| certificate = source[mount] |} |}

            afterSource mount
            snapshot
        elif path.StartsWith "secret/data/ca/" then
            let name = path.Substring("secret/data/".Length)

            if request.Method = HttpMethod.Get then
                let snapshot =
                    response
                        HttpStatusCode.OK
                        {| data =
                            {| data = {| certificate = stored[name] |}
                               metadata = {| version = versions[name] |} |} |}

                afterRead name
                snapshot
            else
                use body =
                    JsonDocument.Parse(request.Content.ReadAsStringAsync().GetAwaiter().GetResult())

                let expected = body.RootElement.GetProperty("options").GetProperty("cas").GetInt32()

                if expected <> versions[name] then
                    response HttpStatusCode.BadRequest {| errors = [| "CAS mismatch" |] |}
                else
                    stored[name] <- body.RootElement.GetProperty("data").GetProperty("certificate").GetString()
                    versions[name] <- versions[name] + 1
                    response HttpStatusCode.OK {| data = {| version = versions[name] |} |}
        else
            failwith $"unexpected request: {key}"

    override self.Send(request, _) = self.Handle request
    override self.SendAsync(request, _) = Task.FromResult(self.Handle request)

let check condition message =
    if not condition then
        failwith message

let changed results =
    results
    |> List.sumBy (fun result ->
        match result.Outcome with
        | Ok(Publish _) -> 1
        | Ok Unchanged
        | Error _ -> 0)

let errors results =
    results
    |> List.choose (fun result ->
        match result.Outcome with
        | Error error -> Some error
        | Ok _ -> None)

let run () =
    for values in
        [| [||]
           [| "pki" |]
           [| "=ca/internal" |]
           [| "pki=" |]
           [| "pki=ca/x"; "other=ca/x" |] |] do
        check (sources values |> Result.isError) "invalid mappings were accepted"

    check ((sources [| " pki = ca/internal " |] |> unwrap)[0] = config.Sources[0]) "mapping whitespace"
    check (settings (fun _ -> null) [| "pki=ca/x" |] |> Result.isError) "missing configuration was accepted"

    let env =
        Map
            [ "VAULT_ADDR", "https://synthetic.invalid"
              "VAULT_ROLE", "ca-sync"
              "JWT_PATH", "synthetic-token"
              "VAULT_MOUNT", "secret" ]

    check (settings (fun name -> env[name]) [| "pki=ca/x" |] |> Result.isOk) "valid configuration was rejected"

    check
        (plan
            { Certificate = "same"
              Current = "same"
              Version = 9 } = Unchanged)
        "no-op plan"

    check
        (plan
            { Certificate = "new"
              Current = "old"
              Version = 9 } = Publish(9, "new"))
        "CAS plan"

    use fixture = new Fixture()
    use client = new HttpClient(fixture, BaseAddress = config.Vault)
    let sync jwt = reconcile config client jwt
    check (sync "synthetic-jwt" |> unwrap |> changed = 3) "initial publication"
    check (sync "synthetic-jwt" |> unwrap |> changed = 0) "unchanged publication"
    check (fixture.Versions.Values |> Seq.forall ((=) 2)) "no-op changed KV versions"
    fixture.Source["pki_postgres"] <- "synthetic-new-postgres"
    check (sync "synthetic-jwt" |> unwrap |> changed = 1) "selective CA rotation"

    check
        (fixture.Versions["ca/internal"] = 2
         && fixture.Versions["ca/postgres"] = 3
         && fixture.Versions["ca/opnsense"] = 2)
        "unrelated versions changed"

    check (sync "synthetic-jwt" |> unwrap |> changed = 0) "rotation is not idempotent"

    let snapshot () =
        fixture.Versions |> Seq.map (fun pair -> pair.Key, pair.Value) |> Map.ofSeq

    let before = snapshot ()
    check (sync "synthetic-wrong-jwt" = Error "POST auth/kubernetes/login: HTTP 403") "unsafe or opaque login error"
    check (snapshot () = before) "failed login wrote KV"
    fixture.Reject <- Some "GET pki_postgres/cert/ca"
    fixture.Source["pki_opnsense"] <- "synthetic-new-opnsense"
    let independent = sync "synthetic-jwt" |> unwrap
    check (errors independent = [ "GET pki_postgres/cert/ca: HTTP 503" ]) "source error context"

    check
        (changed independent = 1
         && fixture.Stored["ca/opnsense"] = "synthetic-new-opnsense")
        "one failed CA blocked another"

    check (fixture.Versions["ca/postgres"] = before["ca/postgres"]) "failed source changed KV"

    for request in [| "GET secret/data/ca/internal"; "POST secret/data/ca/internal" |] do
        fixture.Source["pki"] <- "synthetic-new-internal"
        fixture.Reject <- Some request
        let before = snapshot ()
        check (sync "synthetic-jwt" |> unwrap |> errors = [ request + ": HTTP 503" ]) "KV error context"
        check (snapshot () = before) "failed KV access wrote data"

    fixture.Reject <- None
    fixture.Jwt <- "synthetic-new-jwt"
    check (sync "synthetic-new-jwt" |> unwrap |> changed = 1) "fresh login recovery"
    check (sync "synthetic-new-jwt" |> unwrap |> changed = 0) "recovery no-op"

    fixture.Source["pki"] <- "synthetic-stale"

    fixture.AfterSource <-
        fun name ->
            if name = "pki" then
                fixture.AfterSource <- ignore
                fixture.Source["pki"] <- "synthetic-latest"
                check (sync "synthetic-new-jwt" |> unwrap |> changed = 1) "newer poll did not publish"

    let overlapping = sync "synthetic-new-jwt" |> unwrap
    check (errors overlapping = [ "POST secret/data/ca/internal: HTTP 400" ]) "stale write was accepted"
    check (fixture.Stored["ca/internal"] = "synthetic-latest") "old poll overwrote new certificate"
    let before = snapshot ()
    check (sync "synthetic-new-jwt" |> unwrap |> changed = 0 && snapshot () = before) "CAS recovery is not idempotent"

    fixture.AfterRead <-
        fun name ->
            if name = "ca/internal" then
                fixture.AfterRead <- ignore
                fixture.Source["pki"] <- "synthetic-after-kv"
                check (sync "synthetic-new-jwt" |> unwrap |> changed = 1) "overlap after KV read"

    check
        (sync "synthetic-new-jwt" |> unwrap |> errors = [ "POST secret/data/ca/internal: HTTP 400" ])
        "KV snapshot overlap accepted"

    check (fixture.Stored["ca/internal"] = "synthetic-after-kv") "KV snapshot overlap regressed"

    printfn
        "PASS: configuration, pure plans, no-op versions, isolated failures, safe diagnostics, fresh login and overlapping CAS writes"

run ()