commit 2f45e0bc6bda9cab4322ee7355359d6d73992d3d
parent ef6f27ce90789a1febf656d063fbfc6d7a7d53ca
Author: Jared Tobin <jared@jtobin.io>
Date: Wed, 11 Feb 2026 18:50:43 +0400
feat: add benchmark suites for parser, CFG, and taint analysis (IMPL9)
- Add NFData instances for core types (Reg, Shift, Extend, Operand,
AddrMode, Instr, Line, BasicBlock, CFG, AuditResult, etc.) to enable
full evaluation in benchmarks
- Add deepseq dependency to library
- Create bench/Main.hs with criterion benchmarks for parse, cfg, and
taint (intra/inter-proc) using CurveNCG.s and secp256k1NCG.s fixtures
- Create bench/Weight.hs with weigh benchmarks for allocation tracking
- Add auditor-bench and auditor-weigh benchmark stanzas to cabal file
Run with: cabal bench auditor-bench / cabal bench auditor-weigh
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
6 files changed, 185 insertions(+), 15 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module: Main
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: jared@ppad.tech
+--
+-- Criterion benchmarks for parser, CFG, and taint analysis.
+
+module Main where
+
+import Audit.AArch64.CFG (buildCFG)
+import Audit.AArch64.Check (checkCFG, checkCFGInterProc)
+import Audit.AArch64.Parser (parseAsm)
+import Criterion.Main
+import qualified Data.ByteString as BS
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8)
+
+main :: IO ()
+main = do
+ -- Load fixtures
+ smallSrc <- loadFixture "etc/CurveNCG.s"
+ largeSrc <- loadFixture "etc/secp256k1NCG.s"
+
+ -- Pre-parse for CFG and analysis benchmarks
+ smallLines <- case parseAsm smallSrc of
+ Right lns -> pure lns
+ Left e -> error $ "Failed to parse CurveNCG.s: " ++ show e
+ largeLines <- case parseAsm largeSrc of
+ Right lns -> pure lns
+ Left e -> error $ "Failed to parse secp256k1NCG.s: " ++ show e
+ let smallCFG = buildCFG smallLines
+ largeCFG = buildCFG largeLines
+
+ defaultMain
+ [ bgroup "parse"
+ [ bench "small (CurveNCG)" $ nf parseAsm smallSrc
+ , bench "large (secp256k1NCG)" $ nf parseAsm largeSrc
+ ]
+ , bgroup "cfg"
+ [ bench "small (CurveNCG)" $ nf buildCFG smallLines
+ , bench "large (secp256k1NCG)" $ nf buildCFG largeLines
+ ]
+ , bgroup "taint"
+ [ bench "intra-small" $ nf (checkCFG "bench") smallCFG
+ , bench "intra-large" $ nf (checkCFG "bench") largeCFG
+ , bench "inter-small" $ nf (checkCFGInterProc "bench") smallCFG
+ , bench "inter-large" $ nf (checkCFGInterProc "bench") largeCFG
+ ]
+ ]
+
+loadFixture :: FilePath -> IO Text
+loadFixture path = decodeUtf8 <$> BS.readFile path
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module: Main
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: jared@ppad.tech
+--
+-- Weigh benchmarks for allocation tracking.
+
+module Main where
+
+import Audit.AArch64.CFG (buildCFG, CFG)
+import Audit.AArch64.Check (checkCFG, checkCFGInterProc)
+import Audit.AArch64.Parser (parseAsm)
+import Audit.AArch64.Types (Line)
+import qualified Data.ByteString as BS
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8)
+import System.IO.Unsafe (unsafePerformIO)
+import Weigh
+
+main :: IO ()
+main = mainWith $ do
+ setColumns [Case, Allocated, GCs]
+
+ -- Parse benchmarks
+ wgroup "parse" $ do
+ func "small (CurveNCG)" parseAsm smallSrc
+ func "large (secp256k1NCG)" parseAsm largeSrc
+
+ -- CFG benchmarks
+ wgroup "cfg" $ do
+ func "small (CurveNCG)" buildCFG smallLines
+ func "large (secp256k1NCG)" buildCFG largeLines
+
+ -- Taint benchmarks
+ wgroup "taint-intra" $ do
+ func "small (CurveNCG)" (checkCFG "bench") smallCFG
+ func "large (secp256k1NCG)" (checkCFG "bench") largeCFG
+
+ wgroup "taint-inter" $ do
+ func "small (CurveNCG)" (checkCFGInterProc "bench") smallCFG
+ func "large (secp256k1NCG)" (checkCFGInterProc "bench") largeCFG
+
+-- Fixtures loaded at top-level (evaluated once)
+{-# NOINLINE smallSrc #-}
+smallSrc :: Text
+smallSrc = unsafePerformIO $ loadFixture "etc/CurveNCG.s"
+
+{-# NOINLINE largeSrc #-}
+largeSrc :: Text
+largeSrc = unsafePerformIO $ loadFixture "etc/secp256k1NCG.s"
+
+{-# NOINLINE smallLines #-}
+smallLines :: [Line]
+smallLines = case parseAsm smallSrc of
+ Right lns -> lns
+ Left _ -> error "failed to parse small fixture"
+
+{-# NOINLINE largeLines #-}
+largeLines :: [Line]
+largeLines = case parseAsm largeSrc of
+ Right lns -> lns
+ Left _ -> error "failed to parse large fixture"
+
+{-# NOINLINE smallCFG #-}
+smallCFG :: CFG
+smallCFG = buildCFG smallLines
+
+{-# NOINLINE largeCFG #-}
+largeCFG :: CFG
+largeCFG = buildCFG largeLines
+
+loadFixture :: FilePath -> IO Text
+loadFixture path = decodeUtf8 <$> BS.readFile path
diff --git a/lib/Audit/AArch64/CFG.hs b/lib/Audit/AArch64/CFG.hs
@@ -1,4 +1,6 @@
{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
@@ -27,26 +29,28 @@ module Audit.AArch64.CFG (
) where
import Audit.AArch64.Types
+import Control.DeepSeq (NFData)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
+import GHC.Generics (Generic)
-- | A basic block: a sequence of instructions with a single entry point.
data BasicBlock = BasicBlock
{ bbLabel :: !(Maybe Text) -- ^ Optional label at block start
, bbLines :: ![Line] -- ^ Instructions in the block
, bbSuccs :: ![Text] -- ^ Successor block labels
- } deriving (Eq, Show)
+ } deriving (Eq, Show, Generic, NFData)
-- | Control flow graph.
data CFG = CFG
{ cfgBlocks :: ![BasicBlock] -- ^ All basic blocks
, cfgLabelMap :: !(Map Text Int) -- ^ Label -> block index
, cfgEntry :: !Int -- ^ Entry block index
- } deriving (Eq, Show)
+ } deriving (Eq, Show, Generic, NFData)
-- | Get all labels defined in the CFG.
blockLabels :: CFG -> Set Text
diff --git a/lib/Audit/AArch64/Check.hs b/lib/Audit/AArch64/Check.hs
@@ -1,4 +1,6 @@
{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
@@ -25,17 +27,19 @@ module Audit.AArch64.Check (
import Audit.AArch64.CFG
import Audit.AArch64.Taint
import Audit.AArch64.Types
+import Control.DeepSeq (NFData)
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as Map
-import Data.Text (Text)
import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import GHC.Generics (Generic)
-- | Result of auditing assembly.
data AuditResult = AuditResult
{ arViolations :: ![Violation]
, arLinesChecked :: !Int
, arMemoryAccesses :: !Int
- } deriving (Eq, Show)
+ } deriving (Eq, Show, Generic, NFData)
instance Semigroup AuditResult where
a <> b = AuditResult
diff --git a/lib/Audit/AArch64/Types.hs b/lib/Audit/AArch64/Types.hs
@@ -1,4 +1,5 @@
{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -44,6 +45,7 @@ module Audit.AArch64.Types (
, emptyArgPolicy
) where
+import Control.DeepSeq (NFData)
import Data.Aeson (ToJSON(..), FromJSON(..), (.=), (.:?), object, withObject)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
@@ -84,7 +86,7 @@ data Reg
| Q8 | Q9 | Q10 | Q11 | Q12 | Q13 | Q14 | Q15
| Q16 | Q17 | Q18 | Q19 | Q20 | Q21 | Q22 | Q23
| Q24 | Q25 | Q26 | Q27 | Q28 | Q29 | Q30 | Q31
- deriving (Eq, Ord, Show, Generic)
+ deriving (Eq, Ord, Show, Generic, NFData)
instance ToJSON Reg where
toJSON = toJSON . regName
@@ -147,7 +149,7 @@ data Shift
= LSL !Int -- ^ Logical shift left
| LSR !Int -- ^ Logical shift right
| ASR !Int -- ^ Arithmetic shift right
- deriving (Eq, Show, Generic)
+ deriving (Eq, Show, Generic, NFData)
instance ToJSON Shift
@@ -157,7 +159,7 @@ data Extend
| SXTW -- ^ Signed extend word
| UXTX -- ^ Unsigned extend doubleword
| SXTX -- ^ Signed extend doubleword
- deriving (Eq, Show, Generic)
+ deriving (Eq, Show, Generic, NFData)
instance ToJSON Extend
@@ -169,7 +171,7 @@ data Operand
| OpExtendedReg !Reg !Extend -- ^ Extended register
| OpLabel !Text -- ^ Label reference
| OpAddr !AddrMode -- ^ Memory address
- deriving (Eq, Show, Generic)
+ deriving (Eq, Show, Generic, NFData)
instance ToJSON Operand
@@ -183,7 +185,7 @@ data AddrMode
| PreIndex !Reg !Integer -- ^ [xN, #imm]!
| PostIndex !Reg !Integer -- ^ [xN], #imm
| Literal !Text -- ^ =label or PC-relative
- deriving (Eq, Show, Generic)
+ deriving (Eq, Show, Generic, NFData)
instance ToJSON AddrMode
@@ -271,7 +273,7 @@ data Instr
| Svc !Integer
-- Other (unparsed but recorded)
| Other !Text ![Text]
- deriving (Eq, Show, Generic)
+ deriving (Eq, Show, Generic, NFData)
instance ToJSON Instr
@@ -280,7 +282,7 @@ data Line = Line
{ lineNum :: !Int
, lineLabel :: !(Maybe Text)
, lineInstr :: !(Maybe Instr)
- } deriving (Eq, Show, Generic)
+ } deriving (Eq, Show, Generic, NFData)
instance ToJSON Line
@@ -289,7 +291,7 @@ data Taint
= Public -- ^ Known to be public (derived from stack/heap pointers)
| Secret -- ^ Known or assumed to be secret
| Unknown -- ^ Not yet determined
- deriving (Eq, Ord, Show, Generic)
+ deriving (Eq, Ord, Show, Generic, NFData)
instance ToJSON Taint
@@ -307,7 +309,7 @@ joinTaint _ _ = Unknown -- Public+Unknown or Unknown+Unknown
data Provenance
= ProvPublic -- ^ Derived from public root or constant
| ProvUnknown -- ^ Unknown origin (e.g., loaded from memory)
- deriving (Eq, Ord, Show, Generic)
+ deriving (Eq, Ord, Show, Generic, NFData)
instance ToJSON Provenance
@@ -323,7 +325,7 @@ data ViolationReason
| UnknownBase !Reg -- ^ Base register taint unknown
| UnknownIndex !Reg -- ^ Index register taint unknown
| NonConstOffset -- ^ Non-constant offset without masking
- deriving (Eq, Show, Generic)
+ deriving (Eq, Show, Generic, NFData)
instance ToJSON ViolationReason where
toJSON (SecretBase r) =
@@ -343,7 +345,7 @@ data Violation = Violation
, vLine :: !Int
, vInstr :: !Instr
, vReason :: !ViolationReason
- } deriving (Eq, Show, Generic)
+ } deriving (Eq, Show, Generic, NFData)
instance ToJSON Violation where
toJSON v = object
diff --git a/ppad-auditor.cabal b/ppad-auditor.cabal
@@ -34,6 +34,7 @@ library
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
, containers >= 0.6 && < 0.8
+ , deepseq >= 1.4 && < 1.6
, megaparsec >= 9.0 && < 10
, text >= 1.2 && < 2.2
, aeson >= 2.0 && < 2.3
@@ -69,3 +70,31 @@ test-suite auditor-tests
, tasty
, tasty-hunit
, text
+
+benchmark auditor-bench
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ hs-source-dirs: bench
+ main-is: Main.hs
+ ghc-options:
+ -rtsopts -Wall -O2
+ build-depends:
+ base
+ , bytestring
+ , criterion >= 1.5 && < 1.7
+ , ppad-auditor
+ , text
+
+benchmark auditor-weigh
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ hs-source-dirs: bench
+ main-is: Weight.hs
+ ghc-options:
+ -rtsopts -Wall -O2
+ build-depends:
+ base
+ , bytestring
+ , ppad-auditor
+ , text
+ , weigh >= 0.0.16 && < 0.1
