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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
namespace FundLab.Api
open System
open System.Globalization
open System.IO
open System.Text.Json
open Giraffe
open Microsoft.AspNetCore.Http
type EmptyPortfolioResponse =
{
status: string
message: string
}
type FundApiResponse =
{
id: Guid
name: string
currency: string
initialCash: string
initialUnitNav: string
isSynthetic: bool
availableCash: string
status: string
}
type ApiErrorResponse =
{
error: string
message: string
}
module App =
let private invariant = CultureInfo.InvariantCulture
let private cashText (value: decimal) = value.ToString("0.00", invariant)
let private unitNavText (value: decimal) = value.ToString("0.00000000", invariant)
let private fundResponse (fund: FundRecord) : FundApiResponse =
{
id = fund.Id
name = fund.Name
currency = fund.Currency
initialCash = cashText fund.InitialCash
initialUnitNav = unitNavText fund.InitialUnitNav
isSynthetic = fund.IsSynthetic
availableCash = cashText fund.AvailableCash
status = fund.Status
}
let private errorResponse status error message : HttpHandler =
setStatusCode status
>=> json ({
error = error
message = message
} : ApiErrorResponse)
let private tryStringProperty (root: JsonElement) (name: string) =
let mutable property = Unchecked.defaultof<JsonElement>
if root.TryGetProperty(name, &property) && property.ValueKind = JsonValueKind.String then
property.GetString() |> Option.ofObj
else
None
let private tryBoolProperty (root: JsonElement) (name: string) =
let mutable property = Unchecked.defaultof<JsonElement>
if root.TryGetProperty(name, &property) then
match property.ValueKind with
| JsonValueKind.True -> Some true
| JsonValueKind.False -> Some false
| _ -> None
else
None
let private tryDecimal (label: string) (text: string) =
if String.IsNullOrWhiteSpace text then
Error(sprintf "%s must be a decimal string" label)
else
match Decimal.TryParse(text, NumberStyles.AllowLeadingSign ||| NumberStyles.AllowDecimalPoint, invariant) with
| true, value -> Ok value
| false, _ -> Error(sprintf "%s must be a decimal string" label)
let private parseFundCommand (body: string) =
try
use document = JsonDocument.Parse(body)
let root = document.RootElement
if root.ValueKind <> JsonValueKind.Object then
Error "request body must be a JSON object"
else
match tryStringProperty root "name", tryStringProperty root "initialCash", tryStringProperty root "initialUnitNav", tryBoolProperty root "isSynthetic" with
| Some name, Some initialCashText, Some initialUnitNavText, Some isSynthetic ->
match tryDecimal "initialCash" initialCashText, tryDecimal "initialUnitNav" initialUnitNavText with
| Ok initialCash, Ok initialUnitNav ->
Ok {
Name = name
InitialCash = initialCash
InitialUnitNav = initialUnitNav
IsSynthetic = isSynthetic
}
| Error message, _
| _, Error message -> Error message
| _ ->
Error "name, initialCash, initialUnitNav and isSynthetic are required"
with
| :? JsonException -> Error "request body must be valid JSON"
let private invokeHandler handler next ctx = handler next ctx
let private unauthorized : HttpHandler =
setStatusCode 401
>=> setHttpHeader "WWW-Authenticate" "Bearer"
>=> text "Unauthorized"
let private requireBearer (next: HttpFunc) (ctx: HttpContext) =
let expectedToken =
Environment.GetEnvironmentVariable("FUND_LAB_AUTH_TOKEN")
|> Option.ofObj
|> Option.defaultValue ""
let authorizationHeader = ctx.Request.Headers.Authorization.ToString()
match Authentication.authorize expectedToken authorizationHeader with
| AuthDecision.Authorized -> next ctx
| AuthDecision.Unauthorized -> unauthorized next ctx
let private health : HttpHandler =
json ({
service = "fund-lab-api"
status = "ok"
} : HealthResponse)
let private emptyPortfolio : HttpHandler =
json ({
status = "empty"
message = "尚未创建基金/尚未选择投资"
} : EmptyPortfolioResponse)
let private createFund (repository: FundRepository) : HttpHandler =
fun next ctx ->
task {
use reader = new StreamReader(ctx.Request.Body)
let! body = reader.ReadToEndAsync()
let idempotencyKey = ctx.Request.Headers["Idempotency-Key"].ToString()
match parseFundCommand body with
| Error message ->
return! invokeHandler (errorResponse 400 "INVALID_FUND_REQUEST" message) next ctx
| Ok command ->
try
match repository.CreateFund(idempotencyKey, command) with
| FundWriteResult.Created fund ->
return! invokeHandler (setStatusCode 201 >=> json (fundResponse fund)) next ctx
| FundWriteResult.Replayed fund ->
return! invokeHandler (json (fundResponse fund)) next ctx
| FundWriteResult.IdempotencyConflict ->
return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx
| FundWriteResult.Invalid message ->
return! invokeHandler (errorResponse 400 "INVALID_FUND_REQUEST" message) next ctx
with _ ->
return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "fund persistence failed") next ctx
}
let private getFund (repository: FundRepository) (fundIdText: string) : HttpHandler =
fun next ctx ->
match Guid.TryParse fundIdText with
| false, _ -> errorResponse 400 "INVALID_FUND_ID" "fund id must be a UUID" next ctx
| true, fundId ->
try
match repository.GetFund fundId with
| Some fund -> json (fundResponse fund) next ctx
| None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx
with _ ->
errorResponse 500 "PERSISTENCE_ERROR" "fund persistence failed" next ctx
let createApplication (repository: FundRepository) : HttpHandler =
choose [
GET >=> route "/health" >=> health
subRoute "/api" (
requireBearer
>=> choose [
GET >=> route "/portfolio/summary" >=> emptyPortfolio
POST >=> route "/funds" >=> createFund repository
GET >=> routef "/funds/%s" (getFund repository)
]
)
setStatusCode 404 >=> text "Not Found"
]
|
