diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 8a796b0aa7..f11cc565e6 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -1,17 +1,23 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} module Splice.AggregateLock where import Splice.Amulet.TokenApiUtils +import Splice.AmuletRules +import Splice.Amulet.TwoStepTransfer +import Splice.AmuletAllocation as AmuletAllocationV1 +import Splice.Api.Token.HoldingV1 as V1 import Splice.Api.Token.HoldingV2 as V2 import Splice.Api.Token.AllocationV2 as V2 import Splice.Api.Token.AllocationInstructionV2 as V2 import Splice.Api.Token.MetadataV1 -import Splice.TokenStandard.Utils (maxTime, regularAccountOwner, isValidAllocationSpecificationV2) -import Splice.TokenStandard.Utils.Internal.Allocations (settlementFactoryV2_settleBatchDefaultImplNoSelf) +import Splice.TokenStandard.Utils hiding (require) -- (maxTime, regularAccountOwner, isValidAllocationSpecificationV2) +import Splice.TokenStandard.Utils.Internal.Allocations -- (settlementFactoryV2_settleBatchDefaultImplNoSelf) import Splice.TokenStandard.Utils.Internal.Conversions (timeFromMeta, encodeTime) import Splice.Util +import Splice.Amulet + import DA.Action hiding (mapA) +import DA.Assert (assertDeadlineExceeded, assertWithinDeadline) import DA.Either import DA.Optional import qualified DA.Set as S @@ -21,7 +27,7 @@ import qualified DA.Map as Map import qualified DA.TextMap as TM import DA.Time import DA.Traversable (mapA) -import DA.Foldable (concat) +import DA.Foldable (concat, forA_) import Prelude hiding (mapA, concat) -- Lock management @@ -35,16 +41,30 @@ class GovernanceAllocation a where data GovernanceLock = GovernanceLock_SVLocked AggregatedLock | GovernanceLock_VestingLocked VestingLock + | GovernanceLock_SubstituteProposal SubstitutionProposal deriving (Eq, Show) data GovernanceLockOperation = GovernanceLockOperation_Allocate GovernanceLock | GovernanceLockOperation_TopUp TopUpAllocation + | GovernanceLockOperation_Substitute SubstituteAllocation data TopUpAllocation = TopUpAllocation with allocationCid : ContractId V2.Allocation +data SubstitutionProposal + = Substitute_SV AggregatedLock + | Substitute_Vesting VestingLock + +governanceLockForSubstitution Substitute_SV al = GovernanceLock_SVLocked al +governanceLockForSubstitution Substitute_Vesting vl = GovernanceLock_VestingLocked vl + +data SubstituteAllocation = + SubstituteAllocation with + substituteCid : ContractId V2.Allocation + topupCid : Optional (ContractId V2.Allocation) + data AggregatedLock = AggregatedLock with lockBeneficiary : Text @@ -60,6 +80,23 @@ data VestingLock = controllers : GovernanceLockControllers deriving (Eq, Show) +lockControllersFromGovernanceLock (GovernanceLock_SVLocked (AggregatedLock with controllers)) = Some controllers +lockControllersFromGovernanceLock (GovernanceLock_VestingLocked (VestingLock with controllers)) = Some controllers +lockControllersFromGovernanceLock (GovernanceLock_SubstituteProposal _) = None + +data GovernanceLockKey + = GLK_SVLocked with + beneficiary : Text + | GLK_Vesting with + startDate : Time + endDate : Time + deriving (Ord, Eq) + +governanceLockKey : GovernanceLock -> GovernanceLockKey +governanceLockKey (GovernanceLock_SVLocked (AggregatedLock with lockBeneficiary)) = GLK_SVLocked lockBeneficiary +governanceLockKey (GovernanceLock_VestingLocked (VestingLock with startDate; endDate)) = GLK_Vesting with startDate; endDate +governanceLockKey (GovernanceLock_SubstituteProposal (Substitute_SV (AggregatedLock with lockBeneficiary))) = GLK_SVLocked lockBeneficiary +governanceLockKey (GovernanceLock_SubstituteProposal (Substitute_Vesting (VestingLock with startDate; endDate))) = GLK_Vesting with startDate; endDate getBeneficiaryPartyOptional : Party -> GovernanceLock -> ExtraArgs -> Update (Optional Party) getBeneficiaryPartyOptional dso (GovernanceLock_SVLocked lock) extraArgs @@ -94,7 +131,6 @@ effectiveAtKey = "cip-105/effectiveAt" topUpAllocationMetadataKey : Text topUpAllocationMetadataKey = "cip-105/topup-allocation-cid" - unlockControllerKey : Text unlockControllerKey = "cip-105/unlockControllers" withdrawControllerKey : Text @@ -102,6 +138,8 @@ withdrawControllerKey = "cip-105/withdrawControllers" substituteControllerKey : Text substituteControllerKey = "cip-105/substituteControllers" +substituteAllocationContextKey : Text +substituteAllocationContextKey = "cip-105/topup-allocation-cid" governanceMetadataKeys : Metadata -> S.Set Text governanceMetadataKeys meta = S.fromList $ fst <$> TM.toList ( TM.filterWithKey ( \_ a -> "cip-105/" `T.isPrefixOf` a ) meta.values ) @@ -173,11 +211,14 @@ parseAndValidateGovernanceLockOperation fromAllocate dso alloc = do pure . Some $ GovernanceLockOperation_Allocate lock None -> do let eitherCid = lookupFromContext @(ContractId V2.Allocation) alloc.extraArgs.context topUpAllocationMetadataKey - case eitherCid of + let substituteCid = lookupFromContext @(ContractId V2.Allocation) alloc.extraArgs.context substituteAllocationContextKey + case (,) <$> eitherCid <*> substituteCid of Left t -> assertFail t - Right None -> pure None - Right (Some topUpAllocationCid) -> + Right (None, None) -> pure None + Right (Some topUpAllocationCid, None) -> pure . Some . GovernanceLockOperation_TopUp $ TopUpAllocation topUpAllocationCid + Right (optTopUpAllocationCid, Some substituteCid) -> + pure . Some . GovernanceLockOperation_Substitute $ SubstituteAllocation substituteCid optTopUpAllocationCid governanceLockProposal_rules (GovernanceLock_VestingLocked _) = assertFail "Creating vesting locks from an allocation instruction is not permitted" diff --git a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml index d4268a673e..1d93908ca6 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -729,6 +729,7 @@ governanceAllocateImpl arg@V2.AllocationFactory_Allocate{..} = do authorizerChangeCids = TextMap.empty output = V2.AllocationInstructionResult_Pending with allocationInstructionCid meta = emptyMetadata + GovernanceLockOperation_Substitute op -> undefined -- FIXME: governanceAllocateSubstitutionImpl arg op allocationAmount GovernanceLockOperation_TopUp (TopUpAllocation topUpAllocationCid) -> do -- Grab top-up-alloc -- fetchButarchiveLater old diff --git a/daml/splice-amulet/daml/Splice/GovernanceSubstitutionProposal.daml b/daml/splice-amulet/daml/Splice/GovernanceSubstitutionProposal.daml new file mode 100644 index 0000000000..3f3c4c7ce9 --- /dev/null +++ b/daml/splice-amulet/daml/Splice/GovernanceSubstitutionProposal.daml @@ -0,0 +1,158 @@ +module Splice.GovernanceSubstitutionProposal where + +import Splice.AmuletAllocationV2 +import Splice.Amulet.TokenApiUtils +import Splice.AmuletRules +import Splice.Amulet.TwoStepTransfer +import Splice.AmuletAllocation as AmuletAllocationV1 +import Splice.Api.Token.HoldingV1 as V1 +import Splice.Api.Token.HoldingV2 as V2 +import Splice.Api.Token.AllocationV2 as V2 +import Splice.Api.Token.AllocationInstructionV2 as V2 +import Splice.Api.Token.MetadataV1 +import Splice.TokenStandard.Utils hiding (require) -- (maxTime, regularAccountOwner, isValidAllocationSpecificationV2) +import Splice.TokenStandard.Utils.Internal.Allocations -- (settlementFactoryV2_settleBatchDefaultImplNoSelf) +import Splice.TokenStandard.Utils.Internal.Conversions (timeFromMeta, encodeTime) +import Splice.Util + +import Splice.Amulet + +import DA.Action hiding (mapA) +import DA.Assert (assertDeadlineExceeded, assertWithinDeadline) +import DA.Either +import DA.Optional +import qualified DA.Set as S +import DA.Text as T +import DA.List hiding (concat) +import qualified DA.Map as Map +import qualified DA.TextMap as TM +import DA.Time +import DA.Traversable (mapA) +import DA.Foldable (concat, forA_) +import Prelude hiding (mapA, concat) + + +template GovernanceLockSubstitutionProposal with + admin : Party + proposedBy : Party + proposedTo : Party + substituteWithCid : ContractId AmuletAllocationV2 + topUpAllocationCid : Optional (ContractId AmuletAllocationV2) + where + signatory admin, proposedBy + interface instance V2.AllocationInstruction for GovernanceLockSubstitutionProposal where + view = V2.AllocationInstructionView with + originalInstructionCid + settlement = V2.SettlementInfo with + executors = [ admin ] + id = "cip-105/substitution" + cid = None + meta = emptyMetadata + allocation = V2.AllocationSpecification with + admin + authorizer = basicAccount allocationAuthorizer + transferLegSides = [] + settlementDeadline = Some maxComparableTime + nextIterationFunding = Some $ TextMap.singleton amuletInstrumentIdName allocationAmount + committed = True -- Revisit for FA locks + meta = governanceLockToMeta proposedLock + requestedAt + inputHoldingCids + availableActions = Map.fromList + [ (V2.AIA_Withdraw, [[allocationAuthorizer]]) + , (V2.AIA_Accept, [optionalToList svParty]) + ] + expiresAt = None + meta = emptyMetadata + + allocationInstruction_withdrawExtraObservers _ = observer this + allocationInstruction_acceptExtraObservers _ = observer this + allocationInstruction_withdrawImpl self arg = do + require "the offering party must be the party to authorize withdraw" $ arg.actors == [ proposedBy ] + archive self + allocationInstruction_acceptImpl self arg = do + substitutedCid <- arg.extraArgs.context `getFromContextU` "cip-105/substituteCid" -- Possibly extend later to allow more than one unlocking CID; does not change offer model. + substitutedAllocation <- fetchChecked (ForDso admin) substitutedCid + require "substituted-for allocation must be owned by the specified party" $ substitutedAllocation.authorizer.owner == proposedTo + let substituteControllers = fromOptional [[proposedTo]] $ (substitutingAllocation.governanceLock >>= lockControllersFromGovernanceLock >>= substitute) + checkControllerSpecification TM.empty arg.actors substituteControllers + -- We have auth from every required party at this point, move on to checking constraints. + + substituteWithAllocation <- fetchChecked (ForDso admin) substituteWithCid + require "substituted-by allocation must be owned by the proposing party" $ substituteWithAllocation.authorizer.owner == proposedTo + + -- Using amount becuase the settlement legs below will all have this amount. nextIterationFunding maps will vary. + let Some [(_, amount)] = TM.toList substituteWithAllocation.allocation.nextIterationFunding + + require "lock subjects must match between substituted allocations" $ + (governanceLockKey <$> substituteWithAllocation.governanceLock) == (governanceLockKey <$> substitutedAllocation.governanceLock) + + -- Update the proposing party's allocations + case topUpAllocationCid of + None -> do -- No allocation to top up, so we can just convert the input allocation to the new lock. + archive substituteWithCid + create substituteWithAllocation with + committed = True + governanceLock = governanceLockForSubstitution <$> substituteWithAllocation.governanceLock + Some topUpAllocationCid -> do + topUpAllocation <- fetchChecked (ForDso admin) substituteWithCid + require "top up allocation must match the substituting lock" + (governanceLockKey <$> topUpAllocation.governanceLock) == (governanceLockKey <$> substitutedAllocation.governanceLock) + let Some [(_, topupInitialAmount)] = TM.toList substituteWithAllocation.allocation.nextIterationFunding + let topUpResultingAmount = topupInitialAmount + amount + settlementFactoryV2_settleBatchDefaultImplNoSelf (\_ _ -> pure arg.extraArgs) admin $ SettlementFactory_SettleBatch with + settlement = topUpAllocation.settlement + actors = [ admin ] + extraArgs = arg.extraArgs + transferLegs = + [ TransferLeg with + transferLegId + sender = basicAccount $ proposedBy + receiver = basicAccount $ proposedBy + amount + instrumentId + meta = emptyMetadata + ] + allocations = + [ FinalizedAllocation with + allocationCid = toInterfaceContractId substituteWithCid + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = SenderSide + otherside = basicAccount $ proposedBy + amount + instrumentId + meta = emptyMetadata + ] + nextIterationFunding = newLockedNextIterationFunding + , FinalizedAllocation with + allocationCid = toInterfaceContractId topUpAllocationCid + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = ReceiverSide + otherside = alloc.allocation.authorizer + amount + instrumentId + meta = emptyMetadata + ] + nextIterationFunding = Some $ TM.singleton amuletInstrumentIdName topUpResultingAmount + ] + + -- And update the acceptor's holding to reflect the released funds. + let Some [(_, acceptingAmount)] = TM.toList substituteWithAllocation.allocation.nextIterationFunding + let newAccepterAmount = acceptingAmount - amount + let nextIterationFunding = if acceptingAmount == amount then None else Some TM.singleton amuletInstrumentIdName newAccepterAmount + settleBatchResult <- settlementFactoryV2_settleBatchDefaultImplNoSelf (\_ _ -> pure arg.extraArgs) admin $ SettlementFactory_SettleBatch with + settlement = topUpAllocation.settlement + actors = [ admin ] + extraArgs = arg.extraArgs + transferLegs = [] + allocations = + [ FinalizedAllocation with + allocationCid = toInterfaceContractId substituteWithCid + extraTransferLegSides = [] + nextIterationFunding + ] + pure $ head settleBatchResult.allocationSettleResults