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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
open Base
exception Exception of string
module User = struct
type t = {
id : string;
email : string;
username : string option;
password : string;
status : string;
admin : bool;
confirmed : bool;
created_at : Ptime.t;
[@to_yojson Utils.Time.ptime_to_yojson]
[@of_yojson Utils.Time.ptime_of_yojson]
}
[@@deriving fields, yojson, show, make]
let equal u1 u2 = String.equal u1.id u2.id
let alcotest = Alcotest.testable pp equal
let ctx_key : t Core.Ctx.key = Core.Ctx.create_key ()
let confirm user = { user with confirmed = true }
let set_user_password user new_password =
let hash = new_password |> Utils.Hashing.hash in
Result.map hash ~f:(fun hash -> { user with password = hash })
let set_user_details user ~email ~username =
{ user with email = String.lowercase email; username }
let is_admin user = user.admin
let is_owner user id = String.equal user.id id
let is_confirmed user = user.confirmed
let matches_password password user =
Utils.Hashing.matches ~hash:user.password ~plain:password
let default_password_policy password =
if String.length password >= 8 then Ok ()
else Error "Password has to contain at least 8 characters"
let validate_new_password ~password ~password_confirmation ~password_policy =
let is_same =
if String.equal password password_confirmation then Ok ()
else Error "Password confirmation doesn't match provided password"
in
let complies_with_policy = password_policy password in
Result.all_unit [ is_same; complies_with_policy ]
let validate_change_password user ~old_password ~new_password
~new_password_confirmation ~password_policy =
let matches_old_password =
match matches_password old_password user with
| true -> Ok ()
| false -> Error "Invalid current password provided"
in
let new_password_valid =
validate_new_password ~password:new_password
~password_confirmation:new_password_confirmation ~password_policy
in
Result.all_unit [ matches_old_password; new_password_valid ]
let create ~email ~password ~username ~admin ~confirmed =
let hash = password |> Utils.Hashing.hash in
Result.map hash ~f:(fun hash ->
{
id = Data.Id.random () |> Data.Id.to_string;
email = String.lowercase email;
password = hash;
username;
admin;
confirmed;
status = "active";
created_at = Ptime_clock.now ();
})
let t =
let encode m =
Ok
( m.id,
( m.email,
( m.username,
(m.password, (m.status, (m.admin, (m.confirmed, m.created_at))))
) ) )
in
let decode
( id,
( email,
(username, (password, (status, (admin, (confirmed, created_at)))))
) ) =
Ok { id; email; username; password; status; admin; confirmed; created_at }
in
Caqti_type.(
custom ~encode ~decode
(tup2 string
(tup2 string
(tup2 (option string)
(tup2 string (tup2 string (tup2 bool (tup2 bool ptime))))))))
end