quorate/services/ca-sync/tests.fsx

264 lines
9.7 KiB
FSharp

#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 ()