New debugging option: --trace-verify

2 files changed, 41 insertions, 1 deletions

diff --git a/lib/Data/OpenPGP/Util.hs b/lib/Data/OpenPGP/Util.hs
new file mode 100644
index 0000000..a51ce64
--- /dev/null
+++ b/lib/Data/OpenPGP/Util.hs
@@ -0,0 +1,37 @@
+{-# OPTIONS_GHC -Wno-duplicate-exports #-}
+{-# LANGUAGE PackageImports #-}
+module Data.OpenPGP.Util
+    ( module P
+    , verify
+    , setVerifyFlag
+    ) where
+
+import Data.Bool
+import Data.IORef
+import Debug.Trace
+import GHC.Stack
+import System.IO.Unsafe
+
+import qualified "openpgp-util" Data.OpenPGP.Util as P
+import "openpgp-util" Data.OpenPGP.Util hiding (verify)
+import Data.OpenPGP
+
+traceVerifyFlag :: IORef Bool
+traceVerifyFlag = unsafePerformIO $ newIORef False
+{-# NOINLINE traceVerifyFlag #-}
+
+getVerifyFlag :: Bool
+getVerifyFlag = unsafePerformIO $ readIORef traceVerifyFlag
+{-# NOINLINE getVerifyFlag #-}
+
+setVerifyFlag :: Bool -> IO ()
+setVerifyFlag x = writeIORef traceVerifyFlag x
+
+shortCallStack :: [([Char], SrcLoc)] -> String
+shortCallStack []          = ""
+shortCallStack ((_,loc):_) = (srcLocFile loc) ++ ":" ++ show (srcLocStartLine loc)
+
+verify :: HasCallStack => Message -> SignatureOver -> SignatureOver
+verify msg sig =
+    bool id (trace $ "verify " ++ shortCallStack (getCallStack callStack)) getVerifyFlag
+        $ P.verify msg sig
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 64e2d7d..6481b58 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Kiki where
+module Kiki
+    ( module Kiki
+    , setVerifyFlag
+    ) where
 
 import           Control.Applicative
 import           Control.Arrow