poly1305

commit 76b967591df3745fd99db0ed302f8bdfe3be8ffd
parent 982080a0d26db7fecd8d4472f5f7449bfb7b63ff
Author: Jared Tobin <jared@jtobin.io>
Date:   Sun,  9 Mar 2025 17:22:57 +0400

lib: basic implementation, test

Diffstat:
M
lib/Crypto/MAC/Poly1305.hs
 | 
79
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
M
test/Main.hs
 | 
25
++++++++++++++++++++++++-

2 files changed, 102 insertions(+), 2 deletions(-)
diff --git a/lib/Crypto/MAC/Poly1305.hs b/lib/Crypto/MAC/Poly1305.hs
@@ -1,2 +1,79 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- |
+-- Module: Crypto.MAC.Poly1305
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- A pure Poly1305 MAC implementation, as specified by
+-- [RFC 8439](https://datatracker.ietf.org/doc/html/rfc8439).
+
+module Crypto.MAC.Poly1305 (
+    -- * Poly1305 message authentication code
+    mac
+  ) where
+
+import qualified Data.Bits as B
+import Data.Bits ((.&.), (.|.), (.<<.), (.>>.))
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Internal as BI
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+{-# INLINE fi #-}
+
+-- arbitrary-size little-endian bytestring decoding
+roll :: BS.ByteString -> Integer
+roll = BS.foldr alg 0 where
+  alg (fi -> !b) !a = (a .<<. 8) .|. b
+{-# INLINE roll #-}
+
+-- little-endian bytestring encoding
+unroll :: Integer -> BS.ByteString
+unroll i = case i of
+    0 -> BS.singleton 0
+    _ -> BS.unfoldr coalg i
+  where
+    coalg = \case
+      0 -> Nothing
+      m -> Just $! (fi m, m .>>. 8)
+{-# INLINE unroll #-}
+
+clamp :: (B.Bits a, Num a) => a -> a
+clamp r = r .&. 0x0ffffffc0ffffffc0ffffffc0fffffff
+{-# INLINE clamp #-}
+
+-- | Produce a Poly1305 MAC for the provided message, given the provided
+--   key.
+--
+--   Per RFC8439, the key must be exactly 256 bits in length. Providing
+--   an invalid key will cause the function to throw an ErrorCall
+--   exception.
+--
+--   >>> mac "don't tell anyone my secret key!" "a message needing authentication"
+--   ";]\a\USf\132A\156\b\171-_\162-\201R"
+mac
+  :: BS.ByteString -- ^ key
+  -> BS.ByteString -- ^ message
+  -> BS.ByteString -- ^ message authentication code
+mac key@(BI.PS _ _ kl) msg
+    | kl /= 32  = error "ppad-poly1305 (mac): invalid key"
+    | otherwise =
+        let (clamp . roll -> r, roll -> s) = BS.splitAt 16 key
+
+            loop !acc !bs = case BS.splitAt 16 bs of
+              (chunk@(BI.PS _ _ l), etc)
+                | l == 0 -> 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))
+  where
+    p = 1361129467683753853853498429727072845819 -- (1 << 130) - 5
+
 
-module Crypto.MAC.Poly1305 where
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,4 +1,27 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main where
 
+import qualified Crypto.MAC.Poly1305 as Poly1305
+import qualified Data.ByteString.Base16 as B16
+import Test.Tasty
+import qualified Test.Tasty.HUnit as H
+
 main :: IO ()
-main = pure ()
+main = defaultMain $ testGroup "ppad-poly1305" [
+    mac
+  ]
+
+mac :: TestTree
+mac = H.testCase "mac" $ do
+  let Just key = B16.decode
+        "85d6be7857556d337f4452fe42d506a80103808afb0db2fd4abff6af4149f51b"
+      msg = "Cryptographic Forum Research Group"
+
+      Just e = B16.decode "a8061dc1305136c6c22b8baf0c0127a9"
+
+      o = Poly1305.mac key msg
+  H.assertEqual mempty e o
+