quorate/services/ca-sync/sync.fsx

module Sync

open System
open System.Net.Http
open System.Text
open System.Text.Json

type Source = { Pki: string; Kv: string }

type Settings =
    { Vault: Uri
      Role: string
      TokenFile: string
      Mount: string
      Sources: Source list }

type Observation =
    { Certificate: string
      Current: string
      Version: int }

type Decision =
    | Unchanged
    | Publish of version: int * certificate: string

type CopyResult =
    { Source: Source
      Outcome: Result<Decision, string> }

let private (>>=) value next = Result.bind next value

let sources (values: string array) =
    let parse (value: string) =
        match value.Split('=') |> Array.map _.Trim() with
        | [| pki; kv |] when pki <> "" && kv <> "" -> Ok { Pki = pki; Kv = kv }
        | _ -> Error "Expected each mapping as PKI=KV"

    let add result value =
        result
        >>= fun parsed ->
            parse value
            >>= fun source ->
                if parsed |> List.exists (fun entry -> entry.Kv = source.Kv) then
                    Error $"Duplicate KV destination: {source.Kv}"
                else
                    Ok(source :: parsed)

    if Array.isEmpty values then
        Error "At least one PKI=KV mapping is required"
    else
        values |> Array.fold add (Ok []) |> Result.map List.rev

let settings lookup values =
    let required name =
        match lookup name with
        | value when String.IsNullOrWhiteSpace value -> Error $"Missing environment variable: {name}"
        | value -> Ok(value.Trim())

    sources values
    >>= fun mappings ->
        required "VAULT_ADDR"
        >>= fun address ->
            match Uri.TryCreate(address.TrimEnd('/') + "/v1/", UriKind.Absolute) with
            | true, uri when uri.Scheme = "https" || uri.Scheme = "http" ->
                required "VAULT_ROLE"
                >>= fun role ->
                    required "JWT_PATH"
                    >>= fun tokenFile ->
                        required "VAULT_MOUNT"
                        |> Result.map (fun mount ->
                            { Vault = uri
                              Role = role
                              TokenFile = tokenFile
                              Mount = mount
                              Sources = mappings })
            | _ -> Error "VAULT_ADDR must be an absolute HTTP(S) URL"

let plan observation =
    if observation.Certificate = observation.Current then
        Unchanged
    else
        Publish(observation.Version, observation.Certificate)

let private send (client: HttpClient) (token: string option) (method: HttpMethod) (path: string) payload decode =
    let error detail =
        Error $"{method.Method} {path}: {detail}"

    try
        use request = new HttpRequestMessage(method, path)
        token |> Option.iter (fun value -> request.Headers.Add("X-Vault-Token", value))

        payload
        |> Option.iter (fun (value: obj) ->
            request.Content <- new StringContent(JsonSerializer.Serialize value, Encoding.UTF8, "application/json"))

        use response = client.Send request

        if not response.IsSuccessStatusCode then
            error $"HTTP {int response.StatusCode}"
        else
            use body = JsonDocument.Parse(response.Content.ReadAsStream())
            Ok(decode body.RootElement)
    with
    | :? HttpRequestException -> error "transport failure"
    | :? OperationCanceledException -> error "request timed out"
    | :? JsonException -> error "invalid JSON response"
    | :? Collections.Generic.KeyNotFoundException -> error "missing response field"
    | :? InvalidOperationException -> error "invalid response field"

let private observe settings client token source =
    // Reading KV before PKI makes an intervening publication invalidate CAS.
    send client token HttpMethod.Get (settings.Mount + "/data/" + source.Kv) None (fun body ->
        let data = body.GetProperty "data"

        data.GetProperty("data").GetProperty("certificate").GetString(),
        data.GetProperty("metadata").GetProperty("version").GetInt32())
    >>= fun (current, version) ->
        send client token HttpMethod.Get (source.Pki + "/cert/ca") None (fun body ->
            { Certificate = body.GetProperty("data").GetProperty("certificate").GetString()
              Current = current
              Version = version })

let private publish settings client token source decision =
    match decision with
    | Unchanged -> Ok Unchanged
    | Publish(version, certificate) ->
        send
            client
            token
            HttpMethod.Post
            (settings.Mount + "/data/" + source.Kv)
            (Some
                {| options = {| cas = version |}
                   data = {| certificate = certificate |} |})
            (fun _ -> decision)

let reconcile settings client jwt =
    send client None HttpMethod.Post "auth/kubernetes/login" (Some {| role = settings.Role; jwt = jwt |}) (fun body ->
        body.GetProperty("auth").GetProperty("client_token").GetString())
    |> Result.map (fun token ->
        settings.Sources
        |> List.map (fun source ->
            { Source = source
              Outcome =
                observe settings client (Some token) source
                |> Result.map plan
                >>= publish settings client (Some token) source }))