diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/LICENSE.brg b/LICENSE.brg new file mode 100644 --- /dev/null +++ b/LICENSE.brg @@ -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. + diff --git a/LICENSE.tf b/LICENSE.tf new file mode 100644 --- /dev/null +++ b/LICENSE.tf @@ -0,0 +1,5 @@ + + Source code author: Doug Whiting, 2008. + + This algorithm and source code is released to the public domain. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/brg_types.h b/cbits/brg_types.h new file mode 100644 --- /dev/null +++ b/cbits/brg_types.h @@ -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_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 diff --git a/cbits/skein_debug.c b/cbits/skein_debug.c new file mode 100644 --- /dev/null +++ b/cbits/skein_debug.c @@ -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 + +#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 diff --git a/cbits/skein_debug.h b/cbits/skein_debug.h new file mode 100644 --- /dev/null +++ b/cbits/skein_debug.h @@ -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_ */ diff --git a/cbits/threefish.h b/cbits/threefish.h new file mode 100644 --- /dev/null +++ b/cbits/threefish.h @@ -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 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_ */ diff --git a/cbits/threefish_block.c b/cbits/threefish_block.c new file mode 100644 --- /dev/null +++ b/cbits/threefish_block.c @@ -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 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 + diff --git a/cbits/threefish_port.h b/cbits/threefish_port.h new file mode 100644 --- /dev/null +++ b/cbits/threefish_port.h @@ -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 diff --git a/src/System/Random/TF.hs b/src/System/Random/TF.hs new file mode 100644 --- /dev/null +++ b/src/System/Random/TF.hs @@ -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 + diff --git a/src/System/Random/TF/Gen.hs b/src/System/Random/TF/Gen.hs new file mode 100644 --- /dev/null +++ b/src/System/Random/TF/Gen.hs @@ -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 + diff --git a/src/System/Random/TF/Init.hs b/src/System/Random/TF/Init.hs new file mode 100644 --- /dev/null +++ b/src/System/Random/TF/Init.hs @@ -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) + diff --git a/src/System/Random/TF/Instances.hs b/src/System/Random/TF/Instances.hs new file mode 100644 --- /dev/null +++ b/src/System/Random/TF/Instances.hs @@ -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 diff --git a/tf-random.cabal b/tf-random.cabal new file mode 100644 --- /dev/null +++ b/tf-random.cabal @@ -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 (), 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: + 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 +