hOpenPGP-3.0.0: bench/mark.hs

-- mark.hs: hOpenPGP benchmark suite
-- Copyright © 2014-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE FlexibleContexts #-}

import Criterion.Main

import Codec.Encryption.OpenPGP.Serialize
  ( conduitParsePktsWithWireRep
  , parsePkts
  , parsePktsEither
  , parsePktsWithWireRep
  )
import Codec.Encryption.OpenPGP.Signatures
  ( verifyAgainstKeyring
  , verifyAgainstKeys
  , verifySigWith
  , verifyTKWith
  , verifyUnknownTKWith
  )
import Codec.Encryption.OpenPGP.Types (wireRepRef)

import Data.Binary (get)
import Data.Conduit.OpenPGP.Keyring
 ( conduitToPublicViewTKs
 , conduitToUnknownTKs
 , sinkPublicKeyringMap
 )
import Data.Conduit.Serialization.Binary (conduitGet)
import qualified Data.IxSet.Typed as IxSet
import qualified Data.ByteString.Lazy as BL

import qualified Data.Conduit as DC
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL

main :: IO ()
main =
  defaultMain
    [ bgroup
        "keyring"
        [ bench "load keys" $ whnfIO (loadKeys "tests/data/pubring.gpg")
        , bench "load keyring" $ whnfIO (loadKeyring "tests/data/pubring.gpg")
        , bench "self-verify keys" $
          whnfIO (selfVerifyKeys "tests/data/pubring.gpg")
        , bench "self-verify keyring" $
          whnfIO (selfVerifyKeyring "tests/data/pubring.gpg")
        ]
    , env (BL.readFile "tests/data/pubring.gpg") $ \pubringPayload ->
        let pubringRef = wireRepRef pubringPayload
         in
        bgroup
          "packet-parse"
          [ bench "parsePkts/count" $ nf (length . parsePkts) pubringPayload
          , bench "parsePktsEither/count" $
            nf
              (either (const 0) length . parsePktsEither)
              pubringPayload
          , bench "parsePktsWithWireRep/count" $
            nf
              (length . parsePktsWithWireRep pubringRef)
              pubringPayload
          , bench "conduitParsePktsWithWireRep/count" $
            whnfIO
              (fmap
                 length
                 (DC.runConduitRes $
                  CB.sourceLbs pubringPayload DC..| conduitParsePktsWithWireRep Nothing DC..|
                  CL.consume))
          ]
    ]
  where
    loadKeys fp =
      DC.runConduitRes $
      CB.sourceFile fp DC..| conduitGet get DC..| conduitToUnknownTKs DC..| CL.consume
    loadKeyring fp =
      DC.runConduitRes $
      CB.sourceFile fp DC..| conduitGet get DC..| conduitToPublicViewTKs DC..|
      sinkPublicKeyringMap
    selfVerifyKeys fp =
      fmap
        (\ks ->
           mapM (verifyUnknownTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks)
        (loadKeys fp)
    selfVerifyKeyring fp =
      fmap
        (\kr ->
           mapM
             (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) Nothing)
             (IxSet.toList kr))
        (loadKeyring fp)