hOpenPGP-2.8.4: bench/mark.hs

-- mark.hs: hOpenPGP benchmark suite
-- Copyright © 2014-2018  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.Signatures
  ( verifyAgainstKeyring
  , verifyAgainstKeys
  , verifySigWith
  , verifyTKWith
  )

import Data.Binary (get)
import Data.Conduit.OpenPGP.Keyring (conduitToTKs, sinkKeyringMap)
import Data.Conduit.Serialization.Binary (conduitGet)
import qualified Data.IxSet.Typed as IxSet

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")
        ]
    ]
  where
    loadKeys fp =
      DC.runConduitRes $
      CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume
    loadKeyring fp =
      DC.runConduitRes $
      CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKs DC..|
      sinkKeyringMap
    selfVerifyKeys fp =
      fmap
        (\ks ->
           mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks)
        (loadKeys fp)
    selfVerifyKeyring fp =
      fmap
        (\kr ->
           mapM
             (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) Nothing)
             (IxSet.toList kr))
        (loadKeyring fp)