Sep26

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

@@ -49,9 +49,12 @@ jobs:
         uses: docker/build-push-action@v3
         with:
           platforms: linux/amd64,linux/arm64
-          push: true
+          push: true    
+          build-args: |
+            CFLAGS=-march=armv8-a
+            CPPFLAGS=-march=armv8-a
           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  
 
-
+

.gitignore

@@ -0,0 +1 @@
+dist-newstyle/

CHANGELOG.md

@@ -1,6 +1,11 @@
 # Changelog for Hastructure
 
 <!-- towncrier release notes start -->
+## 0.52.6
+### 2026-09-27
+* NEW: add new prepayment assumption `PrepaymentABS`, an ABS / absolute prepayment model driven by the asset's seasoning (months elapsed since origin). Supported for `Monthly` assets only.
+* FIX: pool-level `DefaultByAmt` is now allocated across multiple assets proportionally to their current balance.
+
 ## 0.52.5
 ### 2026-08-23
 

Dockerfile

@@ -1,21 +1,21 @@
-FROM haskell:9.8.4-slim-bullseye as build
-RUN mkdir /opt/build
-COPY . /opt/build
-RUN cd /opt/build && cabal update && cabal install
-
+FROM --platform=$BUILDPLATFORM haskell:9.8.4-slim-bullseye AS build
 
-FROM --platform=linux/amd64 ubuntu:25.04
-RUN mkdir -p /opt/myapp
-ARG BINARY_PATH
-WORKDIR /opt/myapp
-RUN apt-get update && apt-get install -y \
-  ca-certificates \
-  libgmp-dev
-# NOTICE THIS LINE
+ARG TARGETPLATFORM
+RUN case "$TARGETPLATFORM" in \
+      linux/arm64) \
+        export CFLAGS="-march=armv8-a" \
+        export CPPFLAGS="-march=armv8-a" ;; \
+      *) ;; \
+    esac
 
+WORKDIR /opt/build
+COPY . /opt/build
+RUN cabal update && cabal install
 
+FROM ubuntu:25.04
+WORKDIR /opt/myapp
+RUN apt-get update && apt-get install -y ca-certificates libgmp-dev
 COPY --from=build /root/.local/bin/Hastructure-exe .
 COPY --from=build /opt/build/config.yml .
 COPY --from=build /opt/build/swagger.json .
-#COPY config.yml /opt/myapp
 CMD ["/opt/myapp/Hastructure-exe"]

Hastructure.cabal

@@ -5,7 +5,7 @@ cabal-version: 3.0
 -- see: https://github.com/sol/hpack
 
 name:           Hastructure
-version: 0.52.5
+version: 0.52.7
 synopsis:       Cashflow modeling library for structured finance
 description:    Please see the README on GitHub at <https://github.com/absbox/Hastructure#readme>
 category:       StructuredFinance,Securitisation,Cashflow
@@ -193,6 +193,7 @@ test-suite Hastructure-test
       UT.ExpTest
       UT.InterestRateTest
       UT.LibTest
+      UT.PoolTest
       UT.QueryTest
       UT.RateHedgeTest
       UT.StmtTest

app/Main.hs

@@ -100,7 +100,7 @@ debug = flip Debug.Trace.trace
 
 
 version1 :: Version 
-version1 = Version "0.52.5"
+version1 = Version "0.52.7"
 
 
 wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp

src/Asset.hs

@@ -19,7 +19,7 @@ import Text.Read (readMaybe)
 
 import Lib (Period(..)
           ,Ts(..),periodRateFromAnnualRate,toDate
-          ,getIntervalDays,zipWith9,mkTs,periodsBetween
+          ,getIntervalDays,zipWith9,mkTs,monthsBetween
           ,mkRateTs,daysBetween, getIntervalFactors)
 
 import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals)
@@ -174,6 +174,8 @@ cpr2smm r = toRational $ 1 - (1 - fromRational r :: Double) ** (1/12)
 normalPerfVector :: [Rate] -> [Rate]
 normalPerfVector = floorWith 0.0 . capWith 1.0
 
+
+-- ^ Given a prerpayment assumption , convert it to <period> based prepayment rate
 buildPrepayRates :: Asset b => b -> [Date] -> Maybe A.AssetPrepayAssumption -> Either ErrorRep [Rate]
 buildPrepayRates _ ds Nothing = return $ replicate ((pred . length) ds) 0.0
 buildPrepayRates a ds (Just (A.PrepaymentConstant r)) 
@@ -184,21 +186,40 @@ buildPrepayRates a ds (Just (A.PrepaymentCPR r))
   | r < 0 || r > 1.0 = Left $ "buildPrepayRates: prepayment CPR rate should be between 0 and 1, got " ++ show r
   | otherwise = return $ Util.toPeriodRateByInterval r <$> getIntervalDays ds
 
+
+-- TODO: can be generlized to irregular payments
+buildPrepayRates a ds (Just (A.PrepaymentABS r)) 
+  | r < 0 || r > 1.0 = Left $ "buildPrepayRates: prepayment ABS rate should be between 0 and 1, got " ++ show r
+  | otherwise 
+    = let 
+        originDate = getOriginDate a
+        pojectedMonthAges = (monthsBetween originDate) <$> ds
+        smm m = r / (1 - r * fromIntegral (pred m))
+        smmVector = smm <$> pojectedMonthAges
+      in 
+        case period (getOriginInfo a) of
+          Monthly -> return smmVector
+          _ -> Left $ "prepayment ABS is only supported for monthly payment but got "++ show (period (getOriginInfo a))
+        -- buildPrepayRates a ds (Just (A.PrepaymentVec smmVector))
+
 buildPrepayRates a ds (Just (A.PrepaymentVec vs))
   | any (> 1.0) vs || any (< 0.0) vs = Left $ "buildPrepayRates: prepayment vector should be between 0 and 1, got " ++ show vs
   | otherwise = return $ zipWith Util.toPeriodRateByInterval
                                 (paddingDefault 0.0 vs (pred (length ds)))
                                 (getIntervalDays ds)
+
 buildPrepayRates a ds (Just (A.PrepaymentVecPadding vs))
   | any (> 1.0) vs || any (< 0.0) vs = Left $ "buildPrepayRates: prepayment vector should be between 0 and 1, got " ++ show vs
   | otherwise = return $ zipWith Util.toPeriodRateByInterval
                                 (paddingDefault (last vs) vs (pred (length ds)))
                                 (getIntervalDays ds)
+
 buildPrepayRates a ds (Just (A.PrepayStressByTs ts x)) 
   | any (< 0.0) (getTsVals ts) = Left $ "buildPrepayRates: prepayment vector by ts should be non-negative, got " ++ show (getTsVals ts)
   | otherwise = do
                   rs <- buildPrepayRates a ds (Just x)
                   return $ getTsVals $ multiplyTs Exc (zipTs (tail ds) rs) ts
+
 buildPrepayRates a ds (Just (A.PrepaymentPSA r))
   | r < 0 = Left $ "buildPrepayRates: PSA rate should be non-negative, got " ++ show r
   | otherwise = let 
@@ -210,6 +231,7 @@ buildPrepayRates a ds (Just (A.PrepaymentPSA r))
                   case period (getOriginInfo a) of
                     Monthly -> return $ cpr2smm <$> vectorUsed
                     _ -> Left $ "PSA is only supported for monthly payment but got "++ show (period (getOriginInfo a))
+
 buildPrepayRates a ds (Just (A.PrepaymentByTerm rs)) 
   | any (< 0.0) (concat rs) = Left $ "buildPrepayRates: prepayment by term vector should be non-negative, got " ++ show rs
   | any (> 1.0) (concat rs) = Left $ "buildPrepayRates: prepayment by term vector should be between 0 and 1, got " ++ show rs

src/AssetClass/Mortgage.hs

@@ -325,6 +325,10 @@ instance Ast.Asset Mortgage where
 
   getCurrentBal (Mortgage _ _bal _ _ _ _) = _bal
   getCurrentBal (AdjustRateMortgage _ _ _bal _ _ _ _) = _bal
+  getCurrentBal (ScheduleMortgageFlow _ flows _) =
+    case flows of
+      [] -> 0
+      (f:_) -> CF.mflowBegBalance f
 
   getOriginBal (Mortgage (MortgageOriginalInfo _bal _ _ _ _ _ _ _) _ _ _ _ _ ) = _bal
   getOriginBal (AdjustRateMortgage (MortgageOriginalInfo _bal _ _ _ _ _ _ _) _ _ _ _ _ _ ) = _bal

src/Assumptions.hs

@@ -178,6 +178,7 @@ stressDefaultAssump x (DefaultByTerm rss) = DefaultByTerm $ ((capWith 1.0) <$> (
 stressPrepaymentAssump :: Rate -> AssetPrepayAssumption -> AssetPrepayAssumption
 stressPrepaymentAssump x (PrepaymentConstant r) = PrepaymentConstant $ min 1.0 (r*x)
 stressPrepaymentAssump x (PrepaymentCPR r) = PrepaymentCPR $ min 1.0 (r*x)
+stressPrepaymentAssump x (PrepaymentABS r) = PrepaymentABS $ min 1.0 (r*x)
 stressPrepaymentAssump x (PrepaymentVec rs) = PrepaymentVec $ capWith 1.0 ((x*) <$> rs)
 stressPrepaymentAssump x (PrepaymentVecPadding rs) = PrepaymentVecPadding $ capWith 1.0 ((x*) <$> rs)
 stressPrepaymentAssump x (PrepayByAmt (b,rs)) = PrepayByAmt (max (mulBR b x) 0, rs)
@@ -188,6 +189,7 @@ stressPrepaymentAssump x (PrepaymentByTerm rss) = PrepaymentByTerm $ (capWith 1.
 
 data AssetPrepayAssumption = PrepaymentConstant Rate
                            | PrepaymentCPR Rate 
+                           | PrepaymentABS Rate 
                            | PrepaymentVec [Rate] 
                            | PrepaymentVecPadding [Rate] 
                            | PrepayByAmt (Balance,[Rate])

src/Lib.hs

@@ -7,7 +7,7 @@ module Lib
     ,StartDate,EndDate,daysBetween,daysBetweenI
     ,Spread,Date
     ,paySeqLiabilities,prorataFactors
-    ,afterNPeriod,Ts(..),periodsBetween
+    ,afterNPeriod,Ts(..),monthsBetween
     ,periodRateFromAnnualRate
     ,Floor,Cap,TsPoint(..)
     ,toDate,toDates,genDates,nextDate
@@ -30,9 +30,6 @@ import Data.Aeson hiding (json)
 import Data.Fixed (Fixed(..), HasResolution,Centi, resolution)
 import Data.Ratio
 import Types
-import Control.Lens
-import Data.List.Lens
-import Control.Lens.TH
 import Data.Decimal
 import Debug.Trace
 debug = flip trace
@@ -62,24 +59,23 @@ getIntervalFactors ds = (\x -> toRational x / 365) <$> getIntervalDays ds -- `de
 centiToDecimal :: Centi -> Decimal
 centiToDecimal c = Decimal 2 (round c * 100)
 
--- | 
+-- | Allocate amt across balances pro-rata using the largest remainder
+-- method: every allocation is non-negative and allocations sum exactly to
+-- min (sum of balances) amt (to the cent). Residual cents go to the elements
+-- with the largest fractional remainders, ties broken by index order.
 prorataFactors :: [Balance] -> Balance -> [Balance]
-prorataFactors bals amt =
-  let 
-    s = toRational $ sum bals
-    amtToPay = toRational $ min s (toRational amt)
-  in 
-    case s of 
-      0.0 -> replicate (length bals) 0.0
-      _ -> let 
-             weights = map (\x -> toRational x / s) bals 
-             outPut = (\y -> fromRational (y * amtToPay)) <$> weights 
-             eps = amt - sum outPut
-           in 
-             if eps == 0.00 then
-                outPut
-             else
-                over (ix 0) (+ eps) outPut
+prorataFactors bals amt
+  | totalCents <= 0 = replicate (length bals) 0
+  | otherwise = map (toEnum . fromInteger) $ zipWith (+) baseAdds extraCents
+  where
+    centList = toInteger . fromEnum <$> bals
+    totalCents = sum centList
+    payCents = max 0 $ min totalCents (toInteger $ fromEnum amt)
+    baseAdds = [ b * payCents `div` totalCents | b <- centList ]
+    residual = payCents - sum baseAdds
+    order = sortOn (negate . snd) $ zip [0..] [ b * payCents `mod` totalCents | b <- centList ]
+    extraIdx = fst <$> take (fromInteger residual) order
+    extraCents = [ if i `elem` extraIdx then 1 else 0 | i <- [0 .. length bals - 1] ]
 
 -- 
 
@@ -117,15 +113,13 @@ afterNPeriod d i p =
       SemiAnnually -> 6
       Annually -> 12
 
-periodsBetween :: T.Day -> T.Day -> Period -> Integer
-periodsBetween t1 t2 p
-  = case p of
-      Weekly ->  div (T.diffDays t1 t2) 7
-      Monthly -> _diff
-      Annually -> div _diff 12
-      Quarterly -> div _diff 4
-  where
-    _diff = T.cdMonths $ T.diffGregorianDurationClip t1 t2
+-- | Number of whole calendar months between two dates, i.e. how many complete
+-- months have elapsed from @t1@ to @t2@. Partial months are clipped, so e.g.
+-- 2021-01-31 -> 2021-02-01 is 0 months. Returns a negative value when @t2@ is
+-- earlier than @t1@ and 0 when both dates are equal.
+monthsBetween :: Date -> Date -> Integer
+monthsBetween t1 t2
+  = T.cdMonths $ T.diffGregorianDurationClip t2 t1
 
 
 mkTs :: [(Date,Rational)] -> Ts

src/Pool.hs

@@ -13,8 +13,8 @@ module Pool (Pool(..),aggPool
 
 import Lib (Period(..)
            ,Ts(..),periodRateFromAnnualRate,toDate
-           ,getIntervalDays,zipWith9,mkTs,periodsBetween
-           ,mkRateTs,daysBetween, )
+           ,getIntervalDays,zipWith9,mkTs,monthsBetween
+           ,mkRateTs,daysBetween, prorataFactors)
 
 import Control.Parallel.Strategies
 import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals)
@@ -206,8 +206,13 @@ runPool (Pool as _ _ asof _ _) Nothing mRates
       return [ (x, Map.empty) | x <- cf ]
 -- asset cashflow with credit stress
 ---- By pool level
-runPool (Pool as _ Nothing asof _ _) (Just (A.PoolLevel assumps)) mRates 
-  = sequenceA $ parMap rdeepseq (\x -> projCashflow x asof assumps mRates) as  
+runPool (Pool as _ Nothing asof _ _) (Just (A.PoolLevel assumps)) mRates = do
+  assetAssumps <- allocateDefaultByAmt balances assumps
+  sequenceA $ parMap rdeepseq
+    (\(x, assump) -> projCashflow x asof assump mRates) (zip as assetAssumps)
+  where
+    balances = getCurrentBal <$> as
+
 ---- By index
 runPool (Pool as _ Nothing  asof _ _) (Just (A.ByIndex idxAssumps)) mRates =
   let
@@ -299,5 +304,36 @@ runPool (Pool as _ Nothing asof _ _) (Just (A.ByObligor obligorRules)) mRates =
 runPool _a _b _c = Left $ "[Run Pool]: Failed to match" ++ show _a ++ show _b ++ show _c
 
 
+allocateDefaultByAmt :: [Balance] -> A.AssetPerf -> Either ErrorRep [A.AssetPerf]
+allocateDefaultByAmt
+  balances
+  ( A.MortgageAssump
+      (Just (A.DefaultByAmt (total, rates)))
+      prepay
+      recovery
+      extra
+  , delinqAssump
+  , defaultAssump
+  )
+  | total > sumBalances =
+      Left $ "[Run Pool]: DefaultByAmt total " ++ show total
+        ++ " exceeds total current balance " ++ show sumBalances
+  | otherwise =
+      Right
+        [ (A.MortgageAssump
+            (Just (A.DefaultByAmt (amount, rates)))
+            prepay
+            recovery
+            extra
+          , delinqAssump
+          , defaultAssump
+          )
+          | amount <- prorataFactors balances total
+        ]
+  where
+    sumBalances = sum balances
+allocateDefaultByAmt balances assumps =
+  Right (replicate (length balances) assumps)
+
 
 $(deriveJSON defaultOptions ''Pool)

test/MainTest.hs

@@ -20,7 +20,7 @@ import qualified UT.InterestRateTest as IRT
 import qualified UT.RateHedgeTest as RHT
 import qualified UT.CeTest as CET
 import qualified UT.LedgerTest as LeT
-
+import qualified UT.PoolTest as PT
 
 import qualified DealTest.DealTest as DealTest
 import qualified DealTest.RevolvingTest as RevolvingTest
@@ -45,6 +45,7 @@ tests = testGroup "Tests" [AT.mortgageTests
                            ,AT.installmentTest
                            ,AT.armTest
                            ,AT.ppyTest
+                           ,AT.ppyVectorTest
 --                           ,AT.delinqScheduleCFTest
                            ,AT.delinqMortgageTest
                            ,AT.nonPayMortgageTest
@@ -119,4 +120,5 @@ tests = testGroup "Tests" [AT.mortgageTests
                            ,RHT.capRateTests
                            ,CET.liqTest
                            ,LeT.bookTest
+                           ,PT.poolTest
                            ]

test/UT/AssetTest.hs

@@ -1,4 +1,4 @@
-module UT.AssetTest(mortgageTests,mortgageCalcTests,loanTests,leaseTests,installmentTest,armTest,ppyTest
+module UT.AssetTest(mortgageTests,mortgageCalcTests,loanTests,leaseTests,installmentTest,armTest,ppyTest,ppyVectorTest
                    ,delinqScheduleCFTest,delinqMortgageTest,btlMortgageTest,nonPayMortgageTest,receivableTest,fixedAssetTest)
 where
 
@@ -620,6 +620,34 @@ ppyTest =
         (CF.cfAt ppy_cf_5 4)   
     ]
 
+ppyVectorTest :: TestTree
+ppyVectorTest =
+  let
+    -- tm origin date is 2021-01-01
+    absDsFirst = L.toDate <$> ["20210201","20210301","20210401","20210501"]
+    absDs = L.toDate <$> ["20210701","20210801","20210901","20211001"]
+    absRatesFirst r = Ast.buildPrepayRates tm absDsFirst (Just (A.PrepaymentABS r))
+    absRates r = Ast.buildPrepayRates tm absDs (Just (A.PrepaymentABS r))
+  in
+    testGroup "Prepayment vector tests" [
+      testCase "PrepaymentABS 2% => SMM by month age | fisth 4 months" $
+        assertEqual "abs vector"
+          (Right [1/50,1/49,1/48,1/47])
+          (absRatesFirst 0.02)
+      ,testCase "PrepaymentABS 2% => SMM by month age" $
+        assertEqual "abs vector"
+          (Right [1/45,1/44,1/43,1/42])
+          (absRates 0.02)
+      ,testCase "PrepaymentABS 0% => all zero" $
+        assertEqual "abs zero"
+          (Right [0,0,0,0])
+          (absRates 0.0)
+      ,testCase "PrepaymentABS rejects rate > 1" $
+        assertBool "rate > 1 should be Left" (isLeft (absRates 1.5))
+      ,testCase "PrepaymentABS rejects negative rate" $
+        assertBool "negative rate should be Left" (isLeft (absRates (-0.1)))
+      ]
+
 delinqScheduleCFTest = 
   let 
     cfs = [CF.MortgageDelinqFlow (L.toDate "20230901") 1000  0 0 0 0 0 0 0 0.08 Nothing Nothing Nothing