Skip to content

Commit

Permalink
fix sd
Browse files Browse the repository at this point in the history
  • Loading branch information
@dk14
dk14 committed Aug 3, 2020
1 parent e69e330 commit dc43581
Show file tree
Hide file tree
Showing 2 changed files with 34 additions and 20 deletions.
16 changes: 14 additions & 2 deletions marlowe-actus/src/Language/Marlowe/ACTUS/MarloweCompat.hs
View file
Expand Up @@ -10,7 +10,7 @@ import Language.Marlowe (Contract (Le

import Data.String (IsString (fromString))
import Data.Time (Day, UTCTime (UTCTime))
import Data.Time.Clock.System (SystemTime (MkSystemTime), utcToSystemTime)
import Data.Time.Clock.System (SystemTime (MkSystemTime), utcToSystemTime, systemToUTCTime)
import Language.Marlowe.ACTUS.Definitions.BusinessEvents (EventType)
import Language.Marlowe.ACTUS.Definitions.ContractState (ContractState, ContractStatePoly (..))
import Language.Marlowe.ACTUS.Ops (marloweFixedPoint)
Expand Down Expand Up @@ -92,7 +92,19 @@ cardanoEpochStart = 100
dayToSlotNumber :: Day -> Integer
dayToSlotNumber d =
let (MkSystemTime secs _) = utcToSystemTime (UTCTime d 0)
in fromIntegral secs - cardanoEpochStart `mod` 20
in (fromIntegral secs - cardanoEpochStart) `mod` 20

slotNumberToDay :: Integer -> Day
slotNumberToDay slot =
let
secs = cardanoEpochStart + slot * 20
(UTCTime d _) = systemToUTCTime (MkSystemTime (fromIntegral secs) 0)
in d


marloweDate :: Day -> Value Observation
marloweDate = Constant . fromInteger . dayToSlotNumber

backFromMarloweDate :: Value Observation -> Day
backFromMarloweDate (Constant x) = slotNumberToDay x
backFromMarloweDate _ = slotNumberToDay 0
38 changes: 20 additions & 18 deletions marlowe-actus/src/Language/Marlowe/ACTUS/Model/STF/StateTransitionFs.hs
View file
Expand Up @@ -9,6 +9,7 @@ import Language.Marlowe.ACTUS.Definitions.BusinessEvents (EventTy
import Data.Maybe (fromJust, fromMaybe)
import Language.Marlowe.ACTUS.Definitions.ContractTerms (ContractTerms (..), ContractType (LAM, PAM),
)
import Language.Marlowe.ACTUS.Definitions.ContractState (ContractStatePoly(sd))
import Language.Marlowe.ACTUS.Definitions.Schedule (ShiftedDay (calculationDay))
import Language.Marlowe.ACTUS.Model.SCHED.ContractSchedule (schedule)
import Language.Marlowe.ACTUS.Model.STF.StateTransitionModel (_STF_AD_PAM, _STF_CE_PAM, _STF_FP_PAM,
Expand All @@ -20,7 +21,7 @@ import Language.Marlowe.ACTUS.Model.Utility.ScheduleGenerator (inf, su
import Language.Marlowe.ACTUS.Ops (YearFractionOps (_y))

import Language.Marlowe (Contract)
import Language.Marlowe.ACTUS.MarloweCompat (constnt, enum, marloweDate,
import Language.Marlowe.ACTUS.MarloweCompat (constnt, enum, marloweDate, backFromMarloweDate,
stateTransitionMarlowe, useval)


Expand Down Expand Up @@ -53,28 +54,29 @@ stateTransitionFs ev terms@ContractTerms{..} t curDate continue =
fpSchedule = schedule FP terms
tfp_minus = fromMaybe curDate $ calculationDay <$> ((\sc -> sup sc curDate) =<< fpSchedule)
tfp_plus = fromMaybe curDate $ calculationDay <$> ((\sc -> inf sc curDate) =<< fpSchedule)
y_sd_t = constnt $ _y ct_DCC ct_SD curDate ct_MD
y_tfpminus_t = constnt $ _y ct_DCC tfp_minus curDate ct_MD
y_tfpminus_tfpplus = constnt $ _y ct_DCC tfp_minus tfp_plus ct_MD
y_ipanx_t = constnt $ _y ct_DCC (fromJust ct_IPANX) curDate ct_MD

in case contractType of
PAM ->
stateTransitionMarlowe ev t continue $ \event st -> case event of
AD -> _STF_AD_PAM st time y_sd_t
IED -> _STF_IED_PAM st time y_ipanx_t __IPNR __IPANX ct_CNTRL __IPAC __NT
MD -> _STF_MD_PAM st time
PP -> _STF_PP_PAM st time __pp_payoff y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
PY -> _STF_PY_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
FP -> _STF_FP_PAM st time y_sd_t
PRD -> _STF_PRD_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
TD -> _STF_IP_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
IP -> _STF_IPCI_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
IPCI -> _STF_IPCI_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
RR -> _STF_RR_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL __RRLF __RRLC __RRPC __RRPF __RRMLT __RRSP __o_rf_RRMO
RRF -> _STF_RRF_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL __RRNXT
SC -> _STF_SC_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL ct_SCEF __o_rf_SCMO __SCIED
CE -> _STF_CE_PAM st time y_sd_t
_ -> st
stateTransitionMarlowe ev t continue $ \event st ->
let y_sd_t = constnt $ _y ct_DCC (backFromMarloweDate $ sd st) curDate ct_MD
in case event of
AD -> _STF_AD_PAM st time y_sd_t
IED -> _STF_IED_PAM st time y_ipanx_t __IPNR __IPANX ct_CNTRL __IPAC __NT
MD -> _STF_MD_PAM st time
PP -> _STF_PP_PAM st time __pp_payoff y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
PY -> _STF_PY_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
FP -> _STF_FP_PAM st time y_sd_t
PRD -> _STF_PRD_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
TD -> _STF_IP_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
IP -> _STF_IPCI_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
IPCI -> _STF_IPCI_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL
RR -> _STF_RR_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL __RRLF __RRLC __RRPC __RRPF __RRMLT __RRSP __o_rf_RRMO
RRF -> _STF_RRF_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL __RRNXT
SC -> _STF_SC_PAM st time y_sd_t y_tfpminus_t y_tfpminus_tfpplus __FEB __FER ct_CNTRL ct_SCEF __o_rf_SCMO __SCIED
CE -> _STF_CE_PAM st time y_sd_t
_ -> st
LAM -> undefined

0 comments on commit dc43581

Please sign in to comment.