poly1305

The Poly1305 message authentication code (docs.ppad.tech/poly1305).
git clone git://git.ppad.tech/poly1305.git
Log | Files | Refs | README | LICENSE

Poly1305.hs (2781B)

      1 {-# OPTIONS_HADDOCK prune #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 {-# LANGUAGE LambdaCase #-}
      4 {-# LANGUAGE ViewPatterns #-}
      5 
      6 -- |
      7 -- Module: Crypto.MAC.Poly1305
      8 -- Copyright: (c) 2025 Jared Tobin
      9 -- License: MIT
     10 -- Maintainer: Jared Tobin <jared@ppad.tech>
     11 --
     12 -- A pure Poly1305 MAC implementation, as specified by
     13 -- [RFC 8439](https://datatracker.ietf.org/doc/html/rfc8439).
     14 
     15 module Crypto.MAC.Poly1305 (
     16     -- * Poly1305 message authentication code
     17     mac
     18 
     19     -- testing
     20   , _poly1305_loop
     21   , _roll
     22   ) where
     23 
     24 import Data.Bits ((.&.), (.|.), (.<<.), (.>>.))
     25 import qualified Data.ByteString as BS
     26 import qualified Data.ByteString.Internal as BI
     27 
     28 fi :: (Integral a, Num b) => a -> b
     29 fi = fromIntegral
     30 {-# INLINE fi #-}
     31 
     32 -- arbitrary-size little-endian bytestring decoding
     33 _roll :: BS.ByteString -> Integer
     34 _roll = BS.foldr alg 0 where
     35   alg (fi -> !b) !a = (a .<<. 8) .|. b
     36 {-# INLINE _roll #-}
     37 
     38 -- little-endian bytestring encoding
     39 unroll :: Integer -> BS.ByteString
     40 unroll i = case i of
     41     0 -> BS.singleton 0
     42     _ -> BS.unfoldr coalg i
     43   where
     44     coalg = \case
     45       0 -> Nothing
     46       m -> Just $! (fi m, m .>>. 8)
     47 {-# INLINE unroll #-}
     48 
     49 -- little-endian bytestring encoding for 128-bit ints, right-padding
     50 -- with zeros
     51 unroll16 :: Integer -> BS.ByteString
     52 unroll16 (unroll -> u@(BI.PS _ _ l))
     53   | l < 16 = u <> BS.replicate (16 - l) 0
     54   | otherwise = u
     55 {-# INLINE unroll16 #-}
     56 
     57 clamp :: Integer -> Integer
     58 clamp r = r .&. 0x0ffffffc0ffffffc0ffffffc0fffffff
     59 {-# INLINE clamp #-}
     60 
     61 -- | Produce a Poly1305 MAC for the provided message, given the provided
     62 --   key.
     63 --
     64 --   Per RFC8439: the key, which is essentially a /one-time/ key, should
     65 --   be unique, and MUST be unpredictable for each invocation.
     66 --
     67 --   The key must be exactly 256 bits in length.
     68 --
     69 --   >>> mac "i'll never use this key again!!!" "a message needing authentication"
     70 --   Just "O'\231Z\224\149\148\246\203[}\210\203\b\200\207"
     71 mac
     72   :: BS.ByteString -- ^ 256-bit one-time key
     73   -> BS.ByteString -- ^ arbitrary-length message
     74   -> Maybe BS.ByteString -- ^ 128-bit message authentication code
     75 mac key@(BI.PS _ _ kl) msg
     76   | kl /= 32  = Nothing
     77   | otherwise =
     78       let (clamp . _roll -> r, _roll -> s) = BS.splitAt 16 key
     79       in  pure (_poly1305_loop r s msg)
     80 
     81 _poly1305_loop :: Integer -> Integer -> BS.ByteString -> BS.ByteString
     82 _poly1305_loop !r !s !msg =
     83     let loop !acc !bs = case BS.splitAt 16 bs of
     84           (chunk@(BI.PS _ _ l), etc)
     85             | l == 0 -> BS.take 16 (unroll16 (acc + s))
     86             | otherwise ->
     87                 let !n = _roll chunk .|. (0x01 .<<. (8 * l))
     88                     !nacc = r * (acc + n) `rem` p
     89                 in  loop nacc etc
     90     in  loop 0 msg
     91   where
     92     p = 1361129467683753853853498429727072845819 -- (1 << 130) - 5
     93 {-# INLINE _poly1305_loop #-}
     94