tf-random (empty) → 0.1
raw patch · 15 files changed
+1650/−0 lines, 15 filesdep +basedep +primitivedep +randomsetup-changed
Dependencies added: base, primitive, random, time
Files
- LICENSE +30/−0
- LICENSE.brg +27/−0
- LICENSE.tf +5/−0
- Setup.hs +2/−0
- cbits/brg_types.h +188/−0
- cbits/skein_debug.c +247/−0
- cbits/skein_debug.h +48/−0
- cbits/threefish.h +141/−0
- cbits/threefish_block.c +278/−0
- cbits/threefish_port.h +29/−0
- src/System/Random/TF.hs +24/−0
- src/System/Random/TF/Gen.hs +252/−0
- src/System/Random/TF/Init.hs +56/−0
- src/System/Random/TF/Instances.hs +230/−0
- tf-random.cabal +93/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ LICENSE.brg view
@@ -0,0 +1,27 @@+ 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.+
+ LICENSE.tf view
@@ -0,0 +1,5 @@++ Source code author: Doug Whiting, 2008.++ This algorithm and source code is released to the public domain.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/brg_types.h view
@@ -0,0 +1,188 @@+/*+ ---------------------------------------------------------------------------+ 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_<nn>t where+ <nn> 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<nn>_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 <limits.h>++#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
+ cbits/skein_debug.c view
@@ -0,0 +1,247 @@+/***********************************************************************+**+** Debug output functions for Skein hashing.+**+** Source code author: Doug Whiting, 2008.+**+** This algorithm and source code is released to the public domain.+**+************************************************************************/+#include <stdio.h>++#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;j<bits/64;j++)+ p[j] = X[perm[j]];+ Show64(bits/64,p);+ }+ else+ {+ printf("\n%s [state after round %2d]=\n",AlgoHeader(bits),(int)r);+ Show64(bits/64,X);+ }+ }+ }+ }++/* show state after a round (or "pseudo-round"), given a list of pointers */+void Skein_Show_R_Ptr(uint_t bits,const Skein_Ctxt_Hdr_t *h,size_t r,const u64b_t *X_ptr[])+ {+ uint_t i;+ u64b_t X[SKEIN_MAX_STATE_WORDS];++ for (i=0;i<bits/64;i++) /* copy over the words */ + X[i] = X_ptr[i][0];+ Skein_Show_Round(bits,h,r,X);+ }+++/* show the state at the start of a block */+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)+ {+ uint_t n;+ if (skein_DebugFlag & SKEIN_DEBUG_CONFIG || ((h->T[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
+ cbits/skein_debug.h view
@@ -0,0 +1,48 @@+#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_ */
+ cbits/threefish.h view
@@ -0,0 +1,141 @@+#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 <COPYRIGHT HOLDER> 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 <stddef.h> /* 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 <assert.h> +#define Skein_Assert(x,retCode) assert(x) +#define Skein_assert(x) assert(x) +#else+#include <assert.h> +#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_ */
+ cbits/threefish_block.c view
@@ -0,0 +1,278 @@+/***********************************************************************+**+** 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 <COPYRIGHT HOLDER> 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 <string.h>+#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+
+ cbits/threefish_port.h view
@@ -0,0 +1,29 @@+#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
+ src/System/Random/TF.hs view
@@ -0,0 +1,24 @@+-- |+-- 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+
+ src/System/Random/TF/Gen.hs view
@@ -0,0 +1,252 @@+{-# Language 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 ( unsafeDupablePerformIO )++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++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+
+ src/System/Random/TF/Init.hs view
@@ -0,0 +1,56 @@+-- 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+ where++import Control.Monad (when)++--import Data.Int+import Data.Word++import Foreign++import Data.Ratio (numerator, denominator)+import Data.Time+import System.CPUTime+import System.IO++-- | 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)+
+ src/System/Random/TF/Instances.hs view
@@ -0,0 +1,230 @@+{-# Language 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 (..)) where++import Data.Bits+import Data.Int+import Data.Word++import System.Random.TF.Gen++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.+{-# 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
+ tf-random.cabal view
@@ -0,0 +1,93 @@+-- 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.1++-- 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 (<https://www.schneier.com/skein.html>), 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 <michal.palka@chalmers.se>++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer: Michał Pałka <michal.palka@chalmers.se>++-- 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:+ 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.5 && < 5,+ primitive >= 0.3,+ random >= 1.0.1.1,+ time+