{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Main
where
import Prelude ()
import Prelude.Compat
import System.Environment
import Control.Monad.Catch (MonadCatch, MonadThrow (..))
import Control.Monad.IO.Class (liftIO)
import Control.Monad (mapM)
import Control.Exception (Exception,throwIO,throw)
import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.TH
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Attoparsec.ByteString
import Data.ByteString (ByteString)
import Data.List
import Data.Map
import Data.Either (fromLeft)
import qualified Data.Set as S
import Data.Proxy
import Data.Time (getCurrentTime)
import qualified Data.Text as T
import Data.Maybe
import Data.Yaml as Y
import Data.OpenApi hiding (Server,contentType)
import qualified Data.Map as Map
import Data.String.Conversions
import Data.Time.Calendar
import GHC.Generics
import GHC.Real
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.ByteString.Char8 as BS
import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Middleware.Cors
import qualified Data.Aeson.Parser
import Language.Haskell.TH
import Network.HTTP.Types.Status
import Servant.OpenApi
import Servant
import Servant.Types.SourceT (source)
import Servant.API.ContentTypes (contentType)
import Types
import MainBase
import qualified Deal as D
import qualified Deal.DealBase as DB
import qualified Deal.DealDate as DD
import qualified Deal.DealMod as DM
import qualified Deal.DealQuery as Q
import qualified Asset as Ast
import qualified Pool as P
import qualified Expense as F
import qualified Ledger as LD
import qualified AssetClass.Installment
import qualified AssetClass.Mortgage
import qualified AssetClass.Loan
import qualified AssetClass.Lease
import qualified AssetClass.ProjectedCashFlow
import qualified AssetClass.MixedAsset as MA
import qualified AssetClass.AssetBase as AB
import qualified Assumptions as AP
import qualified Cashflow as CF
import qualified Accounts as A
import qualified Revolving
import qualified Liability as L
import qualified Call as C
import qualified CreditEnhancement as CE
import qualified Hedge as HE
import qualified Waterfall as W
import qualified InterestRate as IR
import qualified Stmt
import qualified Triggers as TRG
import qualified Revolving as RV
import qualified Lib
import qualified Util as U
import qualified DateUtil as DU
import Data.Scientific (fromRationalRepetend,formatScientific, Scientific,FPFormat(Fixed))
import Control.Lens
import qualified Types as W
import Cashflow (patchCumulative)
import Numeric.RootFinding
import Debug.Trace
debug = flip Debug.Trace.trace
version1 :: Version
version1 = Version "0.50.2"
wrapRun :: [D.ExpectReturn] -> DealType -> Maybe AP.ApplyAssumptionType -> AP.NonPerfAssumption -> RunResp
wrapRun fs (MDeal d) mAssump mNonPerfAssump
= do
(_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump
return (MDeal _d,_pflow,_rs,_p,_osPflow)
wrapRun fs (RDeal d) mAssump mNonPerfAssump
= do
(_d,_pflow,_rs,_p,_osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump
return (RDeal _d,_pflow,_rs,_p,_osPflow)
wrapRun fs (IDeal d) mAssump mNonPerfAssump
= do
(_d,_pflow,_rs,_p,_osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump
return (IDeal _d,_pflow,_rs,_p,_osPflow)
wrapRun fs (LDeal d) mAssump mNonPerfAssump
= do
(_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump
return (LDeal _d,_pflow,_rs,_p,_osPflow)
wrapRun fs (FDeal d) mAssump mNonPerfAssump
= do
(_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump
return (FDeal _d,_pflow,_rs,_p,_osPflow)
wrapRun fs (UDeal d) mAssump mNonPerfAssump
= do
(_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump
return (UDeal _d,_pflow,_rs,_p,_osPflow)
wrapRun fs (VDeal d) mAssump mNonPerfAssump
= do
(_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump
return (VDeal _d,_pflow,_rs,_p,_osPflow)
wrapRun fs (PDeal d) mAssump mNonPerfAssump
= do
(_d,_pflow,_rs,_p, _osPflow) <- D.runDeal d (S.fromList fs) mAssump mNonPerfAssump
return (PDeal _d,_pflow,_rs,_p,_osPflow)
wrapRun _ x _ _ = Left $ "RunDeal Failed ,due to unsupport deal type "++ show x
patchCumulativeToPoolRun :: RunPoolTypeRtn_ -> RunPoolTypeRtn_
patchCumulativeToPoolRun
= Map.map
(\(CF.CashFlowFrame _ txns,mAssetFlow) ->
(CF.CashFlowFrame (0,Lib.toDate "19000101",Nothing) (CF.patchCumulative (0,0,0,0,0,0) [] txns),mAssetFlow))
wrapRunPoolType :: Bool -> PoolTypeWrap -> Maybe AP.ApplyAssumptionType -> Maybe [RateAssumption] -> RunPoolTypeRtn
wrapRunPoolType flag (MPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates})
wrapRunPoolType flag (LPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates})
wrapRunPoolType flag (IPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates})
wrapRunPoolType flag (RPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates})
wrapRunPoolType flag (FPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates})
wrapRunPoolType flag (VPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates})
wrapRunPoolType flag (PPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates})
wrapRunPoolType flag (UPool pt) assump mRates = D.runPoolType flag pt assump $ Just (AP.NonPerfAssumption{AP.interest = mRates})
wrapRunPoolType flag x _ _ = Left $ "RunPool Failed ,due to unsupport pool type "++ show x
wrapRunAsset :: RunAssetReq -> RunAssetResp
wrapRunAsset (RunAssetReq d assets Nothing mRates Nothing)
= do
cfs <- sequenceA $ (\a -> MA.calcAssetUnion a d mRates) <$> assets
return (fst (P.aggPool Nothing [(cf,Map.empty) | cf <- cfs]), Nothing)
wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates Nothing)
= do
cfs <- sequenceA $ (\a -> MA.projAssetUnion a d assumps mRates) <$> assets
return (fst (P.aggPool Nothing [(cf,Map.empty) | (cf,_) <- cfs]) , Nothing)
wrapRunAsset (RunAssetReq d assets (Just (AP.PoolLevel assumps)) mRates (Just pm))
= do
cfs <- sequenceA $ (\a -> MA.projAssetUnion a d assumps mRates) <$> assets
pricingResult <- sequenceA $ (\a -> D.priceAssetUnion a d pm assumps mRates) <$> assets
let (assetCf,_) = P.aggPool Nothing cfs
return (assetCf , Just pricingResult)
-- Swagger API
type SwaggerAPI = "swagger.json" :> Get '[JSON] OpenApi
type EngineAPI = "version" :> Get '[JSON] Version
:<|> "runAsset" :> ReqBody '[JSON] RunAssetReq :> Post '[JSON] RunAssetResp
:<|> "runPool" :> ReqBody '[JSON] RunPoolReq :> Post '[JSON] PoolRunResp
:<|> "runPoolByScenarios" :> ReqBody '[JSON] RunPoolReq :> Post '[JSON] (Map.Map ScenarioName PoolRunResp)
:<|> "runDeal" :> ReqBody '[JSON] RunDealReq :> Post '[JSON] RunResp
:<|> "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)
:<|> "runByRootFinder" :> ReqBody '[JSON] RootFindReq :> Post '[JSON] (Either String RootFindResp)
:<|> "runDate" :> ReqBody '[JSON] RunDateReq :> Post '[JSON] [Date]
engineAPI :: Proxy EngineAPI
engineAPI = Proxy
type API = SwaggerAPI :<|> EngineAPI
engineSwagger:: OpenApi
engineSwagger = toOpenApi engineAPI
& info.title .~ "Hastructure API"
& info.version .~ T.pack (_version version1)
& info.description ?~ "Hastructure is a white-label friendly Cashflow & Analytics Engine for MBS/ABS and REITs"
& info.license ?~ "BSD 3"
-- showVersion :: Handler (Envelope '[] Version)
showVersion :: Handler Version
showVersion = return version1
runAsset :: RunAssetReq -> Handler RunAssetResp
runAsset req = return $ wrapRunAsset req
runPool :: RunPoolReq -> Handler PoolRunResp
runPool (SingleRunPoolReq f pt passumption mRates)
= return $
patchCumulativeToPoolRun <$> (wrapRunPoolType f pt passumption mRates)
runPoolScenarios :: RunPoolReq -> Handler (Map.Map ScenarioName PoolRunResp)
runPoolScenarios (MultiScenarioRunPoolReq f pt mAssumps mRates)
= return $ Map.map (\assump ->
patchCumulativeToPoolRun <$> (wrapRunPoolType f pt (Just assump) mRates))
mAssumps
runDeal :: RunDealReq -> Handler RunResp
runDeal (SingleRunReq f dt assump nonPerfAssump) = return $ wrapRun f dt assump nonPerfAssump
-- Stressing default assumption from AssetPerfAssumption
stressDefaultAssetPerf :: Rate -> AP.AssetPerfAssumption -> AP.AssetPerfAssumption
stressDefaultAssetPerf r (AP.MortgageAssump (Just da) mp mr ms)
= AP.MortgageAssump (Just (AP.stressDefaultAssump r da)) mp mr ms
stressDefaultAssetPerf r (AP.LoanAssump (Just da) mp mr ms)
= AP.LoanAssump (Just (AP.stressDefaultAssump r da)) mp mr ms
stressDefaultAssetPerf r (AP.InstallmentAssump (Just da) mp mr ms)
= AP.InstallmentAssump (Just (AP.stressDefaultAssump r da)) mp mr ms
stressDefaultAssetPerf r (AP.ReceivableAssump (Just da) mr ms)
= AP.ReceivableAssump (Just (AP.stressDefaultAssump r da)) mr ms
stressDefaultAssetPerf r (AP.LeaseAssump (Just (AP.DefaultByContinuation dr)) mg mr me)
= AP.LeaseAssump (Just (AP.DefaultByContinuation (min 1.0 dr * r))) mg mr me
stressDefaultAssetPerf r (AP.LeaseAssump (Just (AP.DefaultByTermination dr)) mg mr me)
= AP.LeaseAssump (Just (AP.DefaultByTermination (min 1.0 dr * r))) mg mr me
stressDefaultAssetPerf _ x = x
-- Stressing prepayment assumption from AssetPerfAssumption
stressPrepayAssetPerf :: Rate -> AP.AssetPerfAssumption -> AP.AssetPerfAssumption
stressPrepayAssetPerf r (AP.MortgageAssump da (Just mp) mr ms)
= AP.MortgageAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms
stressPrepayAssetPerf r (AP.MortgageDeqAssump da (Just mp) mr ms)
= AP.MortgageDeqAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms
stressPrepayAssetPerf r (AP.LoanAssump da (Just mp) mr ms)
= AP.LoanAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms
stressPrepayAssetPerf r (AP.InstallmentAssump da (Just mp) mr ms)
= AP.InstallmentAssump da (Just (AP.stressPrepaymentAssump r mp)) mr ms
stressPrepayAssetPerf _ x = x
-- Stressing default assumption
stressRevovlingPerf :: (AP.AssetPerfAssumption -> AP.AssetPerfAssumption)-> Maybe AP.RevolvingAssumption -> Maybe AP.RevolvingAssumption
stressRevovlingPerf f Nothing = Nothing
stressRevovlingPerf f (Just (AP.AvailableAssets rp applyAssumpType))
= Just (AP.AvailableAssets rp (over (AP.applyAssumptionTypeAssetPerf . _1) f applyAssumpType))
stressRevovlingPerf f (Just (AP.AvailableAssetsBy m))
= Just (AP.AvailableAssetsBy (Map.map (over (_2 . AP.applyAssumptionTypeAssetPerf . _1) f) m))
modifyDealType :: DM.ModifyType -> Double -> DealType -> DealType
modifyDealType dm f (MDeal d) = MDeal $ DM.modDeal dm f d
modifyDealType dm f (RDeal d) = RDeal $ DM.modDeal dm f d
modifyDealType dm f (IDeal d) = IDeal $ DM.modDeal dm f d
modifyDealType dm f (LDeal d) = LDeal $ DM.modDeal dm f d
modifyDealType dm f (FDeal d) = FDeal $ DM.modDeal dm f d
modifyDealType dm f (UDeal d) = UDeal $ DM.modDeal dm f d
modifyDealType dm f (VDeal d) = VDeal $ DM.modDeal dm f d
modifyDealType dm f (PDeal d) = PDeal $ DM.modDeal dm f d
queryDealType :: DealType -> Date -> DealStats -> Either String Rational
queryDealType (MDeal _d) = Q.queryCompound _d
queryDealType (RDeal _d) = Q.queryCompound _d
queryDealType (IDeal _d) = Q.queryCompound _d
queryDealType (LDeal _d) = Q.queryCompound _d
queryDealType (FDeal _d) = Q.queryCompound _d
queryDealType (UDeal _d) = Q.queryCompound _d
queryDealType (VDeal _d) = Q.queryCompound _d
queryDealType (PDeal _d) = Q.queryCompound _d
queryClosingDate :: DealType -> Either String Date
queryClosingDate (MDeal _d) = DD.getClosingDate (DB.dates _d)
queryClosingDate (RDeal _d) = DD.getClosingDate (DB.dates _d)
queryClosingDate (IDeal _d) = DD.getClosingDate (DB.dates _d)
queryClosingDate (LDeal _d) = DD.getClosingDate (DB.dates _d)
queryClosingDate (FDeal _d) = DD.getClosingDate (DB.dates _d)
queryClosingDate (UDeal _d) = DD.getClosingDate (DB.dates _d)
queryClosingDate (VDeal _d) = DD.getClosingDate (DB.dates _d)
queryClosingDate (PDeal _d) = DD.getClosingDate (DB.dates _d)
queryDealTypeBool :: DealType -> Date -> DealStats -> Either String Bool
queryDealTypeBool (MDeal _d) d s = Q.queryDealBool _d s d
queryDealTypeBool (RDeal _d) d s = Q.queryDealBool _d s d
queryDealTypeBool (IDeal _d) d s = Q.queryDealBool _d s d
queryDealTypeBool (LDeal _d) d s = Q.queryDealBool _d s d
queryDealTypeBool (FDeal _d) d s = Q.queryDealBool _d s d
queryDealTypeBool (UDeal _d) d s = Q.queryDealBool _d s d
queryDealTypeBool (VDeal _d) d s = Q.queryDealBool _d s d
queryDealTypeBool (PDeal _d) d s = Q.queryDealBool _d s d
testDealTypeBool :: DealType -> Date -> Pre -> Either String Bool
testDealTypeBool (MDeal _d) d p = Q.testPre d _d p
testDealTypeBool (RDeal _d) d p = Q.testPre d _d p
testDealTypeBool (IDeal _d) d p = Q.testPre d _d p
testDealTypeBool (LDeal _d) d p = Q.testPre d _d p
testDealTypeBool (FDeal _d) d p = Q.testPre d _d p
testDealTypeBool (UDeal _d) d p = Q.testPre d _d p
testDealTypeBool (VDeal _d) d p = Q.testPre d _d p
testDealTypeBool (PDeal _d) d p = Q.testPre d _d p
getDealBondMap :: DealType -> Map.Map BondName L.Bond
getDealBondMap (MDeal d) = DB.bonds d
getDealBondMap (RDeal d) = DB.bonds d
getDealBondMap (IDeal d) = DB.bonds d
getDealBondMap (LDeal d) = DB.bonds d
getDealBondMap (FDeal d) = DB.bonds d
getDealBondMap (UDeal d) = DB.bonds d
getDealBondMap (VDeal d) = DB.bonds d
getDealBondMap (PDeal d) = DB.bonds d
getDealFeeMap :: DealType -> Map.Map FeeName F.Fee
getDealFeeMap (MDeal d) = DB.fees d
getDealFeeMap (RDeal d) = DB.fees d
getDealFeeMap (IDeal d) = DB.fees d
getDealFeeMap (LDeal d) = DB.fees d
getDealFeeMap (FDeal d) = DB.fees d
getDealFeeMap (UDeal d) = DB.fees d
getDealFeeMap (VDeal d) = DB.fees d
getDealFeeMap (PDeal d) = DB.fees d
doTweak :: Double -> RootFindTweak -> DealRunInput -> DealRunInput
doTweak r (StressPoolDefault _) (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f)
= let
stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressDefaultAssetPerf (toRational r)) assumps
stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressDefaultAssetPerf (toRational r)) mRevolving }
in
(dt ,Just stressed, stressedNonPerf, f)
doTweak r (StressPoolPrepayment _) (dt , Just assumps, nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving}, f)
= let
stressed = over (AP.applyAssumptionTypeAssetPerf . _1 ) (stressPrepayAssetPerf (toRational r)) assumps
stressedNonPerf = nonPerfAssump {AP.revolving = stressRevovlingPerf (stressPrepayAssetPerf (toRational r)) mRevolving }
in
(dt ,Just stressed, stressedNonPerf, f)
doTweak r (MaxSpreadTo bn _) (dt , mAssump, rAssump, f)
= (modifyDealType (DM.AddSpreadToBonds bn) r dt , mAssump, rAssump, f)
doTweak r (SplitFixedBalance bn1 bn2 _) (dt , mAssump, rAssump, f)
= (modifyDealType (DM.SlideBalances bn1 bn2) r dt , mAssump, rAssump, f)
evalRootFindStop :: RootFindStop -> RunRespRight -> Double
evalRootFindStop (BondIncurLoss bn) (dt,_,_,_,osPflow)
= let
bondBal = L.getOutstandingAmount $ getDealBondMap dt Map.! bn
in
(fromRational . toRational) $ bondBal - 0.01
evalRootFindStop (BondIncurIntLoss bn threshold) (dt,_,_,_,osPflow)
= let
dueIntAmt = L.getTotalDueInt $ getDealBondMap dt Map.! bn
in
(fromRational . toRational) $ threshold - (dueIntAmt-0.01)
evalRootFindStop (BondIncurPrinLoss bn threshold) (dt,_,_,_,osPflow)
= let
duePrinAmt = L.getCurBalance $ getDealBondMap dt Map.! bn
in
(fromRational . toRational) $ threshold - (duePrinAmt-0.01)
evalRootFindStop (BondPricingEqOriginBal bn otherBondFlag otherFeeFlag) (dt,_,_,pResult,osPflow)
= let
-- bnds
otherBondsName = []
-- check fees/other bonds
otherBondOustanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealBondMap dt)
otherBondOustanding False = 0.0
feeOutstanding True = sum $ L.getOutstandingAmount <$> Map.elems (getDealFeeMap dt)
feeOutstanding False = 0.0
bondBal = L.getOriginBalance $ getDealBondMap dt Map.! bn
v = maybe bondBal getPriceValue $ Map.lookup bn pResult -- TODO shortcut to avoid error
in
if (otherBondOustanding otherBondFlag+feeOutstanding otherFeeFlag) > 0 then
-1
else
(fromRational . toRational) $ bondBal - v
evalRootFindStop (BondMetTargetIrr bn target) (dt,_,_,pResult,osPflow)
= let
v = L.extractIrrResult $ pResult Map.! bn
in
case v of
Nothing -> -1 -- `debug` ("No IRR found for bond:"++ show bn)
Just irr -> (fromRational . toRational) $ irr - target -- `debug` ("IRR for bond:"++ show target ++" is "++ show irr)
evalRootFindStop (BalanceFormula ds targetBal) (dt,collectedFlow,logs,_,osPflow)
= let
_date = case find (\(EndRun d msg) -> True) (reverse logs) of
Just (EndRun (Just d) _ ) -> d
Nothing -> case queryClosingDate dt of
Right d' -> d'
Left err -> error $ "Error in BalanceFormula: " ++ err
v = case queryDealType dt _date (Q.patchDateToStats _date ds) of
Right v' -> fromRational v'
Left err -> error $ "Error in BalanceFormula: " ++ err
in
(fromRational . toRational) $ v - targetBal -- `debug` ("querydate" ++ show _date++"iteration" ++ show v ++ " target:" ++ show targetBal ++ ">> " ++ show ( v- targetBal))
rootFindAlgo :: DealRunInput -> RootFindTweak -> RootFindStop -> Double -> Double
rootFindAlgo (dt ,poolAssumps, runAssumps, f) tweak stop r
= let
(dt' ,poolAssumps', runAssumps', f) = doTweak r tweak (dt ,poolAssumps, runAssumps, f)
in
case wrapRun f dt' poolAssumps' runAssumps' of
Right runRespRight -> evalRootFindStop stop runRespRight -- `debug` ("RootFinder with f" ++ show r++ "with assumpt" ++ show poolAssumps')
Left errorMsg -> -1
runRootFinderBy :: RootFindReq -> Handler (Either String RootFindResp)
runRootFinderBy (RootFinderReq req@(dt,Just assumps,nonPerfAssump@AP.NonPerfAssumption{AP.revolving = mRevolving},f) tweak stop)
= return $
let
itertimes = 1000
def = RiddersParam { riddersMaxIter = itertimes, riddersTol = RelTol 0.000001}
riddersFn = case tweak of
SplitFixedBalance _ _ (l,h) -> ridders def (min h 0.99, max l 0.00001)
StressPoolDefault (l,h) -> ridders def (h ,max l 0.00)
StressPoolPrepayment (l,h) -> ridders def (h ,max l 0.00)
MaxSpreadTo _ (l,h) -> ridders def (h ,max l 0.00)
_ -> error ("Unsupported tweak for root finder" ++ show tweak)
in
case riddersFn (rootFindAlgo req tweak stop) of
Root r -> Right $ RFResult r (doTweak r tweak req)
NotBracketed -> Left "Not able to bracket the root"
SearchFailed -> Left "Not able to find the root"
runDealScenarios :: RunDealReq -> Handler (Map.Map ScenarioName RunResp)
runDealScenarios (MultiScenarioRunReq f dt mAssumps nonPerfAssump)
= return $ Map.map (\singleAssump -> wrapRun f dt (Just singleAssump) nonPerfAssump) mAssumps
runMultiDeals :: RunDealReq -> Handler (Map.Map ScenarioName RunResp)
runMultiDeals (MultiDealRunReq f mDts assump nonPerfAssump)
= return $ Map.map (\singleDealType -> wrapRun f singleDealType assump nonPerfAssump) mDts
runDate :: RunDateReq -> Handler [Date]
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
runDealByRunScenarios :: RunDealReq -> Handler (Map.Map ScenarioName RunResp)
runDealByRunScenarios (MultiRunAssumpReq f dt mAssump nonPerfAssumpMap)
= return $ Map.map (wrapRun f dt mAssump) nonPerfAssumpMap
runDealByCombo :: RunDealReq -> Handler (Map.Map String RunResp)
runDealByCombo (MultiComboReq f dMap assumpMap nonPerfAssumpMap)
= let
dList = Map.toList dMap
aList = Map.toList assumpMap
nList = Map.toList nonPerfAssumpMap
r = [ (intercalate "^" [dk,ak,nk], wrapRun f d a n) | (dk,d) <- dList, (ak,a) <- aList, (nk,n) <- nList ]
rMap = Map.fromList r
in
return rMap
myServer :: ServerT API Handler
myServer = return engineSwagger
:<|> showVersion
:<|> runAsset
:<|> runPool
:<|> runPoolScenarios
:<|> runDeal
:<|> runDealScenarios
:<|> runMultiDeals
:<|> runDealByRunScenarios
:<|> runDealByCombo
:<|> runRootFinderBy
:<|> runDate
writeSwaggerJSON :: IO ()
writeSwaggerJSON = BL8.writeFile "swagger.json" (encodePretty engineSwagger)
data Config = Config { port :: Int}
deriving (Show,Generic)
instance FromJSON Config
app :: Application
app = simpleCors $ serve (Proxy :: Proxy API) myServer
main :: IO ()
main =
do
writeSwaggerJSON
config <- BS.readFile "config.yml"
curTime <- getCurrentTime
let mc = Y.decodeEither' config :: Either ParseException Config
let (Config _p) = case mc of
Left exp -> Config 8081
Right c -> c
print (show curTime ++ ">> Engine start with version:"++ _version version1++";running at Port:"++ show _p)
run _p app