Main.hs (8746B)
1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 {-# LANGUAGE ViewPatterns #-} 5 6 module Main where 7 8 import qualified Crypto.MAC.Poly1305 as Poly1305 9 import Data.Bits ((.&.)) 10 import qualified Data.ByteString as BS 11 import qualified Data.ByteString.Base16 as B16 12 import Data.Foldable (for_) 13 import Test.Tasty 14 import qualified Test.Tasty.HUnit as H 15 16 main :: IO () 17 main = defaultMain $ testGroup "ppad-poly1305" [ 18 mac 19 , mac1 20 , mac2 21 , mac3 22 , mac4 23 , mac5 24 , mac6 25 , mac7 26 , mac8 27 , mac9 28 , mac10 29 , mac11 30 , dispatch 31 ] 32 33 mac :: TestTree 34 mac = H.testCase "mac" $ do 35 let Just key = B16.decode 36 "85d6be7857556d337f4452fe42d506a80103808afb0db2fd4abff6af4149f51b" 37 msg = "Cryptographic Forum Research Group" 38 39 Just e = B16.decode "a8061dc1305136c6c22b8baf0c0127a9" 40 41 Just o = Poly1305.mac key msg 42 H.assertEqual mempty (Poly1305.MAC e) o 43 44 mac1 :: TestTree 45 mac1 = H.testCase "mac (A.3 #1)" $ do 46 let Just key = B16.decode 47 "0000000000000000000000000000000000000000000000000000000000000000" 48 Just msg = B16.decode 49 "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" 50 Just tag = B16.decode 51 "00000000000000000000000000000000" 52 Just out = Poly1305.mac key msg 53 H.assertEqual mempty (Poly1305.MAC tag) out 54 55 mac2 :: TestTree 56 mac2 = H.testCase "mac (A.3 #2)" $ do 57 let Just key = B16.decode 58 "0000000000000000000000000000000036e5f6b5c5e06070f0efca96227a863e" 59 Just msg = B16.decode 60 "416e79207375626d697373696f6e20746f20746865204945544620696e74656e6465642062792074686520436f6e7472696275746f7220666f72207075626c69636174696f6e20617320616c6c206f722070617274206f6620616e204945544620496e7465726e65742d4472616674206f722052464320616e6420616e792073746174656d656e74206d6164652077697468696e2074686520636f6e74657874206f6620616e204945544620616374697669747920697320636f6e7369646572656420616e20224945544620436f6e747269627574696f6e222e20537563682073746174656d656e747320696e636c756465206f72616c2073746174656d656e747320696e20494554462073657373696f6e732c2061732077656c6c206173207772697474656e20616e6420656c656374726f6e696320636f6d6d756e69636174696f6e73206d61646520617420616e792074696d65206f7220706c6163652c207768696368206172652061646472657373656420746f" 61 Just tag = B16.decode 62 "36e5f6b5c5e06070f0efca96227a863e" 63 Just out = Poly1305.mac key msg 64 H.assertEqual mempty (Poly1305.MAC tag) out 65 66 mac3 :: TestTree 67 mac3 = H.testCase "mac (A.3 #3)" $ do 68 let Just key = B16.decode 69 "36e5f6b5c5e06070f0efca96227a863e00000000000000000000000000000000" 70 Just msg = B16.decode 71 "416e79207375626d697373696f6e20746f20746865204945544620696e74656e6465642062792074686520436f6e7472696275746f7220666f72207075626c69636174696f6e20617320616c6c206f722070617274206f6620616e204945544620496e7465726e65742d4472616674206f722052464320616e6420616e792073746174656d656e74206d6164652077697468696e2074686520636f6e74657874206f6620616e204945544620616374697669747920697320636f6e7369646572656420616e20224945544620436f6e747269627574696f6e222e20537563682073746174656d656e747320696e636c756465206f72616c2073746174656d656e747320696e20494554462073657373696f6e732c2061732077656c6c206173207772697474656e20616e6420656c656374726f6e696320636f6d6d756e69636174696f6e73206d61646520617420616e792074696d65206f7220706c6163652c207768696368206172652061646472657373656420746f" 72 Just tag = B16.decode 73 "f3477e7cd95417af89a6b8794c310cf0" 74 Just out = Poly1305.mac key msg 75 H.assertEqual mempty (Poly1305.MAC tag) out 76 77 mac4 :: TestTree 78 mac4 = H.testCase "mac (A.3 #4)" $ do 79 let Just key = B16.decode 80 "1c9240a5eb55d38af333888604f6b5f0473917c1402b80099dca5cbc207075c0" 81 Just msg = B16.decode 82 "2754776173206272696c6c69672c20616e642074686520736c6974687920746f7665730a446964206779726520616e642067696d626c6520696e2074686520776162653a0a416c6c206d696d737920776572652074686520626f726f676f7665732c0a416e6420746865206d6f6d65207261746873206f757467726162652e" 83 Just tag = B16.decode 84 "4541669a7eaaee61e708dc7cbcc5eb62" 85 Just out = Poly1305.mac key msg 86 H.assertEqual mempty (Poly1305.MAC tag) out 87 88 mac5 :: TestTree 89 mac5 = H.testCase "mac (A.3 #5)" $ do 90 let Just (Poly1305._roll16 -> r) = B16.decode $ 91 "02000000000000000000000000000000" 92 Just (Poly1305._roll16 -> s) = B16.decode $ 93 "00000000000000000000000000000000" 94 Just msg = B16.decode 95 "ffffffffffffffffffffffffffffffff" 96 Just tag = B16.decode 97 "03000000000000000000000000000000" 98 out = Poly1305._poly1305_loop r s msg 99 H.assertEqual mempty tag out 100 101 mac6 :: TestTree 102 mac6 = H.testCase "mac (A.3 #6)" $ do 103 let Just (Poly1305._roll16 -> r) = B16.decode $ 104 "02000000000000000000000000000000" 105 Just (Poly1305._roll16 -> s) = B16.decode $ 106 "ffffffffffffffffffffffffffffffff" 107 Just msg = B16.decode 108 "02000000000000000000000000000000" 109 Just tag = B16.decode 110 "03000000000000000000000000000000" 111 out = Poly1305._poly1305_loop r s msg 112 H.assertEqual mempty tag out 113 114 mac7 :: TestTree 115 mac7 = H.testCase "mac (A.3 #7)" $ do 116 let Just (Poly1305._roll16 -> r) = B16.decode $ 117 "01000000000000000000000000000000" 118 Just (Poly1305._roll16 -> s) = B16.decode $ 119 "00000000000000000000000000000000" 120 Just msg = B16.decode 121 "fffffffffffffffffffffffffffffffff0ffffffffffffffffffffffffffffff11000000000000000000000000000000" 122 Just tag = B16.decode 123 "05000000000000000000000000000000" 124 out = Poly1305._poly1305_loop r s msg 125 H.assertEqual mempty tag out 126 127 mac8 :: TestTree 128 mac8 = H.testCase "mac (A.3 #8)" $ do 129 let Just (Poly1305._roll16 -> r) = B16.decode $ 130 "01000000000000000000000000000000" 131 Just (Poly1305._roll16 -> s) = B16.decode $ 132 "00000000000000000000000000000000" 133 Just msg = B16.decode 134 "fffffffffffffffffffffffffffffffffbfefefefefefefefefefefefefefefe01010101010101010101010101010101" 135 Just tag = B16.decode 136 "00000000000000000000000000000000" 137 out = Poly1305._poly1305_loop r s msg 138 H.assertEqual mempty tag out 139 140 mac9 :: TestTree 141 mac9 = H.testCase "mac (A.3 #9)" $ do 142 let Just (Poly1305._roll16 -> r) = B16.decode $ 143 "02000000000000000000000000000000" 144 Just (Poly1305._roll16 -> s) = B16.decode $ 145 "00000000000000000000000000000000" 146 Just msg = B16.decode 147 "fdffffffffffffffffffffffffffffff" 148 Just tag = B16.decode 149 "faffffffffffffffffffffffffffffff" 150 out = Poly1305._poly1305_loop r s msg 151 H.assertEqual mempty tag out 152 153 mac10 :: TestTree 154 mac10 = H.testCase "mac (A.3 #10)" $ do 155 let Just (Poly1305._roll16 -> r) = B16.decode $ 156 "01000000000000000400000000000000" 157 Just (Poly1305._roll16 -> s) = B16.decode $ 158 "00000000000000000000000000000000" 159 Just msg = B16.decode 160 "e33594d7505e43b900000000000000003394d7505e4379cd01000000000000000000000000000000000000000000000001000000000000000000000000000000" 161 Just tag = B16.decode 162 "14000000000000005500000000000000" 163 out = Poly1305._poly1305_loop r s msg 164 H.assertEqual mempty tag out 165 166 mac11 :: TestTree 167 mac11 = H.testCase "mac (A.3 #11)" $ do 168 let Just (Poly1305._roll16 -> r) = B16.decode $ 169 "01000000000000000400000000000000" 170 Just (Poly1305._roll16 -> s) = B16.decode $ 171 "00000000000000000000000000000000" 172 Just msg = B16.decode 173 "e33594d7505e43b900000000000000003394d7505e4379cd010000000000000000000000000000000000000000000000" 174 Just tag = B16.decode 175 "13000000000000000000000000000000" 176 out = Poly1305._poly1305_loop r s msg 177 H.assertEqual mempty tag out 178 179 -- dispatching vs pure 180 181 -- the dispatching 'mac' agrees with the pure Haskell loop for every 182 -- message length from 0 to 640 bytes, covering partial blocks, short 183 -- tails, and any vectorised paths 184 dispatch :: TestTree 185 dispatch = H.testCase "mac (dispatch vs pure)" $ 186 for_ keys $ \key -> 187 for_ msgs $ \m -> 188 for_ [0..640] $ \l -> do 189 let msg = BS.take l m 190 Just out = Poly1305.mac key msg 191 H.assertEqual ("length " <> show l) (Poly1305.MAC (ref key msg)) out 192 where 193 Just clamp = B16.decode "ffffff0ffcffff0ffcffff0ffcffff0f" 194 Just key0 = B16.decode 195 "85d6be7857556d337f4452fe42d506a80103808afb0db2fd4abff6af4149f51b" 196 keys = [key0, BS.replicate 32 0xff] 197 msgs = [ BS.pack [fromIntegral (i * 7 + 3) | i <- [0..639 :: Int]] 198 , BS.replicate 640 0xff 199 ] 200 ref key msg = 201 let (k0, k1) = BS.splitAt 16 key 202 r = Poly1305._roll16 (BS.packZipWith (.&.) clamp k0) 203 s = Poly1305._roll16 k1 204 in Poly1305._poly1305_loop r s msg