From 5290035106eacf84c07cd8d23b71562a7c7bce25 Mon Sep 17 00:00:00 2001 From: kwxm Date: Fri, 17 May 2024 21:04:09 +0100 Subject: [PATCH 1/6] Get the script analysis executable to print out actual execution costs --- .../exe/analyse-script-events/Main.hs | 84 +++++++++++++------ 1 file changed, 57 insertions(+), 27 deletions(-) diff --git a/plutus-ledger-api/exe/analyse-script-events/Main.hs b/plutus-ledger-api/exe/analyse-script-events/Main.hs index 9b4be82bc36..7cdfb9dfc93 100644 --- a/plutus-ledger-api/exe/analyse-script-events/Main.hs +++ b/plutus-ledger-api/exe/analyse-script-events/Main.hs @@ -325,6 +325,10 @@ analyseOneFile -> IO () analyseOneFile analyse eventFile = do events <- loadEvents eventFile + printf "# %s\n" eventFile + -- Print the file in the output so we can narrow down the location of + -- interesting/anomalous data. This may not be helpful for some of the + -- analyses. case ( mkContext V1.mkEvaluationContext (eventsCostParamsV1 events) , mkContext V2.mkEvaluationContext (eventsCostParamsV2 events) ) of @@ -353,29 +357,55 @@ analyseOneFile analyse eventFile = do Just (ctx, params) -> analyse ctx params event Nothing -> putStrLn "*** ctxV2 missing ***" - -max_tx_ex_steps :: Double -max_tx_ex_steps = 10_000_000_000 - -max_tx_ex_mem :: Double -max_tx_ex_mem = 14_000_000 - --- Print out the CPU and memory budgets of each script event. These are the costs --- paid for by the submitters, not the actual costs consumed during execution. --- TODO: add a version that tells us the actual execution costs. -getBudgets :: EventAnalyser -getBudgets _ctx _params ev = - let printFractions d = - let ExBudget (V2.ExCPU cpu) (V2.ExMemory mem) = dataBudget d - in printf "%15d %10.8f %15d %10.8f\n" - (fromSatInt cpu :: Int) - ((fromSatInt cpu) / max_tx_ex_steps) - (fromSatInt mem :: Int) - ((fromSatInt mem) / max_tx_ex_mem) - - in case ev of - PlutusV1Event evdata _expected -> printFractions evdata - PlutusV2Event evdata _expected -> printFractions evdata +analyseCosts :: EventAnalyser +analyseCosts ctx _ ev = + case ev of + PlutusV1Event ScriptEvaluationData{..} _ -> + -- + let actualCost = + case deserialiseScript PlutusV1 dataProtocolVersion dataScript of + Left _ -> Nothing + Right script -> + case + V1.evaluateScriptRestricting + dataProtocolVersion + V1.Quiet + ctx + dataBudget + script + dataInputs + of + (_, Left _) -> Nothing + (_, Right cost) -> Just cost + in printCost actualCost dataBudget + PlutusV2Event ScriptEvaluationData{..} _ -> + let actualCost = + case deserialiseScript PlutusV2 dataProtocolVersion dataScript of + Left _ -> Nothing + Right script -> + case + V2.evaluateScriptRestricting + dataProtocolVersion + V2.Quiet + ctx + dataBudget + script + dataInputs + of + (_, Left _) -> Nothing + (_, Right cost) -> Just cost + in printCost actualCost dataBudget + where printCost :: Maybe ExBudget -> ExBudget -> IO () + printCost actualCost claimedCost = + let (claimedCPU, claimedMem) = costAsInts claimedCost + in case actualCost of + Nothing -> -- something went wrong; print the cost as "NA" so that R can still process it + printf "%15s %15d %15s %15d\n" "NA" claimedCPU "NA" claimedMem + Just cost -> + let (actualCPU, actualMem) = costAsInts cost + in printf "%15d %15d %15d %15d\n" actualCPU claimedCPU actualMem claimedMem + costAsInts :: ExBudget -> (Int, Int) + costAsInts (ExBudget (V2.ExCPU cpu) (V2.ExMemory mem)) = (fromSatInt cpu, fromSatInt mem) main :: IO () main = @@ -400,10 +430,10 @@ main = , "count the total number of occurrences of each builtin in validator scripts" , countBuiltins ) - , ( "budgets" - , "print (claimed) budgets of scripts" - , putStrLn " cpu cpuFraction mem memFraction" - `thenDoAnalysis` getBudgets + , ( "costs" + , "print actual and claimed costs of scripts" + , putStrLn " cpuActual cpuClaimed memActual memClaimed" + `thenDoAnalysis` analyseCosts ) ] From 16047fcdbfaa5f1465532a66af3a42bebf2c48ea Mon Sep 17 00:00:00 2001 From: kwxm Date: Sat, 18 May 2024 13:49:12 +0100 Subject: [PATCH 2/6] Tidying up --- .../exe/analyse-script-events/Main.hs | 32 ++++++++++++------- 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/plutus-ledger-api/exe/analyse-script-events/Main.hs b/plutus-ledger-api/exe/analyse-script-events/Main.hs index 7cdfb9dfc93..836df1ff51d 100644 --- a/plutus-ledger-api/exe/analyse-script-events/Main.hs +++ b/plutus-ledger-api/exe/analyse-script-events/Main.hs @@ -37,7 +37,7 @@ import Data.Primitive.PrimArray qualified as P import Data.SatInt (fromSatInt) import System.Directory.Extra (listFiles) import System.Environment (getArgs, getProgName) -import System.FilePath (isExtensionOf) +import System.FilePath (isExtensionOf, takeFileName) import System.IO (stderr) import Text.Printf (hPrintf, printf) @@ -325,7 +325,7 @@ analyseOneFile -> IO () analyseOneFile analyse eventFile = do events <- loadEvents eventFile - printf "# %s\n" eventFile + printf "# %s\n" $ takeFileName eventFile -- Print the file in the output so we can narrow down the location of -- interesting/anomalous data. This may not be helpful for some of the -- analyses. @@ -357,6 +357,8 @@ analyseOneFile analyse eventFile = do Just (ctx, params) -> analyse ctx params event Nothing -> putStrLn "*** ctxV2 missing ***" + +-- Print out the actual and claimed CPU and memory cost of every script. analyseCosts :: EventAnalyser analyseCosts ctx _ ev = case ev of @@ -378,6 +380,7 @@ analyseCosts ctx _ ev = (_, Left _) -> Nothing (_, Right cost) -> Just cost in printCost actualCost dataBudget + PlutusV2Event ScriptEvaluationData{..} _ -> let actualCost = case deserialiseScript PlutusV2 dataProtocolVersion dataScript of @@ -395,11 +398,12 @@ analyseCosts ctx _ ev = (_, Left _) -> Nothing (_, Right cost) -> Just cost in printCost actualCost dataBudget + where printCost :: Maybe ExBudget -> ExBudget -> IO () printCost actualCost claimedCost = let (claimedCPU, claimedMem) = costAsInts claimedCost in case actualCost of - Nothing -> -- something went wrong; print the cost as "NA" so that R can still process it + Nothing -> -- Something went wrong; print the cost as "NA" so that R can still process it. printf "%15s %15d %15s %15d\n" "NA" claimedCPU "NA" claimedMem Just cost -> let (actualCPU, actualMem) = costAsInts cost @@ -441,17 +445,21 @@ main = (prelude `thenDoAnalysis` analyser) files = prelude >> doAnalysis analyser files usage = do - getProgName >>= hPrintf stderr "Usage: %s \n" + getProgName >>= hPrintf stderr "Usage: %s []\n" + hPrintf stderr "Analyse the .event files in (default = current directory)\n" hPrintf stderr "Avaliable analyses:\n" mapM_ printDescription analyses where printDescription (n,h,_) = hPrintf stderr " %-16s: %s\n" n h + go name dir = + case find (\(n,_,_) -> n == name) analyses of + Nothing -> printf "Unknown analysis: %s\n" name >> usage + Just (_,_,analysis) -> + filter ("event" `isExtensionOf`) <$> listFiles dir >>= \case + [] -> printf "No event files in %s\n" dir + eventFiles -> analysis eventFiles + in getArgs >>= \case - [dir, name] -> - case find (\(n,_,_) -> n == name) analyses of - Nothing -> printf "Unknown analysis: %s\n" name >> usage - Just (_,_,analysis) -> - filter ("event" `isExtensionOf`) <$> listFiles dir >>= \case - [] -> printf "No event files in %s\n" dir - eventFiles -> analysis eventFiles - _ -> usage + [name] -> go name "." + [name, dir] -> go name dir + _ -> usage From 200339750fd1cf37f80bd5486421fb6c06c902fc Mon Sep 17 00:00:00 2001 From: kwxm Date: Sat, 18 May 2024 13:55:39 +0100 Subject: [PATCH 3/6] Empty comment --- plutus-ledger-api/exe/analyse-script-events/Main.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/plutus-ledger-api/exe/analyse-script-events/Main.hs b/plutus-ledger-api/exe/analyse-script-events/Main.hs index 836df1ff51d..0437b711dfb 100644 --- a/plutus-ledger-api/exe/analyse-script-events/Main.hs +++ b/plutus-ledger-api/exe/analyse-script-events/Main.hs @@ -363,7 +363,6 @@ analyseCosts :: EventAnalyser analyseCosts ctx _ ev = case ev of PlutusV1Event ScriptEvaluationData{..} _ -> - -- let actualCost = case deserialiseScript PlutusV1 dataProtocolVersion dataScript of Left _ -> Nothing From e7fb4d3bac7db2fc079b8adfe8b509386504d010 Mon Sep 17 00:00:00 2001 From: kwxm Date: Sat, 18 May 2024 13:57:55 +0100 Subject: [PATCH 4/6] Dot --- plutus-ledger-api/exe/analyse-script-events/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plutus-ledger-api/exe/analyse-script-events/Main.hs b/plutus-ledger-api/exe/analyse-script-events/Main.hs index 0437b711dfb..4fc723bf84c 100644 --- a/plutus-ledger-api/exe/analyse-script-events/Main.hs +++ b/plutus-ledger-api/exe/analyse-script-events/Main.hs @@ -455,7 +455,7 @@ main = Nothing -> printf "Unknown analysis: %s\n" name >> usage Just (_,_,analysis) -> filter ("event" `isExtensionOf`) <$> listFiles dir >>= \case - [] -> printf "No event files in %s\n" dir + [] -> printf "No .event files in %s\n" dir eventFiles -> analysis eventFiles in getArgs >>= \case From 7ee065fb2123b8dfffdeb5f46ce01c3555002613 Mon Sep 17 00:00:00 2001 From: kwxm Date: Sun, 19 May 2024 14:03:10 +0100 Subject: [PATCH 5/6] Output evaluation status too --- .../exe/analyse-script-events/Main.hs | 118 ++++++++++-------- 1 file changed, 65 insertions(+), 53 deletions(-) diff --git a/plutus-ledger-api/exe/analyse-script-events/Main.hs b/plutus-ledger-api/exe/analyse-script-events/Main.hs index 4fc723bf84c..c299fb44568 100644 --- a/plutus-ledger-api/exe/analyse-script-events/Main.hs +++ b/plutus-ledger-api/exe/analyse-script-events/Main.hs @@ -302,6 +302,70 @@ countBuiltins eventFiles = do P.itraversePrimArray_ printEntry finalCounts where printEntry i c = printf "%-35s %12d\n" (show (toEnum i :: DefaultFun)) c + +data EvaluationResult = OK ExBudget | Failed | DeserialisationError + +-- Convert to a string for use in an R frame +toRString :: EvaluationResult -> String +toRString = \case + OK _ -> "T" + Failed -> "F" + DeserialisationError -> "NA" + +-- Print out the actual and claimed CPU and memory cost of every script. +analyseCosts :: EventAnalyser +analyseCosts ctx _ ev = + case ev of + PlutusV1Event ScriptEvaluationData{..} _ -> + let result = + case deserialiseScript PlutusV1 dataProtocolVersion dataScript of + Left _ -> DeserialisationError + Right script -> + case + V1.evaluateScriptRestricting + dataProtocolVersion + V1.Quiet + ctx + dataBudget + script + dataInputs + of + (_, Left _) -> Failed + (_, Right cost) -> OK cost + in printCost result dataBudget + + PlutusV2Event ScriptEvaluationData{..} _ -> + let result = + case deserialiseScript PlutusV2 dataProtocolVersion dataScript of + Left _ -> DeserialisationError + Right script -> + case + V2.evaluateScriptRestricting + dataProtocolVersion + V2.Quiet + ctx + dataBudget + script + dataInputs + of + (_, Left _) -> Failed + (_, Right cost) -> OK cost + in printCost result dataBudget + + where printCost :: EvaluationResult -> ExBudget -> IO () + printCost result claimedCost = + let (claimedCPU, claimedMem) = costAsInts claimedCost + in case result of + OK cost -> + let (actualCPU, actualMem) = costAsInts cost + in printf "%15d %15d %15d %15d T\n" actualCPU claimedCPU actualMem claimedMem + -- Something went wrong; print the cost as "NA" ("Not Available" in R) so that R can + -- still process it. + _ -> + printf "%15s %15d %15s %15d F\n" "NA %s\n" claimedCPU "NA" claimedMem (toRString result) + costAsInts :: ExBudget -> (Int, Int) + costAsInts (ExBudget (V2.ExCPU cpu) (V2.ExMemory mem)) = (fromSatInt cpu, fromSatInt mem) + -- Extract the script from an evaluation event and apply some analysis function analyseUnappliedScript :: (Term NamedDeBruijn DefaultUni DefaultFun () -> IO ()) @@ -358,58 +422,6 @@ analyseOneFile analyse eventFile = do Nothing -> putStrLn "*** ctxV2 missing ***" --- Print out the actual and claimed CPU and memory cost of every script. -analyseCosts :: EventAnalyser -analyseCosts ctx _ ev = - case ev of - PlutusV1Event ScriptEvaluationData{..} _ -> - let actualCost = - case deserialiseScript PlutusV1 dataProtocolVersion dataScript of - Left _ -> Nothing - Right script -> - case - V1.evaluateScriptRestricting - dataProtocolVersion - V1.Quiet - ctx - dataBudget - script - dataInputs - of - (_, Left _) -> Nothing - (_, Right cost) -> Just cost - in printCost actualCost dataBudget - - PlutusV2Event ScriptEvaluationData{..} _ -> - let actualCost = - case deserialiseScript PlutusV2 dataProtocolVersion dataScript of - Left _ -> Nothing - Right script -> - case - V2.evaluateScriptRestricting - dataProtocolVersion - V2.Quiet - ctx - dataBudget - script - dataInputs - of - (_, Left _) -> Nothing - (_, Right cost) -> Just cost - in printCost actualCost dataBudget - - where printCost :: Maybe ExBudget -> ExBudget -> IO () - printCost actualCost claimedCost = - let (claimedCPU, claimedMem) = costAsInts claimedCost - in case actualCost of - Nothing -> -- Something went wrong; print the cost as "NA" so that R can still process it. - printf "%15s %15d %15s %15d\n" "NA" claimedCPU "NA" claimedMem - Just cost -> - let (actualCPU, actualMem) = costAsInts cost - in printf "%15d %15d %15d %15d\n" actualCPU claimedCPU actualMem claimedMem - costAsInts :: ExBudget -> (Int, Int) - costAsInts (ExBudget (V2.ExCPU cpu) (V2.ExMemory mem)) = (fromSatInt cpu, fromSatInt mem) - main :: IO () main = let analyses = @@ -435,7 +447,7 @@ main = ) , ( "costs" , "print actual and claimed costs of scripts" - , putStrLn " cpuActual cpuClaimed memActual memClaimed" + , putStrLn " cpuActual cpuClaimed memActual memClaimed status" `thenDoAnalysis` analyseCosts ) ] From 6178c3973bcc88e614820593f1bf755498719a30 Mon Sep 17 00:00:00 2001 From: kwxm Date: Sun, 19 May 2024 14:15:30 +0100 Subject: [PATCH 6/6] Oops --- plutus-ledger-api/exe/analyse-script-events/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plutus-ledger-api/exe/analyse-script-events/Main.hs b/plutus-ledger-api/exe/analyse-script-events/Main.hs index c299fb44568..62a881d0f2c 100644 --- a/plutus-ledger-api/exe/analyse-script-events/Main.hs +++ b/plutus-ledger-api/exe/analyse-script-events/Main.hs @@ -358,11 +358,11 @@ analyseCosts ctx _ ev = in case result of OK cost -> let (actualCPU, actualMem) = costAsInts cost - in printf "%15d %15d %15d %15d T\n" actualCPU claimedCPU actualMem claimedMem + in printf "%15d %15d %15d %15d %2s\n" actualCPU claimedCPU actualMem claimedMem (toRString result) -- Something went wrong; print the cost as "NA" ("Not Available" in R) so that R can -- still process it. _ -> - printf "%15s %15d %15s %15d F\n" "NA %s\n" claimedCPU "NA" claimedMem (toRString result) + printf "%15s %15d %15s %15d %2s\n" "NA" claimedCPU "NA" claimedMem (toRString result) costAsInts :: ExBudget -> (Int, Int) costAsInts (ExBudget (V2.ExCPU cpu) (V2.ExMemory mem)) = (fromSatInt cpu, fromSatInt mem)