Single piggy bank address

shell.nix

@@ -0,0 +1,15 @@
+(
+  import
+    (
+      let
+        lock = builtins.fromJSON (builtins.readFile ./flake.lock);
+      in
+      fetchTarball {
+        url = "https://github.com/edolstra/flake-compat/archive/${lock.nodes.flake-compat.locked.rev}.tar.gz";
+        sha256 = lock.nodes.flake-compat.locked.narHash;
+      }
+    )
+    {
+      src = ./.;
+    }
+).shellNix.default

src/Fida/Contract/Insurance/Datum.hs

@@ -44,6 +44,10 @@ import qualified Prelude as HPrelude
 newtype FidaCardId = FidaCardId BuiltinByteString
   deriving newtype (ToData, FromData, UnsafeFromData, HPrelude.Show, HPrelude.Eq)
 
+instance Eq FidaCardId where
+  {-# INLINEABLE (==) #-}
+  FidaCardId a == FidaCardId b = a == b
+
 PlutusTx.makeLift ''FidaCardId
 
 type PremiumAmount = Integer
@@ -126,7 +130,8 @@ data InsurancePolicyDatum
   | PremiumPaymentInfo
       { -- | in lovelace
         ppInfoPremiumAmountPerPiggyBank :: Integer
-      , ppInfoPiggyBanks :: [Address]
+      , ppInfoPiggyBankAddress :: Address
+      , ppInfoFidaCardIds :: [FidaCardId]
       }
   | PolicyClaimPayment
   deriving (HPrelude.Show, HPrelude.Eq)
@@ -171,6 +176,7 @@ data PiggyBankDatum
   = PBankPremium
       { pbankPremium'init :: PremiumAmount
       , pbankPremium'refund :: PremiumAmount
+      , pbankPremium'FidaCardId :: FidaCardId
       }
   | PBankFidaCard
       { pbfcIsSold :: Bool

src/Fida/Contract/Insurance/Lifecycle/Initiated.hs

@@ -5,7 +5,7 @@
 module Fida.Contract.Insurance.Lifecycle.Initiated (lifecycleInitiatedStateValidator) where
 
 import Fida.Contract.Insurance.Authority (isSignedByTheAuthority)
-import Fida.Contract.Insurance.Datum (InsurancePolicyDatum (..), InsurancePolicyState (..), PiggyBankDatum (..), untypedUpdatePolicyState)
+import Fida.Contract.Insurance.Datum (FidaCardId (..), InsurancePolicyDatum (..), InsurancePolicyState (..), PiggyBankDatum (..), untypedUpdatePolicyState)
 import Fida.Contract.Insurance.InsuranceId (InsuranceId (..))
 import Fida.Contract.Insurance.Redeemer (PolicyInitiatedRedemeer (..))
 import Fida.Contract.Insurance.Tokens (policyInfoTokenName, policyPaymentTokenName)
@@ -81,7 +81,7 @@ lifecycleInitiatedStateValidator (InsuranceId cs) datum@(InsuranceInfo {iInfoSta
 
   hasCorrectOutput = outputDatum == untypedUpdatePolicyState datum Cancelled
 lifecycleInitiatedStateValidator (InsuranceId cs) PremiumPaymentInfo {..} PolicyInitiatedPayPremium sc =
-  traceIfFalse "ERROR-INITIATED-VALIDATOR-3" (length (nub payments) == length ppInfoPiggyBanks)
+  traceIfFalse "ERROR-INITIATED-VALIDATOR-3" (length (nub payments) == length ppInfoFidaCardIds)
     && traceIfNotSingleton "ERROR-INITIATED-VALIDATOR-4" isPolicyInfoSpent
  where
   txInfo = scriptContextTxInfo sc
@@ -92,12 +92,13 @@ lifecycleInitiatedStateValidator (InsuranceId cs) PremiumPaymentInfo {..} Policy
     , valueOf value cs policyInfoTokenName == 1
     ]
 
-  payments :: [Address]
+  payments :: [FidaCardId]
   payments =
-    [ address
+    [ fidaCardId
     | TxOut address value (OutputDatum (Datum datum)) _ <- txInfoOutputs txInfo
-    , Just (PBankPremium amount refund) <- [PlutusTx.fromBuiltinData datum]
-    , elem address ppInfoPiggyBanks
+    , Just (PBankPremium amount refund fidaCardId) <- [PlutusTx.fromBuiltinData datum]
+    , elem fidaCardId ppInfoFidaCardIds
+    , address == ppInfoPiggyBankAddress
     , refund == 0
     , let paid = lovelaceValueOf value
        in paid >= ppInfoPremiumAmountPerPiggyBank && paid == amount

src/Fida/Contract/Insurance/PiggyBank.hs

@@ -123,12 +123,11 @@ import PlutusTx.Prelude
 {-# INLINEABLE mkPiggyBankValidator #-}
 mkPiggyBankValidator ::
   InsuranceId ->
-  FidaCardId ->
   PiggyBankDatum ->
   PiggyBankRedeemer ->
   ScriptContext ->
   Bool
-mkPiggyBankValidator (InsuranceId cs) _ datum@(PBankFidaCard {pbfcIsSold = False, pbfcFidaCardValue}) BuyFidaCard sc =
+mkPiggyBankValidator (InsuranceId cs) datum@(PBankFidaCard {pbfcIsSold = False, pbfcFidaCardValue}) BuyFidaCard sc =
   traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-0" isSold
  where
   inputLovelace = case findOwnInput sc of
@@ -142,7 +141,7 @@ mkPiggyBankValidator (InsuranceId cs) _ datum@(PBankFidaCard {pbfcIsSold = False
       Just (TxOut _ v (OutputDatum (Datum d)) _)
         | lovelaceValueOf v >= pbfcFidaCardValue + inputLovelace -> d
         | otherwise -> traceError "ERROR-PIGGY-BANK-VALIDATOR-4"
-mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) (PBankFidaCard {pbfcIsSold = True, pbfcFidaCardValue}) SellFidaCard scriptContext =
+mkPiggyBankValidator (InsuranceId cs) (PBankFidaCard {pbfcIsSold = True, pbfcFidaCardValue, pbfcFidaCardId=FidaCardId n}) SellFidaCard scriptContext =
   traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-5" (not pbfcIsSold)
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-6" (pbfcFidaCardValue == pbfcFidaCardValue')
  where
@@ -158,7 +157,7 @@ mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) (PBankFidaCard {pbfcIsSold
     case datum of
       Just (PBankFidaCard {pbfcIsSold = isSold, pbfcFidaCardValue = cardValue}) -> (isSold, cardValue)
       _ -> traceError "ERROR-PIGGY-BANK-VALIDATOR-8"
-mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) datum@(PBankPremium initAmount refund) ClaimPremium sc =
+mkPiggyBankValidator (InsuranceId cs) datum@(PBankPremium initAmount refund (FidaCardId n)) ClaimPremium sc =
   traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-7" isFidaCardOwner
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-8" isClaimedPremiumAmountValid
  where
@@ -185,7 +184,7 @@ mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) datum@(PBankPremium initAmo
       Nothing -> traceError "ERROR-PIGGY-BANK-VALIDATOR-10"
 
   isClaimedPremiumAmountValid = lockedPremium >= initAmount - refund - availablePremium
-mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) (PBankFidaCard {pbfcIsSold = True, pbfcFidaCardValue, pbfcPaidClaims}) PayForClaimWithCollateral sc =
+mkPiggyBankValidator (InsuranceId cs) (PBankFidaCard {pbfcIsSold = True, pbfcFidaCardValue, pbfcPaidClaims, pbfcFidaCardId=FidaCardId n}) PayForClaimWithCollateral sc =
   traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-11" isClaimAccepted
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-12" collateralDiffAmountCorrect
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-13" claimNotPaidYet
@@ -243,7 +242,7 @@ mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) (PBankFidaCard {pbfcIsSold
 --
 -- TODO ClaimPremiumOnCancel rename to RefundPremium
 --
-mkPiggyBankValidator (InsuranceId cs) _ datum@(PBankPremium initAmount refund) ClaimPremiumOnCancel sc =
+mkPiggyBankValidator (InsuranceId cs) datum@(PBankPremium initAmount refund _) ClaimPremiumOnCancel sc =
   traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-21" isPolicyCancelled
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-22" isSignedByPolicyHolder
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-23" isClaimedPremiumAmountValid
@@ -283,7 +282,7 @@ mkPiggyBankValidator (InsuranceId cs) _ datum@(PBankPremium initAmount refund) C
   refundAmount = initAmount - premiumLeftForInvestor
 
   isClaimedPremiumAmountValid = spendValue - lockedPremium <= refundAmount
-mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) (PBankFidaCard {}) UnlockCollateralOnCancel sc =
+mkPiggyBankValidator (InsuranceId cs) (PBankFidaCard {pbfcFidaCardId=FidaCardId n}) UnlockCollateralOnCancel sc =
   traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-25" isPolicyCancelled
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-26" isFidaCardOwner
  where
@@ -297,7 +296,7 @@ mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) (PBankFidaCard {}) UnlockCo
       ]
 
   isFidaCardOwner = valueOf (valueSpent txInfo) cs (fidaCardTokenName n) == 1
-mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) (PBankFidaCard {pbfcPaidClaims}) UnlockCollateral sc =
+mkPiggyBankValidator (InsuranceId cs) (PBankFidaCard {pbfcPaidClaims, pbfcFidaCardId=FidaCardId n}) UnlockCollateral sc =
   traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-28" isPolicyExpired
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-29" isFidaCardOwner
     && traceIfFalse "ERROR-PIGGY-BANK-VALIDATOR-30" isClaimPaid
@@ -316,31 +315,28 @@ mkPiggyBankValidator (InsuranceId cs) (FidaCardId n) (PBankFidaCard {pbfcPaidCla
   isFidaCardOwner = valueOf (valueSpent txInfo) cs (fidaCardTokenName n) == 1
   isClaimPaid = fromMaybe True (((`elem` pbfcPaidClaims) . claimId) <$> mClaim)
 
-mkPiggyBankValidator _ _ _ _ _ = False
+mkPiggyBankValidator _ _ _ _ = False
 
 {-# INLINEABLE mkPiggyBankValidatorUntyped #-}
 mkPiggyBankValidatorUntyped ::
   BuiltinData ->
   BuiltinData ->
   BuiltinData ->
   BuiltinData ->
-  BuiltinData ->
   ()
-mkPiggyBankValidatorUntyped insuranceId fidaCardId =
+mkPiggyBankValidatorUntyped insuranceId =
   wrapValidator $
     mkPiggyBankValidator
       (unsafeFromBuiltinData insuranceId)
-      (unsafeFromBuiltinData fidaCardId)
 
 serialisablePiggyBankValidator :: Script
 serialisablePiggyBankValidator =
   fromCompiledCode $$(PlutusTx.compile [||mkPiggyBankValidatorUntyped||])
 
-piggyBankValidator :: InsuranceId -> FidaCardId -> Validator
-piggyBankValidator iid fcid =
+piggyBankValidator :: InsuranceId -> Validator
+piggyBankValidator iid =
   mkValidatorScript $
     $$(PlutusTx.compile [||wrappedValidator||])
       `PlutusTx.applyCode` PlutusTx.liftCode iid
-      `PlutusTx.applyCode` PlutusTx.liftCode fcid
  where
-  wrappedValidator iid' = wrapValidator . mkPiggyBankValidator iid'
+  wrappedValidator iid' = wrapValidator $ mkPiggyBankValidator iid'

test/Fida/Contract/FidaPolicyContractTest.hs

@@ -49,7 +49,7 @@ testPolicyExpirationDuringFunding = do
   triggerPolicyExpiration iid broker1
 
 
-testPolicyExpirationDuringOnRisk:: Run ()
+testPolicyExpirationDuringOnRisk :: Run ()
 testPolicyExpirationDuringOnRisk = do
   users@Users {..} <- setupUsers
 

test/Fida/Contract/Insurance/Lifecycle/InitiatedTest.hs

@@ -116,10 +116,10 @@ testRequiredUtxos = do
 
           assertTrue "Premium amount per piggy bank doesn't match" $ ppInfoPremiumAmountPerPiggyBank == 20_000_000
           assertTrue "Piggy banks addresses don't match" $
-            ppInfoPiggyBanks == map (piggyBankAddr iid . fidaCardFromInt) [1 .. 10]
+            ppInfoFidaCardIds == map fidaCardFromInt [1 .. 10]
 
           forM_ (map fidaCardFromInt [1 .. 10]) $ \fcid@(FidaCardId tn) ->
-            let ptv = piggyBank iid fcid
+            let ptv = piggyBank iid
              in withBox @PiggyBank (piggyBankInfoBox iid fcid) ptv $
                   \(TxBox _ (TxOut _ piggyBankInfoValue _ _) piggyBankDatum) -> do
                     let atpp msg = msg <> " @ piggy bank " <> show fcid

test/Fida/Contract/Insurance/Lifecycle/OnRiskTest.hs

@@ -75,18 +75,19 @@ createClaim iid policyHolder users@Users{investor1} = do
   let redeemer = PolicyOnRisk $ PolicyOnRiskCreateClaim claim
 
   let tv = insurancePolicy iid
-  withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum) -> do
-    validRangeStart <- currentTime
-    let newDatum = updateClaim iinfoDatum (Just claim)
-    withMay "Can't create claim" (pure newDatum) $ \datum -> do
-      let tx = mconcat
-                [ spendBox tv redeemer box
-                , payToScript tv (InlineDatum datum) value
-                ]
-
-      tx' <- validateIn (from validRangeStart) tx
-      submitTx policyHolder tx'
-      return ()
+  withRefScript (isScriptRef tv) tv $ \(scriptRef, _) -> do
+    withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum) -> do
+      validRangeStart <- currentTime
+      let newDatum = updateClaim iinfoDatum (Just claim)
+      withMay "Can't create claim" (pure newDatum) $ \datum -> do
+        let tx = mconcat
+                  [ spendBoxRef scriptRef tv redeemer box
+                  , payToScript tv (InlineDatum datum) value
+                  ]
+
+        tx' <- validateIn (from validRangeStart) tx
+        submitTx policyHolder tx'
+        return ()
 
 testCloseClaim :: Run ()
 testCloseClaim = do
@@ -103,16 +104,17 @@ closeClaim iid policyHolder users = do
   let redeemer = PolicyOnRisk $ PolicyOnRiskCloseClaim
 
   let tv = insurancePolicy iid
-  withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum) -> do
-    let newDatum = updateClaim iinfoDatum Nothing
-    withMay "Can't close claim" (pure newDatum) $ \datum -> do
-      let tx = mconcat
-                [ spendBox tv redeemer box
-                , payToScript tv (InlineDatum datum) value
-                ]
-
-      submitTx policyHolder tx
-      return ()
+  withRefScript (isScriptRef tv) tv $ \(scriptRef, _) -> do
+    withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum) -> do
+      let newDatum = updateClaim iinfoDatum Nothing
+      withMay "Can't close claim" (pure newDatum) $ \datum -> do
+        let tx = mconcat
+                  [ spendBoxRef scriptRef tv redeemer box
+                  , payToScript tv (InlineDatum datum) value
+                  ]
+
+        submitTx policyHolder tx
+        return ()
 
 testAcceptClaim :: Run ()
 testAcceptClaim = do
@@ -129,16 +131,17 @@ acceptClaim iid fidaSystem users = do
   let redeemer = PolicyOnRisk $ PolicyOnRiskAcceptClaim
 
   let tv = insurancePolicy iid
-  withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum@InsuranceInfo{iInfoClaim = claim}) -> do
-    let newDatum = updateClaim iinfoDatum $ ((\c -> c{claimAccepted=True}) <$> claim)
-    withMay "Can't accept claim" (pure newDatum) $ \datum -> do
-      let tx = mconcat
-                [ spendBox tv redeemer box
-                , payToScript tv (InlineDatum datum) value
-                ]
-
-      submitTx fidaSystem tx
-      return ()
+  withRefScript (isScriptRef tv) tv $ \(scriptRef, _) -> do
+    withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum@InsuranceInfo{iInfoClaim = claim}) -> do
+      let newDatum = updateClaim iinfoDatum $ ((\c -> c{claimAccepted=True}) <$> claim)
+      withMay "Can't accept claim" (pure newDatum) $ \datum -> do
+        let tx = mconcat
+                  [ spendBoxRef scriptRef tv redeemer box
+                  , payToScript tv (InlineDatum datum) value
+                  ]
+
+        submitTx fidaSystem tx
+        return ()
 
 testExpireClaim :: Run ()
 testExpireClaim = do
@@ -157,17 +160,18 @@ expireClaim iid investor1 users = do
   let redeemer = PolicyOnRisk $ PolicyOnRiskExpireClaim
 
   let tv = insurancePolicy iid
-  withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum) -> do
-    let newDatum = updateClaim iinfoDatum Nothing
-    withMay "Can't expire claim" (pure newDatum) $ \datum -> do
-      let tx = mconcat
-                [ spendBox tv redeemer box
-                , payToScript tv (InlineDatum datum) value
-                ]
-      validRangeStart <- currentTime
-      tx' <- validateIn (from validRangeStart) tx
-      submitTx investor1 tx'
-      return ()
+  withRefScript (isScriptRef tv) tv $ \(scriptRef, _) -> do
+    withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum) -> do
+      let newDatum = updateClaim iinfoDatum Nothing
+      withMay "Can't expire claim" (pure newDatum) $ \datum -> do
+        let tx = mconcat
+                  [ spendBoxRef scriptRef tv redeemer box
+                  , payToScript tv (InlineDatum datum) value
+                  ]
+        validRangeStart <- currentTime
+        tx' <- validateIn (from validRangeStart) tx
+        submitTx investor1 tx'
+        return ()
 
 testFailClaim :: Run ()
 testFailClaim = do
@@ -186,15 +190,16 @@ failClaim iid fidaSystem users = do
   let redeemer = PolicyOnRisk $ PolicyOnRiskFailClaim
 
   let tv = insurancePolicy iid
-  withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum) -> do
-    let newDatum = updateClaim iinfoDatum Nothing
-    withMay "Can't fail claim" (pure newDatum) $ \datum -> do
-      let tx = mconcat
-                [ spendBox tv redeemer box
-                , payToScript tv (InlineDatum datum) value
-                ]
-      submitTx fidaSystem tx
-      return ()
+  withRefScript (isScriptRef tv) tv $ \(scriptRef, _) -> do
+    withBox @ InsurancePolicy (iinfoBox iid) tv $ \box@(TxBox _ (TxOut _ value _ _) iinfoDatum) -> do
+      let newDatum = updateClaim iinfoDatum Nothing
+      withMay "Can't fail claim" (pure newDatum) $ \datum -> do
+        let tx = mconcat
+                  [ spendBoxRef scriptRef tv redeemer box
+                  , payToScript tv (InlineDatum datum) value
+                  ]
+        submitTx fidaSystem tx
+        return ()
 
 
 testClaimPayment :: Run ()
@@ -220,15 +225,15 @@ claimPayment iid policyHolder = do
 
   boxes <- filter (\(TxBox _ _ d) -> d == PolicyClaimPayment) <$> boxAt @ InsurancePolicy tv
 
+  withRefScript (isScriptRef tv) tv $ \(scriptRef, _) -> do
+    withBox @ InsurancePolicy (iinfoBox iid) tv $ \iInfoBox -> do
 
-  withBox @ InsurancePolicy (iinfoBox iid) tv $ \iInfoBox -> do
-
-    forM_ boxes $ \box@(TxBox _ (TxOut _ v _ _) _) -> do
-      let tx = mconcat $
-                [ spendBox tv (PolicyOnRisk PolicyOnRiskClaimPayment) box
-                , payToKey policyHolder v
-                , refBoxInline iInfoBox
-                ]
+      forM_ boxes $ \box@(TxBox _ (TxOut _ v _ _) _) -> do
+        let tx = mconcat $
+                  [ spendBoxRef scriptRef tv (PolicyOnRisk PolicyOnRiskClaimPayment) box
+                  , payToKey policyHolder v
+                  , refBoxInline iInfoBox
+                  ]
 
-      submitTx policyHolder tx
-      return ()
+        submitTx policyHolder tx
+        return ()