diff options
Diffstat (limited to 'src/FundLab.Api/App.fs')
| -rw-r--r-- | src/FundLab.Api/App.fs | 143 |
1 files changed, 143 insertions, 0 deletions
diff --git a/src/FundLab.Api/App.fs b/src/FundLab.Api/App.fs index 97787aa..9712fc6 100644 --- a/src/FundLab.Api/App.fs +++ b/src/FundLab.Api/App.fs @@ -96,6 +96,7 @@ type FundPositionResponse = { instrumentCode: string units: string + reservedUnits: string costCash: string lastConfirmedAt: string valuationNav: string option @@ -103,6 +104,25 @@ type FundPositionResponse = valuationCollectedAt: string option } +type RedemptionOrderResponse = + { + id: Guid + fundId: Guid + instrumentCode: string + units: string + feeAmount: string + status: string + submittedAt: string + tradeDate: string + pendingReason: string option + confirmedAt: string option + confirmedNav: string option + confirmedNavDate: string option + confirmedProceeds: string option + confirmedCostReleased: string option + isSynthetic: bool + } + type FundPositionsResponse = { fundId: Guid @@ -222,6 +242,25 @@ module App = isSynthetic = order.IsSynthetic } + let private redemptionResponse (order: RedemptionOrderRecord) : RedemptionOrderResponse = + { + id = order.Id + fundId = order.FundId + instrumentCode = order.InstrumentCode + units = decimalText order.Units + feeAmount = cashText order.FeeAmount + status = order.Status + submittedAt = timestampText order.SubmittedAt + tradeDate = dateText order.TradeDate + pendingReason = order.PendingReason + confirmedAt = order.ConfirmedAt |> Option.map timestampText + confirmedNav = order.ConfirmedNav |> Option.map decimalText + confirmedNavDate = order.ConfirmedNavDate |> Option.map dateText + confirmedProceeds = order.ConfirmedProceeds |> Option.map cashText + confirmedCostReleased = order.ConfirmedCostReleased |> Option.map cashText + isSynthetic = order.IsSynthetic + } + let private errorResponse status error message : HttpHandler = setStatusCode status >=> json ({ @@ -305,6 +344,31 @@ module App = with | :? JsonException -> Error "request body must be valid JSON" + let private parseRedemptionCommand (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 "instrumentCode", tryStringProperty root "units", tryStringProperty root "feeAmount" with + | Some code, Some unitsText, Some feeAmountText -> + match tryDecimal "units" unitsText, tryDecimal "feeAmount" feeAmountText with + | Ok units, Ok feeAmount -> + Ok + { + InstrumentCode = code + Units = units + FeeAmount = feeAmount + } + | Error message, _ + | _, Error message -> Error message + | _ -> + Error "instrumentCode, units and feeAmount are required" + with + | :? JsonException -> Error "request body must be valid JSON" + let private invokeHandler handler next ctx = handler next ctx let private unauthorized : HttpHandler = @@ -462,6 +526,7 @@ module App = { instrumentCode = position.InstrumentCode units = decimalText position.Units + reservedUnits = decimalText position.ReservedUnits costCash = cashText position.CostCash lastConfirmedAt = timestampText position.LastConfirmedAt valuationNav = position.ValuationNav |> Option.map decimalText @@ -481,6 +546,81 @@ module App = with _ -> errorResponse 500 "PERSISTENCE_ERROR" "position persistence failed" next ctx + let private createRedemption (repository: FundRepository) (fundIdText: string) : HttpHandler = + fun next ctx -> + task { + match Guid.TryParse fundIdText with + | false, _ -> + return! invokeHandler (errorResponse 400 "INVALID_REDEMPTION_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 parseRedemptionCommand body with + | Error message -> + return! invokeHandler (errorResponse 400 "INVALID_REDEMPTION_REQUEST" message) next ctx + | Ok command -> + try + match repository.CreateRedemptionOrder(idempotencyKey, fundId, command) with + | RedemptionWriteResult.RedemptionCreated order -> + return! invokeHandler (setStatusCode 201 >=> json (redemptionResponse order)) next ctx + | RedemptionWriteResult.RedemptionReplayed order -> + return! invokeHandler (json (redemptionResponse order)) next ctx + | RedemptionWriteResult.RedemptionIdempotencyConflict -> + return! invokeHandler (errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request") next ctx + | RedemptionWriteResult.RedemptionInvalid message -> + return! invokeHandler (errorResponse 400 "INVALID_REDEMPTION_REQUEST" message) next ctx + | RedemptionWriteResult.RedemptionFundNotFound -> + return! invokeHandler (errorResponse 404 "FUND_NOT_FOUND" "fund was not found") next ctx + | RedemptionWriteResult.RedemptionInstrumentNotFound -> + return! invokeHandler (errorResponse 404 "INSTRUMENT_NOT_FOUND" "instrument code was not found in the instrument catalog") next ctx + | RedemptionWriteResult.RedemptionInsufficientUnits -> + return! invokeHandler (errorResponse 409 "INSUFFICIENT_UNITS" "available holdings are not enough for the requested redemption units") next ctx + with _ -> + return! invokeHandler (errorResponse 500 "PERSISTENCE_ERROR" "redemption persistence failed") next ctx + } + + let private getRedemptions (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 orders = repository.GetRedemptionOrders fundId + json (orders |> List.map redemptionResponse) next ctx + with _ -> + errorResponse 500 "PERSISTENCE_ERROR" "redemption persistence failed" next ctx + + let private confirmRedemption (repository: FundRepository) (fundIdText: string) (orderIdText: string) : HttpHandler = + fun next ctx -> + match Guid.TryParse fundIdText, Guid.TryParse orderIdText with + | (false, _), _ + | _, (false, _) -> + errorResponse 400 "INVALID_CONFIRM_REQUEST" "fund id and order id must be UUIDs" next ctx + | (true, fundId), (true, orderId) -> + let idempotencyKey = ctx.Request.Headers["Idempotency-Key"].ToString() + + try + match repository.ConfirmRedemptionOrder(idempotencyKey, fundId, orderId) with + | RedemptionConfirmed order + | RedemptionConfirmReplayed order + | RedemptionPendingNav order -> json (redemptionResponse order) next ctx + | RedemptionConfirmIdempotencyConflict -> + errorResponse 409 "IDEMPOTENCY_CONFLICT" "idempotency key was used with a different request" next ctx + | RedemptionAlreadyConfirmed -> + errorResponse 409 "ORDER_ALREADY_CONFIRMED" "order was already confirmed with a different idempotency key" next ctx + | RedemptionOrderNotFound -> errorResponse 404 "ORDER_NOT_FOUND" "order was not found" next ctx + | RedemptionInvalidStatus -> + errorResponse 409 "ORDER_INVALID_STATUS" "order is not in a confirmable status" next ctx + | RedemptionConfirmResult.RedemptionInvalid message -> + errorResponse 400 "INVALID_CONFIRM_REQUEST" message next ctx + with _ -> + errorResponse 500 "PERSISTENCE_ERROR" "redemption confirmation failed" next ctx + let private marketDataError (failure: MarketDataFailure) : HttpHandler = let status, error, message = match failure with @@ -579,6 +719,9 @@ module App = POST >=> routef "/funds/%s/orders" (createOrder repository) GET >=> routef "/funds/%s/orders" (getOrders repository) POST >=> routef "/funds/%s/orders/%s/confirm" (fun (fundId, orderId) -> confirmOrder repository fundId orderId) + POST >=> routef "/funds/%s/redemptions" (createRedemption repository) + 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) GET >=> routef "/funds/%s" (getFund repository) ] |