objective categorical abstract machine language personal data server
65
fork

Configure Feed

Select the types of activity you want to include in your feed.

dpop

futurGH a736af08 b83018a4

+175
+175
pegasus/lib/oauth/dpop.ml
··· 1 + type nonce_state = 2 + { secret: bytes 3 + ; mutable counter: int64 4 + ; mutable prev: string 5 + ; mutable curr: string 6 + ; mutable next: string 7 + ; rotation_interval_ms: int64 } 8 + 9 + type proof = {jti: string; jkt: string; htm: string; htu: string} 10 + 11 + let create_nonce_state ?(rotation_interval_ms = 60_000L) secret = 12 + let counter = 13 + Int64.div 14 + (Int64.of_float (Unix.gettimeofday () *. 1000.)) 15 + rotation_interval_ms 16 + in 17 + let compute_nonce cnt = 18 + let data = Bytes.create 8 in 19 + Bytes.set_int64_be data 0 cnt ; 20 + Digestif.SHA256.( 21 + hmac_bytes ~key:(Bytes.to_string secret) data 22 + |> to_raw_string 23 + |> Base64.encode_exn ~pad:false ) 24 + in 25 + { secret 26 + ; counter 27 + ; prev= compute_nonce (Int64.pred counter) 28 + ; curr= compute_nonce counter 29 + ; next= compute_nonce (Int64.succ counter) 30 + ; rotation_interval_ms } 31 + 32 + let next_nonce state = 33 + let now_counter = 34 + Int64.div 35 + (Int64.of_float (Unix.gettimeofday () *. 1000.)) 36 + state.rotation_interval_ms 37 + in 38 + if now_counter <> state.counter then ( 39 + state.prev <- state.curr ; 40 + state.curr <- state.next ; 41 + let data = Bytes.create 8 in 42 + Bytes.set_int64_be data 0 (Int64.succ now_counter) ; 43 + state.next <- 44 + Digestif.SHA256.( 45 + hmac_bytes ~key:(Bytes.to_string state.secret) data 46 + |> to_raw_string 47 + |> Base64.encode_exn ~pad:false ) ; 48 + state.counter <- now_counter ) ; 49 + state.next 50 + 51 + let verify_nonce state nonce = 52 + nonce = state.prev || nonce = state.curr || nonce = state.next 53 + 54 + let compute_jwk_thumbprint jwk = 55 + let open Yojson.Safe.Util in 56 + let crv = jwk |> member "crv" |> to_string in 57 + let kty = jwk |> member "kty" |> to_string in 58 + let x = jwk |> member "x" |> to_string in 59 + let y = jwk |> member "y" |> to_string in 60 + let tp = 61 + Printf.sprintf {|{"crv":"%s","kty":"%s","x":"%s","y":"%s"}|} crv kty x y 62 + in 63 + Digestif.SHA256.( 64 + digest_string tp |> to_raw_string |> Base64.encode_exn ~pad:false ) 65 + 66 + let normalize_url url = 67 + (* Remove query params and fragment, normalize to https://host/path *) 68 + let uri = Uri.of_string url in 69 + Uri.make ~scheme:"https" 70 + ~host:(Uri.host uri |> Option.get) 71 + ?port:(Uri.port uri) ~path:(Uri.path uri) () 72 + |> Uri.to_string 73 + 74 + let verify_signature jwt jwk alg = 75 + let open Yojson.Safe.Util in 76 + let parts = String.split_on_char '.' jwt in 77 + match parts with 78 + | [header_b64; payload_b64; sig_b64] -> 79 + let signing_input = header_b64 ^ "." ^ payload_b64 in 80 + let msg = 81 + Digestif.SHA256.(digest_string signing_input |> to_raw_string) 82 + |> Bytes.of_string 83 + in 84 + let x = jwk |> member "x" |> to_string |> Base64.decode_exn in 85 + let y = jwk |> member "y" |> to_string |> Base64.decode_exn in 86 + let pubkey = 87 + ( Bytes.of_string (x ^ y) 88 + , match alg with 89 + | "ES256K" -> 90 + (module Kleidos.K256 : Kleidos.CURVE) 91 + | "ES256" -> 92 + (module Kleidos.P256 : Kleidos.CURVE) 93 + | _ -> 94 + failwith "unsupported algorithm" ) 95 + in 96 + let sig_bytes = Base64.decode_exn sig_b64 in 97 + let r = String.sub sig_bytes 0 32 in 98 + let s = String.sub sig_bytes 32 32 in 99 + let signature = Bytes.of_string (r ^ s) in 100 + Kleidos.verify ~pubkey ~msg ~signature 101 + | _ -> 102 + false 103 + 104 + let verify_dpop_proof ~nonce_state ~jti_cache ~mthd ~url ~dpop_header 105 + ?access_token () = 106 + match dpop_header with 107 + | None -> 108 + Lwt.return_error "missing dpop header" 109 + | Some jwt -> ( 110 + let open Yojson.Safe.Util in 111 + match String.split_on_char '.' jwt with 112 + | [header_b64; payload_b64; _] -> ( 113 + let header = Yojson.Safe.from_string (Base64.decode_exn header_b64) in 114 + let payload = 115 + Yojson.Safe.from_string (Base64.decode_exn payload_b64) 116 + in 117 + let typ = header |> member "typ" |> to_string in 118 + if typ <> "dpop+jwt" then Lwt.return_error "invalid typ in dpop proof" 119 + else 120 + let alg = header |> member "alg" |> to_string in 121 + if alg <> "ES256" && alg <> "ES256K" then 122 + Lwt.return_error "only es256 and es256k supported for dpop" 123 + else 124 + let jwk = header |> member "jwk" in 125 + let jti = payload |> member "jti" |> to_string in 126 + let htm = payload |> member "htm" |> to_string in 127 + let htu = payload |> member "htu" |> to_string in 128 + let iat = payload |> member "iat" |> to_int in 129 + let nonce_claim = payload |> member "nonce" |> to_string_option in 130 + match nonce_claim with 131 + (* error must be this string; see https://datatracker.ietf.org/doc/html/rfc9449#section-8 *) 132 + | None -> 133 + Lwt.return_error "use_dpop_nonce" 134 + | Some n when not (verify_nonce nonce_state n) -> 135 + Lwt.return_error "use_dpop_nonce" 136 + | Some _ -> 137 + if htm <> mthd then Lwt.return_error "htm mismatch" 138 + else if 139 + not (String.equal (normalize_url htu) (normalize_url url)) 140 + then Lwt.return_error "htu mismatch" 141 + else 142 + let now = int_of_float (Unix.gettimeofday ()) in 143 + if now - iat > 60 then Lwt.return_error "dpop proof too old" 144 + else if Hashtbl.mem jti_cache jti then 145 + Lwt.return_error "dpop proof replay detected" 146 + else ( 147 + Hashtbl.add jti_cache jti (now + 3600) ; 148 + if not (verify_signature jwt jwk alg) then 149 + Lwt.return_error "invalid dpop signature" 150 + else 151 + let jkt = compute_jwk_thumbprint jwk in 152 + (* verify ath if access token is provided *) 153 + match access_token with 154 + | Some token -> 155 + let ath_claim = 156 + payload |> member "ath" |> to_string_option 157 + in 158 + let expected_ath = 159 + Digestif.SHA256.( 160 + digest_string token |> to_raw_string 161 + |> Base64.encode_exn ~pad:false ) 162 + in 163 + if Some expected_ath <> ath_claim then 164 + Lwt.return_error "ath mismatch" 165 + else Lwt.return_ok {jti; jkt; htm; htu} 166 + | None -> 167 + let ath_claim = 168 + payload |> member "ath" |> to_string_option 169 + in 170 + if ath_claim <> None then 171 + Lwt.return_error 172 + "ath claim not allowed without access token" 173 + else Lwt.return_ok {jti; jkt; htm; htu} ) ) 174 + | _ -> 175 + Lwt.return_error "invalid dpop jwt" )