poly1305

commit 2d662165e27e637f0dcc8ab67391c5f6fa8d7d1a
parent 76b967591df3745fd99db0ed302f8bdfe3be8ffd
Author: Jared Tobin <jared@jtobin.io>
Date:   Sun,  9 Mar 2025 17:26:45 +0400

bench: basic suite

Diffstat:
M
bench/Main.hs
 | 
28
+++++++++++++++++++++++++++-
M
lib/Crypto/MAC/Poly1305.hs
 | 
7
+++----

2 files changed, 30 insertions(+), 5 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,4 +1,30 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main where
 
+import Criterion.Main
+import qualified Crypto.MAC.Poly1305 as Poly1305
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import Data.Maybe (fromJust)
+
 main :: IO ()
-main = pure ()
+main = defaultMain [
+    suite
+  ]
+
+msg :: BS.ByteString
+msg = fromJust . B16.decode $
+  "4c616469657320616e642047656e746c656d656e206f662074686520636c617373206f66202739393a204966204920636f756c64206f6666657220796f75206f6e6c79206f6e652074697020666f7220746865206675747572652c2073756e73637265656e20776f756c642062652069742e"
+
+key :: BS.ByteString
+key = fromJust . B16.decode $
+  "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f"
+
+suite :: Benchmark
+suite =
+  bgroup "ppad-poly1305" [
+    bench "mac" $ nf (Poly1305.mac key) msg
+  ]
+
diff --git a/lib/Crypto/MAC/Poly1305.hs b/lib/Crypto/MAC/Poly1305.hs
@@ -16,7 +16,6 @@ module Crypto.MAC.Poly1305 (
     mac
   ) where
 
-import qualified Data.Bits as B
 import Data.Bits ((.&.), (.|.), (.<<.), (.>>.))
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Internal as BI
@@ -42,7 +41,7 @@ unroll i = case i of
       m -> Just $! (fi m, m .>>. 8)
 {-# INLINE unroll #-}
 
-clamp :: (B.Bits a, Num a) => a -> a
+clamp :: Integer -> Integer
 clamp r = r .&. 0x0ffffffc0ffffffc0ffffffc0fffffff
 {-# INLINE clamp #-}
 
@@ -66,13 +65,13 @@ mac key@(BI.PS _ _ kl) msg
 
             loop !acc !bs = case BS.splitAt 16 bs of
               (chunk@(BI.PS _ _ l), etc)
-                | l == 0 -> acc + s
+                | l == 0 -> BS.take 16 (unroll (acc + s))
                 | otherwise ->
                     let !n = roll chunk .|. (0x01 .<<. (8 * l))
                         !nacc = r * (acc + n) `rem` p
                     in  loop nacc etc
 
-        in  BS.take 16 (unroll (loop 0 msg))
+        in  loop 0 msg
   where
     p = 1361129467683753853853498429727072845819 -- (1 << 130) - 5