@voxgig/sdkgen 4.10.0 → 4.12.0

package/project/.sdk/tm/ocaml/feature/secrets/plugins/azuresecrets.ml

@@ -0,0 +1,116 @@
+(* VENDORED: @voxgig/sekreto sdk-20260908-1556-0 (ocaml/plugins/azuresecrets.ml) *)
+(* Source: https://github.com/voxgig/sekreto @ 1267ee2e5f49566bc92695bc9eb3a60ef4924998  [tag: sdk-20260911-2013-0] *)
+(* License: MIT (c) voxgig - see repository LICENSE. Do not edit: resync from upstream. *)
+(* The `azuresecrets` provider kind, as a voxgig/plugin definition.
+
+   Azure Key Vault over HTTPS, with client credentials or IMDS as the
+   source of a token.
+
+   A port of typescript/plugins/azuresecrets.ts, which is canonical. *)
+
+open Secret
+open Provider
+open Httpjson
+
+(* The Key Vault audience an Azure token is minted for. *)
+let azureresource = "https://vault.azure.net"
+
+(* Azure Key Vault.
+
+   `api.token` reads secret `api-token` (dots flattened to `-`; Key Vault
+   names allow nothing else), current version. The token comes from config,
+   then a client-credentials login when tenant/clientid/clientsecret are
+   given, then the IMDS managed-identity endpoint.
+
+   As with GCP, the IMDS call is plain http to a link-local host by platform
+   design and carries no credential; the login and vault addresses are
+   `checkaddr`-guarded. IMDS answers `expires_in` as a STRING, which is why
+   `renewtime` accepts one. *)
+let azuresecrets_provider (vault : string) (token : string) (tenant : string) (clientid : string)
+    (clientsecret : string) (loginaddr : string) (imdsaddr : string) (apiversion : string) :
+    provider =
+  let livetoken = ref None in
+  let renewat = ref never in
+
+  let login () =
+    if "" <> token then token
+    else if "" <> tenant && "" <> clientid && "" <> clientsecret then begin
+      let useloginaddr = firstof [ loginaddr; "https://login.microsoftonline.com" ] in
+      checkaddr useloginaddr;
+
+      let url = trimslash useloginaddr ^ "/" ^ tenant ^ "/oauth2/v2.0/token" in
+      let form =
+        "grant_type=client_credentials&client_id=" ^ Sigv4.uriescape clientid ^ "&client_secret="
+        ^ Sigv4.uriescape clientsecret ^ "&scope="
+        ^ Sigv4.uriescape (azureresource ^ "/.default")
+      in
+
+      let res =
+        fetchjson
+          ~headers:[ ("content-type", "application/x-www-form-urlencoded") ]
+          ~body:form "POST" url
+      in
+
+      let got = digtext res.jbody [ "access_token" ] in
+      if 200 <> res.status || not (isset got) then
+        fail ("sekreto: azure login failed: " ^ string_of_int res.status);
+
+      renewat := renewtime (Json.odig res.jbody [ "expires_in" ]);
+      Option.get got
+    end
+    else begin
+      let url =
+        trimslash (firstof [ imdsaddr; "http://169.254.169.254" ])
+        ^ "/metadata/identity/oauth2/token?api-version=2018-02-01&resource="
+        ^ Sigv4.uriescape azureresource
+      in
+
+      let res = fetchjson ~headers:[ ("Metadata", "true") ] "GET" url in
+      let got = digtext res.jbody [ "access_token" ] in
+
+      if 200 <> res.status || not (isset got) then
+        fail "sekreto: azure: no token, no client credentials, and IMDS did not answer";
+
+      renewat := renewtime (Json.odig res.jbody [ "expires_in" ]);
+      Option.get got
+    end
+  in
+
+  {
+    lookup =
+      (fun name ->
+        if "" = vault then fail "sekreto: azure: no vault";
+
+        (* ONLY an explicit scheme is a URL: a vault NAMED httpvault must
+           still become https://httpvault.vault.azure.net. *)
+        let vaulturl =
+          if String.starts_with ~prefix:"http://" vault || String.starts_with ~prefix:"https://" vault
+          then vault
+          else "https://" ^ vault ^ ".vault.azure.net"
+        in
+        checkaddr vaulturl;
+
+        if None = !livetoken || nowms () >= !renewat then livetoken := Some (login ());
+
+        let url =
+          trimslash vaulturl ^ "/secrets/" ^ flatname name "-" ^ "?api-version="
+          ^ firstof [ apiversion; "7.4" ]
+        in
+
+        let res =
+          fetchjson
+            ~headers:[ ("authorization", "Bearer " ^ Option.value ~default:"" !livetoken) ]
+            "GET" url
+        in
+
+        if 404 = res.status then None
+        else if 200 <> res.status then
+          fail ("sekreto: azure error: " ^ string_of_int res.status ^ ": " ^ bare url)
+        else digtext res.jbody [ "value" ]);
+    describe = (fun () -> "azuresecrets:" ^ vault);
+  }
+
+let plugin () : Defs.definition =
+  providerplugin "azuresecrets" (fun spec ->
+      azuresecrets_provider spec.vault spec.token spec.tenant spec.clientid spec.clientsecret
+        spec.loginaddr spec.imdsaddr spec.apiversion)

package/project/.sdk/tm/ocaml/feature/secrets/plugins/boru.ml

@@ -0,0 +1,95 @@
+(* VENDORED: @voxgig/sekreto sdk-20260908-1556-0 (ocaml/plugins/boru.ml) *)
+(* Source: https://github.com/voxgig/sekreto @ 1267ee2e5f49566bc92695bc9eb3a60ef4924998  [tag: sdk-20260911-2013-0] *)
+(* License: MIT (c) voxgig - see repository LICENSE. Do not edit: resync from upstream. *)
+(* The `boru` provider kind, as a voxgig/plugin definition.
+
+   Two ways in, and both keep it out of the core: boru's own CLI, which is
+   a child process, and boru's wire protocol, which is a socket.
+
+   A port of typescript/plugins/boru.ts, which is canonical. *)
+
+open Secret
+open Provider
+open Httpjson
+open Runcmd
+
+(* Does this boru failure mean "no such secret" rather than "I could not
+   answer"? Matched on boru's own wording for a missing alias: a locked
+   vault or a wrong passphrase is not a miss, and treating it as one would
+   fall through to a weaker store without saying so. *)
+let borumiss (why : string) : bool = None <> findsub why "no alias named"
+
+(* A boru vault (https://github.com/boru-lang/boru).
+
+   Two ways in, both boru's own.
+
+   With no `addr`, the CLI: `boru vault get --reveal <alias>` prints the
+   secret on stdout and nothing else. The passphrase is read by boru itself
+   from BORU_VAULT_PASSPHRASE; sekreto never accepts it as config and never
+   puts it on a command line, where it would show up in the process table.
+
+   With an `addr`, boru's wire protocol: a read-only, HashiCorp-shaped
+   provision API authenticated by a capability token. A sekreto name is
+   already a valid boru alias, and boru aliases KEEP THEIR DOTS, so
+   `api.token` is the single path segment `api.token` - not the `api`/`token`
+   split a HashiCorp KV gets. The value is the `value` field. *)
+let boru_provider (commandgiven : string) (namespace : string) (home : string)
+    (addrgiven : string) (token : string) (mountgiven : string) : provider =
+  let command = if "" = commandgiven then "boru" else commandgiven in
+  let addr = trimslash addrgiven in
+  let mount = if "" = mountgiven then "secret" else mountgiven in
+
+  let wirelookup name =
+    checkaddr addr;
+
+    let alias = if "" = namespace then name else namespace ^ "/" ^ name in
+    let url = addr ^ "/v1/" ^ mount ^ "/data/" ^ alias in
+
+    let res = fetchjson ~headers:[ ("X-Vault-Token", token) ] "GET" url in
+
+    if 404 = res.status then None
+    else if 200 <> res.status then
+      fail ("sekreto: boru serve error: " ^ string_of_int res.status ^ ": " ^ url)
+    else digtext res.jbody [ "data"; "data"; "value" ]
+  in
+
+  {
+    lookup =
+      (fun name ->
+        ignore (checkname name);
+
+        if "" <> addr then wirelookup name
+        else begin
+          let alias = if "" = namespace then name else namespace ^ ":" ^ name in
+          let env =
+            if "" = home then Unix.environment ()
+            else
+              Array.append
+                (Array.of_list
+                   (List.filter
+                      (fun entry -> not (String.starts_with ~prefix:"BORU_HOME=" entry))
+                      (Array.to_list (Unix.environment ()))))
+                [| "BORU_HOME=" ^ home |]
+          in
+
+          let ran = runcmd [ command; "vault"; "get"; "--reveal"; alias ] env command in
+
+          if 0 = ran.status then
+            (* boru prints the value and one newline, and nothing else. *)
+            Some (dropsuffix ran.out "\n")
+          else if borumiss ran.why then None
+          else
+            fail
+              ("sekreto: boru vault error: "
+              ^ if "" = ran.why then "exit " ^ string_of_int ran.status else ran.why)
+        end);
+    describe =
+      (fun () ->
+        if "" <> addr then "boru:" ^ addr
+        else if "" = namespace then "boru"
+        else "boru:" ^ namespace);
+  }
+
+let plugin () : Defs.definition =
+  providerplugin "boru" (fun spec ->
+      boru_provider spec.command spec.namespace spec.home spec.addr spec.token spec.mount)

package/project/.sdk/tm/ocaml/feature/secrets/plugins/crypto.ml

@@ -0,0 +1,149 @@
+(* VENDORED: @voxgig/sekreto sdk-20260908-1556-0 (ocaml/plugins/crypto.ml) *)
+(* Source: https://github.com/voxgig/sekreto @ 1267ee2e5f49566bc92695bc9eb3a60ef4924998  [tag: sdk-20260911-2013-0] *)
+(* License: MIT (c) voxgig - see repository LICENSE. Do not edit: resync from upstream. *)
+(* SHA-256 and HMAC-SHA256, hand-rolled.
+
+   OCaml's distribution has no cryptographic digest but MD5, so the two
+   primitives SigV4 is built from are written out here, straight from FIPS
+   180-4 and RFC 2104.
+
+   The one dependency this port takes is OpenSSL, and it is taken for
+   TRANSPORT only (plugins/tls_stubs.c). Reaching into libcrypto for a digest
+   would widen that exception from "cryptographic transport is not
+   hand-rolled" to "cryptography is not hand-rolled", which is not the rule.
+   Rust is the worked precedent: `ring` is already inside rustls's closure
+   and `rust/src/crypto.rs` still carries both primitives.
+
+   Correctness is not argued from inspection: a SigV4 signature is a chain
+   of these two functions, so a single wrong bit anywhere fails the five
+   known-answer vectors in the shared spec - one of which is AWS's own
+   published `get-vanilla`. *)
+
+let mask = 0xFFFFFFFF
+
+let k =
+  [| 0x428a2f98; 0x71374491; 0xb5c0fbcf; 0xe9b5dba5; 0x3956c25b; 0x59f111f1; 0x923f82a4;
+     0xab1c5ed5; 0xd807aa98; 0x12835b01; 0x243185be; 0x550c7dc3; 0x72be5d74; 0x80deb1fe;
+     0x9bdc06a7; 0xc19bf174; 0xe49b69c1; 0xefbe4786; 0x0fc19dc6; 0x240ca1cc; 0x2de92c6f;
+     0x4a7484aa; 0x5cb0a9dc; 0x76f988da; 0x983e5152; 0xa831c66d; 0xb00327c8; 0xbf597fc7;
+     0xc6e00bf3; 0xd5a79147; 0x06ca6351; 0x14292967; 0x27b70a85; 0x2e1b2138; 0x4d2c6dfc;
+     0x53380d13; 0x650a7354; 0x766a0abb; 0x81c2c92e; 0x92722c85; 0xa2bfe8a1; 0xa81a664b;
+     0xc24b8b70; 0xc76c51a3; 0xd192e819; 0xd6990624; 0xf40e3585; 0x106aa070; 0x19a4c116;
+     0x1e376c08; 0x2748774c; 0x34b0bcb5; 0x391c0cb3; 0x4ed8aa4a; 0x5b9cca4f; 0x682e6ff3;
+     0x748f82ee; 0x78a5636f; 0x84c87814; 0x8cc70208; 0x90befffa; 0xa4506ceb; 0xbef9a3f7;
+     0xc67178f2 |]
+
+let initial = [| 0x6a09e667; 0xbb67ae85; 0x3c6ef372; 0xa54ff53a; 0x510e527f; 0x9b05688c;
+                 0x1f83d9ab; 0x5be0cd19 |]
+
+let rotr x n = ((x lsr n) lor (x lsl (32 - n))) land mask
+let shr x n = (x lsr n) land mask
+
+(* The digest of a message, as 32 raw bytes. *)
+let sha256 (message : string) : string =
+  let len = String.length message in
+
+  (* 0x80, then zeros until the length lands 8 short of a block, then the
+     message length in BITS, big-endian. *)
+  let padded = Buffer.create (len + 72) in
+  Buffer.add_string padded message;
+  Buffer.add_char padded '\x80';
+  while (Buffer.length padded + 8) mod 64 <> 0 do
+    Buffer.add_char padded '\x00'
+  done;
+  let bits = len * 8 in
+  for shift = 7 downto 0 do
+    Buffer.add_char padded (Char.chr ((bits lsr (shift * 8)) land 0xff))
+  done;
+
+  let block = Buffer.contents padded in
+  let state = Array.copy initial in
+  let w = Array.make 64 0 in
+
+  let blocks = String.length block / 64 in
+
+  for index = 0 to blocks - 1 do
+    let base = index * 64 in
+
+    for step = 0 to 15 do
+      let at = base + (step * 4) in
+      w.(step) <-
+        (Char.code block.[at] lsl 24)
+        lor (Char.code block.[at + 1] lsl 16)
+        lor (Char.code block.[at + 2] lsl 8)
+        lor Char.code block.[at + 3]
+    done;
+
+    for step = 16 to 63 do
+      let s0 = rotr w.(step - 15) 7 lxor rotr w.(step - 15) 18 lxor shr w.(step - 15) 3 in
+      let s1 = rotr w.(step - 2) 17 lxor rotr w.(step - 2) 19 lxor shr w.(step - 2) 10 in
+      w.(step) <- (w.(step - 16) + s0 + w.(step - 7) + s1) land mask
+    done;
+
+    let a = ref state.(0) and b = ref state.(1) and c = ref state.(2) and d = ref state.(3) in
+    let e = ref state.(4) and f = ref state.(5) and g = ref state.(6) and h = ref state.(7) in
+
+    for step = 0 to 63 do
+      let s1 = rotr !e 6 lxor rotr !e 11 lxor rotr !e 25 in
+      let ch = (!e land !f) lxor (lnot !e land !g land mask) in
+      let temp1 = (!h + s1 + ch + k.(step) + w.(step)) land mask in
+      let s0 = rotr !a 2 lxor rotr !a 13 lxor rotr !a 22 in
+      let maj = (!a land !b) lxor (!a land !c) lxor (!b land !c) in
+      let temp2 = (s0 + maj) land mask in
+
+      h := !g;
+      g := !f;
+      f := !e;
+      e := (!d + temp1) land mask;
+      d := !c;
+      c := !b;
+      b := !a;
+      a := (temp1 + temp2) land mask
+    done;
+
+    state.(0) <- (state.(0) + !a) land mask;
+    state.(1) <- (state.(1) + !b) land mask;
+    state.(2) <- (state.(2) + !c) land mask;
+    state.(3) <- (state.(3) + !d) land mask;
+    state.(4) <- (state.(4) + !e) land mask;
+    state.(5) <- (state.(5) + !f) land mask;
+    state.(6) <- (state.(6) + !g) land mask;
+    state.(7) <- (state.(7) + !h) land mask
+  done;
+
+  let out = Bytes.create 32 in
+  Array.iteri
+    (fun index word ->
+      Bytes.set out (index * 4) (Char.chr ((word lsr 24) land 0xff));
+      Bytes.set out ((index * 4) + 1) (Char.chr ((word lsr 16) land 0xff));
+      Bytes.set out ((index * 4) + 2) (Char.chr ((word lsr 8) land 0xff));
+      Bytes.set out ((index * 4) + 3) (Char.chr (word land 0xff)))
+    state;
+
+  Bytes.to_string out
+
+(* Lowercase hex, two digits a byte. Uppercase hex is wanted in exactly one
+   place in this library, and that is percent-escaping. *)
+let hex (raw : string) : string =
+  let out = Buffer.create (String.length raw * 2) in
+  String.iter (fun ch -> Buffer.add_string out (Printf.sprintf "%02x" (Char.code ch))) raw;
+  Buffer.contents out
+
+let sha256hex (message : string) : string = hex (sha256 message)
+
+(* RFC 2104, block size 64. Argument order is (key, data) in every port;
+   two standard libraries take it the other way round. *)
+let hmac (key : string) (data : string) : string =
+  let block = 64 in
+  let shortened = if String.length key > block then sha256 key else key in
+  let padkey = Bytes.make block '\x00' in
+  Bytes.blit_string shortened 0 padkey 0 (String.length shortened);
+
+  let inner = Bytes.create block and outer = Bytes.create block in
+  for index = 0 to block - 1 do
+    let byte = Char.code (Bytes.get padkey index) in
+    Bytes.set inner index (Char.chr (byte lxor 0x36));
+    Bytes.set outer index (Char.chr (byte lxor 0x5c))
+  done;
+
+  sha256 (Bytes.to_string outer ^ sha256 (Bytes.to_string inner ^ data))

package/project/.sdk/tm/ocaml/feature/secrets/plugins/doppler.ml

@@ -0,0 +1,61 @@
+(* VENDORED: @voxgig/sekreto sdk-20260908-1556-0 (ocaml/plugins/doppler.ml) *)
+(* Source: https://github.com/voxgig/sekreto @ 1267ee2e5f49566bc92695bc9eb3a60ef4924998  [tag: sdk-20260911-2013-0] *)
+(* License: MIT (c) voxgig - see repository LICENSE. Do not edit: resync from upstream. *)
+(* The `doppler` provider kind, as a voxgig/plugin definition.
+
+   The Doppler API over HTTPS.
+
+   A port of typescript/plugins/doppler.ts, which is canonical. *)
+
+open Secret
+open Provider
+open Httpjson
+
+(* Doppler.
+
+   The whole config is downloaded ONCE - Doppler's own bulk endpoint - and
+   answered from memory, like a remote .env: `api.token` is the `API_TOKEN`
+   entry. A service token is config-scoped, so project and config are only
+   needed with broader tokens. A failed load caches nothing, so it retries.
+
+   The `prefix` option is deliberately not consulted by this kind. *)
+let doppler_provider (token : string) (project : string) (config : string) (addr : string) :
+    provider =
+  let values = ref None in
+
+  let load () =
+    match !values with
+    | Some loaded -> loaded
+    | None ->
+      let useaddr = trimslash (firstof [ addr; "https://api.doppler.com" ]) in
+      checkaddr useaddr;
+
+      let url = ref (useaddr ^ "/v3/configs/config/secrets/download?format=json") in
+      if "" <> project then url := !url ^ "&project=" ^ Sigv4.uriescape project;
+      if "" <> config then url := !url ^ "&config=" ^ Sigv4.uriescape config;
+
+      let res = fetchjson ~headers:[ ("authorization", "Bearer " ^ token) ] "GET" !url in
+      let body = Json.oasobj res.jbody in
+
+      if 200 <> res.status || None = body then
+        fail ("sekreto: doppler error: " ^ string_of_int res.status);
+
+      let loaded =
+        List.filter_map
+          (fun (key, value) -> match Json.text value with Some text -> Some (key, text) | None -> None)
+          (Option.get body)
+      in
+
+      values := Some loaded;
+      loaded
+  in
+
+  {
+    lookup = (fun name -> List.assoc_opt (envkey name) (load ()));
+    describe =
+      (fun () -> if "" = project then "doppler" else "doppler:" ^ project ^ "/" ^ config);
+  }
+
+let plugin () : Defs.definition =
+  providerplugin "doppler" (fun spec ->
+      doppler_provider spec.token spec.project spec.config spec.addr)

package/project/.sdk/tm/ocaml/feature/secrets/plugins/gcpsecrets.ml

@@ -0,0 +1,93 @@
+(* VENDORED: @voxgig/sekreto sdk-20260908-1556-0 (ocaml/plugins/gcpsecrets.ml) *)
+(* Source: https://github.com/voxgig/sekreto @ 1267ee2e5f49566bc92695bc9eb3a60ef4924998  [tag: sdk-20260911-2013-0] *)
+(* License: MIT (c) voxgig - see repository LICENSE. Do not edit: resync from upstream. *)
+(* The `gcpsecrets` provider kind, as a voxgig/plugin definition.
+
+   Google Secret Manager over HTTPS, with the metadata server as the
+   fallback source of a token.
+
+   A port of typescript/plugins/gcpsecrets.ts, which is canonical. *)
+
+open Secret
+open Provider
+open Httpjson
+
+(* GCP Secret Manager.
+
+   `api.token` reads secret `api_token` (dots flattened to `_`; Secret
+   Manager ids have no hierarchy and reject dots), latest version. The token
+   comes from config, then GOOGLE_OAUTH_ACCESS_TOKEN, then the GCE/GKE
+   metadata server - so on Google's own platform no credential configuration
+   is needed at all.
+
+   The metadata call itself is plain http to a link-local host by platform
+   design and carries no credential, so `checkaddr` guards the Secret
+   Manager address instead. *)
+let gcpsecrets_provider (project : string) (token : string) (addr : string)
+    (metadataaddr : string) : provider =
+  let livetoken = ref None in
+  let renewat = ref never in
+
+  let usemetadataaddr () =
+    if "" <> metadataaddr then metadataaddr
+    else
+      let host = getenv "GCE_METADATA_HOST" in
+      if "" <> host then "http://" ^ host else "http://metadata.google.internal"
+  in
+
+  let login () =
+    let configured = firstof [ token; getenv "GOOGLE_OAUTH_ACCESS_TOKEN" ] in
+    if "" <> configured then configured
+    else begin
+      let url =
+        trimslash (usemetadataaddr ()) ^ "/computeMetadata/v1/instance/service-accounts/default/token"
+      in
+
+      let res = fetchjson ~headers:[ ("Metadata-Flavor", "Google") ] "GET" url in
+      let got = digtext res.jbody [ "access_token" ] in
+
+      if 200 <> res.status || not (isset got) then
+        fail "sekreto: gcp: no token and metadata server did not answer";
+
+      renewat := renewtime (Json.odig res.jbody [ "expires_in" ]);
+      Option.get got
+    end
+  in
+
+  {
+    lookup =
+      (fun name ->
+        if "" = project then fail "sekreto: gcp: no project";
+
+        let useaddr = firstof [ addr; "https://secretmanager.googleapis.com" ] in
+        checkaddr useaddr;
+
+        if None = !livetoken || nowms () >= !renewat then livetoken := Some (login ());
+
+        let url =
+          trimslash useaddr ^ "/v1/projects/" ^ project ^ "/secrets/" ^ flatname name "_"
+          ^ "/versions/latest:access"
+        in
+
+        let res =
+          fetchjson
+            ~headers:[ ("authorization", "Bearer " ^ Option.value ~default:"" !livetoken) ]
+            "GET" url
+        in
+
+        if 404 = res.status then None
+        else if 200 <> res.status then
+          fail ("sekreto: gcp error: " ^ string_of_int res.status ^ ": " ^ url)
+        else
+          match digstr res.jbody [ "payload"; "data" ] with
+          | None -> None
+          | Some data -> (
+            match Http.unbase64 data with
+            | Some bytes -> Some bytes
+            | None -> fail "sekreto: gcp: undecodable secret"));
+    describe = (fun () -> "gcpsecrets:" ^ project);
+  }
+
+let plugin () : Defs.definition =
+  providerplugin "gcpsecrets" (fun spec ->
+      gcpsecrets_provider spec.project spec.token spec.addr spec.metadataaddr)

package/project/.sdk/tm/ocaml/feature/secrets/plugins/hashicorp.ml

@@ -0,0 +1,120 @@
+(* VENDORED: @voxgig/sekreto sdk-20260908-1556-0 (ocaml/plugins/hashicorp.ml) *)
+(* Source: https://github.com/voxgig/sekreto @ 1267ee2e5f49566bc92695bc9eb3a60ef4924998  [tag: sdk-20260911-2013-0] *)
+(* License: MIT (c) voxgig - see repository LICENSE. Do not edit: resync from upstream. *)
+(* The `hashicorp` provider kind, as a voxgig/plugin definition.
+
+   HashiCorp Vault over HTTPS, so it is a plugin rather than a built-in
+   kind: only a program that names this module links the framing, the TLS
+   binding and the OpenSSL beneath it.
+
+   A port of typescript/plugins/hashicorp.ts, which is canonical. *)
+
+open Secret
+open Provider
+open Httpjson
+
+(* HashiCorp Vault.
+
+   KV v2 (the default): `api.token` reads `{addr}/v1/{mount}/data/api` and
+   takes the `token` field of `data.data`. KV v1 reads
+   `{addr}/v1/{mount}/api` and takes the field of `data`. A 404 means "not
+   here" - a miss - so a vault can sit in a chain with fallbacks.
+
+   A Vault Enterprise namespace rides the X-Vault-Namespace header, on
+   logins as well as reads.
+
+   Instead of being handed a token, the provider can log in: Kubernetes auth
+   (the pod's service-account JWT, from its conventional path) or AppRole. A
+   failed login is an error, never a miss - it means this store could not
+   answer at all. *)
+let hashicorp_provider (addr : string) (token : string) (mountgiven : string) (kv : int)
+    (vaultnamespace : string) (auth : authspec option) : provider =
+  let mount = if "" = mountgiven then "secret" else mountgiven in
+
+  (* A version typo like kv: 3 must not quietly behave as v2 and turn its
+     404s into misses; there is nothing safe to assume it meant. *)
+  if 1 <> kv && 2 <> kv then
+    fail ("sekreto: hashicorp: unsupported kv version: " ^ string_of_int kv);
+
+  (* The working token: a configured token is kept forever, a logged-in one
+     is renewed shortly before its lease runs out - a long-running process
+     must not keep presenting a token the vault already expired. *)
+  let livetoken = ref (if "" = token then None else Some token) in
+  let renewat = ref never in
+
+  let baseheaders () =
+    if "" = vaultnamespace then [] else [ ("X-Vault-Namespace", vaultnamespace) ]
+  in
+
+  let login () =
+    let use = match auth with
+      | Some use -> use
+      | None -> fail "sekreto: hashicorp: no token and no auth method"
+    in
+
+    let authmount = firstof [ use.amount; use.amethod ] in
+    let url = trimslash addr ^ "/v1/auth/" ^ authmount ^ "/login" in
+
+    let body =
+      match use.amethod with
+      | "kubernetes" ->
+        let jwt =
+          if "" <> use.jwt then use.jwt
+          else begin
+            let path =
+              if "" = use.jwtfile then "/var/run/secrets/kubernetes.io/serviceaccount/token"
+              else use.jwtfile
+            in
+            match readfile path with
+            | text -> trim text
+            | exception Unix.Unix_error _ ->
+              fail ("sekreto: hashicorp: cannot read jwt file " ^ path)
+          end
+        in
+        Json.obj [ ("role", Json.str use.role); ("jwt", Json.str jwt) ]
+      | "approle" ->
+        Json.obj [ ("role_id", Json.str use.roleid); ("secret_id", Json.str use.secretid) ]
+      | other -> fail ("sekreto: hashicorp: unknown auth method: " ^ other)
+    in
+
+    let res = fetchjson ~headers:(baseheaders ()) ~body:(Json.stringify body) "POST" url in
+    let got = digtext res.jbody [ "auth"; "client_token" ] in
+
+    if 200 <> res.status || not (isset got) then
+      fail ("sekreto: hashicorp login failed: " ^ string_of_int res.status ^ ": " ^ url);
+
+    renewat := renewtime (Json.odig res.jbody [ "auth"; "lease_duration" ]);
+    Option.get got
+  in
+
+  {
+    lookup =
+      (fun name ->
+        checkaddr addr;
+
+        if None = !livetoken || nowms () >= !renewat then livetoken := Some (login ());
+
+        let ref_ = vaultref name in
+        let base = trimslash addr ^ "/v1/" ^ mount in
+        let url = if 1 = kv then base ^ "/" ^ ref_.path else base ^ "/data/" ^ ref_.path in
+
+        let headers =
+          baseheaders () @ [ ("X-Vault-Token", Option.value ~default:"" !livetoken) ]
+        in
+
+        let res = fetchjson ~headers "GET" url in
+
+        if 404 = res.status then None
+        else if 200 <> res.status then
+          fail ("sekreto: hashicorp error: " ^ string_of_int res.status ^ ": " ^ url)
+        else
+          let data = if 1 = kv then Json.odig res.jbody [ "data" ] else Json.odig res.jbody [ "data"; "data" ] in
+          digtext data [ ref_.field ]);
+    describe = (fun () -> "hashicorp:" ^ addr ^ "/" ^ mount);
+  }
+
+(* The definition the catalog holds. A function, so two chains never share
+   one and nothing is built at load time. *)
+let plugin () : Defs.definition =
+  providerplugin "hashicorp" (fun spec ->
+      hashicorp_provider spec.addr spec.token spec.mount spec.kv spec.vaultnamespace spec.auth)