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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
open! Values
open! Core
open! Async
let default_max_results = 20
let list_user_pools cfg ?(max_results = default_max_results) () =
Log.Global.debug "list-user-pools" ~tags:[ "max_results", Int.to_string max_results ];
let maxResults = PoolQueryLimitType.make max_results in
match%bind Io.list_user_pools ~cfg (ListUserPoolsRequest.make ~maxResults ()) with
| Error _ -> failwithf "idp.list_user_pools" ()
| Ok x -> return x
;;
let user_pools_to_json t = UserPoolListType.to_json t
let user_pools_to_string t =
let x = user_pools_to_json t in
Yojson.Safe.to_string x
;;
module Attribute = struct
module Unsafe = struct
include AttributeType
module Name = AttributeNameType
module Value = AttributeValueType
end
module Safe = struct
include Awso_cognito_idp.User.Attribute
let value_string ?here ?message ?error value =
let v = Option.value_exn ?here ?message ?error value |> Unsafe.Value.to_value in
match v with
| `String s -> s
| _ ->
failwith
(match message with
| None -> "value not a string shape"
| Some m -> m)
;;
let value_string_opt ?message value =
let x =
match value with
| Some x ->
let x = Unsafe.Value.to_value x in
Some x
| None -> None
in
Option.map x ~f:(function
| `String s -> s
| _boto_value ->
failwith
(match message with
| None -> "value not a string shape"
| Some m -> m))
;;
let of_unsafe { Unsafe.name; value } =
match Unsafe.Name.to_value name with
| `String "email" ->
value_string ?here:None ?error:None ~message:"email must be a string shape" value
|> fun x -> `Email x
| `String "name" ->
value_string ?here:None ?error:None ~message:"name must be a string shape" value
|> fun x -> `Name x
| `String "preferred_user_name" ->
value_string_opt ~message:"prefered user name must be a string shape" value
|> fun x -> `Preferred_user_name x
| `String s -> (
match String.split s ~on:':' with
| "custom" :: rest ->
let name = String.concat ~sep:":" rest in
value_string_opt value |> fun value -> `Custom { name; value }
| _ -> value_string_opt value |> fun value -> `Unknown { name = s; value })
| _ -> failwith "not a valid shape for attribute key"
;;
end
end
module User = Awso_cognito_idp.User
type get_user_error = GetUserResponse.error
exception
Get_user_error of
{ message : string option
; cause : get_user_error
}
let get_user_failwith ?message cause = raise (Get_user_error { message; cause })
let get_user ?retry_delay ?retry_cnt cfg ~access_token () =
Awso_async.Import.with_retries ?retry_delay ?retry_cnt
@@ fun () ->
let accessToken = TokenModelType.make access_token in
let request = GetUserRequest.make ~accessToken () in
match%map Io.get_user ~cfg request with
| Error e -> Error e
| Ok ({ GetUserResponse.username; userAttributes; _ } as response) ->
let x = GetUserResponse.to_json response in
let resp_str = Yojson.Safe.to_string x in
Log.Global.debug "response body is %s" resp_str;
let username =
match Option.map username ~f:UsernameType.to_value with
| Some (`String username) -> username
| _ -> failwith "get_user: username missing or not a string"
in
let userAttributes = Option.value userAttributes ~default:[] in
List.map ~f:Attribute.Safe.of_unsafe userAttributes
|> fun attributes -> Ok User.{ username; attributes; access_token }
;;
let admin_get_user ?retry_delay ?retry_cnt cfg ~user_pool_id ~username () =
Awso_async.Import.with_retries ?retry_delay ?retry_cnt
@@ fun () ->
Io.admin_get_user
~cfg
(AdminGetUserRequest.make
~userPoolId:(UserPoolIdType.make user_pool_id)
~username:(UsernameType.make username)
())
>>= fun response ->
match response with
| Error response -> return (Error response)
| Ok
({ AdminGetUserResponse.username
; userAttributes
; mFAOptions = _
; userCreateDate = _
; userLastModifiedDate = _
; enabled = _
; userStatus = _
; preferredMfaSetting = _
; userMFASettingList = _
} as response) ->
let userAttributes = Option.value userAttributes ~default:[] in
let x = AdminGetUserResponse.to_json response in
let resp_str = Yojson.Safe.to_string x in
Log.Global.debug "response body is %s" resp_str;
let username =
match Option.map username ~f:UsernameType.to_value with
| Some (`String username) -> username
| _ -> failwith "admin_get_user: username missing or not a string"
in
List.map ~f:Attribute.Safe.of_unsafe userAttributes
|> fun attributes -> return (Ok User.{ username; attributes; access_token = "" })
;;