577 lines
21 KiB
Text
577 lines
21 KiB
Text
|
#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
|