Skip to content

Commit

Permalink
add functionality to generate and validate email verification signatures
Browse files Browse the repository at this point in the history
  • Loading branch information
@PizieDust
PizieDust committed Aug 9, 2024
1 parent 43ea1ed commit eb9aeaf
Show file tree
Hide file tree
Showing 3 changed files with 192 additions and 20 deletions.
68 changes: 60 additions & 8 deletions unikernel.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -692,18 +692,70 @@ struct
match Middleware.has_session_cookie reqd with
| Some cookie -> (
match Middleware.user_from_auth_cookie cookie users with
| Ok user ->
Middleware.apply_middleware middlewares
(fun _reqd ->
Lwt.return
(reply ~content_type:"text/html"
(Verify_email.verify_page ~user
~icon:"/images/robur.png" ())))
reqd
| Ok user -> (
let updated_user =
User_model.update_user user ~updated_at:now ()
in
Store.update_user !store updated_user >>= function
| Ok store' ->
store := store';
let verification_link =
Utils.Email.generate_verification_link
updated_user.uuid now
in
Logs.info (fun m ->
m "Verification link is: %s" verification_link);
Middleware.apply_middleware middlewares
(fun _reqd ->
Lwt.return
(reply ~content_type:"text/html"
(Verify_email.verify_page ~user
~icon:"/images/robur.png" ())))
reqd
| Error (`Msg _msg) ->
let res =
"{\"status\": 400, \"success\": false, \"message\": \
\"Something went wrong. Wait a few seconds and try \
again.\"}"
in
Lwt.return (reply ~content_type:"application/json" res))
| Error (`Msg s) ->
Logs.err (fun m -> m "Error: verify email endpoint %s" s);
Middleware.redirect_to_register reqd ())
| None -> Middleware.redirect_to_login reqd ())
| path
when String.(
length path >= 19 && sub path 0 19 = "/auth/verify/token=")
-> (
let request = Httpaf.Reqd.request reqd in
match request.meth with
| `GET -> (
let _, (t : Storage.t) = !store in
let users = User_model.create_user_uuid_map t.users in
let now = Ptime.v (P.now_d_ps ()) in
let veification_token =
String.sub path 19 (String.length path - 19)
in
match User_model.verify_email users veification_token now with
| Ok user -> (
Store.update_user !store user >>= function
| Ok store' ->
store := store';
Middleware.redirect_to_dashboard reqd ()
| Error (`Msg _msg) ->
let res =
"{\"status\": 400, \"success\": false, \"message\": \
\"Something went wrong. Wait a few seconds and try \
again.\"}"
in
Lwt.return (reply ~content_type:"application/json" res))
| Error (`Msg s) -> Middleware.redirect_to_login reqd ~msg:s ())
| _ ->
let res =
"{\"status\": 400, \"success\": false, \"message\": \"Bad \
request method\"}"
in
Lwt.return (reply ~content_type:"application/json" res))
| "/dashboard" ->
let now = Ptime.v (P.now_d_ps ()) in
let _, (t : Storage.t) = !store in
Expand Down
89 changes: 86 additions & 3 deletions user_model.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ type user = {
tokens : token list;
cookies : cookie list;
created_at : Ptime.t;
updated_at : Ptime.t;
}

let week = 604800 (* a week = 7 days * 24 hours * 60 minutes * 60 seconds *)
Expand Down Expand Up @@ -168,6 +169,7 @@ let user_to_json (u : user) : Yojson.Basic.t =
("tokens", `List (List.map token_to_json u.tokens));
("cookies", `List (List.map cookie_to_json u.cookies));
("created_at", `String (Utils.TimeHelper.string_of_ptime u.created_at));
("updated_at", `String (Utils.TimeHelper.string_of_ptime u.updated_at));
]

let user_of_json = function
Expand All @@ -181,7 +183,8 @@ let user_of_json = function
get "uuid" xs,
get "tokens" xs,
get "cookies" xs,
get "created_at" xs )
get "created_at" xs,
get "updated_at" xs )
with
| ( Some (`String name),
Some (`String email),
Expand All @@ -190,12 +193,18 @@ let user_of_json = function
Some (`String uuid),
Some (`List tokens),
Some (`List cookies),
Some (`String updated_at_str),
Some (`String created_at_str) ) ->
let created_at =
match Utils.TimeHelper.ptime_of_string created_at_str with
| Ok ptime -> Some ptime
| Error _ -> None
in
let updated_at =
match Utils.TimeHelper.ptime_of_string updated_at_str with
| Ok ptime -> Some ptime
| Error _ -> None
in
let* email_verified = Utils.TimeHelper.ptime_of_json email_verified in
let* tokens =
List.fold_left
Expand Down Expand Up @@ -223,6 +232,7 @@ let user_of_json = function
tokens;
cookies;
created_at = Option.get created_at;
updated_at = Option.get updated_at;
}
| _ -> Error (`Msg "invalid json for user"))
| _ -> Error (`Msg "invalid json for user")
Expand Down Expand Up @@ -291,13 +301,14 @@ let create_user ~name ~email ~password ~created_at =
tokens = [ auth_token ];
cookies = [ session ];
created_at;
updated_at = created_at;
}

let check_if_user_exists email users =
List.find_opt (fun user -> user.email = Utils.Json.clean_string email) users

let update_user user ?name ?email ?email_verified ?password ?tokens ?cookies ()
=
let update_user user ?name ?email ?email_verified ?password ?tokens ?cookies
?updated_at () =
{
user with
name = (match name with Some name -> name | _ -> user.name);
Expand All @@ -307,6 +318,10 @@ let update_user user ?name ?email ?email_verified ?password ?tokens ?cookies ()
(match password with Some password -> password | _ -> user.password);
tokens = (match tokens with Some tokens -> tokens | _ -> user.tokens);
cookies = (match cookies with Some cookies -> cookies | _ -> user.cookies);
updated_at =
(match updated_at with
| Some updated_at -> updated_at
| _ -> user.updated_at);
}

let update_cookies (cookies : cookie list) (cookie : cookie) : cookie list =
Expand All @@ -320,6 +335,74 @@ let is_valid_cookie (cookie : cookie) now =

let is_email_verified user = Option.is_some user.email_verified

let verify_email users token timestamp =
let token_data = String.split_on_char '/' token in
let uuid =
match List.nth_opt token_data 0 with
| Some user_uuid ->
Logs.err (fun m -> m "email verification: user uuid is %s" user_uuid);
user_uuid
| None ->
Logs.err (fun m -> m "email verification: empty uuid in signature");
""
in

let token_signature =
match List.nth_opt token_data 1 with
| Some token ->
Logs.err (fun m -> m "email verification: token sig is %s" token);
token
| None ->
Logs.err (fun m -> m "email verification: empty signature");
""
in
let decoded_uuid =
match Base64.decode uuid with
| Ok d_uuid ->
Logs.err (fun m ->
m "email verification: decoded user uuid is %s" d_uuid);
d_uuid
| Error (`Msg s) ->
Logs.err (fun m ->
m "email verification: can't decode uuid with error %s" s);
""
in
let user = find_user_by_key decoded_uuid users in
match user with
| Some u -> (
let is_valid_link =
3600 > Utils.TimeHelper.diff_in_seconds timestamp u.updated_at
in
match is_valid_link with
| true -> (
let computed_signature =
Utils.Email.generate_signature u.uuid u.updated_at
in
Logs.err (fun m ->
m "email verification: token signature is %s" token_signature);
Logs.err (fun m ->
m "email verification: computed signature is %s"
computed_signature);
match String.equal token_signature computed_signature with
| true ->
let updated_user =
update_user u ~email_verified:(Some timestamp)
~updated_at:timestamp ()
in
Ok updated_user
| false ->
Logs.err (fun m -> m "email verification: This link is invalid");
Error (`Msg "This link is invalid."))
| false ->
Logs.err (fun m -> m "email verification: This link has expired");
Error
(`Msg
"This link has expired. Please sign in to get a new verification \
link."))
| None ->
Logs.err (fun m -> m "email verification: This account does not exist.");
Error (`Msg "This account does not exist.")

let user_auth_cookie_from_user (user : user) =
List.find_opt
(fun (cookie : cookie) -> String.equal cookie.name "molly_session")
Expand Down
55 changes: 46 additions & 9 deletions utils.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,15 +9,6 @@ module Json = struct
Buffer.contents buffer
end

module Email = struct
let validate_email email =
match Emile.of_string (Json.clean_string email) with
| Ok _ -> true
| Error s ->
Logs.err (fun m -> m "Emile-Email-Validation: %a" Emile.pp_error s);
false
end

module TimeHelper = struct
let ptime_of_string (t_str : string) : (Ptime.t, [> `Msg of string ]) result =
match Ptime.of_rfc3339 t_str with
Expand Down Expand Up @@ -55,3 +46,49 @@ module TimeHelper = struct
| `Null -> Ok None
| _ -> Error (`Msg "invalid json for Ptime.t option")
end

module Email = struct
type config = {
smtp_host : string;
smtp_port : int;
username : string;
password : string;
}

let validate_email email =
match Emile.of_string (Json.clean_string email) with
| Ok _ -> true
| Error s ->
Logs.err (fun m -> m "Emile-Email-Validation: %a" Emile.pp_error s);
false

let generate_signature uuid timestamp =
let timestamp_str = TimeHelper.string_of_ptime timestamp in
Base64.encode_string
(Cstruct.to_string
(Mirage_crypto.Hash.SHA256.digest
(Cstruct.of_string (uuid ^ "-" ^ timestamp_str))))

let generate_verification_link uuid timestamp =
let signature = generate_signature uuid timestamp in
let encoded_uuid = Base64.encode_string uuid in
"/auth/verify/token=" ^ encoded_uuid ^ "/" ^ signature

let send_verification_email _email _now =
let config_data =
{
smtp_host = "sandbox.smtp.mailtrap.io";
smtp_port = 25;
username = "2b08693767f1d9";
password = "55168d154ddc56";
}
in
let authentication =
{
Sendmail.mechanism = PLAIN;
username = config_data.username;
password = config_data.password;
}
in
authentication
end

0 comments on commit eb9aeaf

Please sign in to comment.