1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
module Database = Sihl_database
exception Exception of string
module Status = struct
type t =
| Active
| Inactive
[@@deriving yojson, show, eq]
let to_string = function
| Active -> "active"
| Inactive -> "inactive"
;;
let of_string str =
match str with
| "active" -> Ok Active
| "inactive" -> Ok Inactive
| _ -> Error (Printf.sprintf "Invalid token status %s provided" str)
;;
let alco = Alcotest.testable pp equal
end
type t =
{ id : string
; value : string
; data : string option
; kind : string
; status : Status.t
; expires_at : Ptime.t
; created_at : Ptime.t
}
[@@deriving fields, show, eq]
let make ~id ~value ~data ~kind ~status ~expires_at ~created_at =
{ id; value; data; kind; status; expires_at; created_at }
;;
let invalidate token = { token with status = Inactive }
let is_valid token =
Status.equal token.status Status.Active
&& Ptime.is_later token.expires_at ~than:(Ptime_clock.now ())
;;
let alco = Alcotest.testable pp equal
let t =
let encode m =
let status = Status.to_string m.status in
Ok (m.id, (m.value, (m.data, (m.kind, (status, (m.expires_at, m.created_at))))))
in
let decode (id, (value, (data, (kind, (status, (expires_at, created_at)))))) =
match Status.of_string status with
| Ok status -> Ok { id; value; data; kind; status; expires_at; created_at }
| Error msg -> Error msg
in
Caqti_type.(
custom
~encode
~decode
(tup2
Database.Id.t_string
(tup2
string
(tup2 (option string) (tup2 string (tup2 string (tup2 ptime ptime)))))))
;;