diff options
Diffstat (limited to 'src/FundLab.Api/App.fs')
| -rw-r--r-- | src/FundLab.Api/App.fs | 89 |
1 files changed, 89 insertions, 0 deletions
diff --git a/src/FundLab.Api/App.fs b/src/FundLab.Api/App.fs index 9712fc6..55a29f4 100644 --- a/src/FundLab.Api/App.fs +++ b/src/FundLab.Api/App.fs @@ -131,6 +131,16 @@ type FundPositionsResponse = positions: FundPositionResponse list } +type CapitalDepositResponse = + { + id: Guid + fundId: Guid + amount: string + note: string option + isSynthetic: bool + createdAt: string + } + type ApiErrorResponse = { error: string @@ -261,6 +271,16 @@ module App = isSynthetic = order.IsSynthetic } + let private capitalDepositResponse (deposit: CapitalDepositRecord) : CapitalDepositResponse = + { + id = deposit.Id + fundId = deposit.FundId + amount = cashText deposit.Amount + note = deposit.Note + isSynthetic = deposit.IsSynthetic + createdAt = timestampText deposit.CreatedAt + } + let private errorResponse status error message : HttpHandler = setStatusCode status >=> json ({ @@ -369,6 +389,28 @@ module App = with | :? JsonException -> Error "request body must be valid JSON" + let private parseCapitalDepositCommand (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 "amount" with + | None -> Error "amount is required" + | Some amountText -> + match tryDecimal "amount" amountText with + | Error message -> Error message + | Ok amount -> + Ok + { + Amount = amount + Note = tryStringProperty root "note" + } + with + | :? JsonException -> Error "request body must be valid JSON" + let private invokeHandler handler next ctx = handler next ctx let private unauthorized : HttpHandler = @@ -621,6 +663,51 @@ module App = with _ -> errorResponse 500 "PERSISTENCE_ERROR" "redemption confirmation failed" next ctx + + let private createCapitalDeposit (repository: FundRepository) (fundIdText: string) : HttpHandler = + fun next ctx -> + task { + match Guid.TryParse fundIdText with + | false, _ -> + return! invokeHandler (errorResponse 400 "INVALID_CAPITAL_REQUEST" "fund id must be a UUID") next ctx + | true, fundId -> + use reader = new StreamReader(ctx.Request.Body) + let! body = reader.ReadToEndAsync() + let idempotencyKey = ctx.Request.Headers["Idempotency-Key"].ToString() + + match parseCapitalDepositCommand body with + | Error message -> + return! invokeHandler (errorResponse 400 "INVALID_CAPITAL_REQUEST" message) next ctx + | Ok command -> + try + match repository.CreateCapitalDeposit(idempotencyKey, fundId, command) with + | CapitalDepositWriteResult.CapitalDepositCreated deposit -> + return! invokeHandler (setStatusCode 201 >=> json (capitalDepositResponse deposit)) next ctx + | CapitalDepositWriteResult.CapitalDepositReplayed deposit -> + return! invokeHandler (json (capitalDepositResponse deposit)) next ctx + | CapitalDepositWriteResult.CapitalDepositIdempotencyConflict -> + return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx + | CapitalDepositWriteResult.CapitalDepositInvalid message -> + return! invokeHandler (errorResponse 400 "INVALID_CAPITAL_REQUEST" message) next ctx + | CapitalDepositWriteResult.CapitalDepositFundNotFound -> + return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx + with _ -> + return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "capital deposit persistence failed") next ctx + } + + let private getCapitalDeposits (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 + | None -> errorResponse 404 "FUND_NOT_FOUND" "fund was not found" next ctx + | Some _ -> + let deposits = repository.GetCapitalDeposits fundId + json (deposits |> List.map capitalDepositResponse) next ctx + with _ -> + errorResponse 500 "PERSISTENCE_ERROR" "capital deposit persistence failed" next ctx let private marketDataError (failure: MarketDataFailure) : HttpHandler = let status, error, message = match failure with @@ -723,6 +810,8 @@ module App = GET >=> routef "/funds/%s/redemptions" (getRedemptions repository) POST >=> routef "/funds/%s/redemptions/%s/confirm" (fun (fundId, orderId) -> confirmRedemption repository fundId orderId) GET >=> routef "/funds/%s/positions" (getPositions repository) + POST >=> routef "/funds/%s/capital/deposit" (createCapitalDeposit repository) + GET >=> routef "/funds/%s/capital/deposits" (getCapitalDeposits repository) GET >=> routef "/funds/%s" (getFund repository) ] @ (marketData |> Option.map marketDataRoutes |> Option.defaultValue []) |