futur.blue
objective categorical abstract machine language personal data server
Handle jwts ourselves
-1
dune-project
-1
dune-project
+4
kleidos/kleidos.ml
+4
kleidos/kleidos.ml
···
213
let privkey, (module Curve : CURVE) = privkey in
214
Curve.sign ~privkey ~msg
215
216
+
let verify ~pubkey ~msg ~signature : bool =
217
+
let pubkey, (module Curve : CURVE) = pubkey in
218
+
Curve.verify ~pubkey ~msg ~signature
219
+
220
let pubkey_to_did_key pubkey : string =
221
let pubkey, (module Curve : CURVE) = pubkey in
222
Curve.pubkey_to_did_key pubkey
-1
pegasus.opam
-1
pegasus.opam
+1
-1
pegasus/lib/api/repo/createAccount.ml
+1
-1
pegasus/lib/api/repo/createAccount.ml
+1
-1
pegasus/lib/api/server/createSession.ml
+1
-1
pegasus/lib/api/server/createSession.ml
+3
-2
pegasus/lib/api/server/getServiceAuth.ml
+3
-2
pegasus/lib/api/server/getServiceAuth.ml
···
10
| _ ->
11
Errors.invalid_request "missing aud or lxm"
12
in
13
-
let%lwt signing_key =
14
match%lwt Data_store.get_actor_by_identifier did db with
15
| Some {signing_key; _} ->
16
Lwt.return signing_key
17
| None ->
18
Errors.internal_error ~msg:"actor not found" ()
19
in
20
-
let token = Auth.generate_service_jwt ~did ~aud ~lxm ~signing_key in
21
Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {token} )
···
10
| _ ->
11
Errors.invalid_request "missing aud or lxm"
12
in
13
+
let%lwt signing_multikey =
14
match%lwt Data_store.get_actor_by_identifier did db with
15
| Some {signing_key; _} ->
16
Lwt.return signing_key
17
| None ->
18
Errors.internal_error ~msg:"actor not found" ()
19
in
20
+
let signing_key = Kleidos.parse_multikey_str signing_multikey in
21
+
let token = Jwt.generate_service_jwt ~did ~aud ~lxm ~signing_key in
22
Dream.json @@ Yojson.Safe.to_string @@ response_to_yojson {token} )
+1
-1
pegasus/lib/api/server/refreshSession.ml
+1
-1
pegasus/lib/api/server/refreshSession.ml
···
18
in
19
let%lwt () = Data_store.revoke_token ~did ~jti db in
20
let%lwt {handle; did; active; status; _} = Auth.get_session_info did db in
21
-
let access_jwt, refresh_jwt = Auth.generate_jwt did in
22
Dream.json @@ Yojson.Safe.to_string
23
@@ response_to_yojson
24
{access_jwt; refresh_jwt; handle; did; active; status} )
···
18
in
19
let%lwt () = Data_store.revoke_token ~did ~jti db in
20
let%lwt {handle; did; active; status; _} = Auth.get_session_info did db in
21
+
let access_jwt, refresh_jwt = Jwt.generate_jwt did in
22
Dream.json @@ Yojson.Safe.to_string
23
@@ response_to_yojson
24
{access_jwt; refresh_jwt; handle; did; active; status} )
+15
-76
pegasus/lib/auth.ml
+15
-76
pegasus/lib/auth.ml
···
1
type t = (module Rapper_helper.CONNECTION)
2
3
-
type symmetric_jwt =
4
-
{scope: string; aud: string; sub: string; iat: int; exp: int; jti: string}
5
-
6
type session_info =
7
{ handle: string
8
; did: string
···
19
| Access of {did: string}
20
| Refresh of {did: string; jti: string}
21
22
-
let generate_jwt did =
23
-
let now_s = int_of_float (Unix.gettimeofday ()) in
24
-
let access_exp = now_s + (60 * 60 * 3) in
25
-
let refresh_exp = now_s + (60 * 60 * 24 * 7) in
26
-
let jti = Uuidm.v4_gen (Random.get_state ()) () |> Uuidm.to_string in
27
-
let access =
28
-
match
29
-
Jwto.encode Jwto.HS256 Env.jwt_secret
30
-
[ ("scope", "com.atproto.access")
31
-
; ("aud", Env.did)
32
-
; ("sub", did)
33
-
; ("iat", Int.to_string now_s)
34
-
; ("exp", Int.to_string access_exp)
35
-
; ("jti", jti) ]
36
-
with
37
-
| Ok token ->
38
-
token
39
-
| Error err ->
40
-
failwith err
41
-
in
42
-
let refresh =
43
-
match
44
-
Jwto.encode Jwto.HS256 Env.jwt_secret
45
-
[ ("scope", "com.atproto.refresh")
46
-
; ("aud", Env.did)
47
-
; ("sub", did)
48
-
; ("iat", Int.to_string now_s)
49
-
; ("exp", Int.to_string refresh_exp)
50
-
; ("jti", jti) ]
51
-
with
52
-
| Ok token ->
53
-
token
54
-
| Error err ->
55
-
failwith err
56
-
in
57
-
(access, refresh)
58
-
59
-
let generate_service_jwt ~did ~aud ~lxm ~signing_key =
60
-
let now_s = int_of_float (Unix.gettimeofday ()) in
61
-
let exp = now_s + (60 * 5) in
62
-
match
63
-
Jwto.encode Jwto.HS256 signing_key
64
-
[("iss", did); ("aud", aud); ("lxm", lxm); ("exp", Int.to_string exp)]
65
-
with
66
-
| Ok token ->
67
-
token
68
-
| Error err ->
69
-
failwith err
70
-
71
let verify_bearer_jwt t token expected_scope =
72
-
match Jwto.decode_and_verify Env.jwt_secret token with
73
| Error err ->
74
Lwt.return_error err
75
-
| Ok jwt ->
76
-
let payload = Jwto.get_payload jwt in
77
let now_s = int_of_float (Unix.gettimeofday ()) in
78
-
let scope = List.assoc_opt "scope" payload |> Option.value ~default:"" in
79
-
let aud = List.assoc_opt "aud" payload |> Option.value ~default:"" in
80
-
let sub = List.assoc_opt "sub" payload |> Option.value ~default:"" in
81
-
let iat =
82
-
List.assoc_opt "iat" payload
83
-
|> Option.map int_of_string
84
-
|> Option.value ~default:max_int
85
-
in
86
-
let exp =
87
-
List.assoc_opt "exp" payload
88
-
|> Option.map int_of_string |> Option.value ~default:0
89
-
in
90
-
let jti = List.assoc_opt "jti" payload |> Option.value ~default:"" in
91
-
if aud <> Env.did then Lwt.return_error "invalid aud"
92
-
else if sub = "" then Lwt.return_error "missing sub"
93
-
else if now_s < iat then Lwt.return_error "token issued in the future"
94
-
else if now_s > exp then Lwt.return_error "expired token"
95
-
else if scope <> expected_scope then Lwt.return_error "invalid scope"
96
-
else if jti = "" then Lwt.return_error "missing jti"
97
else
98
-
let%lwt revoked_at = Data_store.is_token_revoked t ~did:sub ~jti in
99
if revoked_at <> None then Lwt.return_error "token revoked"
100
-
else Lwt.return_ok {scope; aud; sub; iat; exp; jti}
101
102
let verify_auth ?(refresh = false) credentials did =
103
match credentials with
···
1
type t = (module Rapper_helper.CONNECTION)
2
3
type session_info =
4
{ handle: string
5
; did: string
···
16
| Access of {did: string}
17
| Refresh of {did: string; jti: string}
18
19
let verify_bearer_jwt t token expected_scope =
20
+
match Jwt.verify_jwt token Env.jwt_key with
21
| Error err ->
22
Lwt.return_error err
23
+
| Ok (_, payload) -> (
24
+
try
25
let now_s = int_of_float (Unix.gettimeofday ()) in
26
+
let jwt = Jwt.symmetric_jwt_of_yojson payload |> Result.get_ok in
27
+
if jwt.aud <> Env.did then Lwt.return_error "invalid aud"
28
+
else if jwt.sub = "" then Lwt.return_error "missing sub"
29
+
else if now_s < jwt.iat then Lwt.return_error "token issued in the future"
30
+
else if now_s > jwt.exp then Lwt.return_error "expired token"
31
+
else if jwt.scope <> expected_scope then Lwt.return_error "invalid scope"
32
+
else if jwt.jti = "" then Lwt.return_error "missing jti"
33
else
34
+
let%lwt revoked_at =
35
+
Data_store.is_token_revoked t ~did:jwt.sub ~jti:jwt.jti
36
+
in
37
if revoked_at <> None then Lwt.return_error "token revoked"
38
+
else Lwt.return_ok jwt
39
+
with _ -> Lwt.return_error "invalid token format" )
40
41
let verify_auth ?(refresh = false) credentials did =
42
match credentials with
-1
pegasus/lib/dune
-1
pegasus/lib/dune
+2
-2
pegasus/lib/env.ml
+2
-2
pegasus/lib/env.ml
+128
pegasus/lib/jwt.ml
+128
pegasus/lib/jwt.ml
···
···
1
+
module Defaults = struct
2
+
let service_token_exp = 60 * 5 (* 5 minutes *)
3
+
4
+
let access_token_exp = 60 * 60 * 3 (* 3 hours *)
5
+
6
+
let refresh_token_exp = 60 * 60 * 24 * 7 (* 7 days *)
7
+
end
8
+
9
+
type service_jwt = {iss: string; aud: string; lxm: string; exp: int}
10
+
[@@deriving yojson]
11
+
12
+
type symmetric_jwt =
13
+
{scope: string; aud: string; sub: string; iat: int; exp: int; jti: string}
14
+
[@@deriving yojson]
15
+
16
+
let b64_encode str =
17
+
Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet str
18
+
19
+
let b64_decode str =
20
+
match Base64.decode ~pad:false ~alphabet:Base64.uri_safe_alphabet str with
21
+
| Ok s ->
22
+
Ok s
23
+
| Error (`Msg e) ->
24
+
Error e
25
+
26
+
let extract_signature_components signature =
27
+
if Bytes.length signature <> 64 then failwith "expected 64 byte jwt signature"
28
+
else
29
+
let r = Bytes.sub signature 0 32 in
30
+
let s = Bytes.sub signature 32 32 in
31
+
(r, s)
32
+
33
+
let sign_jwt payload signing_key =
34
+
let _, (module Curve : Kleidos.CURVE) = signing_key in
35
+
let alg =
36
+
match Curve.name with
37
+
| "K256" ->
38
+
"ES256K"
39
+
| "P256" ->
40
+
"ES256"
41
+
| _ ->
42
+
failwith "invalid curve"
43
+
in
44
+
let crv =
45
+
match Curve.name with
46
+
| "K256" ->
47
+
"secp256k1"
48
+
| "P256" ->
49
+
"P-256"
50
+
| _ ->
51
+
failwith "invalid curve"
52
+
in
53
+
let header_json =
54
+
`Assoc [("alg", `String alg); ("crv", `String crv); ("typ", `String "JWT")]
55
+
in
56
+
let encoded_header = header_json |> Yojson.Safe.to_string |> b64_encode in
57
+
let encoded_payload = payload |> Yojson.Safe.to_string |> b64_encode in
58
+
let signing_input = encoded_header ^ "." ^ encoded_payload in
59
+
let signature =
60
+
Kleidos.sign ~privkey:signing_key ~msg:(Bytes.of_string signing_input)
61
+
in
62
+
let encoded_signature = b64_encode (Bytes.to_string signature) in
63
+
signing_input ^ "." ^ encoded_signature
64
+
65
+
let decode_jwt jwt =
66
+
match String.split_on_char '.' jwt with
67
+
| [header_b64; payload_b64; _] -> (
68
+
match (b64_decode header_b64, b64_decode payload_b64) with
69
+
| Ok header_str, Ok payload_str -> (
70
+
try
71
+
let header = Yojson.Safe.from_string header_str in
72
+
let payload = Yojson.Safe.from_string payload_str in
73
+
Ok (header, payload)
74
+
with _ -> Error "invalid json in jwt" )
75
+
| Error e, _ | _, Error e ->
76
+
Error e )
77
+
| _ ->
78
+
Error "invalid jwt format"
79
+
80
+
let verify_jwt jwt pubkey =
81
+
match String.split_on_char '.' jwt with
82
+
| [header_b64; payload_b64; signature_b64] -> (
83
+
match b64_decode signature_b64 with
84
+
| Error e ->
85
+
Error e
86
+
| Ok signature_str ->
87
+
let signature = Bytes.of_string signature_str in
88
+
let signing_input = header_b64 ^ "." ^ payload_b64 in
89
+
let verified =
90
+
Kleidos.verify ~pubkey ~msg:(Bytes.of_string signing_input) ~signature
91
+
in
92
+
if verified then decode_jwt jwt
93
+
else Error "jwt signature verification failed" )
94
+
| _ ->
95
+
Error "invalid jwt format"
96
+
97
+
let generate_jwt did =
98
+
let now_s = int_of_float (Unix.gettimeofday ()) in
99
+
let access_exp = now_s + Defaults.access_token_exp in
100
+
let refresh_exp = now_s + Defaults.refresh_token_exp in
101
+
let jti = Uuidm.v4_gen (Random.get_state ()) () |> Uuidm.to_string in
102
+
let access_payload =
103
+
symmetric_jwt_to_yojson
104
+
{ scope= "com.atproto.access"
105
+
; aud= Env.did
106
+
; sub= did
107
+
; iat= now_s
108
+
; exp= access_exp
109
+
; jti }
110
+
in
111
+
let refresh_payload =
112
+
symmetric_jwt_to_yojson
113
+
{ scope= "com.atproto.refresh"
114
+
; aud= Env.did
115
+
; sub= did
116
+
; iat= now_s
117
+
; exp= refresh_exp
118
+
; jti }
119
+
in
120
+
let access = sign_jwt access_payload Env.jwt_key in
121
+
let refresh = sign_jwt refresh_payload Env.jwt_key in
122
+
(access, refresh)
123
+
124
+
let generate_service_jwt ~did ~aud ~lxm ~signing_key =
125
+
let now_s = int_of_float (Unix.gettimeofday ()) in
126
+
let exp = now_s + Defaults.service_token_exp in
127
+
let payload = service_jwt_to_yojson {iss= did; aud; lxm; exp} in
128
+
sign_jwt payload signing_key
+3
-2
pegasus/lib/xrpc.ml
+3
-2
pegasus/lib/xrpc.ml
···
69
| None ->
70
Errors.invalid_request "failed to resolve destination service"
71
in
72
-
let%lwt signing_key =
73
match%lwt Data_store.get_actor_by_identifier did ctx.db with
74
| Some {signing_key; _} ->
75
Lwt.return signing_key
76
| None ->
77
Errors.internal_error ~msg:"user not found" ()
78
in
79
let jwt =
80
-
Auth.generate_service_jwt ~did ~aud:service_did ~lxm:nsid ~signing_key
81
in
82
let uri =
83
host ^ "/" ^ String.concat "/" @@ (Dream.path [@warning "-3"]) ctx.req
···
69
| None ->
70
Errors.invalid_request "failed to resolve destination service"
71
in
72
+
let%lwt signing_multikey =
73
match%lwt Data_store.get_actor_by_identifier did ctx.db with
74
| Some {signing_key; _} ->
75
Lwt.return signing_key
76
| None ->
77
Errors.internal_error ~msg:"user not found" ()
78
in
79
+
let signing_key = Kleidos.parse_multikey_str signing_multikey in
80
let jwt =
81
+
Jwt.generate_service_jwt ~did ~aud:service_did ~lxm:nsid ~signing_key
82
in
83
let uri =
84
host ^ "/" ^ String.concat "/" @@ (Dream.path [@warning "-3"]) ctx.req