BitStringRandomMonad (empty) → 0.1.0.0

raw patch · 4 files changed

+196/−0 lines, 4 filesdep +basedep +bitstringdep +bytestringsetup-changed

Dependencies added: base, bitstring, bytestring, mtl, parallel, primitive, transformers, vector

Files

• BitStringRandomMonad.cabal +36/−0
• Crypto/RandomMonad.hs +128/−0
• LICENSE +30/−0
• Setup.hs +2/−0

@@ -0,0 +1,36 @@+-- Initial BitStringRandomMonad.cabal generated by cabal init.  For further+--  documentation, see http://haskell.org/cabal/users-guide/++name:                BitStringRandomMonad+version:             0.1.0.0+description:         A library which turns a bytestring into a random monad.+                     Input could be any PRNG which can output a lazy+                     bytestring.+license:             BSD3+license-file:        LICENSE+author:              Marcus Ofenhed+maintainer:          marcus@conditionraise.se+-- copyright:+category:            Crypto+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Crypto.RandomMonad+  -- other-modules:+  other-extensions:    GeneralizedNewtypeDeriving, FlexibleContexts, TypeFamilies+  build-depends:       base >=4.9 && <4.10,+                       transformers,+                       bytestring,+                       bitstring,+                       mtl,+                       primitive,+                       parallel,+                       vector++  -- hs-source-dirs:+  default-language:    Haskell2010++Source-Repository head+  Type:       git+  Location:   https://github.com/Ofenhed/BitStringRandomMonad

@@ -0,0 +1,128 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++module Crypto.RandomMonad (RndT, RndST, RndIO, Rnd, RndState, getRandomM, getRandom2M, runRndT, newRandomElementST, getRandomElement, randomElementsLength, replaceSeedM, addSeedM, getRandomByteStringM) where++import Control.Exception (Exception, throw)+import Control.Monad.Identity (Identity)+import Control.Monad.Primitive (PrimMonad, PrimState, primitive)+import Control.Monad.ST (ST)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.Trans.State.Lazy (StateT, put, state, runStateT)+import Control.Parallel.Strategies (parMap, rpar, using, rseq)+import Data.Bits (shiftL, (.|.), xor)+import Data.Typeable (Typeable)+import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef)++import qualified Data.BitString as BS+import qualified Data.ByteString.Lazy as ByS+import qualified Data.Vector.Unboxed as V+import qualified Data.Vector.Unboxed.Mutable as VM++data BitStringToRandomExceptions = OutOfElementsException deriving (Show, Typeable)+instance Exception BitStringToRandomExceptions++bitsNeeded :: Integer -> Integer+bitsNeeded x = (+) 1 $ floor $ logBase 2 (fromIntegral x)++convertBitStringToInteger = BS.foldl' convert' 0+  where+  convert' :: Integer -> Bool -> Integer+  convert' prev cur = (shiftL prev 1) .|. (case cur of True -> 1 ; False -> 0)++multipleBitstringsSplitAt i x = join' (split' x) [] []+ where+ split' = parMap rpar (\bs -> let (take,drop) = BS.splitAt i bs in (take `using` rseq, drop))+ join' [] takers droppers = (takers, droppers)+ join' (x:xs) takers droppers = let (newTake, newDrop) = x in join' xs (newTake:takers) (newDrop:droppers)++multipleBitstringsAssertLength _ [] = False+multipleBitstringsAssertLength len x = len' x+  where+  len' [] = True+  len' (x:xs) = if (BS.length x) == len+                   then len' xs+                   else False+++getRandom :: Integer -> [BS.BitString] -> (Integer, [BS.BitString])+getRandom 0 x = (0, x)+getRandom max string = if has_error+                          then error "There was an error acquiring random data"+                          else if random <= max+                                  then (random, unused)+                                  else getRandom max unused+  where+    bitsNeeded' = bitsNeeded max+    has_error = not $ multipleBitstringsAssertLength (fromInteger bitsNeeded') used+    random = foldl (\i cur -> xor i $ convertBitStringToInteger cur) 0 used+    (used, unused) = multipleBitstringsSplitAt (fromIntegral bitsNeeded') string++getRandom2 :: Integer -> Integer -> [BS.BitString] -> (Integer, [BS.BitString])+getRandom2 a b string = getRandom2' (getRandom (max' - min') string)+  where+  min' = min a b+  max' = max a b+  getRandom2' (random, unused) = (random + min', unused)++getRandomByteString :: Integer -> [BS.BitString] -> (ByS.ByteString, [BS.BitString])+getRandomByteString 0 x = (ByS.pack [], x)+getRandomByteString len x = let (byte, newState) = getRandom 255 x ; (allBytes, lastState) = getRandomByteString (len - 1) newState in (ByS.cons (fromIntegral byte) allBytes, lastState)++newRandomElementST :: VM.Unbox a => [a] -> ST s (STRef s (V.Vector a))+newRandomElementST acc = newSTRef $ V.fromList acc++getRandomElement :: (V.Unbox a) => STRef s (V.Vector a) -> RndST s a+getRandomElement ref = do+  vec <- lift $ readSTRef ref+  vec' <- lift $ V.unsafeThaw vec+  let n = toInteger $ VM.length vec'+  j <- if n > 0 then getRandomM $ n - 1+                else throw OutOfElementsException+  let j' = fromInteger j+  aa <- lift $ VM.read vec' 0+  ab <- lift $ VM.read vec' j'+  lift $ VM.write vec' j' aa+  vec'' <- lift $ V.unsafeFreeze vec'+  lift $ writeSTRef ref $ V.unsafeTail vec''+  return ab++randomElementsLength ref = do+  vec <- lift $ readSTRef ref+  return $ V.length vec++type RndState = [BS.BitString]+newtype RndT m a = RndT+  { unRndT :: StateT RndState m a }+  deriving (Functor, Applicative, Monad, MonadTrans)++instance PrimMonad m => PrimMonad (RndT m) where+  type PrimState (RndT m) = PrimState m+  primitive = lift . primitive+  {-# INLINE primitive #-}++type RndST s a = RndT (ST s) a+type RndIO a = RndT IO a+type Rnd a = RndT Identity a++replaceSeedM :: Monad m => RndState -> RndT m ()+replaceSeedM s = RndT $ put s++addSeedM :: Monad m => RndState -> RndT m ()+addSeedM s = RndT $ state $ addSeedM s+  where+  addSeedM x y = ((),x ++ y)+++getRandomM :: Monad m => Integer -> RndT m Integer+getRandomM x = RndT $ state $ getRandom x++getRandom2M :: Monad m => Integer -> Integer -> RndT m Integer+getRandom2M x y = RndT $ state $ getRandom2 x y++getRandomByteStringM :: Monad m => Integer -> RndT m ByS.ByteString+getRandomByteStringM x = RndT $ state $ getRandomByteString x++runRndT :: RndState -> RndT m a -> m (a, RndState)+runRndT rnd m = runStateT (unRndT m) rnd

@@ -0,0 +1,30 @@+Copyright (c) 2016, Marcus Ofenhed++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Marcus Ofenhed nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain