-- |
-- Module      : Crypto.Random.Test
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : Good
--
-- Provide way to test usual simple statisticals test for randomness
--
{-# LANGUAGE GADTs #-}

module Crypto.Random.Test
    ( RandomTestState
    , RandomTestResult(..)
    , randomTestInitialize
    , randomTestAppend
    , randomTestFinalize
    ) where

import Data.Word
import Data.Int (Int64)
import qualified Data.ByteString.Lazy as L
import Control.Applicative
import Data.List (foldl')

import qualified Data.Vector.Mutable as M
import qualified Data.Vector as V

-- | Randomness various result relative to random bytes
data RandomTestResult = RandomTestResult
    { RandomTestResult -> Word64
res_totalChars         :: Word64 -- ^ Total number of characters
    , RandomTestResult -> Double
res_entropy            :: Double -- ^ Entropy per byte
    , RandomTestResult -> Double
res_chi_square         :: Double -- ^ Chi Square
    , RandomTestResult -> Double
res_mean               :: Double -- ^ Arithmetic Mean
    , RandomTestResult -> Double
res_compressionPercent :: Double -- ^ Theorical Compression percent
    , RandomTestResult -> [Double]
res_probs              :: [Double] -- ^ Probability of every bucket
    } deriving (Int -> RandomTestResult -> ShowS
[RandomTestResult] -> ShowS
RandomTestResult -> String
(Int -> RandomTestResult -> ShowS)
-> (RandomTestResult -> String)
-> ([RandomTestResult] -> ShowS)
-> Show RandomTestResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RandomTestResult] -> ShowS
$cshowList :: [RandomTestResult] -> ShowS
show :: RandomTestResult -> String
$cshow :: RandomTestResult -> String
showsPrec :: Int -> RandomTestResult -> ShowS
$cshowsPrec :: Int -> RandomTestResult -> ShowS
Show,RandomTestResult -> RandomTestResult -> Bool
(RandomTestResult -> RandomTestResult -> Bool)
-> (RandomTestResult -> RandomTestResult -> Bool)
-> Eq RandomTestResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RandomTestResult -> RandomTestResult -> Bool
$c/= :: RandomTestResult -> RandomTestResult -> Bool
== :: RandomTestResult -> RandomTestResult -> Bool
$c== :: RandomTestResult -> RandomTestResult -> Bool
Eq)

-- | Mutable random test State
newtype RandomTestState = RandomTestState (M.IOVector Word64)

-- | Initialize new state to run tests
randomTestInitialize :: IO RandomTestState
randomTestInitialize :: IO RandomTestState
randomTestInitialize = IOVector Word64 -> RandomTestState
RandomTestState (IOVector Word64 -> RandomTestState)
-> IO (IOVector Word64) -> IO RandomTestState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word64 -> IO (MVector (PrimState IO) Word64)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate Int
256 Word64
0

-- | Append random data to the test state
randomTestAppend :: RandomTestState -> L.ByteString -> IO ()
randomTestAppend :: RandomTestState -> ByteString -> IO ()
randomTestAppend (RandomTestState IOVector Word64
buckets) = ByteString -> IO ()
loop
  where loop :: ByteString -> IO ()
loop ByteString
bs
            | ByteString -> Bool
L.null ByteString
bs = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = do
                let (ByteString
b1,ByteString
b2) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
monteN ByteString
bs
                (Word8 -> IO ()) -> [Word8] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Word64 -> Int -> IO ()
addVec Word64
1 (Int -> IO ()) -> (Word8 -> Int) -> Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> IO ()) -> [Word8] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
L.unpack ByteString
b1
                ByteString -> IO ()
loop ByteString
b2
        addVec :: Word64 -> Int -> IO ()
        addVec :: Word64 -> Int -> IO ()
addVec Word64
a Int
i = MVector (PrimState IO) Word64 -> Int -> IO Word64
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
M.read IOVector Word64
MVector (PrimState IO) Word64
buckets Int
i IO Word64 -> (Word64 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
d -> MVector (PrimState IO) Word64 -> Int -> Word64 -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
M.write IOVector Word64
MVector (PrimState IO) Word64
buckets Int
i (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word64
dWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
a

-- | Finalize random test state into some result
randomTestFinalize :: RandomTestState -> IO RandomTestResult
randomTestFinalize :: RandomTestState -> IO RandomTestResult
randomTestFinalize (RandomTestState IOVector Word64
buckets) = ([Word64] -> RandomTestResult
calculate ([Word64] -> RandomTestResult)
-> (Vector Word64 -> [Word64]) -> Vector Word64 -> RandomTestResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word64 -> [Word64]
forall a. Vector a -> [a]
V.toList) (Vector Word64 -> RandomTestResult)
-> IO (Vector Word64) -> IO RandomTestResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` MVector (PrimState IO) Word64 -> IO (Vector Word64)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze IOVector Word64
MVector (PrimState IO) Word64
buckets

monteN :: Int64
monteN :: Int64
monteN = Int64
6

calculate :: [Word64] -> RandomTestResult
calculate :: [Word64] -> RandomTestResult
calculate [Word64]
buckets = RandomTestResult :: Word64
-> Double
-> Double
-> Double
-> Double
-> [Double]
-> RandomTestResult
RandomTestResult
    { res_totalChars :: Word64
res_totalChars = Word64
totalChars
    , res_entropy :: Double
res_entropy    = Double
entropy
    , res_chi_square :: Double
res_chi_square = Double
chisq
    , res_mean :: Double
res_mean       = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
datasum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars
    , res_compressionPercent :: Double
res_compressionPercent = Double
100.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
8 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
entropy) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
8.0
    , res_probs :: [Double]
res_probs      = [Double]
probs
    }
  where totalChars :: Word64
totalChars = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Word64]
buckets
        probs :: [Double]
probs = (Word64 -> Double) -> [Word64] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Word64
v -> Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars :: Double) [Word64]
buckets
        entropy :: Double
entropy = (Double -> Double -> Double) -> Double -> [Double] -> Double
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Double -> Double -> Double
forall p. (Ord p, Floating p) => p -> p -> p
accEnt Double
0.0 [Double]
probs
        cexp :: Double
cexp    = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
256.0 :: Double
        (Word64
datasum, Double
chisq) = ((Word64, Double) -> Int -> (Word64, Double))
-> (Word64, Double) -> [Int] -> (Word64, Double)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word64, Double) -> Int -> (Word64, Double)
accMeanChi (Word64
0, Double
0.0) [Int
0..Int
255]
        --chip' = abs (sqrt (2.0 * chisq) - sqrt (2.0 * 255.0 - 1.0))

        accEnt :: p -> p -> p
accEnt p
ent p
pr
            | p
pr p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
0.0  = p
ent p -> p -> p
forall a. Num a => a -> a -> a
+ (p
pr p -> p -> p
forall a. Num a => a -> a -> a
* p -> p
forall a. Floating a => a -> a
xlog (p
1 p -> p -> p
forall a. Fractional a => a -> a -> a
/ p
pr))
            | Bool
otherwise = p
ent
        xlog :: a -> a
xlog a
v = a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
10 a
v a -> a -> a
forall a. Num a => a -> a -> a
* (a -> a
forall a. Floating a => a -> a
log a
10 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
log a
2)

        accMeanChi :: (Word64, Double) -> Int -> (Word64, Double)
        accMeanChi :: (Word64, Double) -> Int -> (Word64, Double)
accMeanChi (Word64
dataSum, Double
chiSq) Int
i =
            let ccount :: Word64
ccount = [Word64]
buckets [Word64] -> Int -> Word64
forall a. [a] -> Int -> a
!! Int
i
                a :: Double
a      = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ccount Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cexp
             in (Word64
dataSum Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
ccount, Double
chiSq Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cexp))