From 30ded282943d2fa433fcd8897c893acab4827887 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sun, 9 Jun 2024 23:10:28 +0800 Subject: [PATCH 1/7] Fix bug on pay fee with limit (Due pct) --- src/Deal/DealAction.hs | 15 +++++++++------ swagger.json | 31 +------------------------------ 2 files changed, 10 insertions(+), 36 deletions(-) diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 7de3ed8f..97277c58 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -733,17 +733,20 @@ performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFee mLimit an fns supportAvail = case mSupport of Just support -> sum ( evalExtraSupportBalance d t support) Nothing -> 0 - amtAvailable = case mLimit of - Nothing -> availAccBal + supportAvail - Just (DS ds) -> min (availAccBal + supportAvail) $ queryDeal t (patchDateToStats d ds) - Just (DueCapAmt amt) -> min amt $ availAccBal + supportAvail - + feesToPay = map (feeMap Map.!) fns feeDueAmts = map F.feeDue feesToPay + + amtAvailable = availAccBal + supportAvail -- Just (DuePct pct) -> map (\x -> mulBR (F.feeDue x) pct ) feesToPay -- Just (DueCapAmt amt) -> prorataFactors (F.feeDue <$> feesToPay) amt + dueAmtAfterCap = case mLimit of + Nothing -> sum feeDueAmts + Just (DS ds) -> min (queryDeal t (patchDateToStats d ds)) $ sum feeDueAmts + Just (DueCapAmt amt) -> min amt $ sum feeDueAmts + Just (DuePct pct) -> mulBR (sum feeDueAmts) pct -- total actual pay out - actualPaidOut = min amtAvailable $ sum feeDueAmts -- `debug` ("Fee Due Amounts"++show(feeDueAmts)) + actualPaidOut = min amtAvailable dueAmtAfterCap feesAmountToBePaid = zip feesToPay $ prorataFactors feeDueAmts actualPaidOut feesPaid = map (\(f,amt) -> F.payFee d amt f) feesAmountToBePaid diff --git a/swagger.json b/swagger.json index 9f710fd7..94f83f94 100644 --- a/swagger.json +++ b/swagger.json @@ -6407,35 +6407,6 @@ "title": "BondDuePrin", "type": "object" }, - { - "properties": { - "contents": { - "items": [ - { - "type": "string" - }, - { - "$ref": "#/components/schemas/DealStats" - } - ], - "maxItems": 2, - "minItems": 2, - "type": "array" - }, - "tag": { - "enum": [ - "BondGroup" - ], - "type": "string" - } - }, - "required": [ - "tag", - "contents" - ], - "title": "BondGroup", - "type": "object" - }, { "properties": { "contents": { @@ -16352,7 +16323,7 @@ "name": "BSD 3" }, "title": "Hastructure API", - "version": "0.28.1" + "version": "0.28.2" }, "openapi": "3.0.0", "paths": { From 994e1cc17c3c5dc9d875627ffdafa7301a2d0ec5 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Sun, 9 Jun 2024 23:12:03 +0800 Subject: [PATCH 2/7] bump version to-> < 0.28.3 > --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index d9cb9a58..92e3ebfe 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -102,7 +102,7 @@ $(deriveJSON defaultOptions ''Version) instance ToSchema Version version1 :: Version -version1 = Version "0.28.2" +version1 = Version "0.28.3" data DealType = MDeal (DB.TestDeal AB.Mortgage) From 2fa5bd3b5d33c464426d6cec494a1a4fb6ba8dcd Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Mon, 10 Jun 2024 00:29:58 +0800 Subject: [PATCH 3/7] fix --- ChangeLog.md | 5 +++++ src/Deal/DealAction.hs | 11 ++++++----- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 3752dd27..31b7f60d 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for Hastructure +## 0.28.3 +### TODO +* FIX: `limit` on `payFee` was not working with `duePct` + + ## 0.28.2 ### 2024-05-27 * NEW: enable `trigger` to run waterfall `actions` diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 97277c58..da0f4b7d 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -736,15 +736,16 @@ performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFee mLimit an fns feesToPay = map (feeMap Map.!) fns feeDueAmts = map F.feeDue feesToPay + feeTotalDueAmt = sum feeDueAmts amtAvailable = availAccBal + supportAvail -- Just (DuePct pct) -> map (\x -> mulBR (F.feeDue x) pct ) feesToPay -- Just (DueCapAmt amt) -> prorataFactors (F.feeDue <$> feesToPay) amt dueAmtAfterCap = case mLimit of - Nothing -> sum feeDueAmts - Just (DS ds) -> min (queryDeal t (patchDateToStats d ds)) $ sum feeDueAmts - Just (DueCapAmt amt) -> min amt $ sum feeDueAmts - Just (DuePct pct) -> mulBR (sum feeDueAmts) pct + Nothing -> feeTotalDueAmt + Just (DS ds) -> min (queryDeal t (patchDateToStats d ds)) feeTotalDueAmt + Just (DueCapAmt amt) -> min amt feeTotalDueAmt + Just (DuePct pct) -> mulBR feeTotalDueAmt pct -- total actual pay out actualPaidOut = min amtAvailable dueAmtAfterCap @@ -755,7 +756,7 @@ performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFee mLimit an fns dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (SeqPayFee fns)) an accMap ,fees = Map.fromList (zip fns feesPaid) <> feeMap} - supportPaidOut = sum feeDueAmts - accPaidOut + supportPaidOut = dueAmtAfterCap - accPaidOut performAction d t (W.AccrueAndPayIntBySeq mLimit an bnds mSupport) = let From b85622dab84f2093369f69f488a627dc227de693 Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Mon, 10 Jun 2024 00:30:30 +0800 Subject: [PATCH 4/7] bump version to-> < 0.28.4 > --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 92e3ebfe..d285ec4c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -102,7 +102,7 @@ $(deriveJSON defaultOptions ''Version) instance ToSchema Version version1 :: Version -version1 = Version "0.28.3" +version1 = Version "0.28.4" data DealType = MDeal (DB.TestDeal AB.Mortgage) From 3ada8ccedea4ec8d8c448e899c33a0770c7794bb Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Mon, 10 Jun 2024 12:56:26 +0800 Subject: [PATCH 5/7] add end date for dates projection --- app/Main.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index d285ec4c..d201037e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -337,7 +337,7 @@ data RunPoolReq = SingleRunPoolReq PoolTypeWrap (Maybe AP.ApplyAssumptionType) ( instance ToSchema RunPoolReq -data RunDateReq = RunDateReq Date DatePattern +data RunDateReq = RunDateReq Date DatePattern (Maybe Date) deriving(Show, Generic) instance ToSchema RunDateReq @@ -402,7 +402,10 @@ runMultiDeals :: RunDealReq -> Handler (Map.Map ScenarioName RunResp) runMultiDeals (MultiDealRunReq mDts assump nonPerfAssump) = return $ Map.map (\singleDealType -> wrapRun singleDealType assump nonPerfAssump) mDts runDate :: RunDateReq -> Handler [Date] -runDate (RunDateReq sd dp) = return $ DU.genSerialDatesTill2 IE sd dp (Lib.toDate "20990101") +runDate (RunDateReq sd dp md) = return $ + case md of + Nothing -> DU.genSerialDatesTill2 IE sd dp (Lib.toDate "20990101") + Just d -> DU.genSerialDatesTill2 IE sd dp d myServer :: ServerT API Handler myServer = return engineSwagger From accd84b2a23bf189392b3c743c23bbca47ae63ec Mon Sep 17 00:00:00 2001 From: Xiaoyu Date: Mon, 10 Jun 2024 12:58:42 +0800 Subject: [PATCH 6/7] bump version to-> < 0.28.5 > --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index d201037e..65a9196a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -102,7 +102,7 @@ $(deriveJSON defaultOptions ''Version) instance ToSchema Version version1 :: Version -version1 = Version "0.28.4" +version1 = Version "0.28.5" data DealType = MDeal (DB.TestDeal AB.Mortgage) From 3d85e5309c5e8066b72976480398f66384f54e14 Mon Sep 17 00:00:00 2001 From: yellowbean Date: Thu, 13 Jun 2024 01:02:40 +0800 Subject: [PATCH 7/7] init commit: expose trigger stmt --- src/Deal.hs | 28 ++++++++++++++++------------ src/Deal/DealAction.hs | 26 +++++++++++++++++--------- src/Stmt.hs | 3 +++ src/Triggers.hs | 4 +++- src/Types.hs | 7 ++++++- 5 files changed, 45 insertions(+), 23 deletions(-) diff --git a/src/Deal.hs b/src/Deal.hs index 374f6519..03a3648e 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -249,9 +249,9 @@ queryTrigger t@TestDeal{ triggers = trgs } wt Just _trgs -> maybe [] Map.elems $ Map.lookup wt _trgs -- ^ run trigger sequentially -testTriggers :: Ast.Asset a => TestDeal a -> Date -> [Trigger] -> Bool -testTriggers t d [] = False -testTriggers t d triggers = any (testTrigger t d) triggers +-- testTriggers :: Ast.Asset a => TestDeal a -> Date -> [Trigger] -> Bool +-- testTriggers t d [] = False +-- testTriggers t d triggers = any (testTrigger t d) triggers -- ^ execute effects of trigger: making changes to deal runEffects :: Ast.Asset a => (TestDeal a, RunContext a) -> Date -> TriggerEffect -> (TestDeal a, RunContext a) @@ -271,7 +271,7 @@ runEffects (t@TestDeal{accounts = accMap, fees = feeMap },rc) d te DoNothing -> (t, rc) _ -> error $ "Failed to match trigger effects: "++show te --- ^ test trigger and add a log if deal status changed +-- ^ test triggers in the deal and add a log if deal status changed runTriggers :: Ast.Asset a => (TestDeal a, RunContext a) -> Date -> DealCycle -> (TestDeal a, RunContext a,[ResultComponent]) runTriggers (t@TestDeal{status=oldStatus, triggers = Nothing},rc) d dcycle = (t, rc, []) runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc) d dcycle = @@ -281,14 +281,18 @@ runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc) d dcycle = -- get triggeres to run at `dealCycle` trgsMap = Map.findWithDefault Map.empty dcycle trgM - -- triggered trigger - triggeredTrgs = Map.filter - (\trg -> - (not (trgStatus trg) || trgStatus trg && trgCurable trg) && testTrigger t d trg) + + -- get a map of triggers to test + trgsToTest = Map.filter + (\trg -> (not (trgStatus trg) || trgStatus trg && trgCurable trg)) trgsMap + -- test triggers + triggeredTrgs = Map.map + (\trg -> testTrigger t d trg) + trgsToTest - -- extract trigger effects to run - triggeredEffects = [ trgEffects _trg | _trg <- Map.elems triggeredTrgs ] + -- extract trigger effects to run, if the trigger is true + triggeredEffects = [ trgEffects _trg | _trg <- Map.elems triggeredTrgs, (trgStatus _trg) ] -- run effects on deals -- aka (\_t _te -> runEffects _t d _te) @@ -301,7 +305,7 @@ runTriggers (t@TestDeal{status=oldStatus, triggers = Just trgM},rc) d dcycle = -- new status of trigger, update status of trigger to True triggeredNames = Map.keys triggeredTrgs - newTriggers = Map.union (Map.map (set trgStatusLens True) triggeredTrgs) trgsMap + newTriggers = Map.union triggeredTrgs trgsMap run :: Ast.Asset a => TestDeal a -> Map.Map PoolId CF.CashFlowFrame -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe [C.CallOption] @@ -999,4 +1003,4 @@ depositPoolFlow rules d pFlowMap amap -- = foldr (\pflowM acc -> depositPoolInflow rules d pflowM acc) amap $ pFlowMap `debug` ("Deposit p fd"++ show (Map.elems pFlowMap)) = foldr (\rule acc -> depositInflow d rule pFlowMap acc) amap rules -$(deriveJSON defaultOptions ''ExpectReturn) \ No newline at end of file +$(deriveJSON defaultOptions ''ExpectReturn) diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index da0f4b7d..924fdeb8 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -77,15 +77,22 @@ getPoolFlows t@TestDeal{ pool = _pool } sd ed rt = where trs = getAllCollectedTxnsList t Nothing -testTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Bool -testTrigger t d trigger@Trigger{ trgStatus=st,trgCurable=cure,trgCondition=cond } - | not cure && st = True - | otherwise = testPre d t cond -updateTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Trigger -updateTrigger t d trigger@Trigger{ trgStatus=st,trgCurable=cure,trgCondition=cond} - | testTrigger t d trigger = trigger {trgStatus = True} - | otherwise = trigger +-- ^ +testTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Trigger +testTrigger t d trigger@Trigger{trgStatus=st,trgCurable=curable,trgCondition=cond,trgStmt = tStmt} + | not curable && st = trigger + | otherwise = let + newSt = testPre d t cond + newTxn = TrgTxn d newSt Stmt.Empty + in + trigger { trgStatus = newSt + , trgStmt = Stmt.appendStmt tStmt newTxn} + +-- updateTrigger :: Ast.Asset a => TestDeal a -> Date -> Trigger -> Trigger +-- updateTrigger t d trigger@Trigger{ trgStatus=st,trgCurable=cure,trgCondition=cond} +-- | testTrigger t d trigger = trigger {trgStatus = True} +-- | otherwise = trigger pricingAssets :: PricingMethod -> [ACM.AssetUnion] -> Date -> Amount pricingAssets (BalanceFactor currentfactor defaultfactor) assets d = 0 @@ -1345,6 +1352,7 @@ performAction d t@TestDeal{rateSwap = Just rtSwap, accounts = accsMap } (W.SwapS performAction d t@TestDeal{ triggers = Just trgM } (W.RunTrigger loc tName) = t { triggers = Just (Map.insert loc newMap trgM) } where - newMap = Map.adjust (updateTrigger t d) tName (trgM Map.! loc) + -- newMap = Map.adjust (updateTrigger t d) tName (trgM Map.! loc) + newMap = Map.adjust (testTrigger t d) tName (trgM Map.! loc) performAction d t action = error $ "failed to match action>>"++show action++">>Deal"++show (name t) diff --git a/src/Stmt.hs b/src/Stmt.hs index e001ea03..c041a219 100644 --- a/src/Stmt.hs +++ b/src/Stmt.hs @@ -72,6 +72,7 @@ getTxnComment (ExpTxn _ _ _ _ t ) = t getTxnComment (SupportTxn _ _ _ _ _ _ t ) = t getTxnComment (IrsTxn _ _ _ _ _ _ t ) = t getTxnComment (EntryTxn _ _ _ t ) = t +getTxnComment (TrgTxn _ _ t) = t getTxnBalance :: Txn -> Balance getTxnBalance (BondTxn _ t _ _ _ _ _ _ _ _) = t @@ -96,6 +97,7 @@ getTxnAmt (ExpTxn _ _ t _ _ ) = t getTxnAmt (SupportTxn _ _ t _ _ _ _) = t getTxnAmt (IrsTxn _ _ t _ _ _ _ ) = t getTxnAmt (EntryTxn _ _ t _) = t +getTxnAmt (TrgTxn {} ) = 0.0 getTxnAsOf :: [Txn] -> Date -> Maybe Txn getTxnAsOf txns d = find (\x -> getDate x <= d) $ reverse txns @@ -107,6 +109,7 @@ emptyTxn ExpTxn {} d = ExpTxn d 0 0 0 Empty emptyTxn SupportTxn {} d = SupportTxn d Nothing 0 0 0 0 Empty emptyTxn IrsTxn {} d = IrsTxn d 0 0 0 0 0 Empty emptyTxn EntryTxn {} d = EntryTxn d 0 0 Empty +emptyTxn TrgTxn {} d = TrgTxn d False Empty isEmptyTxn :: Txn -> Bool isEmptyTxn (BondTxn _ 0 0 0 _ 0 0 0 _ _) = True diff --git a/src/Triggers.hs b/src/Triggers.hs index 61f033d1..1634b4e4 100644 --- a/src/Triggers.hs +++ b/src/Triggers.hs @@ -8,6 +8,7 @@ module Triggers( where import qualified Data.Text as T +import qualified Stmt as S import Text.Read (readMaybe) import Lib ( Pre, DealStatus ) import Types @@ -43,6 +44,7 @@ data Trigger = Trigger { ,trgEffects :: TriggerEffect -- ^ what happen if it was triggered ,trgStatus :: Bool -- ^ if it is triggered or not ,trgCurable :: Bool -- ^ if it is curable trigger + ,trgStmt :: Maybe S.Statement -- ^ Transaction stmt } deriving (Show, Eq, Generic,Ord) makeLensesFor [("trgStatus","trgStatusLens") @@ -50,4 +52,4 @@ makeLensesFor [("trgStatus","trgStatusLens") ,("trgCondition","trgConditionLens") ,("trgCurable","trgCurableLens")] ''Trigger -$(concat <$> traverse (deriveJSON defaultOptions) [''TriggerEffect, ''Trigger]) \ No newline at end of file +$(concat <$> traverse (deriveJSON defaultOptions) [''TriggerEffect, ''Trigger]) diff --git a/src/Types.hs b/src/Types.hs index 6163028d..6d1fef85 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -24,7 +24,7 @@ module Types ,RoundingBy(..),DateDirection(..) ,TxnComment(..),BookDirection(..),DealStatType(..),getDealStatType ,Liable(..),CumPrepay,CumDefault,CumDelinq,CumPrincipal,CumLoss,CumRecovery,PoolId(..) - ,DealName,lookupIntervalTable,getPriceValue,Txn(..) + ,DealName,lookupIntervalTable,getPriceValue,Txn(..),preToStr ) where @@ -352,12 +352,15 @@ type DueInt = Balance type DuePremium = Balance type DueIoI = Balance + + data Txn = BondTxn Date Balance Interest Principal IRate Cash DueInt DueIoI (Maybe Float) TxnComment -- ^ bond transaction record for interest and principal | AccTxn Date Balance Amount TxnComment -- ^ account transaction record | ExpTxn Date Balance Amount Balance TxnComment -- ^ expense transaction record | SupportTxn Date (Maybe Balance) Amount Balance DueInt DuePremium TxnComment -- ^ liquidity provider transaction record | IrsTxn Date Balance Amount IRate IRate Balance TxnComment -- ^ interest swap transaction record | EntryTxn Date Balance Amount TxnComment -- ^ ledger book entry + | TrgTxn Date Bool TxnComment deriving (Show, Generic, Eq) @@ -675,6 +678,8 @@ data Pre = IfZero DealStats | All [Pre] -- ^ deriving (Show,Generic,Eq,Ord) +preToStr :: Pre -> String +preToStr p = show p type BookItems = [BookItem]