futur.blue
objective categorical abstract machine language personal data server
Add OATH-HOTP 2FA support
+15
bin/main.ml
+15
bin/main.ml
···
48
; ( post
49
, "/account/security/totp/disable"
50
, Api.Account_.Security.Totp.disable_handler )
51
; (get, "/account/permissions", Api.Account_.Permissions.get_handler)
52
; (post, "/account/permissions", Api.Account_.Permissions.post_handler)
53
; (get, "/account/identity", Api.Account_.Identity.get_handler)
···
48
; ( post
49
, "/account/security/totp/disable"
50
, Api.Account_.Security.Totp.disable_handler )
51
+
; ( get
52
+
, "/account/security/keys"
53
+
, Api.Account_.Security.Security_key.list_handler )
54
+
; ( post
55
+
, "/account/security/keys/setup"
56
+
, Api.Account_.Security.Security_key.setup_handler )
57
+
; ( post
58
+
, "/account/security/keys/:id/verify"
59
+
, Api.Account_.Security.Security_key.verify_handler )
60
+
; ( post
61
+
, "/account/security/keys/:id/resync"
62
+
, Api.Account_.Security.Security_key.resync_handler )
63
+
; ( delete
64
+
, "/account/security/keys/:id"
65
+
, Api.Account_.Security.Security_key.delete_handler )
66
; (get, "/account/permissions", Api.Account_.Permissions.get_handler)
67
; (post, "/account/permissions", Api.Account_.Permissions.post_handler)
68
; (get, "/account/identity", Api.Account_.Identity.get_handler)
+541
frontend/src/templates/AccountSecurityPage.mlx
+541
frontend/src/templates/AccountSecurityPage.mlx
···
14
; last_used_at: int option [@default None] }
15
[@@deriving json]
16
17
type props =
18
{ current_user: actor
19
; logged_in_users: actor list
20
; csrf_token: string
21
; passkeys: passkey_display list [@default []]
22
; totp_enabled: bool [@default false]
23
; email_2fa_enabled: bool [@default false]
24
; backup_codes_remaining: int [@default 10]
···
32
; logged_in_users
33
; csrf_token
34
; passkeys
35
; totp_enabled
36
; email_2fa_enabled
37
; backup_codes_remaining
···
45
let passkeyError, setPasskeyError = useState (fun () -> None) in
46
let webauthnSupported, setWebauthnSupported = useState (fun () -> false) in
47
let currentWebAuthnOptions = useRef None in
48
(* TOTP state *)
49
let totpEnabled, setTotpEnabled = useState (fun () -> totp_enabled) in
50
let settingUpTotp, setSettingUpTotp = useState (fun () -> false) in
···
635
</Aria.Modal>
636
</Aria.ModalOverlay>
637
</Aria.DialogTrigger>
638
</div>]
639
</ClientOnly>
640
</div>
···
14
; last_used_at: int option [@default None] }
15
[@@deriving json]
16
17
+
type security_key_display =
18
+
{ id: int
19
+
; name: string
20
+
; created_at: int
21
+
; last_used_at: int option [@default None]
22
+
; verified: bool [@default false] }
23
+
[@@deriving json]
24
+
25
type props =
26
{ current_user: actor
27
; logged_in_users: actor list
28
; csrf_token: string
29
; passkeys: passkey_display list [@default []]
30
+
; security_keys: security_key_display list [@default []]
31
; totp_enabled: bool [@default false]
32
; email_2fa_enabled: bool [@default false]
33
; backup_codes_remaining: int [@default 10]
···
41
; logged_in_users
42
; csrf_token
43
; passkeys
44
+
; security_keys
45
; totp_enabled
46
; email_2fa_enabled
47
; backup_codes_remaining
···
55
let passkeyError, setPasskeyError = useState (fun () -> None) in
56
let webauthnSupported, setWebauthnSupported = useState (fun () -> false) in
57
let currentWebAuthnOptions = useRef None in
58
+
(* security key state *)
59
+
let securityKeysState, setSecurityKeysState =
60
+
useState (fun () -> security_keys)
61
+
in
62
+
let settingUpSecurityKey, setSettingUpSecurityKey =
63
+
useState (fun () -> false)
64
+
in
65
+
let securityKeyName, setSecurityKeyName = useState (fun () -> "") in
66
+
let securityKeyId, setSecurityKeyId = useState (fun () -> None) in
67
+
let securityKeyUri, setSecurityKeyUri = useState (fun () -> "") in
68
+
let securityKeySecret, setSecurityKeySecret = useState (fun () -> "") in
69
+
let securityKeyCode, setSecurityKeyCode = useState (fun () -> "") in
70
+
let securityKeyError, setSecurityKeyError = useState (fun () -> None) in
71
+
let securityKeyLoading, setSecurityKeyLoading = useState (fun () -> false) in
72
+
(* resync state *)
73
+
let resyncingKeyId, setResyncingKeyId = useState (fun () -> None) in
74
+
let resyncCode1, setResyncCode1 = useState (fun () -> "") in
75
+
let resyncCode2, setResyncCode2 = useState (fun () -> "") in
76
+
let resyncError, setResyncError = useState (fun () -> None) in
77
+
let resyncLoading, setResyncLoading = useState (fun () -> false) in
78
(* TOTP state *)
79
let totpEnabled, setTotpEnabled = useState (fun () -> totp_enabled) in
80
let settingUpTotp, setSettingUpTotp = useState (fun () -> false) in
···
665
</Aria.Modal>
666
</Aria.ModalOverlay>
667
</Aria.DialogTrigger>
668
+
</div>]
669
+
</ClientOnly>
670
+
</div>
671
+
<div className="mb-6">
672
+
<h3 className="text-lg font-medium text-mana-200 mb-2">
673
+
(string "security keys")
674
+
</h3>
675
+
<p className="text-mist-100 text-sm mb-4">
676
+
(string
677
+
"Use a hardware security key for two-factor authentication via \
678
+
a 6-digit OATH-HOTP code." )
679
+
</p>
680
+
<ClientOnly
681
+
fallback=(<div>
682
+
<p className="text-mist-80 text-sm mb-4">
683
+
(string "Loading security keys...")
684
+
</p>
685
+
</div>)>
686
+
[%browser_only
687
+
fun () ->
688
+
let module Aria = ReactAria in
689
+
let formatDate ts =
690
+
let d = Js.Date.fromFloat (Float.of_int ts) in
691
+
Js.Date.toLocaleDateString d
692
+
in
693
+
let startSetup () =
694
+
setSecurityKeyLoading (fun _ -> true) ;
695
+
setSecurityKeyError (fun _ -> None) ;
696
+
let body =
697
+
Js.Json.object_
698
+
(Js.Dict.fromArray
699
+
[| ( "name"
700
+
, Js.Json.string
701
+
( if securityKeyName = "" then "Security Key"
702
+
else securityKeyName ) ) |] )
703
+
in
704
+
let _ =
705
+
Fetch.fetchWithInit "/account/security/keys/setup"
706
+
(Fetch.RequestInit.make ~method_:Post
707
+
~body:(Fetch.BodyInit.make (Js.Json.stringify body))
708
+
~headers:
709
+
(Fetch.HeadersInit.makeWithArray
710
+
[|("Content-Type", "application/json")|] )
711
+
() )
712
+
|> Js.Promise.then_ (fun response ->
713
+
setSecurityKeyLoading (fun _ -> false) ;
714
+
if Fetch.Response.ok response then
715
+
Fetch.Response.json response
716
+
|> Js.Promise.then_ (fun json ->
717
+
let id =
718
+
Js.Dict.unsafeGet (Obj.magic json) "id"
719
+
|> Obj.magic
720
+
in
721
+
let uri =
722
+
Js.Dict.unsafeGet (Obj.magic json) "uri"
723
+
|> Js.Json.decodeString
724
+
|> Option.value ~default:""
725
+
in
726
+
let secret =
727
+
Js.Dict.unsafeGet (Obj.magic json) "secret"
728
+
|> Js.Json.decodeString
729
+
|> Option.value ~default:""
730
+
in
731
+
setSecurityKeyId (fun _ -> Some id) ;
732
+
setSecurityKeyUri (fun _ -> uri) ;
733
+
setSecurityKeySecret (fun _ -> secret) ;
734
+
setSettingUpSecurityKey (fun _ -> true) ;
735
+
Js.Promise.resolve () )
736
+
else begin
737
+
Fetch.Response.json response
738
+
|> Js.Promise.then_ (fun json ->
739
+
let msg =
740
+
Js.Dict.get (Obj.magic json) "message"
741
+
|> Option.map Js.Json.decodeString
742
+
|> Option.join
743
+
|> Option.value ~default:"Setup failed"
744
+
in
745
+
setSecurityKeyError (fun _ -> Some msg) ;
746
+
Js.Promise.resolve () )
747
+
|> Js.Promise.catch (fun _ ->
748
+
setSecurityKeyError (fun _ ->
749
+
Some "Setup failed" ) ;
750
+
Js.Promise.resolve () )
751
+
end )
752
+
|> Js.Promise.catch (fun _ ->
753
+
setSecurityKeyLoading (fun _ -> false) ;
754
+
setSecurityKeyError (fun _ -> Some "Setup failed") ;
755
+
Js.Promise.resolve () )
756
+
in
757
+
()
758
+
in
759
+
let verifySetup () =
760
+
match securityKeyId with
761
+
| None ->
762
+
()
763
+
| Some id ->
764
+
setSecurityKeyLoading (fun _ -> true) ;
765
+
setSecurityKeyError (fun _ -> None) ;
766
+
let body =
767
+
Js.Json.object_
768
+
(Js.Dict.fromArray
769
+
[|("code", Js.Json.string securityKeyCode)|] )
770
+
in
771
+
let _ =
772
+
Fetch.fetchWithInit
773
+
( "/account/security/keys/" ^ string_of_int id
774
+
^ "/verify" )
775
+
(Fetch.RequestInit.make ~method_:Post
776
+
~body:
777
+
(Fetch.BodyInit.make (Js.Json.stringify body))
778
+
~headers:
779
+
(Fetch.HeadersInit.makeWithArray
780
+
[|("Content-Type", "application/json")|] )
781
+
() )
782
+
|> Js.Promise.then_ (fun response ->
783
+
setSecurityKeyLoading (fun _ -> false) ;
784
+
if Fetch.Response.ok response then begin
785
+
let new_key : security_key_display =
786
+
{ id
787
+
; name=
788
+
( if securityKeyName = "" then "Security Key"
789
+
else securityKeyName )
790
+
; created_at= (Obj.magic (Js.Date.now ()) : int)
791
+
; last_used_at= None
792
+
; verified= true }
793
+
in
794
+
setSecurityKeysState (fun keys ->
795
+
new_key :: keys ) ;
796
+
setSettingUpSecurityKey (fun _ -> false) ;
797
+
setSecurityKeyName (fun _ -> "") ;
798
+
setSecurityKeyCode (fun _ -> "") ;
799
+
setSecurityKeyUri (fun _ -> "") ;
800
+
setSecurityKeySecret (fun _ -> "") ;
801
+
setSecurityKeyId (fun _ -> None) ;
802
+
Js.Promise.resolve ()
803
+
end
804
+
else begin
805
+
Fetch.Response.json response
806
+
|> Js.Promise.then_ (fun json ->
807
+
let msg =
808
+
Js.Dict.get (Obj.magic json) "message"
809
+
|> Option.map Js.Json.decodeString
810
+
|> Option.join
811
+
|> Option.value
812
+
~default:"Verification failed"
813
+
in
814
+
setSecurityKeyError (fun _ -> Some msg) ;
815
+
Js.Promise.resolve () )
816
+
|> Js.Promise.catch (fun _ ->
817
+
setSecurityKeyError (fun _ ->
818
+
Some "Verification failed" ) ;
819
+
Js.Promise.resolve () )
820
+
end )
821
+
|> Js.Promise.catch (fun _ ->
822
+
setSecurityKeyLoading (fun _ -> false) ;
823
+
setSecurityKeyError (fun _ ->
824
+
Some "Verification failed" ) ;
825
+
Js.Promise.resolve () )
826
+
in
827
+
()
828
+
in
829
+
let cancelSetup () =
830
+
match securityKeyId with
831
+
| Some id ->
832
+
let _ =
833
+
Fetch.fetchWithInit
834
+
("/account/security/keys/" ^ string_of_int id)
835
+
(Fetch.RequestInit.make ~method_:Delete ())
836
+
in
837
+
()
838
+
| None ->
839
+
() ;
840
+
setSettingUpSecurityKey (fun _ -> false) ;
841
+
setSecurityKeyName (fun _ -> "") ;
842
+
setSecurityKeyCode (fun _ -> "") ;
843
+
setSecurityKeyUri (fun _ -> "") ;
844
+
setSecurityKeySecret (fun _ -> "") ;
845
+
setSecurityKeyId (fun _ -> None) ;
846
+
setSecurityKeyError (fun _ -> None)
847
+
in
848
+
let deleteKey id =
849
+
let _ =
850
+
Fetch.fetchWithInit
851
+
("/account/security/keys/" ^ string_of_int id)
852
+
(Fetch.RequestInit.make ~method_:Delete ())
853
+
|> Js.Promise.then_ (fun response ->
854
+
if Fetch.Response.ok response then
855
+
setSecurityKeysState (fun keys ->
856
+
List.filter
857
+
(fun sk -> (sk : security_key_display).id <> id)
858
+
keys ) ;
859
+
Js.Promise.resolve () )
860
+
in
861
+
()
862
+
in
863
+
let startResync id =
864
+
setResyncingKeyId (fun _ -> Some id) ;
865
+
setResyncCode1 (fun _ -> "") ;
866
+
setResyncCode2 (fun _ -> "") ;
867
+
setResyncError (fun _ -> None)
868
+
in
869
+
let cancelResync () =
870
+
setResyncingKeyId (fun _ -> None) ;
871
+
setResyncCode1 (fun _ -> "") ;
872
+
setResyncCode2 (fun _ -> "") ;
873
+
setResyncError (fun _ -> None)
874
+
in
875
+
let doResync () =
876
+
match resyncingKeyId with
877
+
| None ->
878
+
()
879
+
| Some id ->
880
+
setResyncLoading (fun _ -> true) ;
881
+
setResyncError (fun _ -> None) ;
882
+
let body =
883
+
Js.Json.object_
884
+
(Js.Dict.fromArray
885
+
[| ("code1", Js.Json.string resyncCode1)
886
+
; ("code2", Js.Json.string resyncCode2) |] )
887
+
in
888
+
let _ =
889
+
Fetch.fetchWithInit
890
+
( "/account/security/keys/" ^ string_of_int id
891
+
^ "/resync" )
892
+
(Fetch.RequestInit.make ~method_:Post
893
+
~body:
894
+
(Fetch.BodyInit.make (Js.Json.stringify body))
895
+
~headers:
896
+
(Fetch.HeadersInit.makeWithArray
897
+
[|("Content-Type", "application/json")|] )
898
+
() )
899
+
|> Js.Promise.then_ (fun response ->
900
+
setResyncLoading (fun _ -> false) ;
901
+
if Fetch.Response.ok response then begin
902
+
setResyncingKeyId (fun _ -> None) ;
903
+
setResyncCode1 (fun _ -> "") ;
904
+
setResyncCode2 (fun _ -> "") ;
905
+
Js.Promise.resolve ()
906
+
end
907
+
else begin
908
+
Fetch.Response.json response
909
+
|> Js.Promise.then_ (fun json ->
910
+
let msg =
911
+
Js.Dict.get (Obj.magic json) "message"
912
+
|> Option.map Js.Json.decodeString
913
+
|> Option.join
914
+
|> Option.value ~default:"Resync failed"
915
+
in
916
+
setResyncError (fun _ -> Some msg) ;
917
+
Js.Promise.resolve () )
918
+
|> Js.Promise.catch (fun _ ->
919
+
setResyncError (fun _ ->
920
+
Some "Resync failed" ) ;
921
+
Js.Promise.resolve () )
922
+
end )
923
+
|> Js.Promise.catch (fun _ ->
924
+
setResyncLoading (fun _ -> false) ;
925
+
setResyncError (fun _ -> Some "Resync failed") ;
926
+
Js.Promise.resolve () )
927
+
in
928
+
()
929
+
in
930
+
<div>
931
+
( if List.length securityKeysState = 0 then
932
+
<p className="text-mist-80 text-sm mb-4">
933
+
(string "You haven't registered any security keys yet.")
934
+
</p>
935
+
else
936
+
<ul className="mb-4 space-y-2">
937
+
( List.map
938
+
(fun (sk : security_key_display) ->
939
+
<li
940
+
key=(string_of_int sk.id)
941
+
className="flex items-center p-3 outline-1 \
942
+
outline-mana-40/50 rounded-lg">
943
+
<span
944
+
className="font-medium text-mist-100 truncate">
945
+
(string sk.name)
946
+
</span>
947
+
( if not sk.verified then
948
+
<span
949
+
className="text-xs text-phoenix-100 ml-2">
950
+
(string "(pending)")
951
+
</span>
952
+
else null )
953
+
<span
954
+
className="text-sm text-mist-80 ml-2 \
955
+
min-w-fit">
956
+
(string
957
+
({js|⸱ |js} ^ formatDate sk.created_at) )
958
+
</span>
959
+
( if sk.verified then
960
+
<button
961
+
type_="button"
962
+
className="p-1 ml-2 text-mana-100 \
963
+
hover:text-mana-200 \
964
+
cursor-pointer text-sm"
965
+
onClick=(fun _ -> startResync sk.id)>
966
+
(string "resync")
967
+
</button>
968
+
else null )
969
+
<button
970
+
type_="button"
971
+
className="p-1 ml-auto text-phoenix-100 \
972
+
hover:text-phoenix-200 \
973
+
cursor-pointer"
974
+
onClick=(fun _ -> deleteKey sk.id)>
975
+
<TrashIcon className="w-4 h-4" />
976
+
</button>
977
+
</li> )
978
+
securityKeysState
979
+
|> Array.of_list |> React.array )
980
+
</ul> )
981
+
<Aria.DialogTrigger
982
+
isOpen=(Option.is_some resyncingKeyId)
983
+
onOpenChange=(fun o -> if not o then cancelResync ())>
984
+
<Aria.ModalOverlay
985
+
className="fixed inset-0 z-50 bg-mist-80/80 flex \
986
+
items-center justify-center"
987
+
isDismissable=true>
988
+
<Aria.Modal
989
+
className="bg-feather-100 border border-mist-60 \
990
+
rounded-xl px-6 pb-6 pt-5 w-full max-w-sm \
991
+
mx-4 shadow-xl">
992
+
<Aria.Dialog className="outline-none">
993
+
<Aria.Heading
994
+
slot="title"
995
+
className="text-lg font-serif text-mana-200 mb-2">
996
+
(string "resync security key")
997
+
</Aria.Heading>
998
+
<div className="flex flex-col gap-y-3">
999
+
<p className="text-mist-100 text-sm">
1000
+
(string
1001
+
"Enter two consecutive codes from your \
1002
+
security key to resynchronize the counter:" )
1003
+
</p>
1004
+
<Input
1005
+
name="resync_code1"
1006
+
label="First code"
1007
+
placeholder="123456"
1008
+
showIndicator=false
1009
+
inputMode="numeric"
1010
+
value=resyncCode1
1011
+
onChange=(fun e ->
1012
+
setResyncCode1 (fun _ ->
1013
+
(Event.Form.target e)##value ) )
1014
+
/>
1015
+
<Input
1016
+
name="resync_code2"
1017
+
label="Second code"
1018
+
placeholder="234567"
1019
+
showIndicator=false
1020
+
inputMode="numeric"
1021
+
value=resyncCode2
1022
+
onChange=(fun e ->
1023
+
setResyncCode2 (fun _ ->
1024
+
(Event.Form.target e)##value ) )
1025
+
/>
1026
+
( match resyncError with
1027
+
| Some err ->
1028
+
<span
1029
+
className="inline-flex items-center \
1030
+
text-phoenix-100 text-sm">
1031
+
<CircleAlertIcon className="w-4 h-4 mr-2" />
1032
+
(string err)
1033
+
</span>
1034
+
| None ->
1035
+
null )
1036
+
<div className="flex flex-row gap-x-3 mt-2">
1037
+
<Button
1038
+
type_="button"
1039
+
disabled=resyncLoading
1040
+
onClick=(fun _ -> doResync ())>
1041
+
(string
1042
+
( if resyncLoading then "resyncing..."
1043
+
else "resync" ) )
1044
+
</Button>
1045
+
<Button
1046
+
kind=`Tertiary
1047
+
type_="button"
1048
+
onClick=(fun _ -> cancelResync ())>
1049
+
(string "cancel")
1050
+
</Button>
1051
+
</div>
1052
+
</div>
1053
+
</Aria.Dialog>
1054
+
</Aria.Modal>
1055
+
</Aria.ModalOverlay>
1056
+
</Aria.DialogTrigger>
1057
+
( if List.length securityKeysState < 5 then
1058
+
<div className="flex flex-col gap-y-2">
1059
+
<div className="flex flex-row gap-x-3">
1060
+
<div className="flex-1">
1061
+
<Input
1062
+
name="security_key_name"
1063
+
label="Security key name"
1064
+
placeholder="My Security Key"
1065
+
showIndicator=false
1066
+
value=securityKeyName
1067
+
onChange=(fun e ->
1068
+
setSecurityKeyName (fun _ ->
1069
+
(Event.Form.target e)##value ) )
1070
+
/>
1071
+
</div>
1072
+
<div className="self-end min-w-32">
1073
+
<Button
1074
+
type_="button"
1075
+
disabled=securityKeyLoading
1076
+
onClick=(fun _ -> startSetup ())>
1077
+
(string
1078
+
( if securityKeyLoading then "setting up..."
1079
+
else "add" ) )
1080
+
</Button>
1081
+
</div>
1082
+
</div>
1083
+
</div>
1084
+
else
1085
+
<p className="text-sm text-mist-80">
1086
+
(string "Maximum 5 security keys registered.")
1087
+
</p> )
1088
+
<Aria.DialogTrigger
1089
+
isOpen=settingUpSecurityKey
1090
+
onOpenChange=(fun o -> if not o then cancelSetup ())>
1091
+
<Aria.ModalOverlay
1092
+
className="fixed inset-0 z-50 bg-mist-80/80 flex \
1093
+
items-center justify-center"
1094
+
isDismissable=true>
1095
+
<Aria.Modal
1096
+
className="bg-feather-100 border border-mist-60 \
1097
+
rounded-xl px-6 pb-6 pt-5 w-full max-w-sm \
1098
+
mx-4 shadow-xl">
1099
+
<Aria.Dialog className="outline-none">
1100
+
<Aria.Heading
1101
+
slot="title"
1102
+
className="text-lg font-serif text-mana-200 mb-2">
1103
+
(string "set up security key")
1104
+
</Aria.Heading>
1105
+
<div className="flex flex-col gap-y-3">
1106
+
<p className="text-mist-100 text-sm">
1107
+
(string
1108
+
"Scan this QR code with your security key \
1109
+
app, or enter the secret manually, then \
1110
+
enter the generated code:" )
1111
+
</p>
1112
+
<div className="flex justify-center p-4 rounded-lg">
1113
+
<QRCode.SVG
1114
+
value=securityKeyUri
1115
+
size=200
1116
+
title="Security Key QR code"
1117
+
bgColor="#c8cfd2"
1118
+
fgColor="#312b4d"
1119
+
/>
1120
+
</div>
1121
+
<div
1122
+
className="p-3 bg-mist-20 rounded-lg text-center \
1123
+
font-mono text-mana-200 text-sm \
1124
+
break-all">
1125
+
(string securityKeySecret)
1126
+
</div>
1127
+
<Input
1128
+
name="security_key_code"
1129
+
label="Verification code"
1130
+
placeholder="123456"
1131
+
showIndicator=false
1132
+
inputMode="numeric"
1133
+
value=securityKeyCode
1134
+
onChange=(fun e ->
1135
+
setSecurityKeyCode (fun _ ->
1136
+
(Event.Form.target e)##value ) )
1137
+
/>
1138
+
( match securityKeyError with
1139
+
| Some err ->
1140
+
<span
1141
+
className="inline-flex items-center \
1142
+
text-phoenix-100 text-sm">
1143
+
<CircleAlertIcon className="w-4 h-4 mr-2" />
1144
+
(string err)
1145
+
</span>
1146
+
| None ->
1147
+
null )
1148
+
<div className="flex flex-row gap-x-3 mt-2">
1149
+
<Button
1150
+
type_="button"
1151
+
disabled=securityKeyLoading
1152
+
onClick=(fun _ -> verifySetup ())>
1153
+
(string
1154
+
( if securityKeyLoading then "verifying..."
1155
+
else "verify" ) )
1156
+
</Button>
1157
+
<Button
1158
+
kind=`Tertiary
1159
+
type_="button"
1160
+
onClick=(fun _ -> cancelSetup ())>
1161
+
(string "cancel")
1162
+
</Button>
1163
+
</div>
1164
+
</div>
1165
+
</Aria.Dialog>
1166
+
</Aria.Modal>
1167
+
</Aria.ModalOverlay>
1168
+
</Aria.DialogTrigger>
1169
+
( match securityKeyError with
1170
+
| Some err ->
1171
+
<span
1172
+
className="inline-flex items-center text-phoenix-100 \
1173
+
text-sm mt-2">
1174
+
<CircleAlertIcon className="w-4 h-4 mr-2" />
1175
+
(string err)
1176
+
</span>
1177
+
| None ->
1178
+
null )
1179
</div>]
1180
</ClientOnly>
1181
</div>
+10
-4
frontend/src/templates/LoginPage.mlx
+10
-4
frontend/src/templates/LoginPage.mlx
···
6
type two_fa_methods =
7
{ totp: bool [@default false]
8
; email: bool [@default false]
9
-
; backup_code: bool [@default false] }
10
[@@deriving json]
11
12
type props =
···
107
(* 2FA verification step *)
108
let methods =
109
Option.value
110
-
~default:{totp= false; email= false; backup_code= false}
111
two_fa_methods
112
in
113
<div>
114
<span className="w-full text-balance text-mist-100">
115
-
( if methods.totp then
116
-
string "Enter the 6-digit code from your authenticator app."
117
else if methods.email then
118
string "Enter the verification code sent to your email."
119
else string "Enter your verification code." )
···
6
type two_fa_methods =
7
{ totp: bool [@default false]
8
; email: bool [@default false]
9
+
; backup_code: bool [@default false]
10
+
; security_key: bool [@default false] }
11
[@@deriving json]
12
13
type props =
···
108
(* 2FA verification step *)
109
let methods =
110
Option.value
111
+
~default:
112
+
{ totp= false
113
+
; email= false
114
+
; backup_code= false
115
+
; security_key= false }
116
two_fa_methods
117
in
118
<div>
119
<span className="w-full text-balance text-mist-100">
120
+
( if methods.totp || methods.security_key then
121
+
string
122
+
"Enter the code from your authenticator app or security key."
123
else if methods.email then
124
string "Enter the verification code sent to your email."
125
else string "Enter your verification code." )
+13
pegasus/lib/api/account_/security/index.ml
+13
pegasus/lib/api/account_/security/index.ml
···
38
: Frontend.AccountSecurityPage.passkey_display ) )
39
passkeys
40
in
41
let%lwt two_fa_status = Two_factor.get_status ~did ctx.db in
42
let error = Dream.query ctx.req "error" in
43
let success = Dream.query ctx.req "success" in
···
48
; logged_in_users
49
; csrf_token
50
; passkeys= passkey_list
51
; totp_enabled= two_fa_status.totp_enabled
52
; email_2fa_enabled= two_fa_status.email_2fa_enabled
53
; backup_codes_remaining= two_fa_status.backup_codes_remaining
···
38
: Frontend.AccountSecurityPage.passkey_display ) )
39
passkeys
40
in
41
+
let%lwt security_keys = Security_key.get_keys_for_user ~did ctx.db in
42
+
let security_key_list =
43
+
List.map
44
+
(fun (sk : Security_key.Types.security_key) ->
45
+
( { id= sk.id
46
+
; name= sk.name
47
+
; created_at= sk.created_at
48
+
; last_used_at= sk.last_used_at
49
+
; verified= Option.is_some sk.verified_at }
50
+
: Frontend.AccountSecurityPage.security_key_display ) )
51
+
security_keys
52
+
in
53
let%lwt two_fa_status = Two_factor.get_status ~did ctx.db in
54
let error = Dream.query ctx.req "error" in
55
let success = Dream.query ctx.req "success" in
···
60
; logged_in_users
61
; csrf_token
62
; passkeys= passkey_list
63
+
; security_keys= security_key_list
64
; totp_enabled= two_fa_status.totp_enabled
65
; email_2fa_enabled= two_fa_status.email_2fa_enabled
66
; backup_codes_remaining= two_fa_status.backup_codes_remaining
+108
pegasus/lib/api/account_/security/security_key.ml
+108
pegasus/lib/api/account_/security/security_key.ml
···
···
1
+
type security_key_display =
2
+
{ id: int
3
+
; name: string
4
+
; created_at: int
5
+
; last_used_at: int option [@default None]
6
+
; verified: bool }
7
+
[@@deriving yojson {strict= false}]
8
+
9
+
type list_response = {security_keys: security_key_display list}
10
+
[@@deriving yojson {strict= false}]
11
+
12
+
type setup_request = {name: string option [@default None]}
13
+
[@@deriving yojson {strict= false}]
14
+
15
+
type setup_response = {id: int; secret: string; uri: string}
16
+
[@@deriving yojson {strict= false}]
17
+
18
+
type verify_request = {code: string} [@@deriving yojson {strict= false}]
19
+
20
+
type resync_request = {code1: string; code2: string}
21
+
[@@deriving yojson {strict= false}]
22
+
23
+
type success_response = {success: bool; message: string option [@default None]}
24
+
[@@deriving yojson {strict= false}]
25
+
26
+
let list_handler =
27
+
Xrpc.handler (fun ctx ->
28
+
let%lwt did = Session.get_current_did_exn ctx.req in
29
+
let%lwt keys = Security_key.get_keys_for_user ~did ctx.db in
30
+
let key_list =
31
+
List.map
32
+
(fun (sk : Security_key.Types.security_key) ->
33
+
( { id= sk.id
34
+
; name= sk.name
35
+
; created_at= sk.created_at
36
+
; last_used_at= sk.last_used_at
37
+
; verified= Option.is_some sk.verified_at }
38
+
: security_key_display ) )
39
+
keys
40
+
in
41
+
Dream.json @@ Yojson.Safe.to_string
42
+
@@ list_response_to_yojson {security_keys= key_list} )
43
+
44
+
let setup_handler =
45
+
Xrpc.handler (fun ctx ->
46
+
let%lwt did = Session.get_current_did_exn ctx.req in
47
+
let%lwt {name; _} = Xrpc.parse_body ctx.req setup_request_of_yojson in
48
+
let%lwt count = Security_key.count_security_keys ~did ctx.db in
49
+
if count >= Security_key.max_security_keys_per_user then
50
+
Errors.invalid_request
51
+
( "Maximum "
52
+
^ string_of_int Security_key.max_security_keys_per_user
53
+
^ " security keys allowed per account" )
54
+
else
55
+
let name = Option.value name ~default:"Security Key" in
56
+
let%lwt id, secret, uri =
57
+
Security_key.setup_security_key ~did ~name ctx.db
58
+
in
59
+
Dream.json @@ Yojson.Safe.to_string
60
+
@@ setup_response_to_yojson {id; secret; uri} )
61
+
62
+
let verify_handler =
63
+
Xrpc.handler (fun ctx ->
64
+
let%lwt did = Session.get_current_did_exn ctx.req in
65
+
match Dream.param ctx.req "id" |> int_of_string_opt with
66
+
| None ->
67
+
Errors.invalid_request "Invalid security key ID"
68
+
| Some id -> (
69
+
let%lwt {code; _} =
70
+
Xrpc.parse_body ctx.req verify_request_of_yojson
71
+
in
72
+
match%lwt Security_key.verify_setup ~id ~did ~code ctx.db with
73
+
| Ok () ->
74
+
Dream.json @@ Yojson.Safe.to_string
75
+
@@ success_response_to_yojson
76
+
{success= true; message= Some "Security key verified"}
77
+
| Error msg ->
78
+
Errors.invalid_request msg ) )
79
+
80
+
let resync_handler =
81
+
Xrpc.handler (fun ctx ->
82
+
let%lwt did = Session.get_current_did_exn ctx.req in
83
+
match Dream.param ctx.req "id" |> int_of_string_opt with
84
+
| None ->
85
+
Errors.invalid_request "Invalid security key ID"
86
+
| Some id -> (
87
+
let%lwt {code1; code2; _} =
88
+
Xrpc.parse_body ctx.req resync_request_of_yojson
89
+
in
90
+
match%lwt Security_key.resync_key ~id ~did ~code1 ~code2 ctx.db with
91
+
| Ok () ->
92
+
Dream.json @@ Yojson.Safe.to_string
93
+
@@ success_response_to_yojson
94
+
{success= true; message= Some "Security key resynchronized"}
95
+
| Error msg ->
96
+
Errors.invalid_request msg ) )
97
+
98
+
let delete_handler =
99
+
Xrpc.handler (fun ctx ->
100
+
let%lwt did = Session.get_current_did_exn ctx.req in
101
+
match Dream.param ctx.req "id" |> int_of_string_opt with
102
+
| None ->
103
+
Errors.invalid_request "Invalid security key ID"
104
+
| Some id ->
105
+
let%lwt _ = Security_key.delete_key ~id ~did ctx.db in
106
+
Dream.json @@ Yojson.Safe.to_string
107
+
@@ success_response_to_yojson
108
+
{success= true; message= Some "Security key removed"} )
+20
-12
pegasus/lib/api/server/createSession.ml
+20
-12
pegasus/lib/api/server/createSession.ml
···
27
28
let verify_2fa_code ~(actor : Data_store.Types.actor) ~code db =
29
let did = actor.did in
30
-
let%lwt totp_valid = Totp.verify_login_code ~did ~code db in
31
-
if totp_valid then Lwt.return_ok ()
32
else
33
-
let%lwt backup_valid = Totp.Backup_codes.verify_and_consume ~did ~code db in
34
-
if backup_valid then Lwt.return_ok ()
35
else
36
-
match%lwt Two_factor.verify_email_code_by_did ~did ~code db with
37
-
| Ok _ ->
38
-
Lwt.return_ok ()
39
-
| Error e ->
40
-
Lwt.return_error e
41
42
let handler =
43
Xrpc.handler (fun {req; db; _} ->
···
59
Lwt_result.catch @@ fun () -> Data_store.try_login ~id ~password db
60
with
61
| Ok (Some actor) -> (
62
-
let is_2fa_enabled =
63
-
actor.email_2fa_enabled = 1 || actor.totp_verified_at <> None
64
in
65
if not is_2fa_enabled then complete_login actor
66
else
···
78
in
79
(* only send code to email if email is the only method *)
80
let%lwt () =
81
-
if methods.email && not methods.totp then
82
let%lwt session_token =
83
Two_factor.create_pending_session ~did:actor.did db
84
in
···
27
28
let verify_2fa_code ~(actor : Data_store.Types.actor) ~code db =
29
let did = actor.did in
30
+
let%lwt sk_valid = Security_key.verify_login ~did ~code db in
31
+
if sk_valid then Lwt.return_ok ()
32
else
33
+
let%lwt totp_valid = Totp.verify_login_code ~did ~code db in
34
+
if totp_valid then Lwt.return_ok ()
35
else
36
+
let%lwt backup_valid =
37
+
Totp.Backup_codes.verify_and_consume ~did ~code db
38
+
in
39
+
if backup_valid then Lwt.return_ok ()
40
+
else
41
+
match%lwt Two_factor.verify_email_code_by_did ~did ~code db with
42
+
| Ok _ ->
43
+
Lwt.return_ok ()
44
+
| Error e ->
45
+
Lwt.return_error e
46
47
let handler =
48
Xrpc.handler (fun {req; db; _} ->
···
64
Lwt_result.catch @@ fun () -> Data_store.try_login ~id ~password db
65
with
66
| Ok (Some actor) -> (
67
+
let%lwt is_2fa_enabled =
68
+
Two_factor.is_2fa_enabled ~did:actor.did db
69
in
70
if not is_2fa_enabled then complete_login actor
71
else
···
83
in
84
(* only send code to email if email is the only method *)
85
let%lwt () =
86
+
if
87
+
methods.email && (not methods.totp)
88
+
&& not methods.security_key
89
+
then
90
let%lwt session_token =
91
Two_factor.create_pending_session ~did:actor.did db
92
in
+13
pegasus/lib/migrations/data_store/007_security_keys.sql
+13
pegasus/lib/migrations/data_store/007_security_keys.sql
···
···
1
+
CREATE TABLE IF NOT EXISTS security_keys (
2
+
id INTEGER PRIMARY KEY,
3
+
did TEXT NOT NULL,
4
+
name TEXT NOT NULL DEFAULT 'Security Key',
5
+
secret BLOB NOT NULL,
6
+
counter INTEGER NOT NULL DEFAULT 0,
7
+
created_at INTEGER NOT NULL,
8
+
last_used_at INTEGER,
9
+
verified_at INTEGER,
10
+
FOREIGN KEY (did) REFERENCES actors(did) ON DELETE CASCADE
11
+
);
12
+
13
+
CREATE INDEX IF NOT EXISTS security_keys_did_idx ON security_keys(did);
+280
pegasus/lib/security_key.ml
+280
pegasus/lib/security_key.ml
···
···
1
+
open Util.Rapper
2
+
3
+
let max_security_keys_per_user = 5
4
+
5
+
let look_ahead_window = 100
6
+
7
+
let resync_window = 1000
8
+
9
+
let code_digits = 6
10
+
11
+
let secret_length = 20 (* 160 bits for HMAC-SHA1 *)
12
+
13
+
module Types = struct
14
+
type security_key =
15
+
{ id: int
16
+
; did: string
17
+
; name: string
18
+
; secret: bytes
19
+
; counter: int
20
+
; created_at: int
21
+
; last_used_at: int option
22
+
; verified_at: int option }
23
+
end
24
+
25
+
open Types
26
+
27
+
module Queries = struct
28
+
let insert_security_key =
29
+
[%rapper
30
+
execute
31
+
{sql| INSERT INTO security_keys (did, name, secret, counter, created_at)
32
+
VALUES (%string{did}, %string{name}, %Blob{secret}, %int{counter}, %int{created_at})
33
+
|sql}]
34
+
35
+
let get_last_insert_id =
36
+
[%rapper get_one {sql| SELECT last_insert_rowid() AS @int{id} |sql}]
37
+
38
+
let get_security_keys_by_did =
39
+
[%rapper
40
+
get_many
41
+
{sql| SELECT @int{id}, @string{did}, @string{name}, @Blob{secret},
42
+
@int{counter}, @int{created_at}, @int?{last_used_at}, @int?{verified_at}
43
+
FROM security_keys WHERE did = %string{did}
44
+
ORDER BY created_at DESC
45
+
|sql}
46
+
record_out]
47
+
48
+
let get_verified_security_keys_by_did =
49
+
[%rapper
50
+
get_many
51
+
{sql| SELECT @int{id}, @string{did}, @string{name}, @Blob{secret},
52
+
@int{counter}, @int{created_at}, @int?{last_used_at}, @int?{verified_at}
53
+
FROM security_keys WHERE did = %string{did} AND verified_at IS NOT NULL
54
+
ORDER BY created_at DESC
55
+
|sql}
56
+
record_out]
57
+
58
+
let get_security_key_by_id id did =
59
+
[%rapper
60
+
get_opt
61
+
{sql| SELECT @int{id}, @string{did}, @string{name}, @Blob{secret},
62
+
@int{counter}, @int{created_at}, @int?{last_used_at}, @int?{verified_at}
63
+
FROM security_keys WHERE id = %int{id} AND did = %string{did}
64
+
|sql}
65
+
record_out]
66
+
~id ~did
67
+
68
+
let update_counter_and_last_used =
69
+
[%rapper
70
+
execute
71
+
{sql| UPDATE security_keys SET counter = %int{counter}, last_used_at = %int{last_used_at}
72
+
WHERE id = %int{id}
73
+
|sql}]
74
+
75
+
let update_counter =
76
+
[%rapper
77
+
execute
78
+
{sql| UPDATE security_keys SET counter = %int{counter}
79
+
WHERE id = %int{id}
80
+
|sql}]
81
+
82
+
let verify_security_key =
83
+
[%rapper
84
+
execute
85
+
{sql| UPDATE security_keys SET verified_at = %int{verified_at}, counter = %int{counter}
86
+
WHERE id = %int{id} AND did = %string{did}
87
+
|sql}]
88
+
89
+
let delete_security_key =
90
+
[%rapper
91
+
execute
92
+
{sql| DELETE FROM security_keys WHERE id = %int{id} AND did = %string{did}
93
+
|sql}]
94
+
95
+
let count_security_keys =
96
+
[%rapper
97
+
get_one
98
+
{sql| SELECT COUNT(*) AS @int{count} FROM security_keys WHERE did = %string{did}
99
+
|sql}]
100
+
101
+
let count_verified_security_keys =
102
+
[%rapper
103
+
get_one
104
+
{sql| SELECT COUNT(*) AS @int{count} FROM security_keys
105
+
WHERE did = %string{did} AND verified_at IS NOT NULL
106
+
|sql}]
107
+
108
+
let has_security_keys =
109
+
[%rapper
110
+
get_opt
111
+
{sql| SELECT 1 AS @int{has_sk} FROM security_keys
112
+
WHERE did = %string{did} AND verified_at IS NOT NULL LIMIT 1
113
+
|sql}]
114
+
end
115
+
116
+
(* RFC 4226 *)
117
+
let hotp ~(secret : bytes) ~(counter : int64) : string =
118
+
(* convert counter to 8-byte big-endian *)
119
+
let counter_bytes = Bytes.create 8 in
120
+
let c = ref counter in
121
+
for i = 7 downto 0 do
122
+
Bytes.set counter_bytes i (Char.chr (Int64.to_int (Int64.logand !c 0xffL))) ;
123
+
c := Int64.shift_right_logical !c 8
124
+
done ;
125
+
let hmac =
126
+
Digestif.SHA1.(
127
+
hmac_bytes ~key:(Bytes.to_string secret) counter_bytes |> to_raw_string )
128
+
in
129
+
(* dynamic truncation *)
130
+
let offset = Char.code hmac.[19] land 0xf in
131
+
let code =
132
+
((Char.code hmac.[offset] land 0x7f) lsl 24)
133
+
lor ((Char.code hmac.[offset + 1] land 0xff) lsl 16)
134
+
lor ((Char.code hmac.[offset + 2] land 0xff) lsl 8)
135
+
lor (Char.code hmac.[offset + 3] land 0xff)
136
+
in
137
+
let modulo = int_of_float (10. ** float_of_int code_digits) in
138
+
Printf.sprintf "%0*d" code_digits (code mod modulo)
139
+
140
+
let generate_secret () =
141
+
let () = Mirage_crypto_rng_unix.use_default () in
142
+
Bytes.of_string (Mirage_crypto_rng_unix.getrandom secret_length)
143
+
144
+
let make_provisioning_uri ~secret ~account ~issuer =
145
+
let secret_b32 =
146
+
Multibase.Base32.encode_exn ~pad:false (Bytes.to_string secret)
147
+
in
148
+
let encoded_account = Uri.pct_encode account in
149
+
let encoded_issuer = Uri.pct_encode issuer in
150
+
Printf.sprintf
151
+
"otpauth://hotp/%s:%s?secret=%s&issuer=%s&algorithm=SHA1&digits=%d&counter=0"
152
+
encoded_issuer encoded_account secret_b32 encoded_issuer code_digits
153
+
154
+
let verify_code ~secret ~stored_counter ~code =
155
+
let rec check_window offset =
156
+
if offset > look_ahead_window then Error "Code not valid (may need resync)"
157
+
else
158
+
let counter = Int64.of_int (stored_counter + offset) in
159
+
if hotp ~secret ~counter = code then Ok (stored_counter + offset + 1)
160
+
(* update counter past this one *)
161
+
else check_window (offset + 1)
162
+
in
163
+
check_window 0
164
+
165
+
(* resync requires two consecutive valid codes *)
166
+
let resync ~secret ~stored_counter ~code1 ~code2 =
167
+
let rec find_first offset =
168
+
if offset > resync_window then None
169
+
else
170
+
let counter = Int64.of_int (stored_counter + offset) in
171
+
if hotp ~secret ~counter = code1 then Some (stored_counter + offset)
172
+
else find_first (offset + 1)
173
+
in
174
+
match find_first 0 with
175
+
| None ->
176
+
Error "First code not found in resync window"
177
+
| Some counter1 ->
178
+
let counter2 = Int64.of_int (counter1 + 1) in
179
+
if hotp ~secret ~counter:counter2 = code2 then Ok (counter1 + 2)
180
+
(* resync to after both codes *)
181
+
else Error "Second code must immediately follow the first"
182
+
183
+
let setup_security_key ~did ~name db =
184
+
let secret = generate_secret () in
185
+
let now = Util.now_ms () in
186
+
let%lwt () =
187
+
Util.use_pool db
188
+
@@ Queries.insert_security_key ~did ~name ~secret ~counter:0 ~created_at:now
189
+
in
190
+
let%lwt id = Util.use_pool db @@ Queries.get_last_insert_id () in
191
+
let issuer = "Pegasus PDS (" ^ Env.hostname ^ ")" in
192
+
let uri = make_provisioning_uri ~secret ~account:did ~issuer in
193
+
let secret_b32 =
194
+
Multibase.Base32.encode_exn ~pad:false (Bytes.to_string secret)
195
+
in
196
+
Lwt.return (id, secret_b32, uri)
197
+
198
+
let verify_setup ~id ~did ~code db =
199
+
match%lwt Util.use_pool db @@ Queries.get_security_key_by_id id did with
200
+
| None ->
201
+
Lwt.return_error "Security key not found"
202
+
| Some sk -> (
203
+
if Option.is_some sk.verified_at then
204
+
Lwt.return_error "Security key already verified"
205
+
else
206
+
match
207
+
verify_code ~secret:sk.secret ~stored_counter:sk.counter ~code
208
+
with
209
+
| Error msg ->
210
+
Lwt.return_error msg
211
+
| Ok new_counter ->
212
+
let now = Util.now_ms () in
213
+
let%lwt () =
214
+
Util.use_pool db
215
+
@@ Queries.verify_security_key ~id ~did ~verified_at:now
216
+
~counter:new_counter
217
+
in
218
+
Lwt.return_ok () )
219
+
220
+
let verify_login ~did ~code db =
221
+
let%lwt keys =
222
+
Util.use_pool db @@ Queries.get_verified_security_keys_by_did ~did
223
+
in
224
+
let rec try_keys = function
225
+
| [] ->
226
+
Lwt.return_false
227
+
| sk :: rest -> (
228
+
match verify_code ~secret:sk.secret ~stored_counter:sk.counter ~code with
229
+
| Error _ ->
230
+
try_keys rest
231
+
| Ok new_counter ->
232
+
let now = Util.now_ms () in
233
+
let%lwt () =
234
+
Util.use_pool db
235
+
@@ Queries.update_counter_and_last_used ~id:sk.id
236
+
~counter:new_counter ~last_used_at:now
237
+
in
238
+
Lwt.return_true )
239
+
in
240
+
try_keys keys
241
+
242
+
let resync_key ~id ~did ~code1 ~code2 db =
243
+
match%lwt Util.use_pool db @@ Queries.get_security_key_by_id id did with
244
+
| None ->
245
+
Lwt.return_error "Security key not found"
246
+
| Some sk -> (
247
+
if Option.is_none sk.verified_at then
248
+
Lwt.return_error "Security key not verified yet"
249
+
else
250
+
match
251
+
resync ~secret:sk.secret ~stored_counter:sk.counter ~code1 ~code2
252
+
with
253
+
| Error msg ->
254
+
Lwt.return_error msg
255
+
| Ok new_counter ->
256
+
let%lwt () =
257
+
Util.use_pool db
258
+
@@ Queries.update_counter ~id:sk.id ~counter:new_counter
259
+
in
260
+
Lwt.return_ok () )
261
+
262
+
let get_keys_for_user ~did db =
263
+
Util.use_pool db @@ Queries.get_security_keys_by_did ~did
264
+
265
+
let delete_key ~id ~did db =
266
+
let%lwt () = Util.use_pool db @@ Queries.delete_security_key ~id ~did in
267
+
Lwt.return_true
268
+
269
+
let has_security_keys ~did db =
270
+
match%lwt Util.use_pool db @@ Queries.has_security_keys ~did with
271
+
| Some _ ->
272
+
Lwt.return_true
273
+
| None ->
274
+
Lwt.return_false
275
+
276
+
let count_security_keys ~did db =
277
+
Util.use_pool db @@ Queries.count_security_keys ~did
278
+
279
+
let count_verified_security_keys ~did db =
280
+
Util.use_pool db @@ Queries.count_verified_security_keys ~did
+21
-6
pegasus/lib/two_factor.ml
+21
-6
pegasus/lib/two_factor.ml
···
3
let email_code_expiry_ms = 10 * 60 * 1000
4
5
module Types = struct
6
-
type two_factor_method = TOTP | Email | BackupCode
7
8
type two_factor_status =
9
-
{totp_enabled: bool; email_2fa_enabled: bool; backup_codes_remaining: int}
10
[@@deriving yojson {strict= false}]
11
12
type pending_2fa =
···
20
; created_at: int }
21
22
type available_methods = Frontend.LoginPage.two_fa_methods =
23
-
{totp: bool; email: bool; backup_code: bool}
24
[@@deriving yojson {strict= false}]
25
end
26
···
85
[%rapper
86
get_opt
87
{sql| SELECT CASE
88
-
WHEN totp_verified_at IS NOT NULL OR email_2fa_enabled = 1 THEN 1
89
ELSE 0
90
END AS @int{result}
91
FROM actors
···
114
Lwt.return_false
115
in
116
let%lwt backup_count = Totp.Backup_codes.get_remaining_count ~did db in
117
Lwt.return
118
{ totp_enabled
119
; email_2fa_enabled= email_2fa
120
-
; backup_codes_remaining= backup_count }
121
122
let get_available_methods ~did db =
123
let%lwt totp_enabled = Totp.is_enabled ~did db in
···
129
Lwt.return_false
130
in
131
let%lwt has_backup = Totp.Backup_codes.has_backup_codes ~did db in
132
-
Lwt.return {totp= totp_enabled; email= email_2fa; backup_code= has_backup}
133
134
(* create a pending 2FA session after password verification *)
135
let create_pending_session ~did db =
···
3
let email_code_expiry_ms = 10 * 60 * 1000
4
5
module Types = struct
6
+
type two_factor_method = TOTP | Email | BackupCode | SecurityKey
7
8
type two_factor_status =
9
+
{ totp_enabled: bool
10
+
; email_2fa_enabled: bool
11
+
; backup_codes_remaining: int
12
+
; security_keys_count: int }
13
[@@deriving yojson {strict= false}]
14
15
type pending_2fa =
···
23
; created_at: int }
24
25
type available_methods = Frontend.LoginPage.two_fa_methods =
26
+
{totp: bool; email: bool; backup_code: bool; security_key: bool}
27
[@@deriving yojson {strict= false}]
28
end
29
···
88
[%rapper
89
get_opt
90
{sql| SELECT CASE
91
+
WHEN totp_verified_at IS NOT NULL
92
+
OR email_2fa_enabled = 1
93
+
OR EXISTS(SELECT 1 FROM security_keys WHERE security_keys.did = actors.did AND security_keys.verified_at IS NOT NULL)
94
+
THEN 1
95
ELSE 0
96
END AS @int{result}
97
FROM actors
···
120
Lwt.return_false
121
in
122
let%lwt backup_count = Totp.Backup_codes.get_remaining_count ~did db in
123
+
let%lwt security_keys_count =
124
+
Security_key.count_verified_security_keys ~did db
125
+
in
126
Lwt.return
127
{ totp_enabled
128
; email_2fa_enabled= email_2fa
129
+
; backup_codes_remaining= backup_count
130
+
; security_keys_count }
131
132
let get_available_methods ~did db =
133
let%lwt totp_enabled = Totp.is_enabled ~did db in
···
139
Lwt.return_false
140
in
141
let%lwt has_backup = Totp.Backup_codes.has_backup_codes ~did db in
142
+
let%lwt has_security_key = Security_key.has_security_keys ~did db in
143
+
Lwt.return
144
+
{ totp= totp_enabled
145
+
; email= email_2fa
146
+
; backup_code= has_backup
147
+
; security_key= has_security_key }
148
149
(* create a pending 2FA session after password verification *)
150
let create_pending_session ~did db =