diff --git a/plutus-benchmark/linear-vesting/src/LinearVesting/Validator.hs b/plutus-benchmark/linear-vesting/src/LinearVesting/Validator.hs index a6b252fa3bc..55b5c0e6fed 100644 --- a/plutus-benchmark/linear-vesting/src/LinearVesting/Validator.hs +++ b/plutus-benchmark/linear-vesting/src/LinearVesting/Validator.hs @@ -1,13 +1,8 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE Strict #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -26,18 +21,23 @@ {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-remove-trace #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:preserve-logging #-} -module LinearVesting.Validator where +module LinearVesting.Validator + ( VestingDatum (..) + , VestingRedeemer (..) + , validatorCode + ) +where -import PlutusTx -import PlutusTx.Prelude +import PlutusLedgerApi.Data.V3 (Address) +import PlutusLedgerApi.V1.Data.Value (AssetClass) +import PlutusTx (CompiledCode, compile, makeIsDataIndexed, makeLift) +import PlutusTx.Bool (Bool (..), not, otherwise) +import PlutusTx.Builtins.HasOpaque () +import PlutusTx.Builtins.Internal qualified as BI +import PlutusTx.Trace (traceError) +import Prelude (Integer) import Prelude qualified as Haskell -import PlutusLedgerApi.Data.V3 -import PlutusLedgerApi.V1.Data.Value (AssetClass, assetClassValueOf) -import PlutusLedgerApi.V3.Data.Contexts (txSignedBy) -import PlutusTx.Data.List (List) -import PlutusTx.Data.List qualified as List - data VestingDatum = VestingDatum { beneficiary :: Address , vestingAsset :: AssetClass @@ -54,128 +54,312 @@ $(makeIsDataIndexed ''VestingDatum [('VestingDatum, 0)]) data VestingRedeemer = PartialUnlock | FullUnlock -$(PlutusTx.makeLift ''VestingRedeemer) -$( PlutusTx.makeIsDataIndexed - ''VestingRedeemer - [('PartialUnlock, 0), ('FullUnlock, 1)] - ) +$(makeLift ''VestingRedeemer) +$(makeIsDataIndexed ''VestingRedeemer [('PartialUnlock, 0), ('FullUnlock, 1)]) -countInputsAtScript :: ScriptHash -> List TxInInfo -> Integer -countInputsAtScript scriptHash = go 0 - where - go :: Integer -> List TxInInfo -> Integer - go n = List.caseList' n \txIn txIns -> - case addressCredential (txOutAddress (txInInfoResolved txIn)) of - ScriptCredential vh | vh == scriptHash -> go (n + 1) txIns - _ -> go n txIns - -validateVestingPartialUnlock :: ScriptContext -> Bool -validateVestingPartialUnlock ctx = - let - txInfo :: TxInfo = scriptContextTxInfo ctx - SpendingScript ownRef (Just (Datum datum)) = scriptContextScriptInfo ctx - vestingDatum :: VestingDatum = unsafeFromBuiltinData datum - inputs = txInfoInputs txInfo - - Just ownVestingInput = List.find ((== ownRef) . txInInfoOutRef) inputs - resolvedOut = txInInfoResolved ownVestingInput - inputAddress = txOutAddress resolvedOut - - ScriptCredential scriptHash = addressCredential inputAddress - Just ownVestingOutput = - List.find ((== inputAddress) . txOutAddress) (txInfoOutputs txInfo) - outputDatum = txOutDatum ownVestingOutput - - divCeil :: Integer -> Integer -> Integer - divCeil x y = 1 + (x - 1) `divide` y - - asset :: AssetClass = - vestingAsset vestingDatum - oldRemainingQty :: Integer = - assetClassValueOf (txOutValue resolvedOut) asset - newRemainingQty :: Integer = - assetClassValueOf (txOutValue ownVestingOutput) asset - vestingPeriodLength :: Integer = - vestingPeriodEnd vestingDatum - vestingPeriodStart vestingDatum - currentTimeApproximation :: Integer = - getPOSIXTime (getLowerInclusiveTimeRange (txInfoValidRange txInfo)) - vestingTimeRemaining :: Integer = - vestingPeriodEnd vestingDatum - currentTimeApproximation - timeBetweenTwoInstallments :: Integer = - vestingPeriodLength `divCeil` totalInstallments vestingDatum - futureInstallments :: Integer = - vestingTimeRemaining `divCeil` timeBetweenTwoInstallments - expectedRemainingQty :: Integer = - (futureInstallments * totalVestingQty vestingDatum) - `divCeil` totalInstallments vestingDatum - PubKeyCredential beneficiaryHash = - addressCredential (beneficiary vestingDatum) - in - if - | not (txSignedBy txInfo beneficiaryHash) -> - traceError "Missing beneficiary signature" - | firstUnlockPossibleAfter vestingDatum >= currentTimeApproximation -> - traceError "Unlock not permitted until firstUnlockPossibleAfter time" - | newRemainingQty <= 0 -> - traceError "Zero remaining assets not allowed" - | newRemainingQty >= oldRemainingQty -> - traceError "Remaining asset is not decreasing" - | expectedRemainingQty /= newRemainingQty -> - traceError "Mismatched remaining asset" - | txOutDatum resolvedOut /= outputDatum -> - traceError "Datum Modification Prohibited" - | countInputsAtScript scriptHash inputs /= 1 -> - traceError "Double satisfaction" - | otherwise -> - True - -validateVestingFullUnlock :: ScriptContext -> Bool -validateVestingFullUnlock ctx = - let - txInfo :: TxInfo = scriptContextTxInfo ctx - currentTimeApproximation :: Integer = - getPOSIXTime (getLowerInclusiveTimeRange (txInfoValidRange txInfo)) - SpendingScript _ownRef (Just (Datum datum)) = scriptContextScriptInfo ctx - vestingDatum :: VestingDatum = unsafeFromBuiltinData datum - PubKeyCredential beneficiaryKey = addressCredential (beneficiary vestingDatum) - in - if - | not (txSignedBy txInfo beneficiaryKey) -> - traceError "Missing beneficiary signature" - | vestingPeriodEnd vestingDatum >= currentTimeApproximation -> - traceError "Unlock not permitted until vestingPeriodEnd time" - | otherwise -> - True - -getLowerInclusiveTimeRange :: POSIXTimeRange -> POSIXTime -getLowerInclusiveTimeRange = \case - Interval (LowerBound (Finite posixTime) inclusive) _upperBound -> - if inclusive then posixTime else posixTime + 1 - _ -> traceError "Time range not Finite" - -{-# INLINEABLE typedValidator #-} -typedValidator :: ScriptContext -> Bool -typedValidator context = - trace "Validation completed" - $ case redeemer of - FullUnlock -> - validateVestingFullUnlock $ trace "Full unlock requested" context - PartialUnlock -> - validateVestingPartialUnlock $ trace "Partial unlock requested" context +{-# INLINE divCeil #-} +divCeil :: BI.BuiltinInteger -> BI.BuiltinInteger -> BI.BuiltinInteger +divCeil x y = BI.addInteger 1 (BI.divideInteger (BI.subtractInteger x 1) y) + +{-# INLINE lowerInclusiveTime #-} +lowerInclusiveTime :: BI.BuiltinData -> BI.BuiltinInteger +lowerInclusiveTime iv = + let ivFields = BI.snd (BI.unsafeDataAsConstr iv) + lower = BI.head ivFields + !lowerFields = BI.snd (BI.unsafeDataAsConstr lower) + extended = BI.head lowerFields + closureData = BI.head (BI.tail lowerFields) + closureTag = BI.fst (BI.unsafeDataAsConstr closureData) + !extCon = BI.unsafeDataAsConstr extended + extTag = BI.fst extCon + extFields = BI.snd extCon + offset = + if BI.equalsInteger closureTag 1 then 0 else 1 + in if BI.equalsInteger extTag 1 + then BI.addInteger (BI.unsafeDataAsI (BI.head extFields)) offset + else traceError "Time range not Finite" + +{-# INLINE txSignedBy' #-} +txSignedBy' :: BI.BuiltinList BI.BuiltinData -> BI.BuiltinByteString -> Bool +txSignedBy' signatories pkh = + BI.caseList' + False + ( \s ss -> + let sBytes = BI.unsafeDataAsB s + in if BI.equalsByteString sBytes pkh + then True + else txSignedBy' ss pkh + ) + signatories + +{-# INLINE findInputByOutRef #-} +findInputByOutRef :: BI.BuiltinData -> BI.BuiltinList BI.BuiltinData -> BI.BuiltinData +findInputByOutRef ref inputs = + BI.caseList' + (traceError "Own input not found") + ( \txIn txIns -> + let txInFields = BI.snd (BI.unsafeDataAsConstr txIn) + txInRef = BI.head txInFields + in if BI.equalsData txInRef ref + then txIn + else findInputByOutRef ref txIns + ) + inputs + +{-# INLINE findOutputByAddress #-} +findOutputByAddress :: BI.BuiltinData -> BI.BuiltinList BI.BuiltinData -> BI.BuiltinData +findOutputByAddress addr outputs = + BI.caseList' + (traceError "Own output not found") + ( \out outs -> + let outFields = BI.snd (BI.unsafeDataAsConstr out) + outAddr = BI.head outFields + in if BI.equalsData outAddr addr + then out + else findOutputByAddress addr outs + ) + outputs + +{-# INLINE countInputsAtScript #-} +countInputsAtScript :: BI.BuiltinByteString -> BI.BuiltinList BI.BuiltinData -> BI.BuiltinInteger +countInputsAtScript scriptHash inputs = + BI.caseList' + 0 + ( \txIn txIns -> + let txInFields = BI.snd (BI.unsafeDataAsConstr txIn) + resolvedOut = BI.head (BI.tail txInFields) + resolvedFields = BI.snd (BI.unsafeDataAsConstr resolvedOut) + addr = BI.head resolvedFields + addrFields = BI.snd (BI.unsafeDataAsConstr addr) + cred = BI.head addrFields + !credCon = BI.unsafeDataAsConstr cred + credTag = BI.fst credCon + credFields = BI.snd credCon + rest = countInputsAtScript scriptHash txIns + in if BI.equalsInteger credTag 1 + then + let vh = BI.unsafeDataAsB (BI.head credFields) + in if BI.equalsByteString vh scriptHash + then BI.addInteger 1 rest + else rest + else rest + ) + inputs + +{-# INLINE valueOf #-} +valueOf :: BI.BuiltinData -> BI.BuiltinByteString -> BI.BuiltinByteString -> BI.BuiltinInteger +valueOf valueData cs tn = + let outer = BI.unsafeDataAsMap valueData + in findCurrency outer where - {-# INLINEABLE redeemer #-} - redeemer :: VestingRedeemer - redeemer = - case fromBuiltinData (getRedeemer (scriptContextRedeemer context)) of - Nothing -> traceError "Failed to parse Redeemer" - Just r -> trace "Parsed Redeemer" r + findCurrency :: BI.BuiltinList (BI.BuiltinPair BI.BuiltinData BI.BuiltinData) -> BI.BuiltinInteger + findCurrency pairs = + if BI.null pairs + then 0 + else + let pair = BI.head pairs + key = BI.unsafeDataAsB (BI.fst pair) + in if BI.equalsByteString key cs + then findToken (BI.unsafeDataAsMap (BI.snd pair)) + else findCurrency (BI.tail pairs) + + findToken :: BI.BuiltinList (BI.BuiltinPair BI.BuiltinData BI.BuiltinData) -> BI.BuiltinInteger + findToken pairs = + if BI.null pairs + then 0 + else + let pair = BI.head pairs + key = BI.unsafeDataAsB (BI.fst pair) + in if BI.equalsByteString key tn + then BI.unsafeDataAsI (BI.snd pair) + else findToken (BI.tail pairs) + +-- No credential tag check needed: called on the input being validated, +-- so the ledger guarantees it's a ScriptCredential. +{-# INLINE getScriptHashFromAddress #-} +getScriptHashFromAddress :: BI.BuiltinData -> BI.BuiltinByteString +getScriptHashFromAddress addr = + BI.unsafeDataAsB (BI.head (BI.snd (BI.unsafeDataAsConstr (BI.head (BI.snd (BI.unsafeDataAsConstr addr)))))) + +-- No credential tag check needed: the extracted hash is verified +-- against txInfoSignatories, which the ledger validates. +{-# INLINE getPubKeyHashFromAddress #-} +getPubKeyHashFromAddress :: BI.BuiltinData -> BI.BuiltinByteString +getPubKeyHashFromAddress addr = + BI.unsafeDataAsB (BI.head (BI.snd (BI.unsafeDataAsConstr (BI.head (BI.snd (BI.unsafeDataAsConstr addr)))))) + +{-# INLINE getSpendingInfo #-} +getSpendingInfo :: BI.BuiltinData -> BI.BuiltinPair BI.BuiltinData BI.BuiltinData +getSpendingInfo scriptInfo = + let con = BI.unsafeDataAsConstr scriptInfo + tag = BI.fst con + fields = BI.snd con + in if BI.equalsInteger tag 1 + then + let ownRef = BI.head fields + maybeDatum = BI.head (BI.tail fields) + !mdCon = BI.unsafeDataAsConstr maybeDatum + mdTag = BI.fst mdCon + mdFields = BI.snd mdCon + in if BI.equalsInteger mdTag 0 + then BI.mkPairData ownRef (BI.head mdFields) + else traceError "Missing datum" + else traceError "Not spending script" + +{-# INLINE validateVestingPartialUnlock #-} +validateVestingPartialUnlock + :: BI.BuiltinList BI.BuiltinData + -> BI.BuiltinList BI.BuiltinData + -> BI.BuiltinData + -> BI.BuiltinList BI.BuiltinData + -> BI.BuiltinData + -> BI.BuiltinData + -> Bool +validateVestingPartialUnlock txInputs txOutputs txValidRange txSignatories ownRef vestingDatum = + let ownInput = findInputByOutRef ownRef txInputs + ownInputFields = BI.snd (BI.unsafeDataAsConstr ownInput) + resolvedOut = BI.head (BI.tail ownInputFields) + !resolvedFields = BI.snd (BI.unsafeDataAsConstr resolvedOut) + !inputAddress = BI.head resolvedFields + + scriptHash = getScriptHashFromAddress inputAddress + ownOutput = findOutputByAddress inputAddress txOutputs + !ownOutputFields = BI.snd (BI.unsafeDataAsConstr ownOutput) + outputDatum = BI.head (BI.tail (BI.tail ownOutputFields)) + + resolvedDatum = BI.head (BI.tail (BI.tail resolvedFields)) + + vdFields = BI.snd (BI.unsafeDataAsConstr vestingDatum) + vdFields1 = BI.tail vdFields + !vdFields2 = BI.tail vdFields1 + !vdFields3 = BI.tail vdFields2 + !vdFields4 = BI.tail vdFields3 + !vdFields5 = BI.tail vdFields4 + !vdFields6 = BI.tail vdFields5 + + beneficiaryAddr = BI.head vdFields + assetClassData = BI.head vdFields1 + totalVestingQty = BI.unsafeDataAsI (BI.head vdFields2) + vestingPeriodStart = BI.unsafeDataAsI (BI.head vdFields3) + vestingPeriodEnd = BI.unsafeDataAsI (BI.head vdFields4) + firstUnlockPossibleAfter = BI.unsafeDataAsI (BI.head vdFields5) + totalInstallments = BI.unsafeDataAsI (BI.head vdFields6) + + assetCon = BI.unsafeDataAsConstr assetClassData + assetFields = BI.snd assetCon + assetCs = BI.unsafeDataAsB (BI.head assetFields) + assetTn = BI.unsafeDataAsB (BI.head (BI.tail assetFields)) + + oldRemainingQty = valueOf (BI.head (BI.tail resolvedFields)) assetCs assetTn + newRemainingQty = valueOf (BI.head (BI.tail ownOutputFields)) assetCs assetTn + + vestingPeriodLength = BI.subtractInteger vestingPeriodEnd vestingPeriodStart + currentTimeApproximation = lowerInclusiveTime txValidRange + vestingTimeRemaining = BI.subtractInteger vestingPeriodEnd currentTimeApproximation + timeBetweenTwoInstallments = divCeil vestingPeriodLength totalInstallments + futureInstallments = divCeil vestingTimeRemaining timeBetweenTwoInstallments + expectedRemainingQty = + divCeil (BI.multiplyInteger futureInstallments totalVestingQty) totalInstallments + + beneficiaryHash = getPubKeyHashFromAddress beneficiaryAddr + signed = txSignedBy' txSignatories beneficiaryHash + in if + | not signed -> + traceError "Missing beneficiary signature" + | BI.lessThanEqualsInteger currentTimeApproximation firstUnlockPossibleAfter -> + traceError "Unlock not permitted until firstUnlockPossibleAfter time" + | BI.lessThanEqualsInteger newRemainingQty 0 -> + traceError "Zero remaining assets not allowed" + | BI.lessThanEqualsInteger oldRemainingQty newRemainingQty -> + traceError "Remaining asset is not decreasing" + | not (BI.equalsInteger expectedRemainingQty newRemainingQty) -> + traceError "Mismatched remaining asset" + | not (BI.equalsData resolvedDatum outputDatum) -> + traceError "Datum Modification Prohibited" + | not (BI.equalsInteger (countInputsAtScript scriptHash txInputs) 1) -> + traceError "Double satisfaction" + | otherwise -> True + +{-# INLINE validateVestingFullUnlock #-} +validateVestingFullUnlock + :: BI.BuiltinData + -> BI.BuiltinList BI.BuiltinData + -> BI.BuiltinData + -> Bool +validateVestingFullUnlock txValidRange txSignatories vestingDatum = + let !vdFields = BI.snd (BI.unsafeDataAsConstr vestingDatum) + vdFields1 = BI.tail vdFields + vdFields2 = BI.tail vdFields1 + vdFields3 = BI.tail vdFields2 + vdFields4 = BI.tail vdFields3 + + beneficiaryAddr = BI.head vdFields + vestingPeriodEnd = BI.unsafeDataAsI (BI.head vdFields4) + currentTimeApproximation = lowerInclusiveTime txValidRange + beneficiaryHash = getPubKeyHashFromAddress beneficiaryAddr + in if + | not (txSignedBy' txSignatories beneficiaryHash) -> + traceError "Missing beneficiary signature" + | BI.lessThanEqualsInteger currentTimeApproximation vestingPeriodEnd -> + traceError "Unlock not permitted until vestingPeriodEnd time" + | otherwise -> True {-# INLINEABLE untypedValidator #-} -untypedValidator :: BuiltinData -> BuiltinUnit +untypedValidator :: BI.BuiltinData -> BI.BuiltinUnit untypedValidator scriptContextData = - case trace "Parsing ScriptContext..." (fromBuiltinData scriptContextData) of - Nothing -> traceError "Failed to parse ScriptContext" - Just ctx -> check $ typedValidator $ trace "Parsed ScriptContext" ctx + let ctx = BI.trace "Parsing ScriptContext..." scriptContextData + ctxFields = BI.snd (BI.unsafeDataAsConstr ctx) + txInfoData = BI.head ctxFields + redeemerData = BI.head (BI.tail ctxFields) + scriptInfoData = BI.head (BI.tail (BI.tail ctxFields)) + + txInfoFields = BI.snd (BI.unsafeDataAsConstr txInfoData) + txInfoFields1 = BI.tail txInfoFields + txInfoFields2 = BI.tail txInfoFields1 + txInfoFields3 = BI.tail txInfoFields2 + txInfoFields4 = BI.tail txInfoFields3 + txInfoFields5 = BI.tail txInfoFields4 + txInfoFields6 = BI.tail txInfoFields5 + txInfoFields7 = BI.tail txInfoFields6 + txInfoFields8 = BI.tail txInfoFields7 + + txInputs = BI.unsafeDataAsList (BI.head txInfoFields) + txOutputs = BI.unsafeDataAsList (BI.head txInfoFields2) + txValidRange = BI.head txInfoFields7 + txSignatories = BI.unsafeDataAsList (BI.head txInfoFields8) + + spendingInfo = getSpendingInfo scriptInfoData + ownRef = BI.fst spendingInfo + datumData = BI.snd spendingInfo + + redeemerTag = BI.fst (BI.unsafeDataAsConstr redeemerData) + + result = + BI.trace + "Parsed ScriptContext" + ( BI.trace + "Parsed Redeemer" + ( BI.caseInteger + redeemerTag + [ BI.trace + "Partial unlock requested" + ( validateVestingPartialUnlock + txInputs + txOutputs + txValidRange + txSignatories + ownRef + datumData + ) + , BI.trace + "Full unlock requested" + (validateVestingFullUnlock txValidRange txSignatories datumData) + ] + ) + ) + in if result + then BI.trace "Validation completed" BI.unitval + else traceError "Validation failed" -validatorCode :: CompiledCode (BuiltinData -> BuiltinUnit) +validatorCode :: CompiledCode (BI.BuiltinData -> BI.BuiltinUnit) validatorCode = $$(compile [||untypedValidator||]) diff --git a/plutus-benchmark/linear-vesting/test/9.6/main.golden.eval b/plutus-benchmark/linear-vesting/test/9.6/main.golden.eval index 83c91606b45..763878ab6a1 100644 --- a/plutus-benchmark/linear-vesting/test/9.6/main.golden.eval +++ b/plutus-benchmark/linear-vesting/test/9.6/main.golden.eval @@ -1,6 +1,6 @@ -CPU: 30_405_131 -Memory: 128_919 -AST Size: 1_854 -Flat Size: 2_490 +CPU: 11_040_647 +Memory: 45_828 +AST Size: 1_407 +Flat Size: 2_191 (con unit ()) \ No newline at end of file diff --git a/plutus-benchmark/linear-vesting/test/9.6/main.golden.pir b/plutus-benchmark/linear-vesting/test/9.6/main.golden.pir index 4c0e05b98d0..999964c2529 100644 --- a/plutus-benchmark/linear-vesting/test/9.6/main.golden.pir +++ b/plutus-benchmark/linear-vesting/test/9.6/main.golden.pir @@ -1,1480 +1,811 @@ -(let - data Unit | Unit_match where - Unit : Unit - data (Tuple2 :: * -> * -> *) a b | Tuple2_match where - Tuple2 : a -> b -> Tuple2 a b - !fail : unit -> Tuple2 data data - = \(ds : unit) -> - let - !defaultBody : Tuple2 data data = error {Tuple2 data data} - in - Unit_match (error {Unit}) {Tuple2 data data} defaultBody - !divCeil : integer -> integer -> integer - = \(x : integer) (y : integer) -> - addInteger 1 (divideInteger (subtractInteger x 1) y) - !fail : unit -> Tuple2 data data - = \(ds : unit) -> - let - !defaultBody : Tuple2 data data = error {Tuple2 data data} - in - Unit_match (error {Unit}) {Tuple2 data data} defaultBody - data VestingRedeemer | VestingRedeemer_match where - FullUnlock : VestingRedeemer - PartialUnlock : VestingRedeemer - !equalsData : data -> data -> bool - = \(d : data) (d : data) -> equalsData d d - !`$mPubKeyCredential` : all r. data -> (bytestring -> r) -> (unit -> r) -> r - = /\r -> - \(scrut : data) (cont : bytestring -> r) (fail : unit -> r) -> - let - !tup : pair integer (list data) = unConstrData scrut - in - case - (all dead. r) - (equalsInteger - 0 - (case integer tup [(\(l : integer) (r : list data) -> l)])) - [ (/\dead -> fail ()) - , (/\dead -> - cont - (unBData - (headList - {data} - (case - (list data) - tup - [(\(l : integer) (r : list data) -> r)])))) ] - {all dead. dead} - !`$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` : data -> data - = \(d : data) -> d - !casePair : all a b r. pair a b -> (a -> b -> r) -> r - = /\a b r -> \(p : pair a b) (f : a -> b -> r) -> case r p [f] - data (Maybe :: * -> *) a | Maybe_match where - Just : a -> Maybe a - Nothing : Maybe a - !`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` : - all a. (\a -> data -> a) a -> data -> Maybe a - = /\a -> - \(`$dUnsafeFromData` : (\a -> data -> a) a) (d : data) -> - casePair - {integer} - {list data} - {Maybe a} - (unConstrData d) - (\(index : integer) (args : list data) -> - case - (list data -> Maybe a) - index - [ (\(ds : list data) -> - Just {a} (`$dUnsafeFromData` (headList {data} ds))) - , (\(ds : list data) -> Nothing {a}) ] - args) - !`$mSpendingScript` : - all r. data -> (data -> Maybe data -> r) -> (unit -> r) -> r - = /\r -> - \(scrut : data) (cont : data -> Maybe data -> r) (fail : unit -> r) -> - let - !tup : pair integer (list data) = unConstrData scrut - in - case - (all dead. r) - (equalsInteger - 1 - (case integer tup [(\(l : integer) (r : list data) -> l)])) - [ (/\dead -> fail ()) - , (/\dead -> - let - !l : list data - = case - (list data) - tup - [(\(l : integer) (r : list data) -> r)] - in - cont - (headList {data} l) - (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - {data} - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (headList {data} (tailList {data} l)))) ] - {all dead. dead} - !`/=` : all a. (\a -> a -> a -> bool) a -> a -> a -> bool - = /\a -> - \(`$dEq` : (\a -> a -> a -> bool) a) (x : a) (y : a) -> - case bool (`$dEq` x y) [True, False] - data (Solo :: * -> *) a | Solo_match where - MkSolo : a -> Solo a - !lookup' : data -> list (pair data data) -> Maybe data - = \(k : data) -> - letrec - !go : list (pair data data) -> Maybe data - = \(xs : list (pair data data)) -> - case - (Maybe data) - xs - [ (\(hd : pair data data) -> - case - (all dead. list (pair data data) -> Maybe data) - (equalsData - k - (case data hd [(\(l : data) (r : data) -> l)])) - [ (/\dead -> go) - , (/\dead -> - \(ds : list (pair data data)) -> - Just - {data} - (case - data - hd - [(\(l : data) (r : data) -> r)])) ] - {all dead. dead}) - , (Nothing {data}) ] - in - \(m : list (pair data data)) -> go m - !assetClassValueOf : - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer) -> - Tuple2 bytestring bytestring -> - integer - = \(v : - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer)) - (ds : Tuple2 bytestring bytestring) -> - Tuple2_match - {bytestring} - {bytestring} - ds - {integer} - (\(c : bytestring) (t : bytestring) -> - Maybe_match - {data} - (lookup' (bData c) v) - {integer} - (\(a : data) -> - let - !m : list (pair data data) = unMapData a - in - Maybe_match - {data} - (lookup' (bData t) m) - {integer} - (\(a : data) -> unIData a) - 0) - 0) - data VestingDatum | VestingDatum_match where - VestingDatum : - data -> - Tuple2 bytestring bytestring -> - integer -> - integer -> - integer -> - integer -> - integer -> - VestingDatum - !beneficiary : VestingDatum -> data - = \(ds : VestingDatum) -> - VestingDatum_match - ds - {data} - (\(ds : data) - (ds : Tuple2 bytestring bytestring) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) -> - ds) - !`$mScriptCredential` : all r. data -> (bytestring -> r) -> (unit -> r) -> r - = /\r -> - \(scrut : data) (cont : bytestring -> r) (fail : unit -> r) -> - let - !tup : pair integer (list data) = unConstrData scrut - in - case - (all dead. r) - (equalsInteger - 1 - (case integer tup [(\(l : integer) (r : list data) -> l)])) - [ (/\dead -> fail ()) - , (/\dead -> - cont - (unBData - (headList - {data} - (case - (list data) - tup - [(\(l : integer) (r : list data) -> r)])))) ] - {all dead. dead} - !addressCredential : data -> data - = \(ds : data) -> - headList - {data} - (case - (list data) - (unConstrData ds) - [(\(l : integer) (r : list data) -> r)]) - !traceError : all a. string -> a - = /\a -> - \(str : string) -> let !x : Unit = trace {Unit} str Unit in error {a} - !getLowerInclusiveTimeRange : (\a -> data) integer -> integer - = \(ds : (\a -> data) integer) -> - let - !l : list data - = case - (list data) - (unConstrData - (headList - {data} - (case - (list data) - (unConstrData ds) - [(\(l : integer) (r : list data) -> r)]))) - [(\(l : integer) (r : list data) -> r)] - !tup : pair integer (list data) = unConstrData (headList {data} l) - in +(letrec + !countInputsAtScript : bytestring -> list data -> integer + = \(scriptHash : bytestring) (inputs : list data) -> case - (all dead. integer) - (equalsInteger - 1 - (case integer tup [(\(l : integer) (r : list data) -> l)])) - [ (/\dead -> traceError {integer} "Time range not Finite") - , (/\dead -> + integer + inputs + [ (\(txIn : data) (txIns : list data) -> let - !posixTime : integer - = unIData + !rest : integer = countInputsAtScript scriptHash txIns + !credCon : pair integer (list data) + = unConstrData (headList {data} (case (list data) - tup + (unConstrData + (headList + {data} + (case + (list data) + (unConstrData + (headList + {data} + (tailList + {data} + (case + (list data) + (unConstrData txIn) + [ (\(l : integer) + (r : list data) -> + r) ])))) + [ (\(l : integer) (r : list data) -> + r) ]))) [(\(l : integer) (r : list data) -> r)])) + !credTag : integer + = case + integer + credCon + [(\(l : integer) (r : list data) -> l)] + !credFields : list data + = case + (list data) + credCon + [(\(l : integer) (r : list data) -> r)] in case (all dead. integer) - (casePair - {integer} - {list data} - {bool} - (unConstrData (headList {data} (tailList {data} l))) - (\(index : integer) (args : list data) -> - case - (list data -> bool) - index - [ (\(ds : list data) -> False) - , (\(ds : list data) -> True) ] - args)) - [(/\dead -> addInteger 1 posixTime), (/\dead -> posixTime)] - {all dead. dead}) ] - {all dead. dead} - !greaterThanEqualsInteger : integer -> integer -> bool - = \(x : integer) (y : integer) -> - case bool (lessThanInteger x y) [True, False] - !`$mScriptContext` : - all r. data -> (data -> data -> data -> r) -> (unit -> r) -> r - = /\r -> - \(scrut : data) - (cont : data -> data -> data -> r) - (fail : unit -> r) -> - let - !l : list data - = case - (list data) - (unConstrData scrut) - [(\(l : integer) (r : list data) -> r)] - !l : list data = tailList {data} l - in - cont - (headList {data} l) - (headList {data} l) - (headList {data} (tailList {data} l)) - !scriptContextScriptInfo : data -> data - = \(ds : data) -> - `$mScriptContext` - {data} - ds - (\(ds : data) (ds : data) (ds : data) -> ds) - (\(void : unit) -> error {data}) - !scriptContextTxInfo : data -> data - = \(ds : data) -> - `$mScriptContext` + (equalsInteger 1 credTag) + [ (/\dead -> rest) + , (/\dead -> + case + (all dead. integer) + (equalsByteString + (unBData (headList {data} credFields)) + scriptHash) + [(/\dead -> rest), (/\dead -> addInteger 1 rest)] + {all dead. dead}) ] + {all dead. dead}) + , 0 ] + in + let + data Unit | Unit_match where + Unit : Unit + !caseList' : all a r. r -> (a -> list a -> r) -> list a -> r + = /\a r -> + \(z : r) (f : a -> list a -> r) (xs : list a) -> case r xs [f, z] + in + letrec + !findInputByOutRef : data -> list data -> data + = \(ref : data) (inputs : list data) -> + caseList' {data} - ds - (\(ds : data) (ds : data) (ds : data) -> ds) - (\(void : unit) -> error {data}) - !subtractInteger : integer -> integer -> integer - = \(x : integer) (y : integer) -> subtractInteger x y - !totalInstallments : VestingDatum -> integer - = \(ds : VestingDatum) -> - VestingDatum_match - ds - {integer} - (\(ds : data) - (ds : Tuple2 bytestring bytestring) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) -> - ds) - !txInInfoResolved : data -> data - = \(ds : data) -> - headList {data} - (tailList - {data} - (case - (list data) - (unConstrData ds) - [(\(l : integer) (r : list data) -> r)])) - !`$mTxInfo` : - all r. - data -> - ((\a -> list data) data -> - (\a -> list data) data -> - (\a -> list data) data -> - integer -> - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer) -> - (\a -> list data) data -> - (\k a -> list (pair data data)) data integer -> - (\a -> data) integer -> - (\a -> list data) bytestring -> - (\k a -> list (pair data data)) data data -> - (\k a -> list (pair data data)) bytestring data -> - bytestring -> - (\k a -> list (pair data data)) - data - ((\k a -> list (pair data data)) data data) -> - (\a -> list data) data -> - Maybe integer -> - Maybe integer -> - r) -> - (unit -> r) -> - r - = /\r -> - \(scrut : data) - (cont : - (\a -> list data) data -> - (\a -> list data) data -> - (\a -> list data) data -> - integer -> - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer) -> - (\a -> list data) data -> - (\k a -> list (pair data data)) data integer -> - (\a -> data) integer -> - (\a -> list data) bytestring -> - (\k a -> list (pair data data)) data data -> - (\k a -> list (pair data data)) bytestring data -> - bytestring -> - (\k a -> list (pair data data)) - data - ((\k a -> list (pair data data)) data data) -> - (\a -> list data) data -> - Maybe integer -> - Maybe integer -> - r) - (fail : unit -> r) -> - let - !l : list data - = case - (list data) - (unConstrData scrut) - [(\(l : integer) (r : list data) -> r)] - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - !l : list data = tailList {data} l - in - cont - (unListData (headList {data} l)) - (unListData (headList {data} l)) - (unListData (headList {data} l)) - (unIData (headList {data} l)) - (unMapData (headList {data} l)) - (unListData (headList {data} l)) - (unMapData (headList {data} l)) - (headList {data} l) - (unListData (headList {data} l)) - (unMapData (headList {data} l)) - (unMapData (headList {data} l)) - (unBData (headList {data} l)) - (unMapData (headList {data} l)) - (unListData (headList {data} l)) - (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - {integer} - unIData - (headList {data} l)) - (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - {integer} - unIData - (headList {data} (tailList {data} l))) - !txInfoValidRange : data -> (\a -> data) integer - = \(ds : data) -> - `$mTxInfo` - {(\a -> data) integer} - ds - (\(ds : (\a -> list data) data) - (ds : (\a -> list data) data) - (ds : (\a -> list data) data) - (ds : integer) - (ds : - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer)) - (ds : (\a -> list data) data) - (ds : (\k a -> list (pair data data)) data integer) - (ds : (\a -> data) integer) - (ds : (\a -> list data) bytestring) - (ds : (\k a -> list (pair data data)) data data) - (ds : (\k a -> list (pair data data)) bytestring data) - (ds : bytestring) - (ds : - (\k a -> list (pair data data)) - data - ((\k a -> list (pair data data)) data data)) - (ds : (\a -> list data) data) - (ds : Maybe integer) - (ds : Maybe integer) -> - ds) - (\(void : unit) -> error {(\a -> data) integer}) - !`$mTxOut` : - all r. - data -> - (data -> - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer) -> - data -> - Maybe bytestring -> - r) -> - (unit -> r) -> - r - = /\r -> - \(scrut : data) - (cont : - data -> - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer) -> - data -> - Maybe bytestring -> - r) - (fail : unit -> r) -> - let - !l : list data - = case - (list data) - (unConstrData scrut) - [(\(l : integer) (r : list data) -> r)] - !l : list data = tailList {data} l - !l : list data = tailList {data} l + (let + !x : Unit = trace {Unit} "Own input not found" Unit in - cont - (headList {data} l) - (unMapData (headList {data} l)) - (headList {data} l) - (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - {bytestring} - unBData - (headList {data} (tailList {data} l))) - !txOutAddress : data -> data - = \(ds : data) -> - `$mTxOut` + error {data}) + (\(txIn : data) (txIns : list data) -> + case + (all dead. data) + (equalsData + (headList + {data} + (case + (list data) + (unConstrData txIn) + [(\(l : integer) (r : list data) -> r)])) + ref) + [(/\dead -> findInputByOutRef ref txIns), (/\dead -> txIn)] + {all dead. dead}) + inputs + in + letrec + !findOutputByAddress : data -> list data -> data + = \(addr : data) (outputs : list data) -> + caseList' {data} - ds - (\(ds : data) - (ds : - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer)) - (ds : data) - (ds : Maybe bytestring) -> - ds) - (\(void : unit) -> error {data}) - !txOutDatum : data -> data - = \(ds : data) -> - `$mTxOut` {data} - ds - (\(ds : data) - (ds : - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer)) - (ds : data) - (ds : Maybe bytestring) -> - ds) - (\(void : unit) -> error {data}) - !txOutValue : - data -> - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer) - = \(ds : data) -> - unMapData - (headList + (let + !x : Unit = trace {Unit} "Own output not found" Unit + in + error {data}) + (\(out : data) (outs : list data) -> + case + (all dead. data) + (equalsData + (headList + {data} + (case + (list data) + (unConstrData out) + [(\(l : integer) (r : list data) -> r)])) + addr) + [(/\dead -> findOutputByAddress addr outs), (/\dead -> out)] + {all dead. dead}) + outputs + in + letrec + !txSignedBy' : list data -> bytestring -> bool + = \(signatories : list data) (pkh : bytestring) -> + case + bool + signatories + [ (\(s : data) (ss : list data) -> + case + (all dead. bool) + (equalsByteString (unBData s) pkh) + [(/\dead -> txSignedBy' ss pkh), (/\dead -> True)] + {all dead. dead}) + , False ] + in + \(scriptContextData : data) -> + let + !ctxFields : list data + = case + (list data) + (unConstrData + (trace {data} "Parsing ScriptContext..." scriptContextData)) + [(\(l : integer) (r : list data) -> r)] + !txInfoFields : list data + = case + (list data) + (unConstrData (headList {data} ctxFields)) + [(\(l : integer) (r : list data) -> r)] + !txInfoFields : list data = tailList {data} (tailList {data} txInfoFields) + !txInfoFields : list data + = tailList + {data} + (tailList {data} (tailList {data} - (case - (list data) - (unConstrData ds) - [(\(l : integer) (r : list data) -> r)]))) - !find : - all a. - (\a -> data -> a) a -> (a -> bool) -> (\a -> list data) a -> Maybe a - = /\a -> - \(`$dUnsafeFromData` : (\a -> data -> a) a) (pred' : a -> bool) -> - letrec - !go : (\a -> list data) a -> Maybe a - = \(ds : (\a -> list data) a) -> - case - (Maybe a) - ds - [ (\(x : data) (eta : list data) -> - let - !h : a = `$dUnsafeFromData` x - in - case - (all dead. Maybe a) - (pred' h) - [(/\dead -> go eta), (/\dead -> Just {a} h)] - {all dead. dead}) - , (Nothing {a}) ] - in - \(eta : (\a -> list data) a) -> go eta - !txSignedBy : data -> bytestring -> bool - = \(ds : data) (k : bytestring) -> - `$mTxInfo` - {bool} - ds - (\(ds : (\a -> list data) data) - (ds : (\a -> list data) data) - (ds : (\a -> list data) data) - (ds : integer) - (ds : - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) bytestring integer)) - (ds : (\a -> list data) data) - (ds : (\k a -> list (pair data data)) data integer) - (ds : (\a -> data) integer) - (ds : (\a -> list data) bytestring) - (ds : (\k a -> list (pair data data)) data data) - (ds : (\k a -> list (pair data data)) bytestring data) - (ds : bytestring) - (ds : - (\k a -> list (pair data data)) - data - ((\k a -> list (pair data data)) data data)) - (ds : (\a -> list data) data) - (ds : Maybe integer) - (ds : Maybe integer) -> - Maybe_match - {bytestring} - (find - {bytestring} - unBData - (\(y : bytestring) -> equalsByteString k y) - ds) - {bool} - (\(ds : bytestring) -> True) - False) - (\(void : unit) -> + (tailList {data} (tailList {data} txInfoFields)))) + !txSignatories : list data + = unListData (headList {data} (tailList {data} txInfoFields)) + !txValidRange : data = headList {data} txInfoFields + !txOutputs : list data = unListData (headList {data} txInfoFields) + !txInputs : list data = unListData (headList {data} txInfoFields) + !redeemerTag : integer + = case + integer + (unConstrData (headList {data} (tailList {data} ctxFields))) + [(\(l : integer) (r : list data) -> l)] + !spendingInfo : pair data data + = let + !con : pair integer (list data) + = unConstrData + (headList {data} (tailList {data} (tailList {data} ctxFields))) + !tag : integer + = case integer con [(\(l : integer) (r : list data) -> l)] + !fields : list data + = case (list data) con [(\(l : integer) (r : list data) -> r)] + in + case + (all dead. pair data data) + (equalsInteger 1 tag) + [ (/\dead -> let - !defaultBody : bool = error {bool} + !x : Unit = trace {Unit} "Not spending script" Unit in - Unit_match (error {Unit}) {bool} defaultBody) - !vestingPeriodEnd : VestingDatum -> integer - = \(ds : VestingDatum) -> - VestingDatum_match - ds - {integer} - (\(ds : data) - (ds : Tuple2 bytestring bytestring) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) -> - ds) - in - \(scriptContextData : data) -> - Maybe_match - {data} + error {pair data data}) + , (/\dead -> + let + !mdCon : pair integer (list data) + = unConstrData (headList {data} (tailList {data} fields)) + !mdTag : integer + = case integer mdCon [(\(l : integer) (r : list data) -> l)] + !mdFields : list data + = case + (list data) + mdCon + [(\(l : integer) (r : list data) -> r)] + !ownRef : data = headList {data} fields + in + case + (all dead. pair data data) + (equalsInteger 0 mdTag) + [ (/\dead -> + let + !x : Unit = trace {Unit} "Missing datum" Unit + in + error {pair data data}) + , (/\dead -> mkPairData ownRef (headList {data} mdFields)) ] + {all dead. dead}) ] + {all dead. dead} + !ownRef : data = case data spendingInfo [(\(l : data) (r : data) -> l)] + !datumData : data = case data spendingInfo [(\(l : data) (r : data) -> r)] + in + case + (all dead. unit) (trace - {Maybe data} - "Parsing ScriptContext..." - (Just {data} scriptContextData)) - {all dead. unit} - (\(ctx : data) -> - /\dead -> - case - (all dead. unit) - (let - !context : data = trace {data} "Parsed ScriptContext" ctx - in - trace - {bool} - "Validation completed" - (VestingRedeemer_match - (Maybe_match - {VestingRedeemer} - (let - !d : data - = `$mScriptContext` - {data} - context - (\(ds : data) (ds : data) (ds : data) -> ds) - (\(void : unit) -> error {data}) - in - chooseData - {Unit -> Maybe VestingRedeemer} - d - (\(ds : Unit) -> - casePair - {integer} - {list data} - {Maybe VestingRedeemer} - (unConstrData d) - (\(l : integer) (r : list data) -> - case - (all dead. Maybe VestingRedeemer) - (equalsInteger 0 l) - [ (/\dead -> - case - (all dead. Maybe VestingRedeemer) - (equalsInteger 1 l) - [ (/\dead -> Nothing {VestingRedeemer}) - , (/\dead -> - Just - {VestingRedeemer} - FullUnlock) ] - {all dead. dead}) - , (/\dead -> - Just {VestingRedeemer} PartialUnlock) ] - {all dead. dead})) - (\(ds : Unit) -> Nothing {VestingRedeemer}) - (\(ds : Unit) -> Nothing {VestingRedeemer}) - (\(ds : Unit) -> Nothing {VestingRedeemer}) - (\(ds : Unit) -> Nothing {VestingRedeemer}) - Unit) - {all dead. VestingRedeemer} - (\(r : VestingRedeemer) -> - /\dead -> trace {VestingRedeemer} "Parsed Redeemer" r) - (/\dead -> - let - !x : Unit - = trace {Unit} "Failed to parse Redeemer" Unit + {bool} + "Parsed ScriptContext" + (trace + {bool} + "Parsed Redeemer" + (case + bool + redeemerTag + [ (trace + {bool} + "Partial unlock requested" + (let + !currentTimeApproximation : integer + = let + !lowerFields : list data + = case + (list data) + (unConstrData + (headList + {data} + (case + (list data) + (unConstrData txValidRange) + [ (\(l : integer) (r : list data) -> + r) ]))) + [(\(l : integer) (r : list data) -> r)] + !extCon : pair integer (list data) + = unConstrData (headList {data} lowerFields) + !extTag : integer + = case + integer + extCon + [(\(l : integer) (r : list data) -> l)] + !extFields : list data + = case + (list data) + extCon + [(\(l : integer) (r : list data) -> r)] + !offset : integer + = case + integer + (equalsInteger + 1 + (case + integer + (unConstrData + (headList + {data} + (tailList {data} lowerFields))) + [(\(l : integer) (r : list data) -> l)])) + [1, 0] in - error {VestingRedeemer}) - {all dead. dead}) - {all dead. bool} - (/\dead -> - let - !ctx : data - = trace {data} "Full unlock requested" context - in - Tuple2_match - {data} - {data} - (let - !nt : data = scriptContextScriptInfo ctx - in - `$mSpendingScript` - {Tuple2 data data} - nt - (\(_ownRef : data) (ds : Maybe data) -> - Maybe_match - {data} - ds - {all dead. Tuple2 data data} - (\(ds : data) -> - /\dead -> Tuple2 {data} {data} _ownRef ds) - (/\dead -> fail ()) - {all dead. dead}) - (\(void : unit) -> fail ())) - {bool} - (\(ipv : data) - (ipv : data) -> - let - !ds : Solo VestingDatum - = MkSolo - {VestingDatum} - (casePair - {integer} - {list data} - {VestingDatum} - (unConstrData ipv) - (\(index : integer) (args : list data) -> - case - (list data -> VestingDatum) - index - [ (\(ds : list data) -> - let - !l : list data - = tailList {data} ds - !l : list data - = tailList {data} l - !l : list data - = tailList {data} l - !l : list data - = tailList {data} l - !l : list data - = tailList {data} l - in - VestingDatum - (headList {data} ds) - (let - !d : data = headList {data} l - in - casePair - {integer} - {list data} - {Tuple2 - bytestring - bytestring} - (unConstrData d) - (\(index : integer) - (args : list data) -> - case - (list data -> - Tuple2 - bytestring - bytestring) - index - [ (\(ds : list data) -> - Tuple2 - {bytestring} - {bytestring} - (unBData - (headList - {data} - ds)) - (unBData - (headList - {data} - (tailList - {data} - ds)))) ] - args)) - (unIData (headList {data} l)) - (unIData (headList {data} l)) - (unIData (headList {data} l)) - (unIData (headList {data} l)) - (unIData - (headList - {data} - (tailList {data} l)))) ] - args)) - !vestingDatum : VestingDatum - = Solo_match - {VestingDatum} - ds - {VestingDatum} - (\(vestingDatum : VestingDatum) -> - vestingDatum) - in - Solo_match - {bytestring} - (let - !nt : data - = addressCredential (beneficiary vestingDatum) - in - `$mPubKeyCredential` - {Solo bytestring} - nt - (\(beneficiaryKey : bytestring) -> - MkSolo {bytestring} beneficiaryKey) - (\(void : unit) -> - let - !defaultBody : Solo bytestring - = error {Solo bytestring} - in - Unit_match - (error {Unit}) - {Solo bytestring} - defaultBody)) - {bool} - (\(ipv : bytestring) -> + case + (all dead. integer) + (equalsInteger 1 extTag) + [ (/\dead -> let - !ds : Solo data - = MkSolo {data} (scriptContextTxInfo ctx) - !txInfo : data - = Solo_match - {data} - ds - {data} - (\(txInfo : data) -> txInfo) - !ds : integer - = getLowerInclusiveTimeRange - (txInfoValidRange txInfo) + !x : Unit + = trace {Unit} "Time range not Finite" Unit in - case - (all dead. bool) - (case - bool - (txSignedBy txInfo ipv) - [True, False]) - [ (/\dead -> - case - (all dead. bool) - (greaterThanEqualsInteger - (vestingPeriodEnd vestingDatum) - ds) - [ (/\dead -> True) - , (/\dead -> - traceError - {bool} - "Unlock not permitted until vestingPeriodEnd time") ] - {all dead. dead}) - , (/\dead -> - traceError - {bool} - "Missing beneficiary signature") ] - {all dead. dead}))) - (/\dead -> - let - !ctx : data - = trace {data} "Partial unlock requested" context - in - Tuple2_match - {data} - {data} - (let - !nt : data = scriptContextScriptInfo ctx - in - `$mSpendingScript` - {Tuple2 data data} - nt - (\(ownRef : data) (ds : Maybe data) -> - Maybe_match - {data} - ds - {all dead. Tuple2 data data} - (\(ds : data) -> - /\dead -> Tuple2 {data} {data} ownRef ds) - (/\dead -> fail ()) - {all dead. dead}) - (\(void : unit) -> fail ())) - {bool} - (\(ipv : data) - (ipv : data) -> - let - !ds : Solo VestingDatum - = MkSolo - {VestingDatum} - (casePair - {integer} - {list data} - {VestingDatum} - (unConstrData ipv) - (\(index : integer) (args : list data) -> - case - (list data -> VestingDatum) - index - [ (\(ds : list data) -> - let - !l : list data - = tailList {data} ds - !l : list data - = tailList {data} l - !l : list data - = tailList {data} l - !l : list data - = tailList {data} l - !l : list data - = tailList {data} l - in - VestingDatum - (headList {data} ds) - (let - !d : data = headList {data} l - in - casePair - {integer} - {list data} - {Tuple2 - bytestring - bytestring} - (unConstrData d) - (\(index : integer) - (args : list data) -> - case - (list data -> - Tuple2 - bytestring - bytestring) - index - [ (\(ds : list data) -> - Tuple2 - {bytestring} - {bytestring} - (unBData - (headList - {data} - ds)) - (unBData - (headList - {data} - (tailList - {data} - ds)))) ] - args)) - (unIData (headList {data} l)) - (unIData (headList {data} l)) - (unIData (headList {data} l)) - (unIData (headList {data} l)) - (unIData - (headList - {data} - (tailList {data} l)))) ] - args)) - !vestingDatum : VestingDatum - = Solo_match - {VestingDatum} - ds - {VestingDatum} - (\(vestingDatum : VestingDatum) -> - vestingDatum) - !ds : Solo (Tuple2 bytestring bytestring) - = MkSolo - {Tuple2 bytestring bytestring} - (VestingDatum_match - vestingDatum - {Tuple2 bytestring bytestring} - (\(ds : data) - (ds : Tuple2 bytestring bytestring) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) -> - ds)) - ~asset : Tuple2 bytestring bytestring - = Solo_match - {Tuple2 bytestring bytestring} - ds - {Tuple2 bytestring bytestring} - (\(asset : Tuple2 bytestring bytestring) -> - asset) - !ds : integer - = divCeil + error {integer}) + , (/\dead -> + addInteger + (unIData (headList {data} extFields)) + offset) ] + {all dead. dead} + !vdFields : list data + = case + (list data) + (unConstrData datumData) + [(\(l : integer) (r : list data) -> r)] + !vdFields : list data = tailList {data} vdFields + !vdFields : list data = tailList {data} vdFields + !vdFields : list data = tailList {data} vdFields + !vdFields : list data = tailList {data} vdFields + !vdFields : list data = tailList {data} vdFields + !totalInstallments : integer + = unIData (headList {data} (tailList {data} vdFields)) + !firstUnlockPossibleAfter : integer + = unIData (headList {data} vdFields) + !vestingPeriodEnd : integer + = unIData (headList {data} vdFields) + !vestingTimeRemaining : integer + = subtractInteger + vestingPeriodEnd + currentTimeApproximation + !timeBetweenTwoInstallments : integer + = addInteger + 1 + (divideInteger + (subtractInteger (subtractInteger - (vestingPeriodEnd vestingDatum) - (VestingDatum_match - vestingDatum - {integer} - (\(ds : data) - (ds : Tuple2 bytestring bytestring) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) -> - ds))) - (totalInstallments vestingDatum) - in - Solo_match - {bytestring} - (let - !nt : data - = addressCredential (beneficiary vestingDatum) - in - `$mPubKeyCredential` - {Solo bytestring} - nt - (\(beneficiaryHash : bytestring) -> - MkSolo {bytestring} beneficiaryHash) - (\(void : unit) -> - let - !defaultBody : Solo bytestring - = error {Solo bytestring} - in - Unit_match - (error {Unit}) - {Solo bytestring} - defaultBody)) - {bool} - (\(ipv : bytestring) -> - let - !ds : Solo data - = MkSolo {data} (scriptContextTxInfo ctx) - !txInfo : data - = Solo_match - {data} - ds - {data} - (\(txInfo : data) -> txInfo) - !nt : list data - = `$mTxInfo` - {(\a -> list data) data} - txInfo - (\(ds : (\a -> list data) data) - (ds : (\a -> list data) data) - (ds : (\a -> list data) data) - (ds : integer) - (ds : - (\k a -> list (pair data data)) - bytestring - ((\k a -> list (pair data data)) - bytestring - integer)) - (ds : (\a -> list data) data) - (ds : - (\k a -> list (pair data data)) + vestingPeriodEnd + (unIData (headList {data} vdFields))) + 1) + totalInstallments) + !expectedRemainingQty : integer + = addInteger + 1 + (divideInteger + (subtractInteger + (multiplyInteger + (addInteger + 1 + (divideInteger + (subtractInteger + vestingTimeRemaining + 1) + timeBetweenTwoInstallments)) + (unIData (headList {data} vdFields))) + 1) + totalInstallments) + !assetFields : list data + = case + (list data) + (unConstrData (headList {data} vdFields)) + [(\(l : integer) (r : list data) -> r)] + !assetCs : bytestring + = unBData (headList {data} assetFields) + !assetTn : bytestring + = unBData + (headList {data} (tailList {data} assetFields)) + in + letrec + !findToken : list (pair data data) -> integer + = \(pairs : list (pair data data)) -> + case + (all dead. integer) + (nullList {pair data data} pairs) + [ (/\dead -> + let + !pair : pair data data + = headList {pair data data} pairs + in + case + (all dead. integer) + (equalsByteString + (unBData + (case data - integer) - (ds : (\a -> data) integer) - (ds : (\a -> list data) bytestring) - (ds : - (\k a -> list (pair data data)) + pair + [(\(l : data) (r : data) -> l)])) + assetTn) + [ (/\dead -> + findToken + (tailList {pair data data} pairs)) + , (/\dead -> + unIData + (case + data + pair + [ (\(l : data) (r : data) -> + r) ])) ] + {all dead. dead}) + , (/\dead -> 0) ] + {all dead. dead} + in + letrec + !findCurrency : list (pair data data) -> integer + = \(pairs : list (pair data data)) -> + case + (all dead. integer) + (nullList {pair data data} pairs) + [ (/\dead -> + let + !pair : pair data data + = headList {pair data data} pairs + in + case + (all dead. integer) + (equalsByteString + (unBData + (case data - data) - (ds : - (\k a -> list (pair data data)) - bytestring - data) - (ds : bytestring) - (ds : - (\k a -> list (pair data data)) + pair + [(\(l : data) (r : data) -> l)])) + assetCs) + [ (/\dead -> + findCurrency + (tailList {pair data data} pairs)) + , (/\dead -> + findToken + (unMapData + (case + data + pair + [ (\(l : data) (r : data) -> + r) ]))) ] + {all dead. dead}) + , (/\dead -> 0) ] + {all dead. dead} + in + letrec + !findToken : list (pair data data) -> integer + = \(pairs : list (pair data data)) -> + case + (all dead. integer) + (nullList {pair data data} pairs) + [ (/\dead -> + let + !pair : pair data data + = headList {pair data data} pairs + in + case + (all dead. integer) + (equalsByteString + (unBData + (case data - ((\k a -> list (pair data data)) - data - data)) - (ds : (\a -> list data) data) - (ds : Maybe integer) - (ds : Maybe integer) -> - ds) - (\(void : unit) -> - error {(\a -> list data) data}) - !ds : - Solo data - = Maybe_match - {data} - (find - {data} - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (\(eta : data) -> - equalsData - (headList - {data} - (case - (list data) - (unConstrData eta) - [ (\(l : integer) - (r : list data) -> - r) ])) - ipv) - nt) - {all dead. Solo data} - (\(ownVestingInput : data) -> - /\dead -> - MkSolo {data} ownVestingInput) - (/\dead -> - let - !defaultBody : Solo data - = error {Solo data} - in - Unit_match - (error {Unit}) - {Solo data} - defaultBody) - {all dead. dead} - in - Solo_match - {data} - ds - {bool} - (\(ipv : data) -> - let - !nt : data = txInInfoResolved ipv - !nt : data = txOutAddress nt - in - Solo_match - {bytestring} - (let - !nt : data = addressCredential nt - in - `$mScriptCredential` - {Solo bytestring} - nt - (\(scriptHash : bytestring) -> - MkSolo {bytestring} scriptHash) - (\(void : unit) -> - let - !defaultBody : Solo bytestring - = error {Solo bytestring} - in - Unit_match - (error {Unit}) - {Solo bytestring} - defaultBody)) - {bool} - (\(ipv : bytestring) -> - letrec - !go : - integer -> - (\a -> list data) data -> - integer - = \(n : integer) - (ds : (\a -> list data) data) -> - case - integer - ds - [ (\(x : data) - (eta : list data) -> - let - !nt : - data - = addressCredential - (txOutAddress - (txInInfoResolved - x)) - in - `$mScriptCredential` - {integer} - nt - (\(vh : bytestring) -> - case - (all dead. - integer) - (equalsByteString - vh - ipv) - [ (/\dead -> - go n eta) - , (/\dead -> - go - (addInteger - 1 - n) - eta) ] - {all dead. dead}) - (\(void : unit) -> - go n eta)) - , n ] - in - let - !ds : integer - = assetClassValueOf - (txOutValue nt) - asset - !ds : - Solo data - = Maybe_match - {data} - (find - {data} - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (\(eta : data) -> - equalsData - (txOutAddress eta) - nt) - (`$mTxInfo` - {(\a -> list data) data} - txInfo - (\(ds : - (\a -> list data) - data) - (ds : - (\a -> list data) - data) - (ds : - (\a -> list data) - data) - (ds : integer) - (ds : - (\k a -> - list - (pair - data - data)) - bytestring - ((\k a -> - list - (pair - data - data)) - bytestring - integer)) - (ds : - (\a -> list data) - data) - (ds : - (\k a -> - list - (pair - data - data)) - data - integer) - (ds : - (\a -> data) - integer) - (ds : - (\a -> list data) - bytestring) - (ds : - (\k a -> - list - (pair - data - data)) - data - data) - (ds : - (\k a -> - list - (pair - data - data)) - bytestring - data) - (ds : bytestring) - (ds : - (\k a -> - list - (pair - data - data)) - data - ((\k a -> - list - (pair - data - data)) - data - data)) - (ds : - (\a -> list data) - data) - (ds : Maybe integer) - (ds : Maybe integer) -> - ds) - (\(void : unit) -> - error - {(\a -> list data) - data}))) - {all dead. Solo data} - (\(ownVestingOutput : data) -> - /\dead -> - MkSolo - {data} - ownVestingOutput) - (/\dead -> - let - !defaultBody : Solo data - = error {Solo data} - in - Unit_match - (error {Unit}) - {Solo data} - defaultBody) - {all dead. dead} - !ownVestingOutput : data - = Solo_match - {data} - ds - {data} - (\(ownVestingOutput : data) -> - ownVestingOutput) - !nt : data - = txOutDatum ownVestingOutput - !ds : Solo integer - = MkSolo - {integer} - (assetClassValueOf - (txOutValue - ownVestingOutput) - asset) - ~newRemainingQty : integer - = Solo_match - {integer} - ds - {integer} - (\(newRemainingQty : - integer) -> - newRemainingQty) - !ds : Solo integer - = MkSolo - {integer} - (getLowerInclusiveTimeRange - (txInfoValidRange txInfo)) - !currentTimeApproximation : integer - = Solo_match - {integer} - ds - {integer} - (\(currentTimeApproximation : - integer) -> - currentTimeApproximation) - !ds : - integer - = divCeil - (multiplyInteger - (divCeil - (subtractInteger - (vestingPeriodEnd - vestingDatum) - currentTimeApproximation) - ds) - (VestingDatum_match - vestingDatum - {integer} - (\(ds : data) - (ds : - Tuple2 - bytestring - bytestring) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) -> - ds))) - (totalInstallments - vestingDatum) - in + pair + [(\(l : data) (r : data) -> l)])) + assetTn) + [ (/\dead -> + findToken + (tailList {pair data data} pairs)) + , (/\dead -> + unIData + (case + data + pair + [ (\(l : data) (r : data) -> + r) ])) ] + {all dead. dead}) + , (/\dead -> 0) ] + {all dead. dead} + in + letrec + !findCurrency : list (pair data data) -> integer + = \(pairs : list (pair data data)) -> + case + (all dead. integer) + (nullList {pair data data} pairs) + [ (/\dead -> + let + !pair : pair data data + = headList {pair data data} pairs + in + case + (all dead. integer) + (equalsByteString + (unBData + (case + data + pair + [(\(l : data) (r : data) -> l)])) + assetCs) + [ (/\dead -> + findCurrency + (tailList {pair data data} pairs)) + , (/\dead -> + findToken + (unMapData + (case + data + pair + [ (\(l : data) (r : data) -> + r) ]))) ] + {all dead. dead}) + , (/\dead -> 0) ] + {all dead. dead} + in + let + !beneficiaryHash : bytestring + = unBData + (headList + {data} + (case + (list data) + (unConstrData + (headList + {data} + (case + (list data) + (unConstrData + (headList {data} vdFields)) + [ (\(l : integer) (r : list data) -> + r) ]))) + [(\(l : integer) (r : list data) -> r)])) + !signed : bool = txSignedBy' txSignatories beneficiaryHash + !resolvedFields : list data + = case + (list data) + (unConstrData + (headList + {data} + (tailList + {data} + (case + (list data) + (unConstrData + (findInputByOutRef ownRef txInputs)) + [ (\(l : integer) (r : list data) -> + r) ])))) + [(\(l : integer) (r : list data) -> r)] + !inputAddress : data = headList {data} resolvedFields + !scriptHash : bytestring + = unBData + (headList + {data} + (case + (list data) + (unConstrData + (headList + {data} + (case + (list data) + (unConstrData inputAddress) + [ (\(l : integer) (r : list data) -> + r) ]))) + [(\(l : integer) (r : list data) -> r)])) + !ownOutputFields : list data + = case + (list data) + (unConstrData + (findOutputByAddress inputAddress txOutputs)) + [(\(l : integer) (r : list data) -> r)] + !outputDatum : data + = headList + {data} + (tailList {data} (tailList {data} ownOutputFields)) + !newRemainingQty : integer + = let + !valueData : data + = headList {data} (tailList {data} ownOutputFields) + in + findCurrency (unMapData valueData) + !resolvedDatum : data + = headList + {data} + (tailList {data} (tailList {data} resolvedFields)) + !oldRemainingQty : integer + = let + !valueData : data + = headList {data} (tailList {data} resolvedFields) + in + findCurrency (unMapData valueData) + in + case + (all dead. bool) + (case bool signed [True, False]) + [ (/\dead -> + case + (all dead. bool) + (lessThanEqualsInteger + currentTimeApproximation + firstUnlockPossibleAfter) + [ (/\dead -> + case + (all dead. bool) + (lessThanEqualsInteger newRemainingQty 0) + [ (/\dead -> case (all dead. bool) - (case - bool - (txSignedBy txInfo ipv) - [True, False]) + (lessThanEqualsInteger + oldRemainingQty + newRemainingQty) [ (/\dead -> case (all dead. bool) - (greaterThanEqualsInteger - (VestingDatum_match - vestingDatum - {integer} - (\(ds : data) - (ds : - Tuple2 - bytestring - bytestring) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) - (ds : integer) -> - ds)) - currentTimeApproximation) + (case + bool + (equalsInteger + expectedRemainingQty + newRemainingQty) + [True, False]) [ (/\dead -> case (all dead. bool) - (lessThanEqualsInteger - newRemainingQty - 0) + (case + bool + (equalsData + resolvedDatum + outputDatum) + [True, False]) [ (/\dead -> case (all dead. bool) - (greaterThanEqualsInteger - newRemainingQty - ds) + (case + bool + (equalsInteger + 1 + (countInputsAtScript + scriptHash + txInputs)) + [ True + , False ]) [ (/\dead -> - case - (all dead. - bool) - (case - bool - (equalsInteger - ds - newRemainingQty) - [ True - , False ]) - [ (/\dead -> - case - (all dead. - bool) - (`/=` - {data} - equalsData - (txOutDatum - nt) - nt) - [ (/\dead -> - case - (all dead. - bool) - (`/=` - {integer} - (\(x : - integer) - (y : - integer) -> - equalsInteger - x - y) - (go - 0 - nt) - 1) - [ (/\dead -> - True) - , (/\dead -> - traceError - {bool} - "Double satisfaction") ] - {all dead. - dead}) - , (/\dead -> - traceError - {bool} - "Datum Modification Prohibited") ] - {all dead. - dead}) - , (/\dead -> - traceError - {bool} - "Mismatched remaining asset") ] - {all dead. - dead}) + True) , (/\dead -> - traceError - {bool} - "Remaining asset is not decreasing") ] + let + !x : + Unit + = trace + {Unit} + "Double satisfaction" + Unit + in + error + {bool}) ] {all dead. dead}) , (/\dead -> - traceError - {bool} - "Zero remaining assets not allowed") ] + let + !x : + Unit + = trace + {Unit} + "Datum Modification Prohibited" + Unit + in + error {bool}) ] {all dead. dead}) , (/\dead -> - traceError - {bool} - "Unlock not permitted until firstUnlockPossibleAfter time") ] + let + !x : + Unit + = trace + {Unit} + "Mismatched remaining asset" + Unit + in + error {bool}) ] {all dead. dead}) , (/\dead -> - traceError - {bool} - "Missing beneficiary signature") ] - {all dead. dead}))))) - {all dead. dead})) - [(/\dead -> traceError {unit} "PT5"), (/\dead -> ())] - {all dead. dead}) - (/\dead -> - let - !x : Unit = trace {Unit} "Failed to parse ScriptContext" Unit - in - error {unit}) + let + !x : + Unit + = trace + {Unit} + "Remaining asset is not decreasing" + Unit + in + error {bool}) ] + {all dead. dead}) + , (/\dead -> + let + !x : + Unit + = trace + {Unit} + "Zero remaining assets not allowed" + Unit + in + error {bool}) ] + {all dead. dead}) + , (/\dead -> + let + !x : + Unit + = trace + {Unit} + "Unlock not permitted until firstUnlockPossibleAfter time" + Unit + in + error {bool}) ] + {all dead. dead}) + , (/\dead -> + let + !x : Unit + = trace + {Unit} + "Missing beneficiary signature" + Unit + in + error {bool}) ] + {all dead. dead})) + , (trace + {bool} + "Full unlock requested" + (let + !currentTimeApproximation : integer + = let + !lowerFields : list data + = case + (list data) + (unConstrData + (headList + {data} + (case + (list data) + (unConstrData txValidRange) + [ (\(l : integer) (r : list data) -> + r) ]))) + [(\(l : integer) (r : list data) -> r)] + !extCon : pair integer (list data) + = unConstrData (headList {data} lowerFields) + !extTag : integer + = case + integer + extCon + [(\(l : integer) (r : list data) -> l)] + !extFields : list data + = case + (list data) + extCon + [(\(l : integer) (r : list data) -> r)] + !offset : integer + = case + integer + (equalsInteger + 1 + (case + integer + (unConstrData + (headList + {data} + (tailList {data} lowerFields))) + [(\(l : integer) (r : list data) -> l)])) + [1, 0] + in + case + (all dead. integer) + (equalsInteger 1 extTag) + [ (/\dead -> + let + !x : Unit + = trace {Unit} "Time range not Finite" Unit + in + error {integer}) + , (/\dead -> + addInteger + (unIData (headList {data} extFields)) + offset) ] + {all dead. dead} + !vdFields : list data + = case + (list data) + (unConstrData datumData) + [(\(l : integer) (r : list data) -> r)] + !vestingPeriodEnd : integer + = unIData + (headList + {data} + (tailList + {data} + (tailList + {data} + (tailList + {data} + (tailList {data} vdFields))))) + !beneficiaryHash : bytestring + = unBData + (headList + {data} + (case + (list data) + (unConstrData + (headList + {data} + (case + (list data) + (unConstrData + (headList {data} vdFields)) + [ (\(l : integer) (r : list data) -> + r) ]))) + [(\(l : integer) (r : list data) -> r)])) + in + case + (all dead. bool) + (case + bool + (txSignedBy' txSignatories beneficiaryHash) + [True, False]) + [ (/\dead -> + case + (all dead. bool) + (lessThanEqualsInteger + currentTimeApproximation + vestingPeriodEnd) + [ (/\dead -> True) + , (/\dead -> + let + !x : + Unit + = trace + {Unit} + "Unlock not permitted until vestingPeriodEnd time" + Unit + in + error {bool}) ] + {all dead. dead}) + , (/\dead -> + let + !x : Unit + = trace + {Unit} + "Missing beneficiary signature" + Unit + in + error {bool}) ] + {all dead. dead})) ]))) + [ (/\dead -> + let + !x : Unit = trace {Unit} "Validation failed" Unit + in + error {unit}) + , (/\dead -> trace {unit} "Validation completed" ()) ] {all dead. dead}) (Constr 0 [ Constr 0 diff --git a/plutus-benchmark/linear-vesting/test/9.6/main.golden.uplc b/plutus-benchmark/linear-vesting/test/9.6/main.golden.uplc index 6e41fcd7aac..648d6c42d9a 100644 --- a/plutus-benchmark/linear-vesting/test/9.6/main.golden.uplc +++ b/plutus-benchmark/linear-vesting/test/9.6/main.golden.uplc @@ -1,1171 +1,828 @@ (program 1.1.0 - ((\fix1 - scriptContextData -> - force - (case - (force trace - "Parsing ScriptContext..." - (constr 0 [scriptContextData])) - [ ((\vestingPeriodEnd -> - (\find -> - (\`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` -> - (\`$mTxInfo` -> - (\txSignedBy -> - (\txOutValue -> - (\`$mTxOut` -> - (\txOutDatum -> - (\txOutAddress -> - (\txInfoValidRange -> - (\txInInfoResolved -> - (\totalInstallments -> - (\`$mScriptContext` -> - (\scriptContextTxInfo -> - (\scriptContextScriptInfo -> - (\traceError -> - (\getLowerInclusiveTimeRange -> - (\addressCredential -> - (\`$mScriptCredential` -> - (\beneficiary -> - (\assetClassValueOf -> - (\`$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` -> - (\`$mSpendingScript` -> - (\`$mPubKeyCredential` -> - (\divCeil - ctx -> - delay - (case - ((\context -> - force - trace - "Validation completed" - (case - (case - ((\d -> - force - chooseData - d - (\ds -> - case - (unConstrData - d) - [ (\l - r -> - case - (equalsInteger - 0 - l) - [ (case - (equalsInteger - 1 - l) - [ (constr 1 - [ ]) - , (constr 0 - [ (constr 0 - [ ]) ]) ]) - , (constr 0 - [ (constr 1 - [ ]) ]) ]) ]) - (\ds -> - constr 1 - [ ]) - (\ds -> - constr 1 - [ ]) - (\ds -> - constr 1 - [ ]) - (\ds -> - constr 1 - [ ]) - (constr 0 - [ ])) - (`$mScriptContext` - context - (\ds - ds - ds -> - ds) - (\void -> - error))) - [ (\r -> - force - trace - "Parsed Redeemer" - r) - , ((\x -> - error) - (force - trace - "Failed to parse Redeemer" - (constr 0 - [ ]))) ]) - [ ((\ctx -> - case - (`$mSpendingScript` - (scriptContextScriptInfo - ctx) - (\_ownRef - ds -> - case - ds - [ (\ds -> - constr 0 - [ _ownRef - , ds ]) - , ((\defaultBody -> - case - error - [ defaultBody ]) - error) ]) - (\void -> - (\defaultBody -> - case - error - [ defaultBody ]) - error)) - [ (\ipv - ipv -> - (\vestingDatum -> - case - (`$mPubKeyCredential` - (addressCredential - (beneficiary - vestingDatum)) - (\beneficiaryKey -> - constr 0 - [ beneficiaryKey ]) - (\void -> - (\defaultBody -> - case - error - [ defaultBody ]) - error)) - [ (\ipv -> - (\txInfo -> - (\ds -> - case - (txSignedBy - txInfo - ipv) - [ (traceError - "Missing beneficiary signature") - , (case - (lessThanInteger - (vestingPeriodEnd - vestingDatum) - ds) - [ (traceError - "Unlock not permitted until vestingPeriodEnd time") - , True ]) ]) - (getLowerInclusiveTimeRange - (txInfoValidRange - txInfo))) - (scriptContextTxInfo - ctx)) ]) - (case - (unConstrData - ipv) - [ (\index - args -> - case - index - [ (\ds -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - constr 0 - [ (force - headList - ds) - , (case - (unConstrData - (force - headList - l)) - [ (\index - args -> - case - index - [ (\ds -> - constr 0 - [ (unBData - (force - headList - ds)) - , (unBData - (force - headList - (force - tailList - ds))) ]) ] - args) ]) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - (force - tailList - l))) ]) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - ds)) ] - args) ])) ]) - (force - trace - "Full unlock requested" - context)) - , ((\ctx -> - case - (`$mSpendingScript` - (scriptContextScriptInfo - ctx) - (\ownRef - ds -> - case - ds - [ (\ds -> - constr 0 - [ ownRef - , ds ]) - , ((\defaultBody -> - case - error - [ defaultBody ]) - error) ]) - (\void -> - (\defaultBody -> - case - error - [ defaultBody ]) - error)) - [ (\ipv - ipv -> - (\vestingDatum -> - (\ds -> - (\ds -> - case - (`$mPubKeyCredential` - (addressCredential - (beneficiary - vestingDatum)) - (\beneficiaryHash -> - constr 0 - [ beneficiaryHash ]) - (\void -> - (\defaultBody -> - case - error - [ defaultBody ]) - error)) - [ ((\asset - ipv -> - (\txInfo -> - (\nt -> + ((\fix1 -> + (\countInputsAtScript -> + (\caseList' -> + (\findInputByOutRef -> + (\findOutputByAddress -> + (\txSignedBy' + scriptContextData -> + (\ctxFields -> + (\txInfoFields -> + (\txInfoFields -> + (\txInfoFields -> + (\txSignatories -> + (\txValidRange -> + (\txOutputs -> + (\txInputs -> + (\redeemerTag -> + (\spendingInfo -> + (\ownRef -> + (\datumData -> + case + (force + trace + "Parsed ScriptContext" + (force + trace + "Parsed Redeemer" + (case + redeemerTag + [ (force + trace + "Partial unlock requested" + ((\currentTimeApproximation -> + (\vdFields -> + (\vdFields -> + (\vdFields -> + (\vdFields -> + (\vdFields -> + (\vdFields -> + (\totalInstallments -> + (\firstUnlockPossibleAfter -> + (\vestingPeriodEnd -> + (\vestingTimeRemaining -> + (\timeBetweenTwoInstallments -> + (\expectedRemainingQty -> + (\assetFields -> + (\assetCs -> + (\assetTn -> + (\findToken -> + (\findCurrency -> + (\findToken -> + (\findCurrency -> + (\beneficiaryHash -> + (\signed -> + (\resolvedFields -> + (\inputAddress -> + (\scriptHash -> + (\ownOutputFields -> + (\outputDatum -> + (\newRemainingQty -> + (\resolvedDatum -> + (\oldRemainingQty -> + case + signed + [ ((\x -> + error) + (force + trace + "Missing beneficiary signature" + (constr 0 + [ ]))) + , (case + (lessThanEqualsInteger + currentTimeApproximation + firstUnlockPossibleAfter) + [ (case + (lessThanEqualsInteger + newRemainingQty + 0) + [ (case + (lessThanEqualsInteger + oldRemainingQty + newRemainingQty) + [ (case + (equalsInteger + expectedRemainingQty + newRemainingQty) + [ ((\x -> + error) + (force + trace + "Mismatched remaining asset" + (constr 0 + [ ]))) + , (case + (equalsData + resolvedDatum + outputDatum) + [ ((\x -> + error) + (force + trace + "Datum Modification Prohibited" + (constr 0 + [ ]))) + , (case + (equalsInteger + 1 + (countInputsAtScript + scriptHash + txInputs)) + [ ((\x -> + error) + (force + trace + "Double satisfaction" + (constr 0 + [ ]))) + , True ]) ]) ]) + , ((\x -> + error) + (force + trace + "Remaining asset is not decreasing" + (constr 0 + [ ]))) ]) + , ((\x -> + error) + (force + trace + "Zero remaining assets not allowed" + (constr 0 + [ ]))) ]) + , ((\x -> + error) + (force + trace + "Unlock not permitted until firstUnlockPossibleAfter time" + (constr 0 + [ ]))) ]) ]) + (findCurrency + (unMapData + (force + headList + (force + tailList + resolvedFields))))) + (force + headList + (force + tailList + (force + tailList + resolvedFields)))) + (findCurrency + (unMapData + (force + headList + (force + tailList + ownOutputFields))))) + (force + headList + (force + tailList + (force + tailList + ownOutputFields)))) + (case + (unConstrData + (findOutputByAddress + inputAddress + txOutputs)) + [ (\l + r -> + r) ])) + (unBData + (force + headList + (case + (unConstrData + (force + headList + (case + (unConstrData + inputAddress) + [ (\l + r -> + r) ]))) + [ (\l + r -> + r) ])))) + (force + headList + resolvedFields)) + (case + (unConstrData + (force + headList + (force + tailList + (case + (unConstrData + (findInputByOutRef + ownRef + txInputs)) + [ (\l + r -> + r) ])))) + [ (\l + r -> + r) ])) + (txSignedBy' + txSignatories + beneficiaryHash)) + (unBData + (force + headList + (case + (unConstrData + (force + headList + (case + (unConstrData + (force + headList + vdFields)) + [ (\l + r -> + r) ]))) + [ (\l + r -> + r) ])))) + (fix1 + (\findCurrency + pairs -> case - (case - (find - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (\eta -> - equalsData - (force - headList + (force + nullList + pairs) + [ ((\pair -> + case + (equalsByteString + (unBData (case - (unConstrData - eta) + pair [ (\l r -> - r) ])) - ipv) - nt) - [ (\ownVestingInput -> - constr 0 - [ ownVestingInput ]) - , ((\defaultBody -> - case - error - [ defaultBody ]) - error) ]) - [ (\ipv -> - (\nt -> - (\nt -> - case - (`$mScriptCredential` - (addressCredential - nt) - (\scriptHash -> - constr 0 - [ scriptHash ]) - (\void -> - (\defaultBody -> - case - error - [ defaultBody ]) - error)) - [ (\ipv -> - (\go -> - (\ds -> - (\ownVestingOutput -> - (\nt -> - (\ds -> - (\currentTimeApproximation -> - (\ds -> - case - (txSignedBy - txInfo - ipv) - [ (traceError - "Missing beneficiary signature") - , (case - (lessThanInteger - (case - vestingDatum - [ (\ds - ds - ds - ds - ds - ds - ds -> - ds) ]) - currentTimeApproximation) - [ (traceError - "Unlock not permitted until firstUnlockPossibleAfter time") - , (force - ((\newRemainingQty -> - case - (lessThanEqualsInteger - (force - newRemainingQty) - 0) - [ (delay - (case - (lessThanInteger - (force - newRemainingQty) - ds) - [ (traceError - "Remaining asset is not decreasing") - , (case - (equalsInteger - ds - (force - newRemainingQty)) - [ (traceError - "Mismatched remaining asset") - , (case - (equalsData - (txOutDatum - nt) - nt) - [ (traceError - "Datum Modification Prohibited") - , (case - (equalsInteger - (go - 0 - nt) - 1) - [ (traceError - "Double satisfaction") - , True ]) ]) ]) ])) - , (delay - (traceError - "Zero remaining assets not allowed")) ]) - (delay - (case - ds - [ (\newRemainingQty -> - newRemainingQty) ])))) ]) ]) - (divCeil - (multiplyInteger - (divCeil - (subtractInteger - (vestingPeriodEnd - vestingDatum) - currentTimeApproximation) - ds) - (case - vestingDatum - [ (\ds - ds - ds - ds - ds - ds - ds -> - ds) ])) - (totalInstallments - vestingDatum))) - (getLowerInclusiveTimeRange - (txInfoValidRange - txInfo))) - (constr 0 - [ (assetClassValueOf - (txOutValue - ownVestingOutput) - (force - asset)) ])) - (txOutDatum - ownVestingOutput)) - (case - (case - (find - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (\eta -> - equalsData - (txOutAddress - eta) - nt) - (`$mTxInfo` - txInfo - (\ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds -> - ds) - (\void -> - error))) - [ (\ownVestingOutput -> - constr 0 - [ ownVestingOutput ]) - , ((\defaultBody -> - case - error - [ defaultBody ]) - error) ]) - [ (\ownVestingOutput -> - ownVestingOutput) ])) - (assetClassValueOf - (txOutValue - nt) - (force - asset))) - (fix1 - (\go - n - ds -> - case - ds - [ (\x - eta -> - `$mScriptCredential` - (addressCredential - (txOutAddress - (txInInfoResolved - x))) - (\vh -> - case - (equalsByteString - vh - ipv) - [ (go - n - eta) - , (go - (addInteger - 1 - n) - eta) ]) - (\void -> - go - n - eta)) - , n ]))) ]) - (txOutAddress - nt)) - (txInInfoResolved - ipv)) ]) - (`$mTxInfo` - txInfo - (\ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds -> - ds) - (\void -> - error))) - (scriptContextTxInfo - ctx)) - (delay - (case - ds - [ (\asset -> - asset) ]))) ]) - (divCeil - (subtractInteger - (vestingPeriodEnd - vestingDatum) - (case - vestingDatum - [ (\ds - ds - ds - ds - ds - ds - ds -> - ds) ])) - (totalInstallments - vestingDatum))) - (constr 0 - [ (case - vestingDatum - [ (\ds - ds - ds - ds - ds - ds - ds -> - ds) ]) ])) - (case - (unConstrData - ipv) - [ (\index - args -> - case - index - [ (\ds -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - constr 0 - [ (force - headList - ds) - , (case - (unConstrData - (force - headList - l)) - [ (\index - args -> - case - index - [ (\ds -> - constr 0 - [ (unBData - (force - headList - ds)) - , (unBData - (force - headList - (force - tailList - ds))) ]) ] - args) ]) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - l)) - , (unIData - (force - headList - (force - tailList - l))) ]) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) + l) ])) + assetCs) + [ (findCurrency + (force + tailList + pairs)) + , (findToken + (unMapData + (case + pair + [ (\l + r -> + r) ]))) ]) + (force + headList + pairs)) + , 0 ]))) + (fix1 + (\findToken + pairs -> + case (force - tailList - l)) + nullList + pairs) + [ ((\pair -> + case + (equalsByteString + (unBData + (case + pair + [ (\l + r -> + l) ])) + assetTn) + [ (findToken + (force + tailList + pairs)) + , (unIData + (case + pair + [ (\l + r -> + r) ])) ]) + (force + headList + pairs)) + , 0 ]))) + (fix1 + (\findCurrency + pairs -> + case (force - tailList - ds)) ] - args) ])) ]) - (force - trace - "Partial unlock requested" - context)) ])) - (force - trace - "Parsed ScriptContext" - ctx)) - [ (traceError - "PT5") - , () ])) - (\x - y -> - addInteger - 1 - (divideInteger - (subtractInteger - x - 1) - y))) - (\scrut - cont - fail -> - (\tup -> - case - (equalsInteger - 0 - (case - tup - [ (\l - r -> - l) ])) - [ (fail - ()) - , (cont - (unBData - (force - headList - (case - tup - [ (\l - r -> - r) ])))) ]) - (unConstrData - scrut))) - (\scrut - cont - fail -> - (\tup -> - case - (equalsInteger - 1 - (case - tup - [ (\l - r -> - l) ])) - [ (fail - ()) - , ((\l -> - cont + nullList + pairs) + [ ((\pair -> + case + (equalsByteString + (unBData + (case + pair + [ (\l + r -> + l) ])) + assetCs) + [ (findCurrency + (force + tailList + pairs)) + , (findToken + (unMapData + (case + pair + [ (\l + r -> + r) ]))) ]) + (force + headList + pairs)) + , 0 ]))) + (fix1 + (\findToken + pairs -> + case + (force + nullList + pairs) + [ ((\pair -> + case + (equalsByteString + (unBData + (case + pair + [ (\l + r -> + l) ])) + assetTn) + [ (findToken + (force + tailList + pairs)) + , (unIData + (case + pair + [ (\l + r -> + r) ])) ]) + (force + headList + pairs)) + , 0 ]))) + (unBData + (force + headList + (force + tailList + assetFields)))) + (unBData + (force + headList + assetFields))) + (case + (unConstrData + (force + headList + vdFields)) + [ (\l + r -> + r) ])) + (addInteger + 1 + (divideInteger + (subtractInteger + (multiplyInteger + (addInteger + 1 + (divideInteger + (subtractInteger + vestingTimeRemaining + 1) + timeBetweenTwoInstallments)) + (unIData + (force + headList + vdFields))) + 1) + totalInstallments))) + (addInteger + 1 + (divideInteger + (subtractInteger + (subtractInteger + vestingPeriodEnd + (unIData + (force + headList + vdFields))) + 1) + totalInstallments))) + (subtractInteger + vestingPeriodEnd + currentTimeApproximation)) + (unIData + (force + headList + vdFields))) + (unIData + (force + headList + vdFields))) + (unIData + (force + headList + (force + tailList + vdFields)))) + (force + tailList + vdFields)) + (force + tailList + vdFields)) + (force + tailList + vdFields)) + (force + tailList + vdFields)) + (force + tailList + vdFields)) + (case + (unConstrData + datumData) + [ (\l + r -> + r) ])) + ((\lowerFields -> + (\extCon -> + (\extTag -> + (\extFields -> + (\offset -> + case + (equalsInteger + 1 + extTag) + [ ((\x -> + error) + (force + trace + "Time range not Finite" + (constr 0 + [ ]))) + , (addInteger + (unIData + (force + headList + extFields)) + offset) ]) + (case + (equalsInteger + 1 + (case + (unConstrData + (force + headList + (force + tailList + lowerFields))) + [ (\l + r -> + l) ])) + [ 1 + , 0 ])) + (case + extCon + [ (\l + r -> + r) ])) + (case + extCon + [ (\l + r -> + l) ])) + (unConstrData + (force + headList + lowerFields))) + (case + (unConstrData + (force + headList + (case + (unConstrData + txValidRange) + [ (\l + r -> + r) ]))) + [ (\l + r -> + r) ])))) + , (force + trace + "Full unlock requested" + ((\currentTimeApproximation -> + (\vdFields -> + (\vestingPeriodEnd -> + (\beneficiaryHash -> + case + (txSignedBy' + txSignatories + beneficiaryHash) + [ ((\x -> + error) + (force + trace + "Missing beneficiary signature" + (constr 0 + [ ]))) + , (case + (lessThanEqualsInteger + currentTimeApproximation + vestingPeriodEnd) + [ True + , ((\x -> + error) (force - headList - l) - (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` - (force - headList - (force - tailList - l)))) - (case - tup - [ (\l - r -> - r) ])) ]) - (unConstrData - scrut))) - (\d -> - d)) - ((\lookup' - v - ds -> - case - ds - [ (\c - t -> - case - (lookup' - (bData - c) - v) - [ (\a -> - (\m -> - case - (lookup' - (bData - t) - m) - [ (\a -> - unIData - a) - , 0 ]) - (unMapData - a)) - , 0 ]) ]) - (\k -> - (\go - m -> - go - m) - (fix1 - (\go - xs -> - case - xs - [ (\hd -> - case - (equalsData - k - (case - hd - [ (\l - r -> - l) ])) - [ go - , (\ds -> - constr 0 - [ (case - hd - [ (\l - r -> - r) ]) ]) ]) - , (constr 1 - [ ]) ]))))) - (\ds -> - case - ds - [ (\ds - ds - ds - ds - ds - ds - ds -> - ds) ])) - (\scrut - cont - fail -> - (\tup -> - case - (equalsInteger - 1 - (case - tup - [ (\l - r -> - l) ])) - [ (fail - ()) - , (cont - (unBData - (force - headList - (case - tup - [ (\l - r -> - r) ])))) ]) - (unConstrData - scrut))) - (\ds -> - force - headList - (case - (unConstrData - ds) - [ (\l - r -> - r) ]))) - (\ds -> - (\l -> - (\tup -> - case - (equalsInteger - 1 - (case - tup - [ (\l - r -> - l) ])) - [ (traceError - "Time range not Finite") - , ((\posixTime -> - case - (case - (unConstrData - (force - headList - (force - tailList - l))) - [ (\index - args -> - case - index - [ (\ds -> - False) - , (\ds -> - True) ] - args) ]) - [ (addInteger - 1 - posixTime) - , posixTime ]) - (unIData - (force - headList - (case - tup - [ (\l - r -> - r) ])))) ]) - (unConstrData - (force - headList - l))) - (case - (unConstrData - (force - headList - (case - (unConstrData - ds) - [ (\l - r -> - r) ]))) - [ (\l - r -> - r) ]))) - (\str -> - (\x -> error) - (force trace - str - (constr 0 - [])))) - (\ds -> - `$mScriptContext` - ds - (\ds ds ds -> - ds) - (\void -> - error))) - (\ds -> - `$mScriptContext` - ds - (\ds ds ds -> ds) - (\void -> error))) - (\scrut cont fail -> - (\l -> - (\l -> - cont - (force headList - l) - (force headList - l) - (force headList - (force - tailList - l))) - (force tailList l)) - (case - (unConstrData - scrut) - [(\l r -> r)]))) - (\ds -> - case - ds - [ (\ds - ds - ds - ds - ds - ds - ds -> - ds) ])) - (\ds -> - force headList - (force tailList - (case - (unConstrData ds) - [(\l r -> r)])))) - (\ds -> - `$mTxInfo` - ds - (\ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds -> - ds) - (\void -> error))) - (\ds -> - `$mTxOut` - ds - (\ds ds ds ds -> ds) - (\void -> error))) - (\ds -> - `$mTxOut` - ds - (\ds ds ds ds -> ds) - (\void -> error))) - (\scrut - cont - fail -> - (\l -> - (\l -> - (\l -> - cont - (force headList l) - (unMapData (force headList l)) - (force headList l) - (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - unBData - (force headList - (force tailList l)))) - (force tailList l)) - (force tailList l)) - (case - (unConstrData scrut) - [(\l r -> r)]))) - (\ds -> - unMapData - (force headList - (force tailList - (case - (unConstrData ds) - [(\l r -> r)]))))) - (\ds k -> - `$mTxInfo` - ds - (\ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds - ds -> - case - (find - unBData - (\y -> equalsByteString k y) - ds) - [(\ds -> True), False]) - (\void -> - (\defaultBody -> case error [defaultBody]) - error))) - (\scrut - cont - fail -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - (\l -> - cont - (unListData - (force - headList - l)) - (unListData - (force - headList - l)) - (unListData - (force - headList - l)) - (unIData - (force - headList - l)) - (unMapData - (force - headList - l)) - (unListData - (force - headList - l)) - (unMapData - (force - headList - l)) - (force - headList - l) - (unListData - (force - headList - l)) - (unMapData - (force - headList - l)) - (unMapData - (force - headList - l)) - (unBData - (force - headList - l)) - (unMapData - (force - headList - l)) - (unListData - (force - headList - l)) - (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - unIData - (force - headList - l)) - (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` - unIData - (force - headList - (force - tailList - l)))) - (force - tailList - l)) - (force - tailList - l)) - (force - tailList - l)) - (force tailList - l)) - (force tailList l)) - (force tailList l)) - (force tailList l)) - (force tailList l)) - (force tailList l)) - (force tailList l)) - (force tailList l)) - (force tailList l)) - (force tailList l)) - (force tailList l)) - (case (unConstrData scrut) [(\l r -> r)]))) - (\`$dUnsafeFromData` d -> + trace + "Unlock not permitted until vestingPeriodEnd time" + (constr 0 + [ ]))) ]) ]) + (unBData + (force + headList + (case + (unConstrData + (force + headList + (case + (unConstrData + (force + headList + vdFields)) + [ (\l + r -> + r) ]))) + [ (\l + r -> + r) ])))) + (unIData + (force + headList + (force + tailList + (force + tailList + (force + tailList + (force + tailList + vdFields))))))) + (case + (unConstrData + datumData) + [ (\l + r -> + r) ])) + ((\lowerFields -> + (\extCon -> + (\extTag -> + (\extFields -> + (\offset -> + case + (equalsInteger + 1 + extTag) + [ ((\x -> + error) + (force + trace + "Time range not Finite" + (constr 0 + [ ]))) + , (addInteger + (unIData + (force + headList + extFields)) + offset) ]) + (case + (equalsInteger + 1 + (case + (unConstrData + (force + headList + (force + tailList + lowerFields))) + [ (\l + r -> + l) ])) + [ 1 + , 0 ])) + (case + extCon + [ (\l + r -> + r) ])) + (case + extCon + [ (\l + r -> + l) ])) + (unConstrData + (force + headList + lowerFields))) + (case + (unConstrData + (force + headList + (case + (unConstrData + txValidRange) + [ (\l + r -> + r) ]))) + [ (\l + r -> + r) ])))) ]))) + [ ((\x -> + error) + (force + trace + "Validation failed" + (constr 0 + []))) + , (force + trace + "Validation completed" + ()) ]) + (case + spendingInfo + [(\l r -> r)])) + (case + spendingInfo + [(\l r -> l)])) + ((\con -> + (\tag -> + (\fields -> + case + (equalsInteger + 1 + tag) + [ ((\x -> + error) + (force + trace + "Not spending script" + (constr 0 + []))) + , ((\mdCon -> + (\mdTag -> + (\mdFields -> + (\ownRef -> + case + (equalsInteger + 0 + mdTag) + [ ((\x -> + error) + (force + trace + "Missing datum" + (constr 0 + [ ]))) + , (mkPairData + ownRef + (force + headList + mdFields)) ]) + (force + headList + fields)) + (case + mdCon + [ (\l + r -> + r) ])) + (case + mdCon + [ (\l + r -> + l) ])) + (unConstrData + (force + headList + (force + tailList + fields)))) ]) + (case + con + [(\l r -> r)])) + (case + con + [(\l r -> l)])) + (unConstrData + (force + headList + (force + tailList + (force + tailList + ctxFields)))))) + (case + (unConstrData + (force headList + (force tailList + ctxFields))) + [(\l r -> l)])) + (unListData + (force headList txInfoFields))) + (unListData + (force headList txInfoFields))) + (force headList txInfoFields)) + (unListData + (force headList + (force tailList txInfoFields)))) + (force tailList + (force tailList + (force tailList + (force tailList + (force tailList txInfoFields)))))) + (force tailList (force tailList txInfoFields))) + (case + (unConstrData (force headList ctxFields)) + [(\l r -> r)])) + (case + (unConstrData + (force trace + "Parsing ScriptContext..." + scriptContextData)) + [(\l r -> r)])) + (fix1 + (\txSignedBy' signatories pkh -> + case + signatories + [ (\s ss -> + case + (equalsByteString (unBData s) pkh) + [(txSignedBy' ss pkh), True]) + , False ]))) + (fix1 + (\findOutputByAddress addr outputs -> + caseList' + ((\x -> error) + (force trace "Own output not found" (constr 0 []))) + (\out outs -> + case + (equalsData + (force headList + (case (unConstrData out) [(\l r -> r)])) + addr) + [(findOutputByAddress addr outs), out]) + outputs))) + (fix1 + (\findInputByOutRef ref inputs -> + caseList' + ((\x -> error) + (force trace "Own input not found" (constr 0 []))) + (\txIn txIns -> case - (unConstrData d) - [ (\index args -> - case - index - [ (\ds -> - constr 0 - [ (`$dUnsafeFromData` - (force headList ds)) ]) - , (\ds -> constr 1 []) ] - args) ])) - (\`$dUnsafeFromData` pred' -> - (\go eta -> go eta) - (fix1 - (\go ds -> - case - ds - [ (\x eta -> - (\h -> - case - (pred' h) - [(go eta), (constr 0 [h])]) - (`$dUnsafeFromData` x)) - , (constr 1 []) ])))) - (\ds -> case ds [(\ds ds ds ds ds ds ds -> ds)])) - , (delay - ((\x -> error) - (force trace - "Failed to parse ScriptContext" - (constr 0 [])))) ])) + (equalsData + (force headList + (case (unConstrData txIn) [(\l r -> r)])) + ref) + [(findInputByOutRef ref txIns), txIn]) + inputs))) + (\z f xs -> case xs [f, z])) + (fix1 + (\countInputsAtScript scriptHash inputs -> + case + inputs + [ (\txIn txIns -> + (\rest -> + (\credCon -> + (\credTag -> + (\credFields -> + case + (equalsInteger 1 credTag) + [ rest + , (case + (equalsByteString + (unBData + (force headList credFields)) + scriptHash) + [rest, (addInteger 1 rest)]) ]) + (case credCon [(\l r -> r)])) + (case credCon [(\l r -> l)])) + (unConstrData + (force headList + (case + (unConstrData + (force headList + (case + (unConstrData + (force headList + (force tailList + (case + (unConstrData txIn) + [(\l r -> r)])))) + [(\l r -> r)]))) + [(\l r -> r)])))) + (countInputsAtScript scriptHash txIns)) + , 0 ]))) (\f -> (\s -> f