hOpenPGP-3.0.1: 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
  ( someTKToPublicViewTK
  , wireRepRef
  )

import Data.Binary (get)
import Data.Conduit.OpenPGP.Keyring
 ( conduitToSomeTKsEither
 , conduitToTKsEither
 )
import Data.Conduit.Serialization.Binary (conduitGet)
import qualified Data.IxSet.Typed as IxSet
import qualified Data.ByteString.Lazy as BL
import Data.Either (rights)
import Data.Maybe (catMaybes)

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 =
      fmap
        catMaybes
        (DC.runConduitRes $
         CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKsEither DC..|
         CL.consume)
    loadKeyring fp =
      fmap
        (sinkFromSomeTKs . rights)
        (DC.runConduitRes $
         CB.sourceFile fp DC..| conduitGet get DC..| conduitToSomeTKsEither DC..|
         CL.consume)
    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)
    sinkFromSomeTKs =
      IxSet.fromList .
      map someTKToPublicViewTK .
      catMaybes