cryptopals

commit 2e2f27ed7b81b172420a52bb42167dbf7c23ce7b
parent fea928f39845e649cc2a49df9b4936c82bf6c72d
Author: Jared Tobin <jared@jtobin.io>
Date:   Sat, 29 Jul 2023 14:03:17 -0230

Add MT19937 implementation.

Diffstat:
M
cryptopals.cabal
 | 
3
+++
M
docs/s3.md
 | 
16
++++++++++++++++
A
lib/Cryptopals/Stream/RNG.hs
 | 
5
+++++
A
lib/Cryptopals/Stream/RNG/MT19937.hs
 | 
81
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

4 files changed, 105 insertions(+), 0 deletions(-)
diff --git a/cryptopals.cabal b/cryptopals.cabal
@@ -26,6 +26,8 @@ library
     , Cryptopals.Util
     , Cryptopals.Util.ByteString
     , Cryptopals.Util.Similarity
+    , Cryptopals.Stream.RNG
+    , Cryptopals.Stream.RNG.MT19937
   build-depends:
       base
     , base16
@@ -38,6 +40,7 @@ library
     , primitive
     , text
     , unordered-containers
+    , vector
 
 executable fixed-xor
   main-is:           FixedXor.hs
diff --git a/docs/s3.md b/docs/s3.md
@@ -106,4 +106,20 @@ gist of it:
 
 (It turns out this is the way one is supposed to solve 3.20 too.  Whoops!)
 
+#### 3.21
+
+The only annoying thing about this problem is finding a test vector to
+check the implementation on. `Cryptopals.Stream.RNG.MT19937` implements
+the Mersenne Twister (MT19937) PRNG in standard return-the-generator
+fashion:
+
+    > let gen = seed 42
+    > :{
+    ghci| let loop g = let (x, g1) = extract g
+    ghci|                  (y, g2) = extract g1
+    ghci|                  (z, g3) = extract g2
+    ghci|              in  ([x,y,z], g3)
+    ghci| :}
+    > fst $ loop gen
+    [1880174161,2921269485,2329092166]
 
diff --git a/lib/Cryptopals/Stream/RNG.hs b/lib/Cryptopals/Stream/RNG.hs
@@ -0,0 +1,5 @@
+module Cryptopals.Stream.RNG where
+
+import Cryptopals.Stream.RNG.MT19937
+
+
diff --git a/lib/Cryptopals/Stream/RNG/MT19937.hs b/lib/Cryptopals/Stream/RNG/MT19937.hs
@@ -0,0 +1,81 @@
+module Cryptopals.Stream.RNG.MT19937 (
+    Gen
+  , seed
+  , extract
+  ) where
+
+import Data.Bits ((.&.))
+import qualified Data.Bits as B
+import qualified Data.Vector.Unboxed as VU
+import GHC.Word (Word32)
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+-- following notation in https://en.wikipedia.org/wiki/Mersenne_Twister
+
+w, n, m, r, a, u, d, s, b, t, c, l :: Word32
+w = 32
+n = 624
+m = 397
+r = 31
+a = 0x9908B0DF
+u = 11
+d = 0xFFFFFFFF
+s = 7
+b = 0x9D2C5680
+t = 15
+c = 0xEFC60000
+l = 18
+
+f :: Word32
+f = 1812433253
+
+lm :: Word32
+lm = B.shiftL 1 (fi r) - 1 -- 0x0111 1111 1111 1111 1111 1111 1111 1111
+
+um :: Word32
+um = B.complement lm       -- 0x1000 0000 0000 0000 0000 0000 0000 0000
+
+data Gen = Gen !Word32 !(VU.Vector Word32)
+  deriving (Eq, Show)
+
+seed :: Word32 -> Gen
+seed s = Gen n (loop 0 mempty) where
+  loop j !acc
+    | j == n    = VU.fromList (reverse acc)
+    | otherwise = case acc of
+        []    -> loop (succ j) (pure s)
+        (h:_) ->
+          let v = f * (h `B.xor` (B.shiftR h (fi w - 2))) + j -- XX can overflow?
+          in  loop (succ j) (v : acc)
+
+extract :: Gen -> (Word32, Gen)
+extract gen@(Gen idx _) =
+  let Gen i g = if   idx == n
+                then twist gen
+                else gen
+
+      y0 = g `VU.unsafeIndex` fi i
+      y1 = y0 `B.xor` ((B.shiftR y0 (fi u)) .&. d)
+      y2 = y1 `B.xor` ((B.shiftL y1 (fi s)) .&. b)
+      y3 = y2 `B.xor` ((B.shiftL y2 (fi t)) .&. c)
+      y4 = y3 `B.xor` (B.shiftR y3 1)
+
+  in  (y4, Gen (succ i) g)
+
+twist :: Gen -> Gen
+twist (Gen i g) = loop 0 mempty where
+  loop j !acc
+    | j == fi n = Gen 0 (g VU.// acc)
+    | otherwise =
+        let x  = ((g `VU.unsafeIndex` j) .&. um) +
+                 ((g `VU.unsafeIndex` (succ j `mod` fi n)) .&. lm) -- XX check
+            xa = B.shiftR x 1
+            xA | x `mod` 2 /= 0 = xa `B.xor` a
+               | otherwise      = xa
+
+            v  = (g `VU.unsafeIndex` ((j + fi m) `mod` fi n)) `B.xor` xA
+
+        in  loop (succ j) ((j, v) : acc)
+