tf-random-0.5/0000755000000000000000000000000012321250670011431 5ustar0000000000000000tf-random-0.5/LICENSE0000644000000000000000000000272112321250670012440 0ustar0000000000000000Copyright (c) 2012-2013, Michał Pałka 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. * The names of the authors may not 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. tf-random-0.5/Setup.hs0000644000000000000000000000005612321250670013066 0ustar0000000000000000import Distribution.Simple main = defaultMain tf-random-0.5/LICENSE.brg0000644000000000000000000000213312321250670013206 0ustar0000000000000000 Copyright (c) 1998-2006, Brian Gladman, Worcester, UK. All rights reserved. LICENSE TERMS The free distribution and use of this software in both source and binary form is allowed (with or without changes) provided that: 1. distributions of this source code include the above copyright notice, this list of conditions and the following disclaimer; 2. distributions in binary form include the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other associated materials; 3. the copyright holder's name is not used to endorse products built using this software without specific written permission. ALTERNATIVELY, provided that this notice is retained in full, this product may be distributed under the terms of the GNU General Public License (GPL), in which case the provisions of the GPL apply INSTEAD OF those given above. DISCLAIMER This software is provided 'as is' with no explicit or implied warranties in respect of its properties, including, but not limited to, correctness and/or fitness for purpose. tf-random-0.5/LICENSE.tf0000644000000000000000000000015612321250670013050 0ustar0000000000000000 Source code author: Doug Whiting, 2008. This algorithm and source code is released to the public domain. tf-random-0.5/tf-random.cabal0000644000000000000000000000761712321250670014317 0ustar0000000000000000-- Initial tf-random.cabal generated by cabal init. For further -- documentation, see http://haskell.org/cabal/users-guide/ -- The name of the package. name: tf-random -- The package version. See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change version: 0.5 -- A short (one-line) description of the package. synopsis: High-quality splittable pseudorandom number generator -- A longer description of the package. description: This package contains an implementation of a high-quality splittable pseudorandom number generator. The generator is based on a cryptographic hash function built on top of the ThreeFish block cipher. See the paper /Splittable Pseudorandom Number Generators Using Cryptographic Hashing/ by Claessen, Pałka for details and the rationale of the design. . The package provides the following: . * A splittable PRNG that implements the standard 'System.Random.RandomGen' class. . * The generator also implements an alternative version of the 'System.Random.TF.Gen.RandomGen' class (exported from "System.Random.TF.Gen"), which requires the generator to return pseudorandom integers from the full 32-bit range, and contains an n-way split function. . * An alternative version of the @Random@ class is provided, which is linked to the new @RandomGen@ class, together with @Random@ instances for some integral types. . * Two functions for initialising the generator with a non-deterministic seed: one using the system time, and one using the @\/dev\/urandom@ UNIX special file. . The package uses an adapted version of the reference C implementation of ThreeFish from the reference package of the Skein hash function (), originally written by Doug Whiting. . Please note that even though the generator provides very high-quality pseudorandom numbers, it has not been designed with cryptographic applications in mind. -- URL for the project homepage or repository. --homepage: http://no.home.page/ -- The license under which the package is released. license: BSD3 -- The file containing the license text. license-file: LICENSE -- The package author(s). author: Michał Pałka -- An email address to which users can send suggestions, bug reports, and -- patches. maintainer: Michał Pałka -- A copyright notice. -- copyright: category: Random build-type: Simple -- Constraint on the version of Cabal needed to build this package. cabal-version: >=1.8 extra-source-files: ChangeLog, LICENSE.brg, LICENSE.tf, cbits/brg_types.h, cbits/skein_debug.c, cbits/skein_debug.h, cbits/threefish.h, cbits/threefish_port.h source-repository head type: darcs location: http://hub.darcs.net/michal.palka/tf-random library Hs-Source-Dirs: src C-Sources: cbits/threefish_block.c --GHC-options: -O -- Modules exported by the library. exposed-modules: System.Random.TF, System.Random.TF.Gen, System.Random.TF.Init, System.Random.TF.Instances -- Modules included in this library but not exported. -- other-modules: -- Other library packages from which modules are imported. build-depends: base >= 4.2 && < 5, primitive >= 0.3, random, time tf-random-0.5/ChangeLog0000644000000000000000000000037112321250670013204 0ustar00000000000000000.5 * Allow older versions of random. 0.4 * Avoid exporting new RandomGen methods from System.Random.TF . 0.3 * Added newTFGen and mkTFGen. * Small additions to Intances. 0.2 * Compatibility with older base up to 4.2 0.1 * Initial release tf-random-0.5/src/0000755000000000000000000000000012321250670012220 5ustar0000000000000000tf-random-0.5/src/System/0000755000000000000000000000000012321250670013504 5ustar0000000000000000tf-random-0.5/src/System/Random/0000755000000000000000000000000012321250670014724 5ustar0000000000000000tf-random-0.5/src/System/Random/TF.hs0000644000000000000000000000140512321250670015571 0ustar0000000000000000-- | -- Module : System.Random.TF -- Copyright : (c) 2012-2013 Michał Pałka -- License : BSD3 -- -- Maintainer : michal.palka@chalmers.se -- Stability : experimental -- Portability : portable -- -- This module exports "System.Random.TF.Gen" and "System.Random.TF.Init" -- modules without exporting the alternative 'System.Random.TF.Gen.RandomGen' -- class from "System.Random.TF.Gen". To use this class and the 'System.Random.TF.Instances.Random' -- instances written for it, please import "System.Random.TF.Gen" and "System.Random.TF.Instances" -- directly. module System.Random.TF ( module System.Random.TF.Gen, module System.Random.TF.Init, ) where import System.Random.TF.Gen hiding (RandomGen (..)) import System.Random.TF.Init hiding (initTFGen) tf-random-0.5/src/System/Random/TF/0000755000000000000000000000000012321250670015235 5ustar0000000000000000tf-random-0.5/src/System/Random/TF/Gen.hs0000644000000000000000000002077412321250670016314 0ustar0000000000000000{-# Language CPP, BangPatterns, MagicHash, ForeignFunctionInterface, UnliftedFFITypes #-} -- | -- Module : System.Random.TF.Gen -- Copyright : (c) 2012-2013 Michał Pałka -- License : BSD3 -- -- Maintainer : michal.palka@chalmers.se -- Stability : experimental -- Portability : portable -- -- This module provides the 'TFGen' generator and the alternative 'RandomGen' class. -- 'TFGen' also implements the standard 'System.Random.RandomGen' class. module System.Random.TF.Gen (TFGen, RandomGen(..), seedTFGen) where import qualified System.Random as R import System.IO.Unsafe import Data.Bits import Data.Char (toUpper, isSpace) import Data.Maybe (isJust, fromJust) import Data.Int import Data.Word import Data.Primitive.ByteArray import Numeric #if !MIN_VERSION_base(4,4,0) unsafeDupablePerformIO :: IO a -> a unsafeDupablePerformIO = unsafePerformIO #endif foreign import ccall unsafe "skein.h Threefish_256_Process_Block" threefish256EncryptBlock :: ByteArray# -> ByteArray# -> MutableByteArray# s -> Int -> IO () createBlock256 :: Word64 -> Word64 -> Word64 -> Word64 -> IO ByteArray createBlock256 !a !b !c !d = do ma <- newByteArray 32 writeByteArray ma 0 a writeByteArray ma 1 b writeByteArray ma 2 c writeByteArray ma 3 d unsafeFreezeByteArray ma readBlock256 :: ByteArray -> (Word64, Word64, Word64, Word64) readBlock256 ba = ( indexByteArray ba 0 , indexByteArray ba 1 , indexByteArray ba 2 , indexByteArray ba 3 ) -- | The generator type data TFGen = TFGen {-# UNPACK #-} !ByteArray -- Key, four Word64s in host endian format {-# UNPACK #-} !Word64 -- Tree level {-# UNPACK #-} !Word64 -- Tree position bits {-# UNPACK #-} !Int16 -- Index in tree position bits {-# UNPACK #-} !Int16 -- Index in the block ByteArray -- The block, eight Word32s in host endian -- format (this field is lazy) newtype Hex = Hex ByteArray instance Show Hex where showsPrec _ (Hex ba) = map toUpper . showHex' x1 . showHex' x2 . showHex' x3 . showHex' x4 where (x1, x2, x3, x4) = readBlock256 ba showHex' x c = (pad $ showHex x "") ++ c pad s = take (16 - l) (repeat '0') ++ s where l = length s instance Read Hex where readsPrec _ = map (\(l, s) -> (Hex $ makeBA l, s)) . filter (\(l, _) -> length l <= 4) . map (\(x, s) -> (toList x, s)) . readHex . dropWhile isSpace where makeBA l = unsafeDupablePerformIO $ do b <- newByteArray 32 sequence_ [ writeByteArray b i x | (x, i) <- zip (l ++ repeat 0) [3,2..0] ] unsafeFreezeByteArray b toList :: Integer -> [Word64] toList 0 = [] toList n = fromIntegral m : toList d where (d, m) = n `divMod` (2^64) data TFGenR = TFGenR Hex Word64 Word64 Int16 Int16 deriving (Show, Read) toTFGenR :: TFGen -> TFGenR toTFGenR (TFGen k i b bi blki _) = TFGenR (Hex k) i b bi blki fromTFGenR :: TFGenR -> Maybe TFGen fromTFGenR (TFGenR (Hex k@(ByteArray k')) i b bi blki) | bi >= 0 && bi <= 64 && blki >= 0 && blki < 8 = Just $ TFGen k i b bi blki (mash k' (i-fromIntegral blki) b 0 1) | otherwise = Nothing instance Show TFGen where showsPrec n g = showsPrec n (toTFGenR g) instance Read TFGen where readsPrec n = map (\(g, s) -> (fromJust g, s)) . filter (\(g, _) -> isJust g) . map (\(g, s) -> (fromTFGenR g, s)) . readsPrec n mash :: ByteArray# -> Word64 -> Word64 -> Word64 -> Int -> ByteArray mash k' i b m o32 = -- We use unsafeDupablePerformIO here because the cost -- of locking in unsafePerformIO is much higher -- than any gains it could bring. unsafeDupablePerformIO $ do (ByteArray c') <- createBlock256 b i m 0 -- Allocate array for cipher result o@(MutableByteArray o') <- newByteArray 32 threefish256EncryptBlock k' c' o' o32 unsafeFreezeByteArray o mash' :: TFGen -> Word64 -> Int -> ByteArray mash' (TFGen (ByteArray k') i b _ _ _) m o32 = mash k' i b m o32 mkTFGen :: ByteArray -> Word64 -> Word64 -> Int16 -> TFGen mkTFGen k@(ByteArray k') i b bi = TFGen k i b bi 0 (mash k' i b 0 1) extract :: ByteArray -> Int -> Word32 extract b i = indexByteArray b i {-# INLINE tfGenNext #-} tfGenNext :: TFGen -> (Word32, TFGen) tfGenNext (TFGen k@(ByteArray k') i b bi blki blk) = (val, if blki == 7 then if i < maxBound - 1 then mkTFGen k (i+1) b bi else if bi < 64 then mkTFGen k 0 (setBit b $ fromIntegral bi) (bi+1) else mkTFGen (mash k' maxBound b 0 0) 0 0 0 else TFGen k (i+1) b bi (blki+1) blk) where val :: Word32 val = extract blk (fromIntegral blki) tfGenNext' :: TFGen -> (Int, TFGen) tfGenNext' g -- We force the result into StdGen's range | val' <= 2147483562 = (fromIntegral val', g') | otherwise = tfGenNext' g' where (val, g') = tfGenNext g val' = 0x7FFFFFFF .&. val tfGenSplit :: TFGen -> (TFGen, TFGen) tfGenSplit g@(TFGen k i b bi _ _) | bi == maxb = (mkTFGen k' 0 0 1, mkTFGen k' 0 1 1) | otherwise = (mkTFGen k i b bi', mkTFGen k i b'' bi') where maxb = 64 bi' = bi + 1 k' = mash' g 0 0 b'' = setBit b (fromIntegral bi) instance R.RandomGen TFGen where next = tfGenNext' -- Current Random instances assume that the generator -- must have this range. genRange _ = (0, 2147483562) split = tfGenSplit -- | Create a generator from a random seed. seedTFGen :: (Word64, Word64, Word64, Word64) -> TFGen seedTFGen (a1, a2, a3, a4) = mkTFGen (unsafeDupablePerformIO $ createBlock256 a1 a2 a3 a4) 0 0 0 -- | Alternative 'RandomGen' class with a modified 'next' operation, and added 'splitn' -- and 'level' operations. -- -- Using the generator requires that no more than one operation is called -- on the same generator state, as the implementation does not guarantee pseudorandomness -- otherwise. As an exception, calling 'splitn' many times on the same generator state is -- allowed as long as the \'bits\' argument is the same for all the calls. class RandomGen g where -- | 'next' returns a 'Word32' that appears to have been chosen uniformly at random, and a -- new generator state. next :: g -> (Word32, g) -- | 'split' returns two derived generator states that appear to be independent pseudorandom -- number generators. split :: g -> (g, g) -- | 'splitn' is the n-way split operation used to create many derived generator states -- in one go. Application of 'splitn' to two first arguments should be shared between -- different applications of the index argument to avoid unnecessary repeated computations. -- -- The following code creates ten \'independent\' generator states. Number \'4\' comes -- from the fact that at least -- four bits are needed to encode ten different indices. -- -- @ -- f :: RandomGen g => g -> [g] -- f r = map (splitn r 4) [0..9] -- @ splitn :: g -- ^ Original generator state. -> Int -- ^ Number of bits that will be used to index the derived states. -- Must be between 0 and 32. -> Word32 -- ^ Index of the derived state. Call to @splitn r n i@ must -- satisfy @0 <= i < 2^n@. -> g -- | 'level' is a \'hint\' operation that may cause an iteration of work -- of the generator be performed prematurely in order to -- prevent the subsequent operations from being expensive. It is meant to be -- called before a 'splitn' operation, which is expected to be evaluated -- a very large number indices. Calling 'level' in such case might decrease -- the total amount of work performed. level :: g -> g tfGenSplitN :: TFGen -> Int -> Word32 -> TFGen tfGenSplitN (TFGen k@(ByteArray ku) i b bi _ _) nbits | nbits < 0 = error "tfGenSplitN called with nbits < 0" | nbits > 32 = error "tfGenSplitN called with nbits > 32" | bi' + nbits > maxb = \n -> let k' = mash ku i (b .|. shiftL (fromIntegral $ clip n) (fromIntegral bi)) 0 0 in mkTFGen k' 0 (shiftR (fromIntegral $ clip n) (bi' + nbits - maxb)) (bi - fromIntegral (maxb - nbits)) | otherwise = \n -> mkTFGen k i (b .|. shiftL (fromIntegral $ clip n) bi') (bi + fromIntegral nbits) where bi' = fromIntegral bi maxb = 64 clip n = (0xFFFFFFFF `shiftR` (32 - nbits)) .&. n tfGenLevel :: TFGen -> TFGen tfGenLevel g@(TFGen k@(ByteArray ku) i b bi _ _) | bi + 40 > maxb = mkTFGen k' 0 0 0 | otherwise = g where maxb = 64 k' = mash ku i b 0 0 instance RandomGen TFGen where {-# INLINE next #-} next = tfGenNext split = tfGenSplit splitn = tfGenSplitN level = tfGenLevel tf-random-0.5/src/System/Random/TF/Instances.hs0000644000000000000000000001744212321250670017530 0ustar0000000000000000{-# Language CPP, BangPatterns, ScopedTypeVariables #-} -- | -- Module : System.Random.TF.Instances -- Copyright : (c) 2012-2013 Michał Pałka -- License : BSD3 -- -- Maintainer : michal.palka@chalmers.se -- Stability : experimental -- Portability : portable -- -- This module defines alternative 'Random' instances for -- common integral types, which make use of -- the 'System.Random.TF.Gen.RandomGen' class from "System.Random.TF.Gen". module System.Random.TF.Instances (Random (..), randomEnum) where import Data.Bits import Data.Int import Data.Word import System.Random.TF.Gen #if !MIN_VERSION_base(4,5,0) unsafeShiftR :: Bits a => a -> Int -> a unsafeShiftR = shiftR unsafeShiftL :: Bits a => a -> Int -> a unsafeShiftL = shiftL #endif myUnfoldr :: (t -> (a, t)) -> t -> [a] myUnfoldr f g = x' : myUnfoldr f g' where (x', g') = f g class Random a where randomR :: RandomGen g => (a,a) -> g -> (a,g) random :: RandomGen g => g -> (a, g) randomRs :: RandomGen g => (a,a) -> g -> [a] randomRs ival g = myUnfoldr (randomR ival) g randoms :: RandomGen g => g -> [a] randoms g = myUnfoldr random g {- randomRIO :: (a,a) -> IO a randomIO :: IO a -} boundsWrap :: Integral a => (a -> g -> (a, g)) -> (a, a) -> g -> (a, g) boundsWrap f (l, h) rng | l == h = (l, rng) | l > h = mapFst (h+) $ f (l - h) rng | otherwise = mapFst (l+) $ f (h - l) rng where mapFst g (x, y) = (g x, y) randomWord32 :: RandomGen g => (Word32, Word32) -> g -> (Word32, g) randomWord32 (l, h) rng = boundsWrap randomWord32' (l, h) rng randomInt32 :: RandomGen g => (Int32, Int32) -> g -> (Int32, g) randomInt32 (l, h) rng = boundsWrap randomInt32' (l, h) rng where randomInt32' m r = case randomWord32' (fromIntegral m) r of (x, r') -> (fromIntegral x, r') word32Mask :: Word32 -> Word32 word32Mask w = (((((w .>. 1) .>. 2) .>. 4) .>. 8) .>. 16) where w .>. n = w .|. (w `unsafeShiftR` n) -- Inspired by Java's java.util.Random. -- This version avoids division modulo. -- Returns a random number from range [0..k-1], or from the full range if k = 0. {-# INLINE randomWord32' #-} randomWord32' :: RandomGen g => Word32 -> g -> (Word32, g) randomWord32' k -- Case 1: k is the maxBound. | k' == 0 = next -- Case 2: k' is a power of two; k is a bit mask. | k' .&. k == 0 = \rng -> case next rng of (x, rng') -> (x .&. k, rng') -- Case 3: The general case. Case 3 subsumes Case 2, -- and Case 2 subsumes Case 1. Cases 1 and 2 are -- there for efficiency. | otherwise = loop where k' = k + 1 mask = word32Mask k loop rng | x' <= k = (x', rng') | otherwise = loop rng' where (x, rng') = next rng x' = x .&. mask makeWord64 :: Word32 -> Word32 -> Word64 makeWord64 w1 w2 = w1' `unsafeShiftL` 32 .|. w2' where w1', w2' :: Word64 w1' = fromIntegral w1 w2' = fromIntegral w2 randomWord64 :: RandomGen g => (Word64, Word64) -> g -> (Word64, g) randomWord64 (l, h) rng = boundsWrap randomWord64' (l, h) rng randomInt64 :: RandomGen g => (Int64, Int64) -> g -> (Int64, g) randomInt64 (l, h) rng = boundsWrap randomInt64' (l, h) rng where randomInt64' m r = case randomWord64' (fromIntegral m) r of (x, r') -> (fromIntegral x, r') -- Works similarly to randomWord32' randomWord64' :: RandomGen g => Word64 -> g -> (Word64, g) randomWord64' k -- Case 1: The range fits in 32 bits. | k <= m32 = \rng -> case randomWord32' (fromIntegral k) rng of (x, rng') -> (fromIntegral x, rng') -- Case 2: (l,h) is the full range. This case should -- probably be removed | k' == 0 = \rng -> let !(x1, rng') = next rng !(x2, rng'') = next rng' in (makeWord64 x1 x2, rng'') -- Case 3: k' is a power of two; k is a bit mask. | k' .&. k == 0 = \rng -> let !(x1, rng') = next rng !(x2, rng'') = next rng' in (makeWord64 x1 x2 .&. k, rng'') -- Case 4: The general case. Case 4 subsumes Cases 1 and 3, -- and Case 3 subsumes Case 2. Cases 1, 2 and 3 are -- there for efficiency. | otherwise = loop where m32 :: Word64 m32 = fromIntegral (maxBound :: Word32) k' = k + 1 mask = word32Mask (fromIntegral $ k `unsafeShiftR` 32) loop rng | x <= k = (x, rng'') | otherwise = loop rng'' where (x1, rng') = next rng (x2, rng'') = next rng' x = makeWord64 (x1 .&. mask) x2 -- Returns the most significant word and the number of extra words. -- x must be non-negative getShiftAndLead :: (Integral a, Bits a) => a -> (Int, Word32) getShiftAndLead !x = cWords x 0 where cWords !x !c | x' == 0 = (c, fromIntegral x) | otherwise = cWords x' (c+1) where x' = x `unsafeShiftR` 32 randomInteger :: RandomGen g => (Integer, Integer) -> g -> (Integer, g) randomInteger (l, h) rng = boundsWrap randomInteger' (l, h) rng {-# INLINE randomInteger' #-} randomInteger' :: forall g. RandomGen g => Integer -> g -> (Integer, g) randomInteger' k rng | k < 2^64 = case randomWord64' (fromIntegral k) rng of (x, rng') -> (fromIntegral x, rng') | otherwise = loop rng where (w, l) = getShiftAndLead k -- Constructing Integers is very expensive, so it is better -- to do it from Word64s than from Word32s. construct rng | even w = construct' (fromIntegral lx) w rng' | otherwise = construct' (fromIntegral x) (w-1) rng'' where (lx, rng') = randomWord32' l rng (x2, rng'') = next rng' x = makeWord64 lx x2 construct' :: Integer -> Int -> g -> (Integer, g) construct' !a 0 rng = (a, rng) construct' !a n rng = construct' (a `shiftL` 64 .|. fromIntegral x) (n-2) rng'' where (x1, rng') = next rng (x2, rng'') = next rng' x = makeWord64 x1 x2 loop rng | x <= k = (x, rng') | otherwise = loop rng' where (x, rng') = construct rng randomBounded :: (RandomGen g, Random a, Bounded a) => g -> (a, g) randomBounded = randomR (minBound, maxBound) instance Random Int where randomR (a, b) rng = (fromIntegral x, rng') where !(x, rng') = randomR (fromIntegral a :: Int64, fromIntegral b) rng random = randomBounded randomEnum :: (Enum a, RandomGen g) => (a, a) -> g -> (a, g) randomEnum (a,b) g = case randomR (fromEnum a, fromEnum b) g of (x, g') -> (toEnum x, g') instance Random Char where randomR = randomEnum random = randomBounded instance Random Bool where randomR = randomEnum random = randomBounded -- For random Integers we use the range of Int instance Random Integer where randomR = randomInteger random = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) instance Random Word32 where randomR = randomWord32 -- Optimised version random = next instance Random Word64 where randomR = randomWord64 random = randomBounded instance Random Int32 where randomR = randomInt32 -- Optimised version random g = let (x, g') = next g in (fromIntegral x, g') instance Random Int64 where randomR = randomInt64 random = randomBounded instance Random Word8 where randomR (l, h) g = let (x, g') = randomWord32 (fromIntegral l, fromIntegral h) g in (fromIntegral x, g') -- Optimised version random g = let (x, g') = next g in (fromIntegral x, g') instance Random Int8 where randomR (l, h) g = let (x, g') = randomInt32 (fromIntegral l, fromIntegral h) g in (fromIntegral x, g') -- Optimised version random g = let (x, g') = next g in (fromIntegral x, g') instance Random Word16 where randomR (l, h) g = let (x, g') = randomWord32 (fromIntegral l, fromIntegral h) g in (fromIntegral x, g') -- Optimised version random g = let (x, g') = next g in (fromIntegral x, g') instance Random Int16 where randomR (l, h) g = let (x, g') = randomInt32 (fromIntegral l, fromIntegral h) g in (fromIntegral x, g') -- Optimised version random g = let (x, g') = next g in (fromIntegral x, g') tf-random-0.5/src/System/Random/TF/Init.hs0000644000000000000000000000516312321250670016501 0ustar0000000000000000{-# LANGUAGE CPP #-} -- Module : System.Random.TF.Init -- Copyright : (c) 2013 Michał Pałka -- License : BSD3 -- -- Maintainer : michal.palka@chalmers.se -- Stability : experimental -- Portability : portable -- module System.Random.TF.Init (newTFGen, mkTFGen, mkSeedTime, mkSeedUnix, initTFGen) where import System.Random.TF.Gen (TFGen, seedTFGen, split) import Control.Monad (when) import Data.Bits (bitSize) import Data.IORef import Data.Word import Foreign (allocaBytes, peekArray) import Data.Ratio (numerator, denominator) import Data.Time import System.CPUTime import System.IO import System.IO.Unsafe (unsafePerformIO) -- | Use system time create the random seed. -- This method of seeding may not be relible. mkSeedTime :: IO (Word64, Word64, Word64, Word64) mkSeedTime = do utcTm <- getCurrentTime cpu <- getCPUTime let daytime = toRational $ utctDayTime utcTm t1, t2 :: Word64 t1 = fromIntegral $ numerator daytime t2 = fromIntegral $ denominator daytime day = toModifiedJulianDay $ utctDay utcTm d1 :: Word64 d1 = fromIntegral day c1 :: Word64 c1 = fromIntegral cpu return (t1, t2, d1, c1) -- | Use the UNIX special file @\/dev\/urandom@ to create the seed. -- Inspired by @random-mwc@. mkSeedUnix :: IO (Word64, Word64, Word64, Word64) mkSeedUnix = do let bytes = 32 rfile = "/dev/urandom" l <- allocaBytes bytes $ \buf -> do nread <- withBinaryFile rfile ReadMode $ \h -> hGetBuf h buf bytes when (nread /= bytes) $ fail $ "mkSeedUnix: Failed to read " ++ show bytes ++ " from " ++ rfile peekArray 4 buf let [x1, x2, x3, x4] = l return (x1, x2, x3, x4) -- | Create a seed and used it to seed an instance of TFGen. -- Uses 'mkSeedUnix' on UNIX, and 'mkSeedTime' otherwise. initTFGen :: IO TFGen initTFGen = do #ifdef UNIX s <- mkSeedUnix #else s <- mkSeedTime #endif return $ seedTFGen s -- | Derive a new generator instance from the global RNG using split. -- This is the default way of obtaining a new RNG instance. -- Initial generator is seeded using 'mkSeedUnix' on UNIX, -- and 'mkSeedTime' otherwise. This should be eventually -- replaced with proper seeding. -- Inspired by System.Random newTFGen :: IO TFGen newTFGen = atomicModifyIORef theTFGen split {-# NOINLINE theTFGen #-} theTFGen :: IORef TFGen theTFGen = unsafePerformIO $ do rng <- initTFGen newIORef rng -- | Quick and dirty way of creating a deterministically -- seeded generator. mkTFGen :: Int -> TFGen mkTFGen n | bitSize n > 64 = error "mkTFGen: case where size of Int > 64 not implemented" | otherwise = seedTFGen (fromIntegral n, 0, 0, 0) tf-random-0.5/cbits/0000755000000000000000000000000012321250670012535 5ustar0000000000000000tf-random-0.5/cbits/threefish_port.h0000644000000000000000000000176512321250670015744 0ustar0000000000000000#ifndef _THREEFISH_PORT_H_ #define _THREEFISH_PORT_H_ /******************************************************************* ** ** Platform-specific definitions for Skein hash function. ** ** Source code author: Doug Whiting, 2008. ** ** This algorithm and source code is released to the public domain. ** ** Many thanks to Brian Gladman for his portable header files. ** ** To port Skein to an "unsupported" platform, change the definitions ** in this file appropriately. ** ********************************************************************/ #include "brg_types.h" /* get integer type definitions */ typedef unsigned int uint_t; /* native unsigned integer */ typedef uint_8t u08b_t; /* 8-bit unsigned integer */ typedef uint_32t u32b_t; /* 32-bit unsigned integer */ typedef uint_64t u64b_t; /* 64-bit unsigned integer */ #ifndef RotL_64 #define RotL_64(x,N) (((x) << (N)) | ((x) >> (64-(N)))) #endif #endif tf-random-0.5/cbits/skein_debug.c0000644000000000000000000002211512321250670015161 0ustar0000000000000000/*********************************************************************** ** ** Debug output functions for Skein hashing. ** ** Source code author: Doug Whiting, 2008. ** ** This algorithm and source code is released to the public domain. ** ************************************************************************/ #include #ifdef SKEIN_DEBUG /* only instantiate this code if SKEIN_DEBUG is on */ #include "skein.h" static const char INDENT[] = " "; /* how much to indent on new line */ uint_t skein_DebugFlag = 0; /* off by default. Must be set externally */ static void Show64_step(size_t cnt,const u64b_t *X,size_t step) { size_t i,j; for (i=j=0;i < cnt;i++,j+=step) { if (i % 4 == 0) printf(INDENT); printf(" %08X.%08X ",(uint_32t)(X[j] >> 32),(uint_32t)X[j]); if (i % 4 == 3 || i==cnt-1) printf("\n"); fflush(stdout); } } #define Show64(cnt,X) Show64_step(cnt,X,1) static void Show64_flag(size_t cnt,const u64b_t *X) { size_t xptr = (size_t) X; size_t step = (xptr & 1) ? 2 : 1; if (step != 1) { X = (const u64b_t *) (xptr & ~1); } Show64_step(cnt,X,step); } static void Show08(size_t cnt,const u08b_t *b) { size_t i; for (i=0;i < cnt;i++) { if (i %16 == 0) printf(INDENT); else if (i % 4 == 0) printf(" "); printf(" %02X",b[i]); if (i %16 == 15 || i==cnt-1) printf("\n"); fflush(stdout); } } static const char *AlgoHeader(uint_t bits) { if (skein_DebugFlag & SKEIN_DEBUG_THREEFISH) switch (bits) { case 256: return ":Threefish-256: "; case 512: return ":Threefish-512: "; case 1024: return ":Threefish-1024:"; } else switch (bits) { case 256: return ":Skein-256: "; case 512: return ":Skein-512: "; case 1024: return ":Skein-1024:"; } return NULL; } void Skein_Show_Final(uint_t bits,const Skein_Ctxt_Hdr_t *h,size_t cnt,const u08b_t *outPtr) { if (skein_DebugFlag & SKEIN_DEBUG_CONFIG || ((h->T[1] & SKEIN_T1_BLK_TYPE_MASK) != SKEIN_T1_BLK_TYPE_CFG)) if (skein_DebugFlag & SKEIN_DEBUG_FINAL) { printf("\n%s Final output=\n",AlgoHeader(bits)); Show08(cnt,outPtr); printf(" ++++++++++\n"); fflush(stdout); } } /* show state after a round (or "pseudo-round") */ void Skein_Show_Round(uint_t bits,const Skein_Ctxt_Hdr_t *h,size_t r,const u64b_t *X) { static uint_t injectNum=0; /* not multi-thread safe! */ if (skein_DebugFlag & SKEIN_DEBUG_CONFIG || ((h->T[1] & SKEIN_T1_BLK_TYPE_MASK) != SKEIN_T1_BLK_TYPE_CFG)) if (skein_DebugFlag) { if (r >= SKEIN_RND_SPECIAL) { /* a key injection (or feedforward) point */ injectNum = (r == SKEIN_RND_KEY_INITIAL) ? 0 : injectNum+1; if ( skein_DebugFlag & SKEIN_DEBUG_INJECT || ((skein_DebugFlag & SKEIN_DEBUG_FINAL) && r == SKEIN_RND_FEED_FWD)) { printf("\n%s",AlgoHeader(bits)); switch (r) { case SKEIN_RND_KEY_INITIAL: printf(" [state after initial key injection]"); break; case SKEIN_RND_KEY_INJECT: printf(" [state after key injection #%02d]",injectNum); break; case SKEIN_RND_FEED_FWD: printf(" [state after plaintext feedforward]"); injectNum = 0; break; } printf("=\n"); Show64(bits/64,X); if (r== SKEIN_RND_FEED_FWD) printf(" ----------\n"); } } else if (skein_DebugFlag & SKEIN_DEBUG_ROUNDS) { uint_t j; u64b_t p[SKEIN_MAX_STATE_WORDS]; const u08b_t *perm; const static u08b_t PERM_256 [4][ 4] = { { 0,1,2,3 }, { 0,3,2,1 }, { 0,1,2,3 }, { 0,3,2,1 } }; const static u08b_t PERM_512 [4][ 8] = { { 0,1,2,3,4,5,6,7 }, { 2,1,4,7,6,5,0,3 }, { 4,1,6,3,0,5,2,7 }, { 6,1,0,7,2,5,4,3 } }; const static u08b_t PERM_1024[4][16] = { { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15 }, { 0, 9, 2,13, 6,11, 4,15,10, 7,12, 3,14, 5, 8, 1 }, { 0, 7, 2, 5, 4, 3, 6, 1,12,15,14,13, 8,11,10, 9 }, { 0,15, 2,11, 6,13, 4, 9,14, 1, 8, 5,10, 3,12, 7 } }; if ((skein_DebugFlag & SKEIN_DEBUG_PERMUTE) && (r & 3)) { printf("\n%s [state after round %2d (permuted)]=\n",AlgoHeader(bits),(int)r); switch (bits) { case 256: perm = PERM_256 [r&3]; break; case 512: perm = PERM_512 [r&3]; break; default: perm = PERM_1024[r&3]; break; } for (j=0;jT[1] & SKEIN_T1_BLK_TYPE_MASK) != SKEIN_T1_BLK_TYPE_CFG)) if (skein_DebugFlag) { if (skein_DebugFlag & SKEIN_DEBUG_HDR) { printf("\n%s Block: outBits=%4d. T0=%06X.",AlgoHeader(bits),(uint_t) h->hashBitLen,(uint_t)h->T[0]); printf(" Type="); n = (uint_t) ((h->T[1] & SKEIN_T1_BLK_TYPE_MASK) >> SKEIN_T1_POS_BLK_TYPE); switch (n) { case SKEIN_BLK_TYPE_KEY: printf("KEY. "); break; case SKEIN_BLK_TYPE_CFG: printf("CFG. "); break; case SKEIN_BLK_TYPE_PERS: printf("PERS."); break; case SKEIN_BLK_TYPE_PK : printf("PK. "); break; case SKEIN_BLK_TYPE_KDF: printf("KDF. "); break; case SKEIN_BLK_TYPE_MSG: printf("MSG. "); break; case SKEIN_BLK_TYPE_OUT: printf("OUT. "); break; default: printf("0x%02X.",n); break; } printf(" Flags="); printf((h->T[1] & SKEIN_T1_FLAG_FIRST) ? " First":" "); printf((h->T[1] & SKEIN_T1_FLAG_FINAL) ? " Final":" "); printf((h->T[1] & SKEIN_T1_FLAG_BIT_PAD) ? " Pad" :" "); n = (uint_t) ((h->T[1] & SKEIN_T1_TREE_LVL_MASK) >> SKEIN_T1_POS_TREE_LVL); if (n) printf(" TreeLevel = %02X",n); printf("\n"); fflush(stdout); } if (skein_DebugFlag & SKEIN_DEBUG_TWEAK) { printf(" Tweak:\n"); Show64(2,h->T); } if (skein_DebugFlag & SKEIN_DEBUG_STATE) { printf(" %s words:\n",(skein_DebugFlag & SKEIN_DEBUG_THREEFISH)?"Key":"State"); Show64(bits/64,X); } if (skein_DebugFlag & SKEIN_DEBUG_KEYSCHED) { printf(" Tweak schedule:\n"); Show64_flag(3,tsPtr); printf(" Key schedule:\n"); Show64_flag((bits/64)+1,ksPtr); } if (skein_DebugFlag & SKEIN_DEBUG_INPUT_64) { printf(" Input block (words):\n"); Show64(bits/64,wPtr); } if (skein_DebugFlag & SKEIN_DEBUG_INPUT_08) { printf(" Input block (bytes):\n"); Show08(bits/8,blkPtr); } } } void Skein_Show_Key(uint_t bits,const Skein_Ctxt_Hdr_t *h,const u08b_t *key,size_t keyBytes) { if (keyBytes) if (skein_DebugFlag & SKEIN_DEBUG_CONFIG || ((h->T[1] & SKEIN_T1_BLK_TYPE_MASK) != SKEIN_T1_BLK_TYPE_CFG)) if (skein_DebugFlag & SKEIN_DEBUG_KEY) { printf("\n%s MAC key = %4u bytes\n",AlgoHeader(bits),(unsigned) keyBytes); Show08(keyBytes,key); } } #endif tf-random-0.5/cbits/skein_debug.h0000644000000000000000000000504612321250670015172 0ustar0000000000000000#ifndef _SKEIN_DEBUG_H_ #define _SKEIN_DEBUG_H_ /*********************************************************************** ** ** Interface definitions for Skein hashing debug output. ** ** Source code author: Doug Whiting, 2008. ** ** This algorithm and source code is released to the public domain. ** ************************************************************************/ #ifdef SKEIN_DEBUG /* callout functions used inside Skein code */ void Skein_Show_Block(uint_t bits,const Skein_Ctxt_Hdr_t *h,const u64b_t *X,const u08b_t *blkPtr, const u64b_t *wPtr,const u64b_t *ksPtr,const u64b_t *tsPtr); void Skein_Show_Round(uint_t bits,const Skein_Ctxt_Hdr_t *h,size_t r,const u64b_t *X); void Skein_Show_R_Ptr(uint_t bits,const Skein_Ctxt_Hdr_t *h,size_t r,const u64b_t *X_ptr[]); void Skein_Show_Final(uint_t bits,const Skein_Ctxt_Hdr_t *h,size_t cnt,const u08b_t *outPtr); void Skein_Show_Key (uint_t bits,const Skein_Ctxt_Hdr_t *h,const u08b_t *key,size_t keyBytes); extern uint_t skein_DebugFlag; /* flags to control debug output (0 --> none) */ #define SKEIN_RND_SPECIAL (1000u) #define SKEIN_RND_KEY_INITIAL (SKEIN_RND_SPECIAL+0u) #define SKEIN_RND_KEY_INJECT (SKEIN_RND_SPECIAL+1u) #define SKEIN_RND_FEED_FWD (SKEIN_RND_SPECIAL+2u) /* flag bits: skein_DebugFlag */ #define SKEIN_DEBUG_KEY (1u << 1) /* show MAC key */ #define SKEIN_DEBUG_CONFIG (1u << 2) /* show config block processing */ #define SKEIN_DEBUG_STATE (1u << 3) /* show input state during Show_Block() */ #define SKEIN_DEBUG_TWEAK (1u << 4) /* show input state during Show_Block() */ #define SKEIN_DEBUG_KEYSCHED (1u << 5) /* show expanded key schedule */ #define SKEIN_DEBUG_INPUT_64 (1u << 6) /* show input block as 64-bit words */ #define SKEIN_DEBUG_INPUT_08 (1u << 7) /* show input block as 8-bit bytes */ #define SKEIN_DEBUG_INJECT (1u << 8) /* show state after key injection & feedforward points */ #define SKEIN_DEBUG_ROUNDS (1u << 9) /* show state after all rounds */ #define SKEIN_DEBUG_FINAL (1u <<10) /* show final output of Skein */ #define SKEIN_DEBUG_HDR (1u <<11) /* show block header */ #define SKEIN_DEBUG_THREEFISH (1u <<12) /* use Threefish name instead of Skein */ #define SKEIN_DEBUG_PERMUTE (1u <<13) /* use word permutations */ #define SKEIN_DEBUG_ALL ((~0u) & ~(SKEIN_DEBUG_THREEFISH | SKEIN_DEBUG_PERMUTE)) #define THREEFISH_DEBUG_ALL (SKEIN_DEBUG_ALL | SKEIN_DEBUG_THREEFISH) #endif /* SKEIN_DEBUG */ #endif /* _SKEIN_DEBUG_H_ */ tf-random-0.5/cbits/brg_types.h0000644000000000000000000001511512321250670014707 0ustar0000000000000000/* --------------------------------------------------------------------------- Copyright (c) 1998-2006, Brian Gladman, Worcester, UK. All rights reserved. LICENSE TERMS The free distribution and use of this software in both source and binary form is allowed (with or without changes) provided that: 1. distributions of this source code include the above copyright notice, this list of conditions and the following disclaimer; 2. distributions in binary form include the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other associated materials; 3. the copyright holder's name is not used to endorse products built using this software without specific written permission. ALTERNATIVELY, provided that this notice is retained in full, this product may be distributed under the terms of the GNU General Public License (GPL), in which case the provisions of the GPL apply INSTEAD OF those given above. DISCLAIMER This software is provided 'as is' with no explicit or implied warranties in respect of its properties, including, but not limited to, correctness and/or fitness for purpose. --------------------------------------------------------------------------- Issue 09/09/2006 The unsigned integer types defined here are of the form uint_t where is the length of the type; for example, the unsigned 32-bit type is 'uint_32t'. These are NOT the same as the 'C99 integer types' that are defined in the inttypes.h and stdint.h headers since attempts to use these types have shown that support for them is still highly variable. However, since the latter are of the form uint_t, a regular expression search and replace (in VC++ search on 'uint_{:z}t' and replace with 'uint\1_t') can be used to convert the types used here to the C99 standard types. */ #ifndef BRG_TYPES_H #define BRG_TYPES_H #if defined(__cplusplus) extern "C" { #endif #include #ifndef BRG_UI8 # define BRG_UI8 # if UCHAR_MAX == 255u typedef unsigned char uint_8t; # else # error Please define uint_8t as an 8-bit unsigned integer type in brg_types.h # endif #endif #ifndef BRG_UI16 # define BRG_UI16 # if USHRT_MAX == 65535u typedef unsigned short uint_16t; # else # error Please define uint_16t as a 16-bit unsigned short type in brg_types.h # endif #endif #ifndef BRG_UI32 # define BRG_UI32 # if UINT_MAX == 4294967295u # define li_32(h) 0x##h##u typedef unsigned int uint_32t; # elif ULONG_MAX == 4294967295u # define li_32(h) 0x##h##ul typedef unsigned long uint_32t; # elif defined( _CRAY ) # error This code needs 32-bit data types, which Cray machines do not provide # else # error Please define uint_32t as a 32-bit unsigned integer type in brg_types.h # endif #endif #ifndef BRG_UI64 # if defined( __BORLANDC__ ) && !defined( __MSDOS__ ) # define BRG_UI64 # define li_64(h) 0x##h##ui64 typedef unsigned __int64 uint_64t; # elif defined( _MSC_VER ) && ( _MSC_VER < 1300 ) /* 1300 == VC++ 7.0 */ # define BRG_UI64 # define li_64(h) 0x##h##ui64 typedef unsigned __int64 uint_64t; # elif defined( __sun ) && defined(ULONG_MAX) && ULONG_MAX == 0xfffffffful # define BRG_UI64 # define li_64(h) 0x##h##ull typedef unsigned long long uint_64t; # elif defined( UINT_MAX ) && UINT_MAX > 4294967295u # if UINT_MAX == 18446744073709551615u # define BRG_UI64 # define li_64(h) 0x##h##u typedef unsigned int uint_64t; # endif # elif defined( ULONG_MAX ) && ULONG_MAX > 4294967295u # if ULONG_MAX == 18446744073709551615ul # define BRG_UI64 # define li_64(h) 0x##h##ul typedef unsigned long uint_64t; # endif # elif defined( ULLONG_MAX ) && ULLONG_MAX > 4294967295u # if ULLONG_MAX == 18446744073709551615ull # define BRG_UI64 # define li_64(h) 0x##h##ull typedef unsigned long long uint_64t; # endif # elif defined( ULONG_LONG_MAX ) && ULONG_LONG_MAX > 4294967295u # if ULONG_LONG_MAX == 18446744073709551615ull # define BRG_UI64 # define li_64(h) 0x##h##ull typedef unsigned long long uint_64t; # endif # elif defined(__GNUC__) /* DLW: avoid mingw problem with -ansi */ # define BRG_UI64 # define li_64(h) 0x##h##ull typedef unsigned long long uint_64t; # endif #endif #if defined( NEED_UINT_64T ) && !defined( BRG_UI64 ) # error Please define uint_64t as an unsigned 64 bit type in brg_types.h #endif #ifndef RETURN_VALUES # define RETURN_VALUES # if defined( DLL_EXPORT ) # if defined( _MSC_VER ) || defined ( __INTEL_COMPILER ) # define VOID_RETURN __declspec( dllexport ) void __stdcall # define INT_RETURN __declspec( dllexport ) int __stdcall # elif defined( __GNUC__ ) # define VOID_RETURN __declspec( __dllexport__ ) void # define INT_RETURN __declspec( __dllexport__ ) int # else # error Use of the DLL is only available on the Microsoft, Intel and GCC compilers # endif # elif defined( DLL_IMPORT ) # if defined( _MSC_VER ) || defined ( __INTEL_COMPILER ) # define VOID_RETURN __declspec( dllimport ) void __stdcall # define INT_RETURN __declspec( dllimport ) int __stdcall # elif defined( __GNUC__ ) # define VOID_RETURN __declspec( __dllimport__ ) void # define INT_RETURN __declspec( __dllimport__ ) int # else # error Use of the DLL is only available on the Microsoft, Intel and GCC compilers # endif # elif defined( __WATCOMC__ ) # define VOID_RETURN void __cdecl # define INT_RETURN int __cdecl # else # define VOID_RETURN void # define INT_RETURN int # endif #endif /* These defines are used to declare buffers in a way that allows faster operations on longer variables to be used. In all these defines 'size' must be a power of 2 and >= 8 dec_unit_type(size,x) declares a variable 'x' of length 'size' bits dec_bufr_type(size,bsize,x) declares a buffer 'x' of length 'bsize' bytes defined as an array of variables each of 'size' bits (bsize must be a multiple of size / 8) ptr_cast(x,size) casts a pointer to a pointer to a varaiable of length 'size' bits */ #define ui_type(size) uint_##size##t #define dec_unit_type(size,x) typedef ui_type(size) x #define dec_bufr_type(size,bsize,x) typedef ui_type(size) x[bsize / (size >> 3)] #define ptr_cast(x,size) ((ui_type(size)*)(x)) #if defined(__cplusplus) } #endif #endif tf-random-0.5/cbits/threefish.h0000644000000000000000000001307312321250670014673 0ustar0000000000000000#ifndef _THREEFISH_H_ #define _THREEFISH_H_ 1 /*********************************************************************** ** ** Interface declarations and internal definitions for the Threefish-256 ** cipher. ** ** Copyright (c) 2012, Michał Pałka ** 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. ** * The names of the authors may not 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 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. ** ** ** This code is extracted, with some simplifications, from the Skein ** team submission for the NIST SHA-3 competition. Original authorship is ** stated below. ** ** *************************************************************************** ** ** Interface declarations and internal definitions for Skein hashing. ** ** Source code author: Doug Whiting, 2008. ** ** This algorithm and source code is released to the public domain. ** *************************************************************************** ** ** The following compile-time switches may be defined to control some ** tradeoffs between speed, code size, error checking, and security. ** ** The "default" note explains what happens when the switch is not defined. ** ** SKEIN_DEBUG -- make callouts from inside Skein code ** to examine/display intermediate values. ** [default: no callouts (no overhead)] ** ** SKEIN_ERR_CHECK -- how error checking is handled inside Skein ** code. If not defined, most error checking ** is disabled (for performance). Otherwise, ** the switch value is interpreted as: ** 0: use assert() to flag errors ** 1: return SKEIN_FAIL to flag errors ** ***************************************************************************/ #ifdef __cplusplus extern "C" { #endif #include /* get size_t definition */ #include "threefish_port.h" /* get platform-specific definitions */ #define SKEIN_MODIFIER_WORDS ( 2) /* number of modifier (tweak) words */ #define SKEIN_256_STATE_WORDS ( 4) #define SKEIN_256_STATE_BYTES ( 8*SKEIN_256_STATE_WORDS) #define SKEIN_256_STATE_BITS (64*SKEIN_256_STATE_WORDS) #define SKEIN_256_BLOCK_BYTES ( 8*SKEIN_256_STATE_WORDS) #define SKEIN_MK_64(hi32,lo32) ((lo32) + (((u64b_t) (hi32)) << 32)) #define SKEIN_KS_PARITY SKEIN_MK_64(0x1BD11BDA,0xA9FC1A22) /***************************************************************** ** "Internal" Skein definitions for debugging and error checking ******************************************************************/ #ifdef SKEIN_DEBUG /* examine/display intermediate values? */ #include "skein_debug.h" #else /* default is no callouts */ #define Skein_Show_Block(bits,ctx,X,blkPtr,wPtr,ksEvenPtr,ksOddPtr) #define Skein_Show_Round(bits,ctx,r,X) #define Skein_Show_R_Ptr(bits,ctx,r,X_ptr) #define Skein_Show_Final(bits,ctx,cnt,outPtr) #define Skein_Show_Key(bits,ctx,key,keyBytes) #endif #ifndef SKEIN_ERR_CHECK /* run-time checks (e.g., bad params, uninitialized context)? */ #define Skein_Assert(x,retCode)/* default: ignore all Asserts, for performance */ #define Skein_assert(x) #elif defined(SKEIN_ASSERT) #include #define Skein_Assert(x,retCode) assert(x) #define Skein_assert(x) assert(x) #else #include #define Skein_Assert(x,retCode) { if (!(x)) return retCode; } /* caller error */ #define Skein_assert(x) assert(x) /* internal error */ #endif enum { /* Threefish_256 round rotation constants */ R_256_0_0=14, R_256_0_1=16, R_256_1_0=52, R_256_1_1=57, R_256_2_0=23, R_256_2_1=40, R_256_3_0= 5, R_256_3_1=37, R_256_4_0=25, R_256_4_1=33, R_256_5_0=46, R_256_5_1=12, R_256_6_0=58, R_256_6_1=22, R_256_7_0=32, R_256_7_1=32, }; #ifndef SKEIN_ROUNDS #define SKEIN_256_ROUNDS_TOTAL (72) /* number of rounds for the different block sizes */ #else /* allow command-line define in range 8*(5..14) */ #define SKEIN_256_ROUNDS_TOTAL (8*((((SKEIN_ROUNDS/100) + 5) % 10) + 5)) #endif #ifdef __cplusplus } #endif #endif /* ifndef _SKEIN_H_ */ tf-random-0.5/cbits/threefish_block.c0000644000000000000000000002506412321250670016043 0ustar0000000000000000/*********************************************************************** ** ** Implementation of the Threefish-256 block cipher. ** ** Copyright (c) 2012, Michał Pałka ** 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. ** * The names of the authors may not 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 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. ** ** ** This code is extracted, with some simplifications, from the Skein ** team submission for the NIST SHA-3 competition. Original authorship is ** stated below. ** ** ************************************************************************ ** ** Implementation of the Skein block functions. ** ** Source code author: Doug Whiting, 2008. ** ** This algorithm and source code is released to the public domain. ** ************************************************************************/ #include #include "threefish.h" #ifndef SKEIN_LOOP #define SKEIN_LOOP 001 /* default: unroll 256 and 512, but not 1024 */ #endif #define BLK_BITS (WCNT*64) /* some useful definitions for code here */ #define KW_TWK_BASE (0) #define KW_KEY_BASE (3) #define ks (kw + KW_KEY_BASE) #define ts (kw + KW_TWK_BASE) #ifdef SKEIN_DEBUG #define DebugSaveTweak(ctx) { ctx->h.T[0] = ts[0]; ctx->h.T[1] = ts[1]; } #else #define DebugSaveTweak(ctx) #endif void Threefish_256_Process_Block(const u08b_t *keyPtr, const u08b_t *blkPtr, u08b_t *cryptPtr, int w32out); /* keyPtr, blkPtr and cryptPtr are all arrays of 4 64-bit unsingned ints in host-endian * format, unless the w32out argument is non-zero, in which case cryptPtr is an array of * 8 32-bit unsigned ints in host endian format. cryptPtr is the output array. The function * runs the cipher on one block only and ignores the tweak (tweak values are all 0). */ void Threefish_256_Process_Block(const u08b_t *keyPtr, const u08b_t *blkPtr, u08b_t *cryptPtr, int w32out) { /* do it in C */ enum { WCNT = SKEIN_256_STATE_WORDS }; #undef RCNT #define RCNT (SKEIN_256_ROUNDS_TOTAL/8) #ifdef SKEIN_LOOP /* configure how much to unroll the loop */ #define SKEIN_UNROLL_256 (((SKEIN_LOOP)/100)%10) #else #define SKEIN_UNROLL_256 (0) #endif #if SKEIN_UNROLL_256 #if (RCNT % SKEIN_UNROLL_256) #error "Invalid SKEIN_UNROLL_256" /* sanity check on unroll count */ #endif size_t r; u64b_t kw[WCNT+4+RCNT*2]; /* key schedule words : chaining vars + tweak + "rotation"*/ #else u64b_t kw[WCNT+4]; /* key schedule words : chaining vars + tweak */ #endif u64b_t X0,X1,X2,X3; /* local copy of context vars, for speed */ u64b_t w [WCNT]; /* local copy of input block */ #ifdef SKEIN_DEBUG const u64b_t *Xptr[4]; /* use for debugging (help compiler put Xn in registers) */ Xptr[0] = &X0; Xptr[1] = &X1; Xptr[2] = &X2; Xptr[3] = &X3; #endif /*Skein_assert(blkCnt != 0);*/ /* never call with blkCnt == 0! */ /* This is just adding the tweak ts[0] = ctx->h.T[0]; ts[1] = ctx->h.T[1];*/ /* Unnatural shift because of a removed loop */ /* this implementation only supports 2**64 input bytes (no carry out here) */ /*ts[0] += byteCntAdd; another tweak? */ /* update processed length */ /* precompute the key schedule for this block */ /* get the key in little-endian format */ /*Skein_Get64_LSB_First(ks,keyPtr,4); */ ks[0] = ((u64b_t *) keyPtr)[0]; ks[1] = ((u64b_t *) (keyPtr + 8))[0]; ks[2] = ((u64b_t *) (keyPtr + 16))[0]; ks[3] = ((u64b_t *) (keyPtr + 24))[0]; /*ks[0] = ctx->X[0]; ks[1] = ctx->X[1]; ks[2] = ctx->X[2]; ks[3] = ctx->X[3];*/ ks[4] = ks[0] ^ ks[1] ^ ks[2] ^ ks[3] ^ SKEIN_KS_PARITY; /*ts[2] = ts[0] ^ ts[1]*/; ts[0] = 0; ts[1] = 0; ts[2] = 0; /*Skein_Get64_LSB_First(w,blkPtr,WCNT);*/ /* get input block in little-endian format */ w[0] = ((u64b_t *) blkPtr)[0]; w[1] = ((u64b_t *) (blkPtr + 8))[0]; w[2] = ((u64b_t *) (blkPtr + 16))[0]; w[3] = ((u64b_t *) (blkPtr + 24))[0]; DebugSaveTweak(ctx); Skein_Show_Block(BLK_BITS,&ctx->h,ctx->X,blkPtr,w,ks,ts); X0 = w[0] + ks[0]; /* do the first full key injection */ X1 = w[1] + ks[1] + ts[0]; X2 = w[2] + ks[2] + ts[1]; X3 = w[3] + ks[3]; Skein_Show_R_Ptr(BLK_BITS,&ctx->h,SKEIN_RND_KEY_INITIAL,Xptr); /* show starting state values */ /*blkPtr += SKEIN_256_BLOCK_BYTES;*/ /* run the rounds */ #define Round256(p0,p1,p2,p3,ROT,rNum) \ X##p0 += X##p1; X##p1 = RotL_64(X##p1,ROT##_0); X##p1 ^= X##p0; \ X##p2 += X##p3; X##p3 = RotL_64(X##p3,ROT##_1); X##p3 ^= X##p2; \ #if SKEIN_UNROLL_256 == 0 #define R256(p0,p1,p2,p3,ROT,rNum) /* fully unrolled */ \ Round256(p0,p1,p2,p3,ROT,rNum) \ Skein_Show_R_Ptr(BLK_BITS,&ctx->h,rNum,Xptr); #define I256(R) \ X0 += ks[((R)+1) % 5]; /* inject the key schedule value */ \ X1 += ks[((R)+2) % 5] + ts[((R)+1) % 3]; \ X2 += ks[((R)+3) % 5] + ts[((R)+2) % 3]; \ X3 += ks[((R)+4) % 5] + (R)+1; \ Skein_Show_R_Ptr(BLK_BITS,&ctx->h,SKEIN_RND_KEY_INJECT,Xptr); #else /* looping version */ #define R256(p0,p1,p2,p3,ROT,rNum) \ Round256(p0,p1,p2,p3,ROT,rNum) \ Skein_Show_R_Ptr(BLK_BITS,&ctx->h,4*(r-1)+rNum,Xptr); #define I256(R) \ X0 += ks[r+(R)+0]; /* inject the key schedule value */ \ X1 += ks[r+(R)+1] + ts[r+(R)+0]; \ X2 += ks[r+(R)+2] + ts[r+(R)+1]; \ X3 += ks[r+(R)+3] + r+(R) ; \ ks[r + (R)+4 ] = ks[r+(R)-1]; /* rotate key schedule */\ ts[r + (R)+2 ] = ts[r+(R)-1]; \ Skein_Show_R_Ptr(BLK_BITS,&ctx->h,SKEIN_RND_KEY_INJECT,Xptr); for (r=1;r < 2*RCNT;r+=2*SKEIN_UNROLL_256) /* loop thru it */ #endif { #define R256_8_rounds(R) \ R256(0,1,2,3,R_256_0,8*(R) + 1); \ R256(0,3,2,1,R_256_1,8*(R) + 2); \ R256(0,1,2,3,R_256_2,8*(R) + 3); \ R256(0,3,2,1,R_256_3,8*(R) + 4); \ I256(2*(R)); \ R256(0,1,2,3,R_256_4,8*(R) + 5); \ R256(0,3,2,1,R_256_5,8*(R) + 6); \ R256(0,1,2,3,R_256_6,8*(R) + 7); \ R256(0,3,2,1,R_256_7,8*(R) + 8); \ I256(2*(R)+1); R256_8_rounds( 0); #define R256_Unroll_R(NN) ((SKEIN_UNROLL_256 == 0 && SKEIN_256_ROUNDS_TOTAL/8 > (NN)) || (SKEIN_UNROLL_256 > (NN))) #if R256_Unroll_R( 1) R256_8_rounds( 1); #endif #if R256_Unroll_R( 2) R256_8_rounds( 2); #endif #if R256_Unroll_R( 3) R256_8_rounds( 3); #endif #if R256_Unroll_R( 4) R256_8_rounds( 4); #endif #if R256_Unroll_R( 5) R256_8_rounds( 5); #endif #if R256_Unroll_R( 6) R256_8_rounds( 6); #endif #if R256_Unroll_R( 7) R256_8_rounds( 7); #endif #if R256_Unroll_R( 8) R256_8_rounds( 8); #endif #if R256_Unroll_R( 9) R256_8_rounds( 9); #endif #if R256_Unroll_R(10) R256_8_rounds(10); #endif #if R256_Unroll_R(11) R256_8_rounds(11); #endif #if R256_Unroll_R(12) R256_8_rounds(12); #endif #if R256_Unroll_R(13) R256_8_rounds(13); #endif #if R256_Unroll_R(14) R256_8_rounds(14); #endif #if (SKEIN_UNROLL_256 > 14) #error "need more unrolling in Skein_256_Process_Block" #endif } /* do the final "feedforward" xor, update context chaining vars */ /*ctx->X[0] = X0 ^ w[0]; ctx->X[1] = X1 ^ w[1]; ctx->X[2] = X2 ^ w[2]; ctx->X[3] = X3 ^ w[3];*/ if (w32out) { ((u32b_t *) cryptPtr) [0] = X0 >> 32; ((u32b_t *) (cryptPtr + 4)) [0] = X0; ((u32b_t *) (cryptPtr + 8)) [0] = X1 >> 32; ((u32b_t *) (cryptPtr + 12))[0] = X1; ((u32b_t *) (cryptPtr + 16))[0] = X2 >> 32; ((u32b_t *) (cryptPtr + 20))[0] = X2; ((u32b_t *) (cryptPtr + 24))[0] = X3 >> 32; ((u32b_t *) (cryptPtr + 28))[0] = X3; } else { ((u64b_t *) cryptPtr) [0] = X0; ((u64b_t *) (cryptPtr + 8)) [0] = X1; ((u64b_t *) (cryptPtr + 16))[0] = X2; ((u64b_t *) (cryptPtr + 24))[0] = X3; } Skein_Show_Round(BLK_BITS,&ctx->h,SKEIN_RND_FEED_FWD,ctx->X); /*ts[1] &= ~SKEIN_T1_FLAG_FIRST;*/ } #if defined(SKEIN_CODE_SIZE) || defined(SKEIN_PERF) size_t Threefish_256_Process_Block_CodeSize(void) { return ((u08b_t *) Threefish_256_Process_Block_CodeSize) - ((u08b_t *) Threefish_256_Process_Block_Block); } uint_t Threefish_256_Unroll_Cnt(void) { return SKEIN_UNROLL_256; } #endif