diff --git a/daml/splice-amulet/daml/Splice/AmuletRules.daml b/daml/splice-amulet/daml/Splice/AmuletRules.daml index 392e25fa9f..285f32cb60 100644 --- a/daml/splice-amulet/daml/Splice/AmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/AmuletRules.daml @@ -233,6 +233,7 @@ template AmuletRules numPurchases = 1 amuletSpent = trafficCostAmulet usdSpent = trafficCostUsd + totalReimbursed = None -- return result return AmuletRules_BuyMemberTrafficResult with round = transferResult.round @@ -270,6 +271,11 @@ template AmuletRules numPurchases = acc.numPurchases + traffic.numPurchases usdSpent = acc.usdSpent + traffic.usdSpent amuletSpent = acc.amuletSpent + traffic.amuletSpent + totalReimbursed = case (acc.totalReimbursed, traffic.totalReimbursed) of + (None, None) -> None + (Some a, None) -> Some a + (None, Some b) -> Some b + (Some a, Some b) -> Some (a + b) ) (initialMemberTraffic dso first.memberId first.synchronizerId first.migrationId) traffics mergedTrafficCid <- create mergedTraffic return AmuletRules_MergeMemberTrafficContractsResult with .. diff --git a/daml/splice-amulet/daml/Splice/DecentralizedSynchronizer.daml b/daml/splice-amulet/daml/Splice/DecentralizedSynchronizer.daml index a26bbf5686..57cd63b62f 100644 --- a/daml/splice-amulet/daml/Splice/DecentralizedSynchronizer.daml +++ b/daml/splice-amulet/daml/Splice/DecentralizedSynchronizer.daml @@ -64,6 +64,7 @@ template MemberTraffic with numPurchases : Int -- ^ Number of times extra traffic has been purchased amuletSpent : Decimal -- ^ Total Amulet spent on extra traffic usdSpent : Decimal -- ^ Total USD spent on extra traffic + totalReimbursed : Optional Int -- ^ The number of bytes of response traffic reimbursed to this member. where signatory dso @@ -86,6 +87,7 @@ initialMemberTraffic dso memberId synchronizerId migrationId = MemberTraffic wit numPurchases = 0 amuletSpent = 0.0 usdSpent = 0.0 + totalReimbursed = None data ForMemberTraffic = ForMemberTraffic with dso : Party diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestUtils.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestUtils.daml index 17abe747c3..a1a6f00c03 100644 --- a/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestUtils.daml +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestUtils.daml @@ -293,6 +293,19 @@ confirmAWC_MiningRound_Archive app = do confirmer = sv pure () +-- | Convenience function to confirm and execute an action requiring confirmation. +confirmAndExecutionAction : AmuletApp -> ActionRequiringConfirmation -> Script () +confirmAndExecutionAction app action = do + [(dsoRulesCid, rules)] <- query @DsoRules app.dso + forA_ (Map.keys rules.svs) $ \sv -> do + -- mallory does not act + unless ("mallory" `T.isPrefixOf` partyToText sv) $ do + submitMulti [sv] [app.dso] $ exerciseCmd dsoRulesCid DsoRules_ConfirmAction with + action + confirmer = sv + pure () + executeAllConfirmedActions app + executeAllConfirmedActions : AmuletApp -> Script () executeAllConfirmedActions app = do [(amuletRulesCid, _)] <- query @AmuletRules app.dso diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestResponseReimbursement.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestResponseReimbursement.daml new file mode 100644 index 0000000000..bf21902fa5 --- /dev/null +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestResponseReimbursement.daml @@ -0,0 +1,108 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Splice.Scripts.TestResponseReimbursement where + +import DA.Assert +import DA.List +import Daml.Script +import DA.Time + +import Splice.DsoRules +import Splice.DSO.ResponseReimbursement -- FIXME: add Traffic to name +import Splice.DSO.CryptoHash +import Splice.DecentralizedSynchronizer + +import Splice.Scripts.Util +import Splice.Scripts.DsoTestUtils + + +-- | Tests that reimbursement works. +test_confirmation_response_traffic_reimbursement : Script () +test_confirmation_response_traffic_reimbursement = do + (app, dso, (sv1, _, _, _)) <- initMainNet + + setTime demoTime + + [(dsoRulesCid, dsoRules)] <- query @DsoRules dso + + -- setup demo data + let responseTrafficDataRaw = sortOn fst + [ ("PAR::1", 1000) + , ("PAR::2", 2000) + , ("PAR::3", 3000) + , ("PAR::4", 4000) + ] + let responseTrafficData = ResponseTrafficData with + responseTrafficTotals = map (uncurry ResponseTrafficTotal) responseTrafficDataRaw + let responseTrafficDataHash = hash responseTrafficData + let reimbursementConfirmation = ReimbursementConfirmation with + synchronizerId = dsoRules.config.decentralizedSynchronizer.activeSynchronizerId + migrationId = 0 + responseTrafficDataHash + + -- setup reimbursement workflow state + confirmAndExecutionAction app ARC_DsoRules with + dsoAction = SRARC_StartResponseTrafficReimbursement + DsoRules_StartResponseTrafficReimbursement + + -- add a new interval + now <- getTime + let testIntervalEnd = now `addRelTime` hours 1 + [(workflowStateCid, _)] <- query @ReimbursementWorkflowState dso + confirmAndExecutionAction app ARC_DsoRules with + dsoAction = SRARC_AddResponseTrafficReimbursementInterval + DsoRules_AddResponseTrafficReimbursementInterval with + nextIntervalEnd = testIntervalEnd + workflowStateCid + + -- confirm data + [(intervalStateCid, _)] <- query @ReimbursementIntervalState dso + confirmAndExecutionAction app ARC_DsoRules with + dsoAction = SRARC_ConfirmResponseTrafficReimbursement + DsoRules_ConfirmResponseTrafficReimbursement with + intervalStateCid + reimbursementConfirmation + + -- check that there are no member traffic contracts yet + [] <- query @MemberTraffic dso + + -- reimburse responses + [(intervalStateCid, _)] <- query @ReimbursementIntervalState dso + submitMulti [sv1] [app.dso] $ exerciseCmd dsoRulesCid DsoRules_ReimburseResponseTraffic with + intervalStateCid + responseTrafficData + sv = sv1 + + -- check that the expected member traffic contracts were created + actualMemberTrafficContracts <- query @MemberTraffic dso + let expectedMemberTrafficContracts = do + (memberId, totalTraffic) <- responseTrafficDataRaw + pure MemberTraffic with + dso = dso + memberId + synchronizerId = reimbursementConfirmation.synchronizerId + migrationId = reimbursementConfirmation.migrationId + totalReimbursed = Some totalTraffic + totalPurchased = 0 + amuletSpent = 0.0 + usdSpent = 0.0 + numPurchases = 0 + sortOn (.memberId) (map snd actualMemberTrafficContracts) === + expectedMemberTrafficContracts + + -- record the completion + [(intervalStateCid, _)] <- query @ReimbursementIntervalState dso + [(workflowStateCid, _)] <- query @ReimbursementWorkflowState dso + submitMulti [sv1] [app.dso] $ exerciseCmd dsoRulesCid DsoRules_RecordCompletedResponseTrafficReimbursement with + intervalStateCid + workflowStateCid + sv = sv1 + + [] <- query @ReimbursementIntervalState dso + [(_, workflowState)] <- query @ReimbursementWorkflowState dso + (workflowState.earliestIntervalStart, workflowState.nextIntervalStart) === + (testIntervalEnd, testIntervalEnd) + + + pure () diff --git a/daml/splice-dso-governance/daml/Splice/DSO/CryptoHash.daml b/daml/splice-dso-governance/daml/Splice/DSO/CryptoHash.daml new file mode 100644 index 0000000000..9f258cda05 --- /dev/null +++ b/daml/splice-dso-governance/daml/Splice/DSO/CryptoHash.daml @@ -0,0 +1,108 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Utilities to compute cryptographic hashes of Daml data structures. +-- We use this for example for computing compact commitments for moving +-- off-ledger data shared by the SV nodes on-ledger. +module Splice.DSO.CryptoHash + ( + Hash(..), + Hashable(..), + hashRecord, + hashUpgradedRecord, + hashVariant, + hashUpgradedVariant, + ) where + +import DA.Optional (isNone) +import DA.Text qualified as T + +data Hash = Hash with value : Text + deriving (Eq, Show) + +-- | Compute the hash of a record. +hashRecord : [Hash] -> Hash +hashRecord = hashListInternal . map (.value) + +-- | Compute the hash of an upgraded record so that it agrees with the old record hash +-- when ignoring trailing None fields. +hashUpgradedRecord : [Hash] -> [Optional Hash] -> Hash +hashUpgradedRecord oldFieldHashes newFieldHashes = + hashListInternal $ + [ h.value | h <- oldFieldHashes ] ++ + [ (hashOptionalInternal optField).value | optField <- dropTrailingNones newFieldHashes ] + +-- | Compute the hash of a variant. +hashVariant : Text -> [Hash] -> Hash +hashVariant tag fieldHashes = hashVariantInternal tag [ h.value | h <- fieldHashes ] + +-- | Compute the hash of an upgraded variant so that it agrees with the old variant hash +-- when ignoring trailing None fields. +hashUpgradedVariant : Text -> [Hash] -> [Optional Hash] -> Hash +hashUpgradedVariant tag oldFieldHashes newFieldHashes = + hashVariantInternal tag $ + [ h.value | h <- oldFieldHashes ] ++ + [ (hashOptionalInternal optField).value | optField <- dropTrailingNones newFieldHashes ] + +class Hashable a where + hash : a -> Hash + +-- | Identity instance for Hash, which is useful for hash types like [Hash]. +instance Hashable Hash where + hash h = h + +instance Hashable Int where + hash = hashInt + +instance Hashable Text where + hash = hashText + +instance Hashable a => Hashable (Optional a) where + hash = hashOptionalInternal . fmap hash + +instance Hashable a => Hashable [a] where + hash = hashList hash + + +-- internal helper functions +---------------------------- + +-- Design Note: we want these hashes to be easy to compute in many systems. +-- Therefore we essentially encode the data structure as an S-expression and hash that +-- one recursively. Concretely, we use the following rules: +-- +-- - hash scalars by hashing their string rendering +-- - hash lists by hashing the concatenation of the length and the element hashes +-- - hash records by hashing the list of field hashes +-- - hash variants by hashing the list of fields prefixed with tag for the variant constructor +-- +-- The length prefix on lists also serves as a tag to distinguish different tree structures. +-- We include the number of fields in the hash of a record, as the number of fields +-- can change as part of a Smart Contract Upgrades. +-- +-- Tags for variants must be unique within the scope where the hashes are used. + + +hashList : (a -> Hash) -> [a] -> Hash +hashList hashElem xs = hashListInternal [ (hashElem x).value | x <- xs ] + +hashInt : Int -> Hash +hashInt n = Hash $ T.sha256 (show n) + +hashText : Text -> Hash +hashText = Hash . T.sha256 + +hashListInternal : [Text] -> Hash +hashListInternal ts = Hash $ T.sha256 $ mconcat (show (length ts) :: "|" :: ts) + +hashVariantInternal : Text -> [Text] -> Hash +hashVariantInternal tag fieldValues = + Hash $ T.sha256 $ mconcat (tag :: "|" :: show (length fieldValues) :: "|" :: fieldValues) + +-- we view optionals as lists of length 0 or 1 to simplify the encoding in other systems +hashOptionalInternal : Optional Hash -> Hash +hashOptionalInternal None = hashListInternal [] +hashOptionalInternal (Some h) = hashListInternal [h.value] + +dropTrailingNones : [Optional Hash] -> [Optional Hash] +dropTrailingNones = reverse . dropWhile isNone . reverse diff --git a/daml/splice-dso-governance/daml/Splice/DSO/ResponseReimbursement.daml b/daml/splice-dso-governance/daml/Splice/DSO/ResponseReimbursement.daml new file mode 100644 index 0000000000..9a228482c9 --- /dev/null +++ b/daml/splice-dso-governance/daml/Splice/DSO/ResponseReimbursement.daml @@ -0,0 +1,202 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | All the response reimbursement workflows code that does not depend on `DsoRules`. +-- +-- FIXME: the names in this module are not yet as clean as they could be. Make a pass. +-- In particular "Confirmation" may be confusing, and "Traffic" is missing from some names. +module Splice.DSO.ResponseReimbursement where + +import DA.Action +import DA.Assert +import DA.Foldable (forA_) +import DA.Optional +import DA.Text qualified as T +import DA.Time + +import Splice.DecentralizedSynchronizer +import Splice.Util +import Splice.DSO.CryptoHash +import Splice.Types + + + + +-- TODO: consider using a fixed one nibble sharding prefix as that gives a 16x +-- tx size reduction while being cheap to implement due to not being +-- configurable. + + +-- TODO: add contract that makes it easy to test the hashing of the responseTrafficDataHash + + +-- State of the overall reimbursement workflow. +----------------------------------------------- + +data ReimbursementInterval = ReimbursementInterval with + startExclusive : Time + endInclusive : Time + deriving (Eq, Show) + +-- | The top-level state of the reimbursement workflow. We expect there to be exactly one +-- such contract per DSO. +template ReimbursementWorkflowState + with + dso: Party + earliestIntervalStart: Time + -- ^ The start time of the earliest interval that is still being processed. + nextIntervalStart: Time + where + signatory dso + + -- Only called from DsoRules. We keep it as its own choice to simplify reasoning about the logic. + choice ReimbursementWorkflowState_AddReimbursementInterval + : ReimbursementWorkflowState_AddReimbursementIntervalResult + with + minIntervalDuration : RelTime + nextIntervalEnd : Time + controller dso + do + -- ensure minimal duration + let intervalDuration = nextIntervalEnd `subTime` nextIntervalStart + require "Minimal interval duration" (intervalDuration >= minIntervalDuration) + -- ensure that intervals are added at most `minIntervalDuration` ahead of time + let backdatedStart = nextIntervalStart `addRelTime` (negate minIntervalDuration) + assertDeadlineExceeded "nextIntervalStart - minIntervalDuration" backdatedStart + intervalStateCid <- create ReimbursementIntervalState with + dso = dso + interval = ReimbursementInterval with + startExclusive = nextIntervalStart + endInclusive = nextIntervalEnd + reimbursementConfirmation = None + reimbursementComplete = False + workflowStateCid <- create this with + nextIntervalStart = nextIntervalEnd + pure ReimbursementWorkflowState_AddReimbursementIntervalResult with + intervalStateCid + workflowStateCid + + choice ReimbursementWorkflowState_RecordCompletedInterval + : ReimbursementWorkflowState_RecordCompletedIntervalResult + with + intervalStateCid : ContractId ReimbursementIntervalState + controller dso + do + intervalState <- fetchAndArchive (ForDso dso) intervalStateCid + require "Interval must be reimbursed" (intervalState.reimbursementComplete) + require "Interval must be the earliest" (intervalState.interval.startExclusive == earliestIntervalStart) + workflowStateCid <- create this with + earliestIntervalStart = intervalState.interval.endInclusive + pure ReimbursementWorkflowState_RecordCompletedIntervalResult with + workflowStateCid + + +data ReimbursementWorkflowState_AddReimbursementIntervalResult = ReimbursementWorkflowState_AddReimbursementIntervalResult with + intervalStateCid : ContractId ReimbursementIntervalState + workflowStateCid : ContractId ReimbursementWorkflowState + +data ReimbursementWorkflowState_RecordCompletedIntervalResult = ReimbursementWorkflowState_RecordCompletedIntervalResult with + workflowStateCid : ContractId ReimbursementWorkflowState + + +-- State of reimbursing responses for a given interval. +------------------------------------------------------- + +data ReimbursementConfirmation = ReimbursementConfirmation with + synchronizerId : Text -- ^ Synchronizer on which the responses should be reimbursed. Always set to the global synchronizer-id. + migrationId : Int -- ^ Migration id on which the responses should be reimbursed. Always set to the latest migration id. + responseTrafficDataHash : Hash + deriving (Eq, Show) + +data ResponseTrafficData = ResponseTrafficData with + responseTrafficTotals : [ResponseTrafficTotal] + deriving (Eq, Show) + +data ResponseTrafficTotal = ResponseTrafficTotal with + memberId : Text + totalTraffic : Int + deriving (Eq, Show) + + +template ReimbursementIntervalState + with + dso: Party + interval: ReimbursementInterval + reimbursementConfirmation : Optional ReimbursementConfirmation + -- ^ The confirmation of the reimbursement data hash for this interval. + reimbursementComplete : Bool + -- ^ Whether the response traffic for this interval has been reimbursed. + where + signatory dso + + choice ReimbursementIntervalState_ConfirmReimbursement + : ReimbursementIntervalState_ConfirmReimbursementResult + with + reimbursementConfirmation : ReimbursementConfirmation + controller dso + do + require "Not yet confirmed" (isNone this.reimbursementConfirmation) + intervalStateCid <- create this with reimbursementConfirmation = Some reimbursementConfirmation + pure ReimbursementIntervalState_ConfirmReimbursementResult with + intervalStateCid + + choice ReimbursementIntervalState_ReimburseResponses + : ReimbursementIntervalState_ReimburseResponsesResult + with + responseTrafficData : ResponseTrafficData + controller dso + do + case reimbursementConfirmation of + None -> abort "Response traffic reimbursement hash not yet been confirmed" + Some confirmation -> do + let actualHash = hash responseTrafficData + let expectedHash = confirmation.responseTrafficDataHash + unless (actualHash == expectedHash) $ + abort $ T.unwords ["Response traffic data hash", actualHash.value, "does not match expected hash", expectedHash.value] + forA_ responseTrafficData.responseTrafficTotals \(ResponseTrafficTotal with memberId, totalTraffic) -> + create MemberTraffic with + dso = dso + memberId + synchronizerId = confirmation.synchronizerId + migrationId = confirmation.migrationId + totalReimbursed = Some totalTraffic + -- Set these fields to reflect that this reimbursement is not a traffic purchase. + -- Thereby the aggregation in AmuletRules_MergeMemberTrafficContracts works correctly. + totalPurchased = 0 + amuletSpent = 0.0 + usdSpent = 0.0 + numPurchases = 0 + + -- Note: we intentionally do not return the created MemberTraffic contract IDs here + -- to avoid bloating the transaction size on the Ledger API. + intervalStateCid <- create this with reimbursementComplete = True + pure ReimbursementIntervalState_ReimburseResponsesResult with + intervalStateCid + +data ReimbursementIntervalState_ConfirmReimbursementResult = ReimbursementIntervalState_ConfirmReimbursementResult with + intervalStateCid : ContractId ReimbursementIntervalState + +data ReimbursementIntervalState_ReimburseResponsesResult = ReimbursementIntervalState_ReimburseResponsesResult with + intervalStateCid : ContractId ReimbursementIntervalState + + +-- Checked fetch +---------------- + +instance HasCheckedFetch ReimbursementWorkflowState ForDso where + contractGroupId ReimbursementWorkflowState {..} = ForDso with dso + +instance HasCheckedFetch ReimbursementIntervalState ForDso where + contractGroupId ReimbursementIntervalState {..} = ForDso with dso + + +-- Hashing instances +-------------------- + +instance Hashable ResponseTrafficData where + hash (ResponseTrafficData with responseTrafficTotals) = + hashRecord [hash responseTrafficTotals] + +instance Hashable ResponseTrafficTotal where + hash (ResponseTrafficTotal with memberId, totalTraffic) = + hashRecord [hash memberId, hash totalTraffic] diff --git a/daml/splice-dso-governance/daml/Splice/DsoRules.daml b/daml/splice-dso-governance/daml/Splice/DsoRules.daml index 71990a32ea..371c172f5c 100644 --- a/daml/splice-dso-governance/daml/Splice/DsoRules.daml +++ b/daml/splice-dso-governance/daml/Splice/DsoRules.daml @@ -32,6 +32,7 @@ import Splice.Ans import Splice.SvOnboarding import Splice.DSO.AmuletPrice import Splice.DSO.DecentralizedSynchronizer +import Splice.DSO.ResponseReimbursement import Splice.DSO.SvState import Splice.Schedule import Splice.Util @@ -114,6 +115,12 @@ data DsoRules_ActionRequiringConfirmation -- ^ Create TransferCommandCounter contract for the given sender if it does not already exist | SRARC_CreateUnallocatedUnclaimedActivityRecord DsoRules_CreateUnallocatedUnclaimedActivityRecord -- ^ Voted action to create an UnallocatedUnclaimedActivityRecord contract. + | SRARC_StartResponseTrafficReimbursement DsoRules_StartResponseTrafficReimbursement + -- ^ Automated action to start reimbursing responses for a given interval. + | SRARC_AddResponseTrafficReimbursementInterval DsoRules_AddResponseTrafficReimbursementInterval + -- ^ Automated action to add a new confirmation response traffic reimbursement interval. + | SRARC_ConfirmResponseTrafficReimbursement DsoRules_ConfirmResponseTrafficReimbursement + -- ^ Automated action to confirm the response traffic reimbursement data for a reimbursement interval. deriving (Eq, Show) data AnsEntryContext_ActionRequiringConfirmation @@ -294,6 +301,20 @@ data DsoRules_ExpireUnallocatedUnclaimedActivityRecordResult = DsoRules_ExpireUn data DsoRules_ExpireUnclaimedActivityRecordResult = DsoRules_ExpireUnclaimedActivityRecordResult with unclaimedRewardCid : ContractId UnclaimedReward +data DsoRules_StartResponseTrafficReimbursementResult = DsoRules_StartResponseTrafficReimbursementResult with + workflowStateCid : ContractId ReimbursementWorkflowState + +data DsoRules_AddResponseTrafficReimbursementIntervalResult = DsoRules_AddResponseTrafficReimbursementIntervalResult with + result : ReimbursementWorkflowState_AddReimbursementIntervalResult + +data DsoRules_ConfirmResponseTrafficReimbursementResult = DsoRules_ConfirmResponseTrafficReimbursementResult with + result : ReimbursementIntervalState_ConfirmReimbursementResult + +data DsoRules_ReimburseResponsesResult = DsoRules_ReimburseResponsesResult with + result : ReimbursementIntervalState_ReimburseResponsesResult + +data DsoRules_RecordCompletedResponseTrafficReimbursementIntervalResult = DsoRules_RecordCompletedResponseTrafficReimbursementIntervalResult with + result : ReimbursementWorkflowState_RecordCompletedIntervalResult -- Workflow templates --------------------- @@ -1504,6 +1525,72 @@ template DsoRules with pure DsoRules_ExpireUnclaimedActivityRecordResult with unclaimedRewardCid + -- confirmation response traffic reimbursement + ---------------------------------------------- + + nonconsuming choice DsoRules_StartResponseTrafficReimbursement : DsoRules_StartResponseTrafficReimbursementResult + controller dso + do + now <- getTime + workflowStateCid <- create ReimbursementWorkflowState with + dso + earliestIntervalStart = now + nextIntervalStart = now + pure DsoRules_StartResponseTrafficReimbursementResult with + workflowStateCid = workflowStateCid + + nonconsuming choice DsoRules_AddResponseTrafficReimbursementInterval + : DsoRules_AddResponseTrafficReimbursementIntervalResult + with + workflowStateCid : ContractId ReimbursementWorkflowState + nextIntervalEnd : Time + controller dso + do + _ <- fetchChecked (ForDso with dso) workflowStateCid + result <- exercise workflowStateCid ReimbursementWorkflowState_AddReimbursementInterval with + minIntervalDuration = hours 1 -- FIXME: config.responseReimbursementMinIntervalDuration + nextIntervalEnd + pure DsoRules_AddResponseTrafficReimbursementIntervalResult with result + + nonconsuming choice DsoRules_ConfirmResponseTrafficReimbursement + : DsoRules_ConfirmResponseTrafficReimbursementResult + with + intervalStateCid : ContractId ReimbursementIntervalState + reimbursementConfirmation : ReimbursementConfirmation + controller dso + do + result <- exercise intervalStateCid ReimbursementIntervalState_ConfirmReimbursement with + reimbursementConfirmation + pure DsoRules_ConfirmResponseTrafficReimbursementResult with result + + nonconsuming choice DsoRules_ReimburseResponseTraffic : DsoRules_ReimburseResponsesResult + with + intervalStateCid : ContractId ReimbursementIntervalState + responseTrafficData : ResponseTrafficData + sv : Party + controller sv + do + _ <- getAndValidateSvParty this (Some sv) + -- FIXME: avoid this exercise as it leads to a full copy of the response traffic totals + -- in the Ledger API server + result <- exercise intervalStateCid ReimbursementIntervalState_ReimburseResponses with + responseTrafficData + pure DsoRules_ReimburseResponsesResult with result + + nonconsuming choice DsoRules_RecordCompletedResponseTrafficReimbursement + : DsoRules_RecordCompletedResponseTrafficReimbursementIntervalResult + with + workflowStateCid : ContractId ReimbursementWorkflowState + intervalStateCid : ContractId ReimbursementIntervalState + sv : Party + controller sv + do + _ <- getAndValidateSvParty this (Some sv) + result <- exercise workflowStateCid ReimbursementWorkflowState_RecordCompletedInterval with + intervalStateCid + pure DsoRules_RecordCompletedResponseTrafficReimbursementIntervalResult with result + + pruneAtLeastOne : Ord t => t -> Schedule t a -> Optional (Schedule t a) pruneAtLeastOne now schedule = case reverse past of @@ -1562,6 +1649,9 @@ executeActionRequiringConfirmation dso dsoRulesCid amuletRulesCid act = case act SRARC_CreateExternalPartyAmuletRules choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_CreateTransferCommandCounter choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_CreateUnallocatedUnclaimedActivityRecord choiceArg -> void $ exercise dsoRulesCid choiceArg + SRARC_StartResponseTrafficReimbursement choiceArg -> void $ exercise dsoRulesCid choiceArg + SRARC_AddResponseTrafficReimbursementInterval choiceArg -> void $ exercise dsoRulesCid choiceArg + SRARC_ConfirmResponseTrafficReimbursement choiceArg -> void $ exercise dsoRulesCid choiceArg ARC_AnsEntryContext with .. -> do void $ fetchChecked (ForDso with dso) ansEntryContextCid case ansEntryContextAction of