import Data.Bits import Control.Monad import IO import Char rndunity = 4294967291 -- 2^32 - 5 rndmult = 3961633963 -- 2^32 - 333333333 char2integer:: Char -> Integer char2integer = toInteger . ord integer2char:: Integer -> Char integer2char = chr . fromInteger prng:: Integer -> Integer prng seed = mod (seed * rndmult) rndunity rndbyte seed = (newseed,255 .&. r) where newseed = prng seed r = shiftR newseed 24 crypt:: Integer -> [Integer] -> [Integer] crypt _ [] = [] crypt seed (x:xs) = (xor x r):(crypt newseed xs) where (newseed,r) = rndbyte seed testfile = "test.txt" testseed = 123456789 highbit x = testBit x 7 howfaracc:: Integer-> [Integer] -> Integer -> Integer howfaracc _ [] _ = -1 howfaracc seed (x:xs) acc = if found then acc else howfaracc newseed xs (acc+1) where (newseed,r) = rndbyte seed found = highbit $ xor x r howfar:: Integer-> [Integer] -> Integer howfar seed seq = howfaracc seed seq 0 findseed :: [Integer] -> Integer -> Integer -> Integer -> Maybe Integer findseed _ _ _ 0 = Nothing findseed sample uppercount seed mask = let tryout = seed .|. mask count = howfar tryout sample finished = (count == -1) in if finished then Just tryout else if uppercount < count then mplus (findseed sample count ((.|.) seed mask) nextmask) (findseed sample uppercount seed nextmask) else mplus (findseed sample uppercount seed nextmask) (findseed sample count ((.|.) seed mask) nextmask) where nextmask = shiftR mask 1 main = do handle <- openFile testfile ReadMode sample <- hGetContents handle putStrLn "Yosh !" putStrLn sample let sample1 = crypt testseed $ map (toInteger . ord) sample let seed = findseed sample1 0 0 2147483648 case seed of Just a -> do putStrLn $ show a putStrLn $ map ( chr . fromInteger ) sample2 where sample2 = crypt a sample1 Nothing -> do putStrLn "Failed"