Source file service.ml

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
module Core = Sihl_core
module Token = Sihl_token
module User = Sihl_user
module Utils = Sihl_utils
open Lwt.Syntax

let log_src = Logs.Src.create ~doc:"password reset" "sihl.service.password-reset"

module Logs = (val Logs.src_log log_src : Logs.LOG)

let kind = "password_reset"

module TokenData = struct
  type t = { user_id : string } [@@deriving yojson, make, fields]
end

module Make (TokenService : Token.Sig.SERVICE) (UserService : User.Sig.SERVICE) :
  Sig.SERVICE = struct
  let create_reset_token ctx ~email =
    let* user = UserService.find_by_email_opt ctx ~email in
    match user with
    | Some user ->
      let user_id = User.id user in
      let data =
        TokenData.make ~user_id |> TokenData.to_yojson |> Yojson.Safe.to_string
      in
      let* token = TokenService.create ctx ~kind ~data ~expires_in:Utils.Time.OneDay () in
      Lwt.return @@ Some token
    | None ->
      Logs.warn (fun m -> m "PASSWORD_RESET: No user found with email %s" email);
      Lwt.return None
  ;;

  let reset_password ctx ~token ~password ~password_confirmation =
    let* token = TokenService.find_opt ctx token in
    let token = Option.to_result ~none:"Invalid or expired token provided" token in
    let user_id =
      let ( let* ) = Result.bind in
      let* data = Result.map Token.data token in
      let* token = Option.to_result ~none:"Token has not user assigned" data in
      let* parsed = Utils.Json.parse token in
      let* yojson = TokenData.of_yojson parsed in
      Result.ok (TokenData.user_id yojson)
    in
    match user_id with
    | Error msg -> Lwt.return @@ Error msg
    | Ok user_id ->
      let* user = UserService.find ctx ~user_id in
      let* result =
        UserService.set_password ctx ~user ~password ~password_confirmation ()
      in
      Lwt.return @@ Result.map (fun _ -> ()) result
  ;;

  let start ctx = Lwt.return ctx
  let stop _ = Lwt.return ()

  let lifecycle =
    Core.Container.Lifecycle.create
      "password-reset"
      ~start
      ~stop
      ~dependencies:[ TokenService.lifecycle; UserService.lifecycle ]
  ;;

  let configure configuration =
    let configuration = Core.Configuration.make configuration in
    Core.Container.Service.create ~configuration lifecycle
  ;;
end