#load "bootstrap-lib.fsx"

open System
open System.Collections.Generic
open System.IO
open System.Net
open System.Net.Http
open System.Net.Http.Headers
open System.Net.Http.Json
open System.Net.Security
open System.Security.Cryptography
open System.Security.Cryptography.X509Certificates
open System.Text
open System.Text.Json
open System.Text.Json.Nodes
open Bootstrap

type VaultConfig =
    { URL: string
      Role: string
      JwtPath: string
      CaPath: string }

type QuayConfig =
    { URL: string
      ZitadelAPI: string
      ZitadelIssuer: string
      CaPath: string
      LoginKey: string }

type KubeConfig =
    { URL: string
      TokenPath: string
      CaPath: string
      Namespace: string
      Secret: string }

let private require condition message =
    if not condition then
        invalidOp message

let private stringNode (value: string) = JsonValue.Create(value) :> JsonNode

let private jsonObject (values: (string * JsonNode) list) =
    let result = JsonObject()

    for name, value in values do
        result[name] <- value

    result

let private property (name: string) (root: JsonElement) =
    let mutable value = Unchecked.defaultof<JsonElement>
    require (root.TryGetProperty(name, &value)) $"response omitted {name}"
    value

let private stringProp name root =
    let value = property name root
    require (value.ValueKind = JsonValueKind.String) $"response {name} is not a string"

    value.GetString()
    |> Option.ofObj
    |> Option.defaultWith (fun () -> invalidOp $"response {name} is empty")

let private readJson operation status (response: HttpResponseMessage) =
    use response = response
    require (response.StatusCode = status) $"{operation} failed with HTTP {int response.StatusCode}"
    use document = JsonDocument.Parse(response.Content.ReadAsStream())
    document.RootElement.Clone()

let private expect operation status (response: HttpResponseMessage) =
    use response = response
    require (response.StatusCode = status) $"{operation} failed with HTTP {int response.StatusCode}"

let private handler caPath allowRedirect =
    let handler = new HttpClientHandler(AllowAutoRedirect = allowRedirect)

    if not (String.IsNullOrWhiteSpace caPath) then
        let root = X509Certificate2.CreateFromPem(File.ReadAllText caPath)

        handler.ServerCertificateCustomValidationCallback <-
            fun _ certificate peerChain errors ->
                if errors = SslPolicyErrors.None then
                    true
                elif isNull certificate || errors <> SslPolicyErrors.RemoteCertificateChainErrors then
                    false
                else
                    use chain = new X509Chain()
                    chain.ChainPolicy.TrustMode <- X509ChainTrustMode.CustomRootTrust
                    chain.ChainPolicy.CustomTrustStore.Add root |> ignore
                    chain.ChainPolicy.RevocationMode <- X509RevocationMode.NoCheck

                    if not (isNull peerChain) then
                        for element in peerChain.ChainElements do
                            chain.ChainPolicy.ExtraStore.Add element.Certificate |> ignore

                    chain.Build certificate

    handler

let private client caPath allowRedirect =
    let client = new HttpClient(handler caPath allowRedirect, true)
    client.Timeout <- TimeSpan.FromSeconds 30.
    client

let private sessionClient caPath =
    let handler = handler caPath false
    handler.CookieContainer <- CookieContainer()
    let client = new HttpClient(handler, true)
    client.Timeout <- TimeSpan.FromSeconds 30.
    client

let private sendRequest
    (client: HttpClient)
    (method: HttpMethod)
    (endpoint: string)
    (bearer: string option)
    (basic: (string * string) option)
    (csrf: string option)
    (body: JsonNode option)
    (host: string option)
    (headers: (string * string) list)
    =
    use message = new HttpRequestMessage(method, endpoint)

    host |> Option.iter (fun value -> message.Headers.Host <- value)
    headers |> List.iter (fun (name, value) -> message.Headers.Add(name, value))

    match bearer, basic with
    | Some token, _ -> message.Headers.Authorization <- AuthenticationHeaderValue("Bearer", token)
    | _, Some(user, token) ->
        let encoded = Convert.ToBase64String(Encoding.UTF8.GetBytes($"{user}:{token}"))
        message.Headers.Authorization <- AuthenticationHeaderValue("Basic", encoded)
    | _ -> ()

    csrf |> Option.iter (fun token -> message.Headers.Add("X-CSRF-Token", token))

    body
    |> Option.iter (fun value ->
        let content =
            new StringContent(value.ToJsonString(), Encoding.UTF8, "application/json")

        content.Headers.ContentType.CharSet <- null
        message.Content <- content)

    client.Send message

let private request client method endpoint bearer basic csrf body =
    sendRequest client method endpoint bearer basic csrf body None []

let private endpoint (root: string) (path: string) =
    $"{root.TrimEnd('/')}/{path.TrimStart('/')}"

let private base64Url (content: byte array) =
    Convert.ToBase64String content
    |> _.TrimEnd('=')
    |> _.Replace('+', '-')
    |> _.Replace('/', '_')

let private systemToken zitadel (key: string) =
    let issued = DateTimeOffset.UtcNow.ToUnixTimeSeconds()

    let header = JsonSerializer.SerializeToUtf8Bytes {| alg = "RS256" |} |> base64Url

    let claims =
        JsonSerializer.SerializeToUtf8Bytes
            {| iss = "login-client"
               sub = "login-client"
               aud = zitadel
               iat = issued
               exp = issued + 300L |}
        |> base64Url

    let unsigned = $"{header}.{claims}"
    use rsa = RSA.Create()
    rsa.ImportFromPem key

    let signature =
        rsa.SignData(Encoding.UTF8.GetBytes unsigned, HashAlgorithmName.SHA256, RSASignaturePadding.Pkcs1)
        |> base64Url

    $"{unsigned}.{signature}"

let readKubeKeyWith (client: HttpClient) (config: KubeConfig) =
    let token = File.ReadAllText(config.TokenPath).Trim()
    require (not (String.IsNullOrWhiteSpace token)) "service account token is empty"

    let path =
        $"api/v1/namespaces/{Uri.EscapeDataString config.Namespace}/secrets/{Uri.EscapeDataString config.Secret}"

    let response =
        request client HttpMethod.Get (endpoint config.URL path) (Some token) None None None

    let data =
        readJson "read ZITADEL login key" HttpStatusCode.OK response |> property "data"

    let encoded = stringProp "tls.key" data
    Encoding.UTF8.GetString(Convert.FromBase64String encoded)

let readKubeKey (config: KubeConfig) =
    readKubeKeyWith (client config.CaPath true) config

let private vaultRequest
    (client: HttpClient)
    (method: HttpMethod)
    (endpoint: string)
    (token: string)
    (body: JsonNode option)
    =
    use message = new HttpRequestMessage(method, endpoint)
    message.Headers.Add("X-Vault-Token", token)
    body |> Option.iter (fun value -> message.Content <- JsonContent.Create value)
    client.Send message

let makeStoreWith (client: HttpClient) (config: VaultConfig) =
    let jwt = File.ReadAllText(config.JwtPath).Trim()
    require (not (String.IsNullOrWhiteSpace jwt)) "service account token is empty"

    let payload = jsonObject [ "role", stringNode config.Role; "jwt", stringNode jwt ]

    let response =
        request client HttpMethod.Post (endpoint config.URL "v1/auth/kubernetes/login") None None None (Some payload)

    let login = readJson "Vault login" HttpStatusCode.OK response
    let token = login |> property "auth" |> stringProp "client_token"

    let read (path: string) =
        let response =
            vaultRequest client HttpMethod.Get (endpoint config.URL $"v1/{path}") token None

        let root = readJson "Vault read" HttpStatusCode.OK response
        let data = root |> property "data" |> property "data"

        data.EnumerateObject()
        |> Seq.map (fun item -> item.Name, item.Value.GetString())
        |> Seq.choose (fun (name, value) -> value |> Option.ofObj |> Option.map (fun text -> name, text))
        |> Map.ofSeq

    let write (path: string) (values: Map<string, string>) =
        let data = JsonObject()

        for KeyValue(name, value) in values do
            data[name] <- stringNode value

        let payload = jsonObject (List.singleton ("data", data))

        let response =
            vaultRequest client HttpMethod.Post (endpoint config.URL $"v1/{path}") token (Some payload)

        expect "Vault write" HttpStatusCode.OK response

    { Read = read; Write = write }

let makeStore (config: VaultConfig) =
    makeStoreWith (client config.CaPath true) config

let private query values =
    let pairs = values |> List.map (fun (name, value) -> KeyValuePair(name, value))
    use content = new FormUrlEncodedContent(pairs)
    content.ReadAsStringAsync().GetAwaiter().GetResult()

let private assignments quayURL (session: Session) =
    let client = session.State :?> HttpClient

    let response =
        request client HttpMethod.Get (endpoint quayURL "/api/v1/user/assignedauthorization") None None None None

    readJson "list assignments" HttpStatusCode.OK response
    |> property "authorizations"
    |> _.EnumerateArray()
    |> Seq.map _.Clone()
    |> Seq.toList

let private assignment quayURL app items =
    let matches =
        items
        |> List.filter (fun item -> item |> property "application" |> stringProp "clientId" = app.Client)

    match matches with
    | [] -> None
    | [ item ] ->
        let scopes =
            item
            |> property "scopes"
            |> _.EnumerateArray()
            |> Seq.map (stringProp "scope")
            |> Seq.sort
            |> Seq.toList

        require (scopes = List.sort app.Scopes) "assigned authorization has different scopes"

        require
            (stringProp "redirectUri" item = endpoint quayURL "/oauth/localapp")
            "assigned authorization has a different redirect URI"

        require (stringProp "responseType" item = "token") "assigned authorization has a different response type"
        Some item
    | _ -> invalidOp "multiple assigned authorizations use the same client ID"

let makeQuayWith (adminClient: HttpClient) makeSession (config: QuayConfig) =
    let quayURL path = endpoint config.URL path
    let zitadelURL path = endpoint config.ZitadelIssuer path
    let issuer = Uri config.ZitadelIssuer
    let apiRoot = Uri config.ZitadelAPI

    let zitadelRequest client method url bearer body =
        let source = Uri url
        let builder = UriBuilder apiRoot
        builder.Path <- source.AbsolutePath
        builder.Query <- source.Query.TrimStart('?')

        sendRequest
            client
            method
            (builder.Uri.ToString())
            bearer
            None
            None
            body
            (Some issuer.Host)
            [ ("X-Zitadel-Public-Host", issuer.Host) ]

    let login user password loginAuth =
        let client = makeSession ()

        let csrfRoot =
            request client HttpMethod.Get (quayURL "/csrf_token") None None None None

        let csrf =
            readJson "get Quay CSRF token" HttpStatusCode.OK csrfRoot
            |> stringProp "csrf_token"

        let payload = jsonObject (List.singleton ("kind", stringNode "login"))

        let externalResponse =
            request
                client
                HttpMethod.Post
                (quayURL "/api/v1/externallogin/zitadel")
                None
                None
                (Some csrf)
                (Some payload)

        let external = readJson "start Quay login" HttpStatusCode.OK externalResponse
        let authURL = stringProp "auth_url" external
        use started = zitadelRequest client HttpMethod.Get authURL None None

        require
            (int started.StatusCode >= 300 && int started.StatusCode < 400)
            $"start ZITADEL login failed with HTTP {int started.StatusCode}"

        require (not (isNull started.Headers.Location)) "ZITADEL login returned no redirect"
        let loginURL = Uri(Uri(zitadelURL "/"), started.Headers.Location)
        let requestID = loginURL.Query.TrimStart('?').Split('&')

        let requestID =
            requestID
            |> Array.tryPick (fun item ->
                match item.Split('=', 2) with
                | [| name; value |] when name = "authRequest" -> Some(Uri.UnescapeDataString value)
                | _ -> None)
            |> Option.defaultWith (fun () -> invalidOp "ZITADEL redirect omitted authRequest")

        let userCheck =
            jsonObject (
                List.singleton (
                    "checks",
                    jsonObject (List.singleton ("user", jsonObject (List.singleton ("loginName", stringNode user))))
                )
            )

        let createdResponse =
            zitadelRequest client HttpMethod.Post (zitadelURL "/v2/sessions") (Some loginAuth) (Some userCheck)

        let created =
            readJson "create ZITADEL session" HttpStatusCode.Created createdResponse

        let sessionID = stringProp "sessionId" created

        let passwordCheck =
            jsonObject (
                List.singleton (
                    "checks",
                    jsonObject (
                        List.singleton ("password", jsonObject (List.singleton ("password", stringNode password)))
                    )
                )
            )

        let checkedResponse =
            zitadelRequest
                client
                HttpMethod.Patch
                (zitadelURL $"/v2/sessions/{Uri.EscapeDataString sessionID}")
                (Some loginAuth)
                (Some passwordCheck)

        let passwordResult =
            readJson "check ZITADEL password" HttpStatusCode.OK checkedResponse

        let sessionToken = stringProp "sessionToken" passwordResult

        let finish =
            jsonObject (
                List.singleton (
                    "session",
                    jsonObject [ "sessionId", stringNode sessionID; "sessionToken", stringNode sessionToken ]
                )
            )

        let finishResponse =
            zitadelRequest
                client
                HttpMethod.Post
                (zitadelURL $"/v2/oidc/auth_requests/{Uri.EscapeDataString requestID}")
                (Some loginAuth)
                (Some finish)

        let finished = readJson "finish ZITADEL request" HttpStatusCode.OK finishResponse
        let callback = stringProp "callbackUrl" finished
        use callbackResponse = request client HttpMethod.Get callback None None None None

        require
            (int callbackResponse.StatusCode >= 200 && int callbackResponse.StatusCode < 400)
            $"finish Quay login failed with HTTP {int callbackResponse.StatusCode}"

        { User = user; State = client }

    let admin method path token body operation status =
        request adminClient method (quayURL path) (Some token) None None body
        |> expect operation status

    let adminJson method path token body operation =
        request adminClient method (quayURL path) (Some token) None None body
        |> readJson operation HttpStatusCode.OK

    let access adminToken app =
        let teamPath =
            $"/api/v1/organization/{Uri.EscapeDataString app.Org}/team/mirrored-image"

        let team = jsonObject (List.singleton ("role", stringNode "creator"))
        admin HttpMethod.Put teamPath adminToken (Some team) "ensure Quay team" HttpStatusCode.OK

        let memberPath = $"{teamPath}/members/{Uri.EscapeDataString app.User}"
        admin HttpMethod.Put memberPath adminToken None "ensure Quay member" HttpStatusCode.OK
        let protoPath = $"/api/v1/organization/{Uri.EscapeDataString app.Org}/prototypes"

        let listed =
            adminJson HttpMethod.Get protoPath adminToken None "list Quay prototypes"

        let exists =
            listed
            |> property "prototypes"
            |> _.EnumerateArray()
            |> Seq.exists (fun item ->
                let delegateValue = property "delegate" item

                stringProp "role" item = "write"
                && stringProp "name" delegateValue = "mirrored-image"
                && stringProp "kind" delegateValue = "team")

        if not exists then
            let payload =
                jsonObject
                    [ "role", stringNode "write"
                      "delegate", jsonObject [ "name", stringNode "mirrored-image"; "kind", stringNode "team" ] ]

            admin HttpMethod.Post protoPath adminToken (Some payload) "create Quay prototype" HttpStatusCode.OK

    let application adminToken app =
        let path = $"/api/v1/organization/{Uri.EscapeDataString app.Org}/applications"
        let listed = adminJson HttpMethod.Get path adminToken None "list Quay applications"
        let redirect = quayURL "/oauth/localapp"

        let existing =
            listed
            |> property "applications"
            |> _.EnumerateArray()
            |> Seq.tryFind (fun item -> stringProp "name" item = app.Name)

        match existing with
        | Some item ->
            require (stringProp "redirect_uri" item = redirect) "existing application has a different redirect URI"
            stringProp "client_id" item
        | None ->
            let payload =
                jsonObject
                    [ "name", stringNode app.Name
                      "redirect_uri", stringNode redirect
                      "application_uri", stringNode redirect ]

            adminJson HttpMethod.Post path adminToken (Some payload) "create Quay application"
            |> stringProp "client_id"

    let assign adminToken session app =
        if assignment config.URL app (assignments config.URL session) |> Option.isNone then
            let values =
                [ "username", app.User
                  "response_type", "token"
                  "client_id", app.Client
                  "scope", String.concat " " app.Scopes
                  "redirect_uri", quayURL "/oauth/localapp"
                  "format", "json" ]

            let assignPath = quayURL "/oauth/authorize/assignuser"
            let url = $"{assignPath}?{query values}"

            request adminClient HttpMethod.Post url None (Some("$oauthtoken", adminToken)) None None
            |> expect "assign Quay authorization" HttpStatusCode.OK

            assignment config.URL app (assignments config.URL session)
            |> Option.defaultWith (fun () -> invalidOp "assigned authorization is absent")
            |> ignore

    let issue session app =
        let client = session.State :?> HttpClient

        let assigned =
            assignment config.URL app (assignments config.URL session)
            |> Option.defaultWith (fun () -> invalidOp "assigned authorization is absent")

        let scopes =
            assigned
            |> property "scopes"
            |> _.EnumerateArray()
            |> Seq.map (stringProp "scope")
            |> String.concat " "

        let application = property "application" assigned

        let values =
            [ "response_type", stringProp "responseType" assigned
              "client_id", stringProp "clientId" application
              "scope", scopes
              "redirect_uri", stringProp "redirectUri" assigned
              "assignment_uuid", stringProp "uuid" assigned ]

        let approvePath = quayURL "/oauth/authorize"
        let approveQuery = query (values @ List.singleton ("format", "json"))
        let approveURL = $"{approvePath}?{approveQuery}"
        let approvalResponse = request client HttpMethod.Get approveURL None None None None

        let csrf =
            readJson "load Quay authorization" HttpStatusCode.OK approvalResponse
            |> stringProp "csrf_token_val"

        use message = new HttpRequestMessage(HttpMethod.Post, quayURL "/oauth/authorizeapp")

        message.Content <-
            new FormUrlEncodedContent(values |> List.map (fun (name, value) -> KeyValuePair(name, value)))

        message.Headers.Add("X-CSRF-Token", csrf)
        use response = client.Send message

        require
            (response.StatusCode = HttpStatusCode.Found)
            $"issue Quay token failed with HTTP {int response.StatusCode}"

        require (not (isNull response.Headers.Location)) "Quay token response omitted redirect"

        response.Headers.Location.Fragment.TrimStart('#').Split('&')
        |> Array.tryPick (fun item ->
            match item.Split('=', 2) with
            | [| name; value |] when name = "access_token" -> Some(Uri.UnescapeDataString value)
            | _ -> None)
        |> Option.defaultWith (fun () -> invalidOp "Quay token response omitted access token")

    { LoginAuth = fun () -> systemToken config.ZitadelIssuer config.LoginKey
      Login = login
      Access = access
      Application = application
      Assign = assign
      Issue = issue }

let makeQuay (config: QuayConfig) =
    makeQuayWith (client config.CaPath false) (fun () -> sessionClient config.CaPath) config