commit d6300a6ddf03e6ff84b49cddaed8b907a45a11c3
parent 706563d1fa30a3bd75f94e6987b90860f8fa522a
Author: Jared Tobin <jared@jtobin.io>
Date: Tue, 1 Aug 2023 18:41:59 -0230
Add 3.23.
Diffstat:
2 files changed, 152 insertions(+), 28 deletions(-)
diff --git a/docs/s3.md b/docs/s3.md
@@ -129,6 +129,10 @@ There's also a binary:
3421126067
4083286876
+(N.b., the [original
+paper](http://www.math.sci.hiroshima-u.ac.jp/m-mat/MT/ARTICLES/mt.pdf) on
+the Mersenne Twister is very well-written and readable.)
+
#### 3.22
After the fourth or fifth time my children woke me up in the middle of
@@ -165,3 +169,77 @@ we get:
So, via the same timestamp calculator, it was seeded at Sun Jul 30 2023
06:05:00 GMT-0230 (heure d’été de Terre-Neuve).
+#### 3.23
+
+A Mersenne Twister outputs elements of its internal state transformed
+by a tempering map. The state is perturbed every 624 iterations (the
+"twist"), but if we have all 624 outputs generated from a constant
+internal state, that state can be recovered by running the outputs
+through the inverse tempering map.
+
+The tempering transform (in Cryptopals.Stream.RNG.MT19937) can be
+expressed by:
+
+ temper :: Word32 -> Word32
+ temper = e4 . e3 . e2 . e1 where
+ e1 = rs u
+ e2 = ls s b
+ e3 = ls t c
+ e4 = rs l
+
+and the inverse transform by:
+
+ untemper :: Word32 -> Word32
+ untemper = n1 . n2 . n3 . n4 where
+ n1 = rsinv u
+ n2 = lsinv s b
+ n3 = lsinv t c
+ n4 = rsinv l
+
+given the following salad of internal functions:
+
+ ls :: Word32 -> Word32 -> Word32 -> Word32
+ ls s m a = a `B.xor` (B.shiftL a (fi s) .&. m)
+
+ rs :: Word32 -> Word32 -> Word32
+ rs s a = a `B.xor` B.shiftR a (fi s)
+
+ lsinv :: Word32 -> Word32 -> Word32 -> Word32
+ lsinv s bm = loop 0 where
+ loop j !b
+ | j >= fi w = b
+ | otherwise =
+ let m = mask j (min (fi w - 1) (j + fi s - 1))
+ x = ((m .&. b) `B.shiftL` fi s) .&. bm
+ in loop (j + fi s) (b `B.xor` x)
+
+ rsinv :: Word32 -> Word32 -> Word32
+ rsinv s = loop (fi w - 1) where
+ loop j !b
+ | j <= 0 = b
+ | otherwise =
+ let m = mask (max 0 (j - fi s + 1)) j
+ x = (m .&. b) `B.shiftR` fi s
+ in loop (j - fi s) (b `B.xor` x)
+
+ mask :: B.Bits b => Int -> Int -> b
+ mask l h = loop l B.zeroBits where
+ loop j !b
+ | j > h = b
+ | otherwise =
+ loop (succ j) (B.setBit b j)
+
+So we can run a generator for 624 iterations, capture the outputs, and
+untemper them to recover the internal state for those 624 iterations
+(with the caveat that the outputs we need to observe must occur absent
+any intermediate twists of the internal state):
+
+ > let gen = seed 42
+ > let (bs, g) = bytes 624 gen
+ > let cloned = Gen 624 (VU.fromList . fmap untemper $ bs)
+ > fst (bytes 3 g)
+ [108880612,791707097,4134543476]
+ > fst (bytes 3 cloned)
+ [108880612,791707097,4134543476]
+
+
diff --git a/lib/Cryptopals/Stream/RNG/MT19937.hs b/lib/Cryptopals/Stream/RNG/MT19937.hs
@@ -3,6 +3,9 @@ module Cryptopals.Stream.RNG.MT19937 (
, seed
, extract
, bytes
+
+ , temper
+ , untemper
) where
import qualified Control.Monad.ST as ST
@@ -17,28 +20,27 @@ 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
+w, n, m, r, a, u, s, b, t, c, l :: Word32
+w = 32 -- word size
+n = 624 -- degree of recurrence
+m = 397 -- 'middle term'
+r = 31 -- word separation index
+a = 0x9908B0DF -- rational normal form twist matrix coefficients
+u = 11 -- tempering parameter
+s = 7 -- tempering parameter (shift)
+b = 0x9D2C5680 -- tempering parameter (mask)
+t = 15 -- tempering parameter (shift)
+c = 0xEFC60000 -- tempering parameter (mask)
+l = 18 -- tempering parameter
f :: Word32
f = 1812433253
lm :: Word32
-lm = B.shiftL 1 (fi r) - 1 -- 0x0111 1111 1111 1111 1111 1111 1111 1111
+lm = B.shiftL 1 (fi r) - 1 -- 0b0111 1111 1111 1111 1111 1111 1111 1111
um :: Word32
-um = B.complement lm -- 0x1000 0000 0000 0000 0000 0000 0000 0000
+um = B.complement lm -- 0b1000 0000 0000 0000 0000 0000 0000 0000
data Gen = Gen !Word32 !(VU.Vector Word32)
deriving Eq
@@ -46,6 +48,14 @@ data Gen = Gen !Word32 !(VU.Vector Word32)
instance Show Gen where
show Gen {} = "<MT19937.Gen>"
+bytes :: Int -> Gen -> ([Word32], Gen)
+bytes = loop mempty where
+ loop !acc j gen
+ | j == 0 = (reverse acc, gen)
+ | otherwise =
+ let (w, g) = extract gen
+ in loop (w : acc) (pred j) g
+
seed :: Word32 -> Gen
seed s = Gen n (loop 0 mempty) where
loop j !acc
@@ -62,13 +72,54 @@ extract gen@(Gen idx _) =
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 18)
+ y = g `VU.unsafeIndex` fi i
+
+ in (temper y, Gen (succ i) g)
+
+temper :: Word32 -> Word32
+temper = e4 . e3 . e2 . e1 where
+ e1 = rs u
+ e2 = ls s b
+ e3 = ls t c
+ e4 = rs l
+
+untemper :: Word32 -> Word32
+untemper = n1 . n2 . n3 . n4 where
+ n1 = rsinv u
+ n2 = lsinv s b
+ n3 = lsinv t c
+ n4 = rsinv l
+
+mask :: B.Bits b => Int -> Int -> b
+mask l h = loop l B.zeroBits where
+ loop j !b
+ | j > h = b
+ | otherwise =
+ loop (succ j) (B.setBit b j)
+
+ls :: Word32 -> Word32 -> Word32 -> Word32
+ls s m a = a `B.xor` (B.shiftL a (fi s) .&. m)
+
+lsinv :: Word32 -> Word32 -> Word32 -> Word32
+lsinv s bm = loop 0 where
+ loop j !b
+ | j >= fi w = b
+ | otherwise =
+ let m = mask j (min (fi w - 1) (j + fi s - 1))
+ x = ((m .&. b) `B.shiftL` fi s) .&. bm
+ in loop (j + fi s) (b `B.xor` x)
- in (y4, Gen (succ i) g)
+rs :: Word32 -> Word32 -> Word32
+rs s a = a `B.xor` B.shiftR a (fi s)
+
+rsinv :: Word32 -> Word32 -> Word32
+rsinv s = loop (fi w - 1) where
+ loop j !b
+ | j <= 0 = b
+ | otherwise =
+ let m = mask (max 0 (j - fi s + 1)) j
+ x = (m .&. b) `B.shiftR` fi s
+ in loop (j - fi s) (b `B.xor` x)
twist :: Gen -> Gen
twist (Gen i gen) = ST.runST $ do
@@ -95,11 +146,6 @@ twist (Gen i gen) = ST.runST $ do
fen <- VU.freeze g
pure (Gen 0 fen)
-bytes :: Int -> Gen -> ([Word32], Gen)
-bytes = loop mempty where
- loop !acc j gen
- | j == 0 = (reverse acc, gen)
- | otherwise =
- let (w, g) = extract gen
- in loop (w : acc) (pred j) g
+clone :: [Word32] -> Gen
+clone = Gen n . VU.fromList . fmap untemper
