Twofish 0.2 → 0.3
raw patch · 5 files changed
+278/−146 lines, 5 filesdep +binarydep +bytestringdep +cerealdep −Cryptodep ~HUnitdep ~array
Dependencies added: binary, bytestring, cereal, crypto-api, largeword, tagged
Dependencies removed: Crypto
Dependency ranges changed: HUnit, array
Files
- Codec/Encryption/Twofish.hs +70/−9
- Data/Bitlib.hs +30/−0
- Data/Cipher.hs +0/−70
- Test.hs +139/−29
- Twofish.cabal +39/−38
Codec/Encryption/Twofish.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} -- Module : Codec.Encryption.Twofish--- Copyright : (c) Ron Leisti 2010+-- Copyright : (c) Ron Leisti 2010-2012 -- License : BSD3 -- Maintainer : ron.leisti@gmail.com @@ -26,16 +26,31 @@ -- * Functions ,mkStdCipher ,mkCipher- -- * Curiosities+ ,encrypt+ ,decrypt+ -- * Utility functions+ ,mkS+ ,mkfH+ ,mkK+ ,mkG+ ,encryptRounds ,q0o ,q1o ) where +import Crypto.Classes import Data.Array.Unboxed hiding (index)+import Data.Binary+import qualified Data.Binary.Get as BinaryGet+import qualified Data.Binary.Put as BinaryPut+import Data.Bitlib as Bitlib import Data.Bits-import Data.Cipher+import qualified Data.ByteString as ByteString import Data.LargeWord-import Data.Word+import Data.Serialize+import qualified Data.Serialize.Get as SerializeGet+import Data.Serialize.Put as SerializePut+import Data.Tagged import Prelude hiding (length, drop, reverse, take) import qualified Prelude as P @@ -57,18 +72,64 @@ instance Key Word256 -- |A keyed Twofish cipher capable of both encryption and decryption.-data TwofishCipher = C { eb :: Block -> Block, db :: Block -> Block }+data TwofishCipher = C { eb :: Block -> Block,+ db :: Block -> Block } --- |Twofish is a 128 bit block cipher.-instance Cipher Word128 TwofishCipher where- encrypt c = liftCryptor (eb c)- decrypt c = liftCryptor (db c)+encrypt :: TwofishCipher -> Word128 -> Word128+encrypt = liftCryptor . eb +decrypt :: TwofishCipher -> Word128 -> Word128+decrypt = liftCryptor . db+ -- |Lift a crytographic transformation of a block into a -- transformation of a byte vector. liftCryptor :: (Block -> Block) -> Word128 -> Word128 liftCryptor c = deBlock . c . mkBlock +data TwofishKey = TwofishKey { twofishKeyCipher :: TwofishCipher+ ,twofishKeyContent :: Word256+ }++instance (Binary TwofishKey) where+ put = BinaryPut.putByteString . ByteString.pack . Bitlib.unpack . twofishKeyContent+ get = do bytes <- BinaryGet.getBytes 32+ let key = Bitlib.pack . ByteString.unpack $ bytes+ let twofishKey = TwofishKey { twofishKeyCipher = mkStdCipher key+ ,twofishKeyContent = key+ } + return twofishKey ++instance (Serialize TwofishKey) where+ put = SerializePut.putByteString . ByteString.pack . Bitlib.unpack . twofishKeyContent+ get = do bytes <- SerializeGet.getBytes 32+ let key = Bitlib.pack . ByteString.unpack $ bytes+ let twofishKey = TwofishKey { twofishKeyCipher = mkStdCipher key+ ,twofishKeyContent = key+ } + return twofishKey ++instance (BlockCipher TwofishKey) where+ blockSize = Tagged 128+ encryptBlock k s = let bytes = ByteString.unpack s+ ws = Bitlib.packMany (0 :: Word128) bytes+ blocks = map mkBlock ws+ cryptBlocks = map (eb (twofishKeyCipher k)) blocks+ cryptWords = map deBlock cryptBlocks+ cryptBytes = unpackMany cryptWords+ in ByteString.pack cryptBytes+ decryptBlock k s = let cryptBytes = ByteString.unpack s+ cryptWords = Bitlib.packMany (0 :: Word128) cryptBytes+ cryptBlocks = map mkBlock cryptWords+ blocks = map (db (twofishKeyCipher k)) cryptBlocks+ ws = map deBlock blocks+ bytes = unpackMany ws+ in ByteString.pack bytes+ keyLength = unTagged 256+ buildKey s = let word = Bitlib.pack (ByteString.unpack s) :: Word256+ in Just TwofishKey { twofishKeyCipher = mkStdCipher word+ ,twofishKeyContent = word+ }+ -- |A 128 bit data block, decomposed into four words type Block = (Word32, Word32, Word32, Word32)
+ Data/Bitlib.hs view
@@ -0,0 +1,30 @@+module Data.Bitlib (+ pack+ ,packMany+ ,unpack+ ,unpackMany+) where++import Data.Bits++pack :: (Integral a, Bits a, Bits b) => [a] -> b+pack [] = fromInteger 0+pack (x:[]) = fromIntegral x+pack (x:xs) = (fromIntegral x) .|. ((pack xs) `shiftL` (bitSize x))++unpack :: (Integral a, Bits a, Bits b) => a -> [b]+unpack = doUnpack 0+ where doUnpack :: (Integral a, Bits a, Bits b) => Int -> a -> [b]+ doUnpack n x+ | n == bitSize x = []+ | otherwise = (fromIntegral (x .&. 0xFF)) : doUnpack (n + 8) (x `shiftR` 8)++packMany :: (Integral a, Bits a, Num b, Integral b, Bits b) => b -> [a] -> [b]+packMany _ [] = []+packMany zero xs@(x:_) =+ let ct = (bitSize zero) `div` (bitSize x)+ in pack (take ct xs) : packMany zero (drop ct xs)++unpackMany :: (Integral a, Bits a, Bits b) => [a] -> [b]+unpackMany [] = []+unpackMany (x:xs) = concat [(unpack x), (unpackMany xs)]
− Data/Cipher.hs
@@ -1,70 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies,- GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}---- | This module provides support for block ciphers-module Data.Cipher- (- -- * Classes- Cipher(encrypt, decrypt)- ,MonadCbc- -- * Types- ,Cbc- ,CbcT- -- * Functions- ,evalCbc- ,evalCbcT- ,cbcEncrypt- ,cbcDecrypt- ) where--import Control.Monad.State-import Data.Bits---- |Contains the result of an operation in the context of--- cipher-block-chaining mode.-newtype Cbc c iv a = Cbc (State (c, iv) a)- deriving (Monad, Functor)---- |CbcT is the monad transformer version of Cbc-newtype CbcT c iv m a = CbcT (StateT (c, iv) m a)- deriving (Monad, Functor, MonadTrans)---- |Evaluates a cipher-block-chaining-mode operation, given--- a cipher and an initialization vector (IV).-evalCbc :: Cbc c w a -> c -> w -> a-evalCbc (Cbc s) c iv = evalState s (c, iv) ---- |This is the monad tranformer version of evalCbc-evalCbcT :: (Monad m) => CbcT c w m a -> c -> w -> m a-evalCbcT (CbcT s) c iv = evalStateT s (c, iv)---- | A cipher-class (Bits w) => Cipher w c | c -> w where- encrypt :: c -> w -> w- decrypt :: c -> w -> w---- | Any monad that contains the result of an operation in the--- context of cipher-block-chaining mode.-class (Bits w, Cipher w c, MonadState (c, w) s) => MonadCbc c w s m | m -> c, m -> w, m -> s where- monadCbc :: s w -> m w--instance (Bits w, Cipher w c) => MonadCbc c w (State (c, w)) (Cbc c w) where- monadCbc = Cbc--instance (Bits w, Cipher w c, Monad m) => MonadCbc c w (StateT (c, w) m) (CbcT c w m) where- monadCbc = CbcT---- |This is the fundamental cipher-block-chaining encryption protocol-cbcEncrypt :: (MonadCbc c w s m) => w -> m w -cbcEncrypt w = monadCbc $ do (c, iv) <- get- let w' = encrypt c (w `xor` iv)- put (c, w')- return w'---- |This is the fundamental cipher-block-chaining decryption protocol-cbcDecrypt :: (MonadCbc c w s m) => w -> m w-cbcDecrypt w = monadCbc $ do (c, iv) <- get- let w' = decrypt c w `xor` iv- put (c, w)- return w'-
Test.hs view
@@ -1,42 +1,152 @@+-- Module : Main+-- Copyright : (c) Ron Leisti 2010-2012+-- License : BSD3+-- Maintainer : ron.leisti@gmail.com+--+-- |Various tests for the Twofish cipher, taken from the+-- Twofish paper.+-- <http://www.counterpane.com/twofish.html>+-- module Main(main) where +import Data.Array.Unboxed import Data.Bits-import Data.Cipher import Data.LargeWord import Codec.Encryption.Twofish+import System.Exit (exitSuccess, exitFailure) import Test.HUnit+import Text.Printf +-- |A test, including intermediate steps, of 192-bit encryption.+test192_single_encrypt =+ let key = fromIntegral+ 0x77665544332211001032547698BADCFEEFCDAB8967452301 :: Word192+ s = mkS key+ h = mkfH key+ k = mkK key 16 h+ g = mkG h s+ p0 = 0 `xor` k 0+ p1 = 0 `xor` k 1+ p2 = 0 `xor` k 2+ p3 = 0 `xor` k 3+ testRound :: (Integral a) => Int -> a -> a -> Assertion+ testRound n block0 block1 =+ let (r0, r1, r2, r3) = encryptRounds g k n (p0, p1, p2, p3)+ in do+ assertEqualHex (printf "Round %d word 0" n :: String)+ block0+ r0+ assertEqualHex (printf "Round %d word 1" n :: String)+ block1+ r1+ in TestCase $ do+ assertEqualHex "s 0 must match" 0x45661061 (s ! 0)+ assertEqualHex "s 1 must match" 0xb255bc4b (s ! 1)+ assertEqualHex "s 2 must match" 0xb89ff6f2 (s ! 2)+ assertEqualHex "k 0 must match" 0x38394A24 (k 0)+ assertEqualHex "k 1 must match" 0xc36d1175 (k 1)+ assertEqualHex "k 2 must match" 0xe802528f (k 2)+ assertEqualHex "k 3 must match" 0x219bfeb4 (k 3)+ assertEqualHex "k 4 must match" 0xb9141ab4 (k 4)+ assertEqualHex "k 5 must match" 0xbd3e70cd (k 5)+ assertEqualHex "k 6 must match" 0xaf609383 (k 6)+ assertEqualHex "k 7 must match" 0xfd36908a (k 7)+ testRound 1 0x9c263d67 0x5e68be8f+ testRound 2 0xc8f5099f 0x0c4b8f53+ testRound 3 0x69948f5e 0xe67c030f+ testRound 16 0x17738cd3 0xb5142d18+ let (f0, f1, f2, f3) = encryptRounds g k 16 (p0, p1, p2, p3)+ let c0 = f2 `xor` k 4+ c1 = f3 `xor` k 5+ c2 = f0 `xor` k 6+ c3 = f1 `xor` k 7+ assertEqualHex "c0 must match" 0xe5d2d1cf c0+ assertEqualHex "c1 must match" 0xdf9cbea9 c1+ assertEqualHex "c2 must match" 0xb8131f50 c2+ assertEqualHex "c3 must match" 0x4822bd92 c3+ assertEqualHex "final result must match"+ 0x4822bd92b8131f50df9cbea9e5d2d1cf+ $ encrypt (mkStdCipher key) (fromIntegral 0) -tfTest128 :: Test-tfTest128 = tfTest (\k b -> b) - (0 :: Word128)- (0x21f9527982aa147e98c63345a524a7bc :: Word128)- 48+-- | Encryption test with multiple iterations using a 128 bit key.+test128_iterative_encrypt :: Test+test128_iterative_encrypt =+ let key = fromIntegral 0 :: Word128+ block = fromIntegral 0 :: Word128+ run key block n+ | n > 0 = let c = encrypt (mkStdCipher key) block+ in run block c (n - 1)+ | otherwise = block+ testIteration :: Int -> Word128 -> Assertion+ testIteration iteration expected =+ assertEqualHex msg expected (run key block iteration)+ where msg = printf "128 bit encryption iteration %d" iteration :: String+ in TestCase $ do+ testIteration 47 0x21f9527982aa147e98c63345a524a7bc -tfTest192 :: Test-tfTest192 = tfTest (\k b -> fromIntegral b .|. (k `shiftL` 128))- (0 :: Word192)- (0x4109640a86bd90a3f4f9ee2b214954e7 :: Word128)- 50 +-- | Encryption test with multiple iterations using a 192 bit key.+test192_iterative_encrypt :: Test+test192_iterative_encrypt =+ let key = fromIntegral 0 :: Word192+ block = fromIntegral 0 :: Word128+ run key block n+ | n > 0 = let c = encrypt (mkStdCipher key) block+ block' = fromIntegral block :: Integer+ key' = fromIntegral key :: Integer+ key'' = (key' `shiftL` 128) .|. block'+ key''' = fromIntegral key''+ in run key''' c (n - 1)+ | otherwise = block+ testIteration :: Int -> Word128 -> Assertion+ testIteration iteration expected =+ assertEqualHex msg expected (run key block iteration)+ where msg = printf "192 bit encryption iteration %d" iteration :: String+ in TestCase $ do+ testIteration 1 0x0191c18f1760f85344bd6589781fa7ef+ testIteration 2 0x881e1a736dbb46b4365e106b70b2b288+ testIteration 3 0xb241a33c07dcb685d59749bad669da39+ testIteration 4 0x653a1929dcacdaf945ea9714d8022b18+ testIteration 9 0x78fc631263bd71350750c5987bd63f89+ testIteration 10 0x678f8e57b50087d5631a84c8c94f4316+ testIteration 48 0xb676fb8553be70ef21fa25113073abf0+ testIteration 49 0x4109640a86bd90a3f4f9ee2b214954e7 -tfTest256 :: Test-tfTest256 = tfTest (\k b -> fromIntegral b .|. (k `shiftL` 128))- (0 :: Word256)- 0x05a2973bc3f4ddf57561f61cff26fe37- 50+-- | Encryption test with multiple iterations using a 256 bit key.+test256_iterative_encrypt :: Test+test256_iterative_encrypt =+ let key = fromIntegral 0 :: Word256+ block = fromIntegral 0 :: Word128+ run key block n+ | n > 0 = let c = encrypt (mkStdCipher key) block+ block' = fromIntegral block :: Integer+ key' = fromIntegral key :: Integer+ key'' = (key' `shiftL` 128) .|. block'+ key''' = fromIntegral key''+ in run key''' c (n - 1)+ | otherwise = block + testIteration :: Int -> Word128 -> Assertion+ testIteration iteration expected =+ assertEqualHex msg expected (run key block iteration)+ where msg = printf "256 bit encryption iteration %d" iteration :: String+ in TestCase $ do+ testIteration 49 0x05a2973bc3f4ddf57561f61cff26fe37 --- |Test Twofish using the given test vectors in the Twofish--- paper: a 128/192/256 bit key consisting of all zeroes, an--- initial block consisting of all zeroes, and a known--- final cipher text after 48 rounds-tfTest :: (Key a) => (a -> Word128 -> a) -> a -> Word128 -> Int -> Test-tfTest f k o r = TestCase $ assertEqual ("Key Size: " ++ show (bitSize k))- o- $ run k 0 1- where run key block n- | n < r = let c = encrypt (mkStdCipher key) block- in run (f key block) c (n + 1)- | otherwise = block+-- | Asserts that two numeric values are equal, and if they are not,+-- reports the numbers using their hexidecimal representations.+assertEqualHex :: (Integral a, Integral b) => String -> a -> b -> Assertion+assertEqualHex message x y =+ let x' = printf "%x" (fromIntegral x :: Integer) :: String+ y' = printf "%x" (fromIntegral y :: Integer) :: String+ in assertEqual message x' y' -main = runTestTT $ TestList [tfTest128, tfTest192, tfTest256]+main =+ do+ result <- runTestTT $ TestList [test128_iterative_encrypt+ ,test192_single_encrypt+ ,test192_iterative_encrypt+ ,test256_iterative_encrypt]+ if (failures result > 0)+ then exitFailure+ else exitSuccess+
Twofish.cabal view
@@ -1,7 +1,6 @@ Name: Twofish-Version: 0.2+Version: 0.3 Category: Cryptography, Codec-Stability: experimental Synopsis: An implementation of the Twofish Symmetric-key cipher. Description: Implements the Twofish symmetric block cipher, designed by: Bruce Schneier, John Kelsey, Doug Whiting, David Wagner, Chris Hall,@@ -15,55 +14,57 @@ . Acknowledgments: .- Dominic Steinitz and Creighton Hogg for their work on the Crypto- package, upon which this package depends (particularily for the- Data.LargeWord module).+ Dominic Steinitz, Caylee Hogg and Thomas DuBuisson for their work+ on the Crypto package, upon which this package depends. . Stephen Tetley for his advice and code examples provided on the Haskell-Beginners mailing list in response to a question- I had, which helped me to create a transformer version of the Cbc monad.+ I had, which helped me to create a transformer version of the+ Cbc monad. (now deprecated in favor of the CBC definitions in+ crypto-api) Author: Ron Leisti Maintainer: ron.leisti@gmail.com Bug-Reports: mailto:ron.leisti@gmail.com-Homepage:+Homepage: http://github.com/rleisti/twofish License: BSD3 License-File: LICENSE-Cabal-Version: >= 1.2+Cabal-Version: >= 1.14 Build-Type: Simple -Tested-With: GHC == 6.12.1- Library- Build-Depends: array >= 0.3- ,base >= 4 && < 5- ,Crypto >= 4.2.1- ,HUnit >= 1.2.2.1- ,mtl >= 1.1.0.2- Exposed-Modules: Codec.Encryption.Twofish- ,Data.Cipher- Extensions: FlexibleContexts- ,FlexibleInstances - ,FunctionalDependencies- ,GeneralizedNewtypeDeriving- ,MultiParamTypeClasses- ,TypeSynonymInstances+ Build-Depends: array >= 0.4.0.0+ ,base >= 4 && < 5+ ,binary >= 0.5.1.0+ ,bytestring >= 0.9.2.1+ ,cereal >= 0.3.5.2+ ,crypto-api >= 0.10.2+ ,largeword >= 1.0.3+ ,mtl >= 1.1.0.2+ ,tagged >= 0.4.4+ Exposed-Modules: Codec.Encryption.Twofish+ ,Data.Bitlib+ other-extensions: FlexibleContexts+ ,FlexibleInstances + ,FunctionalDependencies+ ,GeneralizedNewtypeDeriving+ ,MultiParamTypeClasses+ ,TypeSynonymInstances Ghc-Options: -Wall+ Default-Language: Haskell2010 -Executable Test- Main-Is: Test.hs- Ghc-options: -fregs-graph- Other-Modules: Data.Cipher- Codec.Encryption.Twofish+Test-Suite Standard-Tests+ type: exitcode-stdio-1.0+ main-is: Test.hs+ build-depends: array >= 0.4.0.0+ ,base >= 4 && < 5+ ,binary >= 0.5.1.0+ ,bytestring >= 0.9.2.1+ ,cereal >= 0.3.5.2+ ,crypto-api >= 0.10.2+ ,HUnit >= 1.2.4.2+ ,largeword >= 1.0.3+ ,tagged >= 0.4.4+ Default-Language: Haskell2010 --- Commented, because I'm not sure about the ramifications--- of attempting to build an executable with profiling --- on a machine that doesn't have the required profiling --- libraries installed.------Executable CbcPerformance--- Main-Is: CbcPerformance.hs--- Ghc-options: -fregs-graph -prof -auto-all -O2--- Other-Modules: Data.Cipher--- Codec.Encryption.Twofish