0.30.x (#216)

* fix revolve buy when building balance; avoid duplicate run waterfall in call
* "expose combo sensitivity endpoint"
* expose pricing for bond groups
* expose single clear ledger function
* expose writeoffBySeq
* expose which pool to liquidate
* add new assumption curve with padding last value to rest
* expose extra Stress on ppy/def curve
* expose transferMultiple

Author: yellowbean

.github/workflows/docker-image-dev-by-tag.yml

@@ -39,7 +39,7 @@ jobs:
           ls -la .
           rm -rf /opt/ghc
           rm -rf /opt/hostedtoolcache
-
+          
       -
         name: Build and push
         uses: docker/build-push-action@v3
@@ -48,4 +48,4 @@ jobs:
           push: true
           tags: ${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:dev, ${{ steps.meta.outputs.tags }}
           cache-from: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache
-          cache-to: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache,mode=max     
+          cache-to: type=registry,ref=${{ secrets.DOCKER_HUB_USERNAME }}/hastructure:buildcache,mode=max  

Hastructure.cabal

@@ -160,6 +160,7 @@ test-suite Hastructure-test
       UT.BondTest
       UT.CashflowTest
       UT.DealTest
+      UT.DealTest2
       UT.ExpTest
       UT.InterestRateTest
       UT.LibTest

app/Main.hs

@@ -44,6 +44,7 @@ import qualified Data.ByteString.Char8 as BS
 import Lucid hiding (type_)
 import Network.Wai
 import Network.Wai.Handler.Warp
+import Network.Wai.Middleware.Cors
 import qualified Data.Aeson.Parser
 import Language.Haskell.TH
 
@@ -102,7 +103,7 @@ $(deriveJSON defaultOptions ''Version)
 instance ToSchema Version
 
 version1 :: Version 
-version1 = Version "0.29.5"
+version1 = Version "0.29.17"
 
 
 
@@ -343,9 +344,10 @@ wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates (Just pm
 type ScenarioName = String
 
 data RunDealReq = SingleRunReq DealType (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption
-                | MultiScenarioRunReq DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption
-                | MultiDealRunReq (Map.Map ScenarioName DealType) (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption
-                | MultiRunAssumpReq DealType (Maybe AP.ApplyAssumptionType) (Map.Map ScenarioName AP.NonPerfAssumption)
+                | MultiScenarioRunReq DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption --- multi pool perf
+                | MultiDealRunReq (Map.Map ScenarioName DealType) (Maybe AP.ApplyAssumptionType) AP.NonPerfAssumption  -- multi deal struct
+                | MultiRunAssumpReq DealType (Maybe AP.ApplyAssumptionType) (Map.Map ScenarioName AP.NonPerfAssumption) -- multi run assump 
+                | MultiComboReq (Map.Map ScenarioName DealType)  (Map.Map ScenarioName (Maybe AP.ApplyAssumptionType))  (Map.Map ScenarioName AP.NonPerfAssumption)
                 deriving(Show, Generic)
 
 data RunSimDealReq = OASReq DealType (Map.Map ScenarioName AP.ApplyAssumptionType) AP.NonPerfAssumption
@@ -382,10 +384,9 @@ type EngineAPI = "version" :> Get '[JSON] Version
             :<|> "runDealByScenarios" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] (Map.Map ScenarioName RunResp)
             :<|> "runMultiDeals" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] (Map.Map ScenarioName RunResp)
             :<|> "runDealByRunScenarios" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] (Map.Map ScenarioName RunResp)
+            :<|> "runByCombo" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] (Map.Map String RunResp)
             :<|> "runDate" :> ReqBody '[JSON] RunDateReq :> Post '[JSON] [Date]
 
--- instance NFData [Date]
-
 
 engineAPI :: Proxy EngineAPI
 engineAPI = Proxy
@@ -433,7 +434,19 @@ runDate (RunDateReq sd dp md) = return $
 
 runDealByRunScenarios :: RunDealReq -> Handler (Map.Map ScenarioName RunResp)
 runDealByRunScenarios (MultiRunAssumpReq dt mAssump nonPerfAssumpMap)
-  = return $ Map.map (\singleAssump -> wrapRun dt mAssump singleAssump) nonPerfAssumpMap
+  = return $ Map.map (wrapRun dt mAssump) nonPerfAssumpMap
+
+
+runDealByCombo :: RunDealReq -> Handler (Map.Map String RunResp)
+runDealByCombo (MultiComboReq dMap assumpMap nonPerfAssumpMap)
+  = let 
+      dList = Map.toList dMap
+      aList = Map.toList assumpMap
+      nList = Map.toList nonPerfAssumpMap
+      r = [ (intercalate "^" [dk,ak,nk], wrapRun d a n) | (dk,d) <- dList, (ak,a) <- aList, (nk,n) <- nList ]
+      rMap = Map.fromList r
+    in 
+      return rMap -- `debug` ("RunDealByCombo->"++ show rMap)
 
 
 myServer :: ServerT API Handler
@@ -446,6 +459,7 @@ myServer =  return engineSwagger
       :<|> runDealScenarios
       :<|> runMultiDeals
       :<|> runDealByRunScenarios
+      :<|> runDealByCombo
       :<|> runDate
 --      :<|> error "not implemented"
 
@@ -459,7 +473,9 @@ data Config = Config { port :: Int}
 instance FromJSON Config
 
 app :: Application
-app = serve (Proxy :: Proxy API) myServer
+-- app = serve (Proxy :: Proxy API) myServer
+app = simpleCors $ serve (Proxy :: Proxy API) myServer
+
 
 
 main :: IO ()

src/Asset.hs

@@ -167,6 +167,16 @@ buildPrepayRates ds mPa =
                                     Util.toPeriodRateByInterval
                                     (paddingDefault 0.0 vs (pred size))
                                     (getIntervalDays ds)
+    Just (A.PrepaymentVecPadding vs) -> zipWith 
+                                         Util.toPeriodRateByInterval
+                                         (paddingDefault (last vs) vs (pred size))
+                                         (getIntervalDays ds)
+    Just (A.PrepayStressByTs ts x) -> 
+      let 
+        rs = buildPrepayRates ds (Just x)
+      in 
+        getTsVals $ multiplyTs Exc (zipTs (tail ds) rs) ts 
+
     _ -> error ("failed to find prepayment type"++ show mPa)
   where
     size = length ds
@@ -175,18 +185,30 @@ buildDefaultRates :: [Date] -> Maybe A.AssetDefaultAssumption -> [Rate]
 buildDefaultRates ds Nothing = replicate (pred (length ds)) 0.0
 buildDefaultRates ds mDa = 
   case mDa of
-    Just (A.DefaultConstant r) ->  replicate size r
+    Just (A.DefaultConstant r) -> replicate size r
     Just (A.DefaultCDR r) -> Util.toPeriodRateByInterval r <$> getIntervalDays ds
     Just (A.DefaultVec vs) -> zipWith 
                                 Util.toPeriodRateByInterval
                                 (paddingDefault 0.0 vs (pred size))
                                 (getIntervalDays ds)
+    Just (A.DefaultVecPadding vs) -> zipWith 
+                                      Util.toPeriodRateByInterval
+                                      (paddingDefault (last vs) vs (pred size))
+                                      (getIntervalDays ds)
     Just (A.DefaultAtEndByRate r rAtEnd)
       -> case size of 
           0 -> []
           1 -> []
           _ -> (Util.toPeriodRateByInterval r <$> getIntervalDays (init ds)) ++ (Util.toPeriodRateByInterval rAtEnd <$> getIntervalDays [head ds,last ds])
 
+    Just (A.DefaultStressByTs ts x) -> 
+      let 
+        rs = buildDefaultRates ds (Just x)
+        r = getTsVals $ multiplyTs Inc (zipTs (tail ds) rs) ts 
+      in 
+        r -- `debug` ("Default Stress"++ show [ (fromRational x)::Float | x <- r] )
+
+
     _ -> error ("failed to find prepayment type"++ show mDa)    
   where
     size = length ds

src/AssetClass/FixedAsset.hs

@@ -102,6 +102,8 @@ instance Ast.Asset FixedAsset where
         cumuDepreciation = tail $ scanl (+) cumuDep amortizedBals 
 
         txns = zipWith6 CF.FixedFlow pdates scheduleBals amortizedBals cumuDepreciation units cash
+        futureTxns = cutBy Inc Future asOfDay txns
+        begBal = CF.buildBegBal futureTxns
       in 
-        (CF.CashFlowFrame (head scheduleBals,asOfDay,Nothing) $ cutBy Inc Future asOfDay txns, Map.empty)
+        (CF.CashFlowFrame (begBal,asOfDay,Nothing) $ futureTxns, Map.empty)
 

src/AssetClass/Installment.hs

@@ -72,7 +72,7 @@ projectInstallmentFlow (startBal, lastPaidDate, (originRepay,originInt), startRa
 
 instance Asset Installment where
   calcCashflow inst@(Installment (LoanOriginalInfo ob or ot p sd ptype _) cb rt st) asOfDay _
-    = CF.CashFlowFrame (cb,asOfDay,Nothing) flows 
+    = CF.CashFlowFrame (begBal,asOfDay,Nothing) flows 
      where 
         lastPayDate:cf_dates = lastN (rt+1) $ sd:getPaymentDates inst 0
         opmt = divideBI ob ot  
@@ -99,6 +99,7 @@ instance Asset Installment where
                                         (replicate _rt orate) (replicate _rt Nothing)
 
         flows = cutBy Inc Future asOfDay _flows
+        begBal = CF.buildBegBal flows
 
 
   getCurrentBal (Installment _ b _ _ ) = b
@@ -130,7 +131,7 @@ instance Asset Installment where
                asOfDay 
                pAssump@(A.InstallmentAssump defaultAssump prepayAssump recoveryAssump ams,_,_)
                mRates
-      = (applyHaircut ams (CF.CashFlowFrame (cb,asOfDay,Nothing) futureTxns), historyM)
+      = (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM)
         where 
           recoveryLag = maybe 0 getRecoveryLag recoveryAssump
           lastPayDate:cfDates = lastN (rt + recoveryLag +1) $ sd:getPaymentDates inst recoveryLag
@@ -149,6 +150,7 @@ instance Asset Installment where
           defRates = Ast.buildDefaultRates (lastPayDate:cfDates) defaultAssump
           (txns,_) = projectInstallmentFlow (cb,lastPayDate,(opmt,ofee),orate,currentFactor,pt,ot) (cfDates,defRates,ppyRates,remainTerms) 
           (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns recoveryAssump)
+          begBal = CF.buildBegBal futureTxns
 
 
   -- ^ project with defaulted at a date
@@ -162,8 +164,10 @@ instance Asset Installment where
          recoveries = calcRecoveriesFromDefault cb rr timing
          bals = scanl (-) cb recoveries
          _txns = [  CF.LoanFlow d b 0 0 0 0 r 0 cr Nothing | (b,d,r) <- zip3 bals cf_dates2 recoveries ]
+         futureTxns = cutBy Inc Future asOfDay $ beforeRecoveryTxn++_txns
+         begBal = CF.buildBegBal futureTxns
       in 
-         (CF.CashFlowFrame (cb,asOfDay,Nothing)$ cutBy Inc Future asOfDay (beforeRecoveryTxn++_txns),Map.empty)
+         (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns ,Map.empty)
       where 
         cr = getOriginRate inst
 

src/AssetClass/Lease.hs

@@ -211,7 +211,7 @@ instance Asset Lease where
       = fst . patchBalance $ RegularLease (LeaseInfo sd ot dp dr ob) bal ot st
 
     projCashflow l asOfDay ((AP.LeaseAssump gapAssump rentAssump ed exStress),_,_) mRates
-      = (CF.CashFlowFrame (0,asOfDay,Nothing) allTxns, Map.empty)  
+      = (CF.CashFlowFrame (begBal,asOfDay,Nothing) allTxns, Map.empty)  
       where 
         currentCf = calcCashflow l asOfDay mRates
         -- (rc,rcCurve,mgTbl,gapDays,ed) = extractAssump (A.LeaseAssump gapAssump rentAssump) -- (0.0,mkTs [],([(0.0,0)],0),0,epocDate)-- `debug` ("7")
@@ -232,6 +232,8 @@ instance Asset Lease where
                       []
         newCfs = [ calcCashflow l asOfDay mRates | l <- newLeases ]  -- `debug` ("new leases"++ show newLeases )
         allTxns = view CF.cashflowTxn currentCf ++ (concat $ (view CF.cashflowTxn) <$> newCfs)
+        begBal = CF.buildBegBal allTxns
+        
 
     getCurrentBal l = case l of 
                         StepUpLease _ _ bal _ _ -> bal

src/AssetClass/Loan.hs

@@ -127,7 +127,7 @@ instance Asset Loan where
                asOfDay 
                (A.LoanAssump defaultAssump prepayAssump recoveryAssump ams,_,_)
                mRate 
-    = (applyHaircut ams (CF.CashFlowFrame (cb,asOfDay,Nothing) futureTxns), historyM)
+    = (applyHaircut ams (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns), historyM)
     where
       recoveryLag = maybe 0 getRecoveryLag recoveryAssump
       lastPayDate:cfDates = lastN (rt + recoveryLag + 1) $ sd:getPaymentDates pl recoveryLag
@@ -143,8 +143,9 @@ instance Asset Loan where
                       in 
                         divideBB cb (scheduleBals!!(ot - rt))
                      _ -> 1.0  
-      (txns,_) = projectLoanFlow ((ob,ot,getOriginRate pl), cb,lastPayDate,prinPayType,dc,cr,initFactor) (cfDates,defRates,ppyRates,rateVector,remainTerms)  `debug` (" rateVector"++show rateVector)
+      (txns,_) = projectLoanFlow ((ob,ot,getOriginRate pl), cb,lastPayDate,prinPayType,dc,cr,initFactor) (cfDates,defRates,ppyRates,rateVector,remainTerms)  -- `debug` (" rateVector"++show rateVector)
       (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns recoveryAssump)
+      begBal = CF.buildBegBal futureTxns
 
   -- ^ Project cashflow for defautled loans 
   projCashflow m@(PersonalLoan (LoanOriginalInfo ob or ot p sd prinPayType _) cb cr rt (Defaulted (Just defaultedDate))) 
@@ -158,8 +159,9 @@ instance Asset Loan where
         _txns = [  CF.LoanFlow d 0 0 0 0 0 r 0 cr Nothing | (d,r) <- zip cf_dates2 recoveries ]
         (_, txns) = splitByDate (beforeRecoveryTxn++_txns) asOfDay EqToRight -- `debug` ("AS OF Date"++show asOfDay)
         (futureTxns,historyM) = CF.cutoffTrs asOfDay txns 
+        begBal = CF.buildBegBal futureTxns
       in 
-        (CF.CashFlowFrame (cb,asOfDay,Nothing) futureTxns, historyM)
+        (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns, historyM)
 
   projCashflow m@(PersonalLoan (LoanOriginalInfo ob or ot p sd prinPayType _) cb cr rt (Defaulted Nothing)) asOfDay assumps _
     = (CF.CashFlowFrame (cb,asOfDay,Nothing) [CF.LoanFlow asOfDay 0 0 0 0 0 0 0 cr Nothing],Map.empty)

src/AssetClass/MixedAsset.hs

@@ -217,6 +217,7 @@ projAssetUnion (ACM.PF ast) d assumps mRates = P.projCashflow ast d assumps mRat
 projAssetUnion x _ _ _ = error ("Failed to match  proj AssetUnion"++ show x)
 
 projAssetUnionList :: [ACM.AssetUnion] -> Date -> A.ApplyAssumptionType -> Maybe [RateAssumption] -> (CF.CashFlowFrame, Map.Map CutoffFields Balance)
+projAssetUnionList [] d (A.PoolLevel assetPerf) mRate = (CF.CashFlowFrame (0,d,Nothing) [], Map.empty)
 projAssetUnionList assets d (A.PoolLevel assetPerf) mRate =
   let 
     results = [ projAssetUnion asset d assetPerf mRate | asset <- assets ]