-
Notifications
You must be signed in to change notification settings - Fork 0
/
AuthServer.fs
83 lines (73 loc) · 2.39 KB
/
AuthServer.fs
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
module AuthServer
open Suave.Http
open JwtToken
open System
open SuaveJson
open Suave.RequestErrors
open Suave
open Suave.Filters
open Suave.Operators
type AudienceCreateRequest = {
Name : string
}
type AudienceCreateResponse = {
ClientId : string
Base64Secret : string
Name : string
}
type TokenCreateCredentials = {
UserName : string
Password : string
ClientId : string
}
type Config = {
AddAudienceUrlPath : string
SaveAudience : Audience -> Async<Audience>
CreateTokenUrlPath : string
GetAudience : string -> Async<Audience option>
Issuer : string
TokenTimeSpan : TimeSpan
}
let audienceWebPart config identityStore =
let toAudienceCreateResponse (audience : Audience) = {
Base64Secret = audience.Secret.ToString()
ClientId = audience.ClientId
Name = audience.Name
}
let tryCreateAudience (ctx: HttpContext) =
match mapJsonPayload<AudienceCreateRequest> ctx.request with
| None -> BAD_REQUEST "Invalid Audience Create Request" ctx
| Some audienceCreateRequest ->
async {
let! audience =
audienceCreateRequest.Name
|> createAudience
|> config.SaveAudience
let audienceCreateResponse =
toAudienceCreateResponse audience
return! JSON audienceCreateResponse ctx
}
let tryCreateToken (ctx: HttpContext) =
match mapJsonPayload<TokenCreateCredentials> ctx.request with
| None -> BAD_REQUEST "Invalid Token Create Request" ctx
| Some tokenCreateCredentials ->
async {
let! audience = config.GetAudience tokenCreateCredentials.ClientId
match audience with
| None -> return! BAD_REQUEST "Invalid Client Id" ctx
| Some audience ->
let tokenCreateRequest : TokenCreateRequest = {
Issuer = config.Issuer
UserName = tokenCreateCredentials.UserName
Password = tokenCreateCredentials.Password
TokenTimeSpan = config.TokenTimeSpan
}
let! token = createToken tokenCreateRequest identityStore audience
match token with
| Some token -> return! JSON token ctx
| None -> return! BAD_REQUEST "Invalid Login Credentials" ctx
}
choose [
path config.AddAudienceUrlPath >=> POST >=> tryCreateAudience
path config.CreateTokenUrlPath >=> POST >=> tryCreateToken
]