-- |
-- 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
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
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = 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
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Word64 -> Int -> IO ()
addVec Word64
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) 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 = forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
M.read IOVector Word64
buckets Int
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
d -> forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
M.write IOVector Word64
buckets Int
i forall a b. (a -> b) -> a -> b
$! Word64
dforall 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze IOVector Word64
buckets

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

calculate :: [Word64] -> RandomTestResult
calculate :: [Word64] -> RandomTestResult
calculate [Word64]
buckets = 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       = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
datasum forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars
    , res_compressionPercent :: Double
res_compressionPercent = Double
100.0 forall a. Num a => a -> a -> a
* (Double
8 forall a. Num a => a -> a -> a
- Double
entropy) forall a. Fractional a => a -> a -> a
/ Double
8.0
    , res_probs :: [Double]
res_probs      = [Double]
probs
    }
  where totalChars :: Word64
totalChars = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Word64]
buckets
        probs :: [Double]
probs = forall a b. (a -> b) -> [a] -> [b]
map (\Word64
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars :: Double) [Word64]
buckets
        entropy :: Double
entropy = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. (Ord a, Floating a) => a -> a -> a
accEnt Double
0.0 [Double]
probs
        cexp :: Double
cexp    = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars forall a. Fractional a => a -> a -> a
/ Double
256.0 :: Double
        (Word64
datasum, Double
chisq) = 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 :: a -> a -> a
accEnt a
ent a
pr
            | a
pr forall a. Ord a => a -> a -> Bool
> a
0.0  = a
ent forall a. Num a => a -> a -> a
+ (a
pr forall a. Num a => a -> a -> a
* forall {a}. Floating a => a -> a
xlog (a
1 forall a. Fractional a => a -> a -> a
/ a
pr))
            | Bool
otherwise = a
ent
        xlog :: a -> a
xlog a
v = forall a. Floating a => a -> a -> a
logBase a
10 a
v forall a. Num a => a -> a -> a
* (forall {a}. Floating a => a -> a
log a
10 forall a. Fractional 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 forall a. [a] -> Int -> a
!! Int
i
                a :: Double
a      = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ccount forall a. Num a => a -> a -> a
- Double
cexp
             in (Word64
dataSum forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
* Word64
ccount, Double
chiSq forall a. Num a => a -> a -> a
+ (Double
a forall a. Num a => a -> a -> a
* Double
a forall a. Fractional a => a -> a -> a
/ Double
cexp))