cipher-des-0.0.6/0000755000000000000000000000000012232141256011724 5ustar0000000000000000cipher-des-0.0.6/LICENSE0000644000000000000000000000272212232141256012734 0ustar0000000000000000Copyright (c) 2013 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. cipher-des-0.0.6/cipher-des.cabal0000644000000000000000000000376112232141256014742 0ustar0000000000000000Name: cipher-des Version: 0.0.6 Description: DES and 3DES primitives License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: DES and 3DES primitives Category: Cryptography Build-Type: Simple Homepage: http://github.com/vincenthz/hs-crypto-cipher Cabal-Version: >=1.8 Library Build-Depends: base >= 4 && < 5 , bytestring , byteable , securemem >= 0.1.2 , crypto-cipher-types >= 0.0.3 && < 0.1 Exposed-modules: Crypto.Cipher.DES , Crypto.Cipher.TripleDES Other-modules: Crypto.Cipher.DES.Primitive , Crypto.Cipher.DES.Serialization ghc-options: -Wall -optc-O3 -fno-cse -fwarn-tabs if (arch(i386) || arch(x86_64)) CPP-options: -DARCH_IS_LITTLE_ENDIAN Test-Suite test-cipher-des type: exitcode-stdio-1.0 hs-source-dirs: Tests Main-Is: Tests.hs Build-depends: base >= 4 && < 5 , bytestring , QuickCheck >= 2 , test-framework >= 0.3.3 , test-framework-quickcheck2 >= 0.2.9 , byteable , crypto-cipher-types , crypto-cipher-tests , cipher-des Benchmark bench-cipher-des hs-source-dirs: Benchmarks Main-Is: Benchmarks.hs type: exitcode-stdio-1.0 Build-depends: base >= 4 && < 5 , bytestring , criterion , mtl , crypto-cipher-types , crypto-cipher-benchmarks , cipher-des source-repository head type: git location: git://github.com/vincenthz/hs-crypto-cipher subdir: cipher-des cipher-des-0.0.6/Setup.hs0000644000000000000000000000005612232141256013361 0ustar0000000000000000import Distribution.Simple main = defaultMain cipher-des-0.0.6/Benchmarks/0000755000000000000000000000000012232141256014001 5ustar0000000000000000cipher-des-0.0.6/Benchmarks/Benchmarks.hs0000644000000000000000000000050512232141256016412 0ustar0000000000000000import Crypto.Cipher.Benchmarks import Crypto.Cipher.DES (DES) import Crypto.Cipher.TripleDES main = defaultMain [GBlockCipher (undefined :: DES) ,GBlockCipher (undefined :: DES_EEE3) ,GBlockCipher (undefined :: DES_EDE3) ,GBlockCipher (undefined :: DES_EEE2) ,GBlockCipher (undefined :: DES_EDE2) ] cipher-des-0.0.6/Crypto/0000755000000000000000000000000012232141256013204 5ustar0000000000000000cipher-des-0.0.6/Crypto/Cipher/0000755000000000000000000000000012232141256014416 5ustar0000000000000000cipher-des-0.0.6/Crypto/Cipher/TripleDES.hs0000644000000000000000000000642512232141256016554 0ustar0000000000000000-- | -- Module : Crypto.Cipher.TripleDES -- License : BSD-style -- Stability : experimental -- Portability : ??? module Crypto.Cipher.TripleDES ( DES_EEE3 , DES_EDE3 , DES_EEE2 , DES_EDE2 ) where import Data.Word import Data.Byteable import qualified Data.ByteString as B import Crypto.Cipher.Types import Crypto.Cipher.DES.Primitive import Crypto.Cipher.DES.Serialization -- | 3DES with 3 different keys used all in the same direction data DES_EEE3 = DES_EEE3 Word64 Word64 Word64 deriving (Eq) -- | 3DES with 3 different keys used in alternative direction data DES_EDE3 = DES_EDE3 Word64 Word64 Word64 deriving (Eq) -- | 3DES where the first and third keys are equal, used in the same direction data DES_EEE2 = DES_EEE2 Word64 Word64 -- key1 and key3 are equal deriving (Eq) -- | 3DES where the first and third keys are equal, used in alternative direction data DES_EDE2 = DES_EDE2 Word64 Word64 -- key1 and key3 are equal deriving (Eq) instance Cipher DES_EEE3 where cipherName _ = "3DES_EEE" cipherKeySize _ = KeySizeFixed 24 cipherInit k = init3DES DES_EEE3 k instance Cipher DES_EDE3 where cipherName _ = "3DES_EDE" cipherKeySize _ = KeySizeFixed 24 cipherInit k = init3DES DES_EDE3 k instance Cipher DES_EDE2 where cipherName _ = "2DES_EDE" cipherKeySize _ = KeySizeFixed 16 cipherInit k = init2DES DES_EDE2 k instance Cipher DES_EEE2 where cipherName _ = "2DES_EEE" cipherKeySize _ = KeySizeFixed 16 cipherInit k = init2DES DES_EEE2 k instance BlockCipher DES_EEE3 where blockSize _ = 8 ecbEncrypt (DES_EEE3 k1 k2 k3) = unblockify . map (encrypt k3 . encrypt k2 . encrypt k1) . blockify ecbDecrypt (DES_EEE3 k1 k2 k3) = unblockify . map (decrypt k1 . decrypt k2 . decrypt k3) . blockify instance BlockCipher DES_EDE3 where blockSize _ = 8 ecbEncrypt (DES_EDE3 k1 k2 k3) = unblockify . map (encrypt k3 . decrypt k2 . encrypt k1) . blockify ecbDecrypt (DES_EDE3 k1 k2 k3) = unblockify . map (decrypt k1 . encrypt k2 . decrypt k3) . blockify instance BlockCipher DES_EEE2 where blockSize _ = 8 ecbEncrypt (DES_EEE2 k1 k2) = unblockify . map (encrypt k1 . encrypt k2 . encrypt k1) . blockify ecbDecrypt (DES_EEE2 k1 k2) = unblockify . map (decrypt k1 . decrypt k2 . decrypt k1) . blockify instance BlockCipher DES_EDE2 where blockSize _ = 8 ecbEncrypt (DES_EDE2 k1 k2) = unblockify . map (encrypt k1 . decrypt k2 . encrypt k1) . blockify ecbDecrypt (DES_EDE2 k1 k2) = unblockify . map (decrypt k1 . encrypt k2 . decrypt k1) . blockify init3DES :: Byteable b => (Word64 -> Word64 -> Word64 -> a) -> b -> a init3DES constr k | len == 24 = constr k1 k2 k3 | otherwise = error "3DES: not a valid key length (valid=24)" where len = byteableLength k (Block k1, Block k2, Block k3) = let (b1, k') = B.splitAt 8 (toBytes k) (b2, b3) = B.splitAt 8 k' in (toW64 b1, toW64 b2, toW64 b3) init2DES :: Byteable b => (Word64 -> Word64 -> a) -> b -> a init2DES constr k | len == 16 = constr k1 k2 | otherwise = error "2DES: not a valid key length (valid=16)" where len = byteableLength k (Block k1, Block k2) = let (b1, b2) = B.splitAt 8 (toBytes k) in (toW64 b1, toW64 b2) cipher-des-0.0.6/Crypto/Cipher/DES.hs0000644000000000000000000000164712232141256015375 0ustar0000000000000000-- | -- Module : Crypto.Cipher.DES -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : stable -- Portability : good -- module Crypto.Cipher.DES ( DES ) where import Data.Byteable import Data.Word import Crypto.Cipher.Types import Crypto.Cipher.DES.Primitive import Crypto.Cipher.DES.Serialization -- | DES Context data DES = DES Word64 deriving (Eq) instance Cipher DES where cipherName _ = "DES" cipherKeySize _ = KeySizeFixed 8 cipherInit k = initDES k instance BlockCipher DES where blockSize _ = 8 ecbEncrypt (DES key) = unblockify . map (encrypt key) . blockify ecbDecrypt (DES key) = unblockify . map (decrypt key) . blockify initDES :: Byteable b => b -> DES initDES k | len == 8 = DES key | otherwise = error "DES: not a valid key length (valid=8)" where len = byteableLength k (Block key) = toW64 $ toBytes k cipher-des-0.0.6/Crypto/Cipher/DES/0000755000000000000000000000000012232141256015031 5ustar0000000000000000cipher-des-0.0.6/Crypto/Cipher/DES/Serialization.hs0000644000000000000000000000540412232141256020205 0ustar0000000000000000-- | -- Module : Crypto.Cipher.DES.Serialization -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : stable -- Portability : good -- -- basic routine to convert between W64 and bytestring for DES. -- {-# LANGUAGE CPP #-} module Crypto.Cipher.DES.Serialization ( toW64 , toBS , blockify , unblockify ) where import qualified Data.ByteString as B import Crypto.Cipher.DES.Primitive (Block(..)) #ifdef ARCH_IS_LITTLE_ENDIAN import Data.Word (Word64) import Data.Byteable (withBytePtr) import qualified Data.ByteString.Internal as B (inlinePerformIO, unsafeCreate) import Foreign.Storable import Foreign.Ptr (castPtr, plusPtr, Ptr) import Data.Bits (shiftL, shiftR, (.|.), (.&.)) #else import Data.Bits (shiftL, shiftR, (.|.)) #endif #ifdef ARCH_IS_LITTLE_ENDIAN -- | convert a 8 byte bytestring big endian to a host one toW64 :: B.ByteString -> Block toW64 b = Block $ B.inlinePerformIO $ withBytePtr b $ \ptr -> (be64 `fmap` peek (castPtr ptr)) -- | convert a word64 to a bytestring in big endian format toBS :: Block -> B.ByteString toBS (Block w) = B.unsafeCreate 8 $ \ptr -> poke (castPtr ptr) (be64 w) -- | Create a strict bytestring out of DES blocks unblockify :: [Block] -> B.ByteString unblockify blocks = B.unsafeCreate (nbBlocks * 8) $ \initPtr -> pokeTo (castPtr initPtr) blocks where nbBlocks = length blocks pokeTo :: Ptr Word64 -> [Block] -> IO () pokeTo _ [] = return () pokeTo ptr (Block x:xs) = poke ptr (be64 x) >> pokeTo (ptr `plusPtr` 8) xs be64 :: Word64 -> Word64 be64 w = (w `shiftR` 56) .|. (w `shiftL` 56) .|. ((w `shiftR` 40) .&. 0xff00) .|. ((w .&. 0xff00) `shiftL` 40) .|. ((w `shiftR` 24) .&. 0xff0000) .|. ((w .&. 0xff0000) `shiftL` 24) .|. ((w `shiftR` 8) .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8) #else -- | convert a 8 byte bytestring to a little endian word64 toW64 :: B.ByteString -> Block toW64 bs = Block $ case B.unpack bs of [a,b,c,d,e,f,g,h] -> shl h 0 .|. shl g 8 .|. shl f 16 .|. shl e 24 .|. shl d 32 .|. shl c 40 .|. shl b 48 .|. shl a 56 _ -> 0 where shl w n = fromIntegral w `shiftL` n -- | convert a word64 to a bytestring in little endian format toBS :: Block -> B.ByteString toBS (Block b) = B.pack $ map (shr b) [56,48,40,32,24,16,8,0] where shr w n = fromIntegral (w `shiftR` n) -- | Create a strict bytestring out of DES blocks unblockify :: [Block] -> B.ByteString unblockify = B.concat . map toBS #endif -- | create DES blocks from a strict bytestring blockify :: B.ByteString -> [Block] blockify s | B.null s = [] | otherwise = let (s1,s2) = B.splitAt 8 s in toW64 s1:blockify s2 cipher-des-0.0.6/Crypto/Cipher/DES/Primitive.hs0000644000000000000000000002033312232141256017336 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Crypto.Cipher.DES.Primitive -- License : BSD-style -- -- This module is copy of DES module from Crypto package. -- http://hackage.haskell.org/package/Crypto -- ----------------------------------------------------------------------------- module Crypto.Cipher.DES.Primitive (encrypt, decrypt, Block(..)) where import Data.Word import Data.Bits newtype Block = Block Word64 type Rotation = Int type Key = Word64 type Bits4 = [Bool] type Bits6 = [Bool] type Bits32 = [Bool] type Bits48 = [Bool] type Bits56 = [Bool] type Bits64 = [Bool] desXor :: [Bool] -> [Bool] -> [Bool] desXor a b = zipWith (\x y -> (not x && y) || (x && not y)) a b desRotate :: [Bool] -> Int -> [Bool] desRotate bits rot = drop rot' bits ++ take rot' bits where rot' = rot `mod` length bits bitify :: Word64 -> Bits64 bitify w = map (\b -> w .&. (shiftL 1 b) /= 0) [63,62..0] unbitify :: Bits64 -> Word64 unbitify bs = foldl (\i b -> if b then 1 + shiftL i 1 else shiftL i 1) 0 bs initial_permutation :: Bits64 -> Bits64 initial_permutation mb = map ((!!) mb) i where i = [57, 49, 41, 33, 25, 17, 9, 1, 59, 51, 43, 35, 27, 19, 11, 3, 61, 53, 45, 37, 29, 21, 13, 5, 63, 55, 47, 39, 31, 23, 15, 7, 56, 48, 40, 32, 24, 16, 8, 0, 58, 50, 42, 34, 26, 18, 10, 2, 60, 52, 44, 36, 28, 20, 12, 4, 62, 54, 46, 38, 30, 22, 14, 6] key_transformation :: Bits64 -> Bits56 key_transformation kb = map ((!!) kb) i where i = [56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17, 9, 1, 58, 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35, 62, 54, 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 21, 13, 5, 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3] des_enc :: Block -> Key -> Block des_enc = do_des [1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28] des_dec :: Block -> Key -> Block des_dec = do_des [28,27,25,23,21,19,17,15,14,12,10,8,6,4,2,1] do_des :: [Rotation] -> Block -> Key -> Block do_des rots (Block m) k = Block $ des_work rots (takeDrop 32 mb) kb where kb = key_transformation $ bitify k mb = initial_permutation $ bitify m des_work :: [Rotation] -> (Bits32, Bits32) -> Bits56 -> Word64 des_work [] (ml, mr) _ = unbitify $ final_perm $ (mr ++ ml) des_work (r:rs) mb kb = des_work rs mb' kb where mb' = do_round r mb kb do_round :: Rotation -> (Bits32, Bits32) -> Bits56 -> (Bits32, Bits32) do_round r (ml, mr) kb = (mr, m') where kb' = get_key kb r comp_kb = compression_permutation kb' expa_mr = expansion_permutation mr res = comp_kb `desXor` expa_mr res' = tail $ iterate (trans 6) ([], res) trans n (_, b) = (take n b, drop n b) res_s = concat $ zipWith (\f (x,_) -> f x) [s_box_1, s_box_2, s_box_3, s_box_4, s_box_5, s_box_6, s_box_7, s_box_8] res' res_p = p_box res_s m' = res_p `desXor` ml get_key :: Bits56 -> Rotation -> Bits56 get_key kb r = kb' where (kl, kr) = takeDrop 28 kb kb' = desRotate kl r ++ desRotate kr r compression_permutation :: Bits56 -> Bits48 compression_permutation kb = map ((!!) kb) i where i = [13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9, 22, 18, 11, 3, 25, 7, 15, 6, 26, 19, 12, 1, 40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47, 43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31] expansion_permutation :: Bits32 -> Bits48 expansion_permutation mb = map ((!!) mb) i where i = [31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 7, 8, 9, 10, 11, 12, 11, 12, 13, 14, 15, 16, 15, 16, 17, 18, 19, 20, 19, 20, 21, 22, 23, 24, 23, 24, 25, 26, 27, 28, 27, 28, 29, 30, 31, 0] s_box :: [[Word8]] -> Bits6 -> Bits4 s_box s [a,b,c,d,e,f] = to_bool 4 $ (s !! row) !! col where row = sum $ zipWith numericise [a,f] [1, 0] col = sum $ zipWith numericise [b,c,d,e] [3, 2, 1, 0] numericise :: Bool -> Int -> Int numericise = (\x y -> if x then 2^y else 0) to_bool :: Int -> Word8 -> [Bool] to_bool 0 _ = [] to_bool n i = ((i .&. 8) == 8):to_bool (n-1) (shiftL i 1) s_box _ _ = error "DES: internal error bits6 more than 6 elements" s_box_1 :: Bits6 -> Bits4 s_box_1 = s_box i where i = [[14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7], [ 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8], [ 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0], [15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13]] s_box_2 :: Bits6 -> Bits4 s_box_2 = s_box i where i = [[15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10], [3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5], [0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15], [13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9]] s_box_3 :: Bits6 -> Bits4 s_box_3 = s_box i where i = [[10, 0, 9, 14 , 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8], [13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1], [13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7], [1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12]] s_box_4 :: Bits6 -> Bits4 s_box_4 = s_box i where i = [[7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15], [13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9], [10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4], [3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14]] s_box_5 :: Bits6 -> Bits4 s_box_5 = s_box i where i = [[2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9], [14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6], [4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14], [11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3]] s_box_6 :: Bits6 -> Bits4 s_box_6 = s_box i where i = [[12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11], [10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8], [9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6], [4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13]] s_box_7 :: Bits6 -> Bits4 s_box_7 = s_box i where i = [[4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1], [13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6], [1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2], [6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12]] s_box_8 :: Bits6 -> Bits4 s_box_8 = s_box i where i = [[13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7], [1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2], [7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8], [2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11]] p_box :: Bits32 -> Bits32 p_box kb = map ((!!) kb) i where i = [15, 6, 19, 20, 28, 11, 27, 16, 0, 14, 22, 25, 4, 17, 30, 9, 1, 7, 23, 13, 31, 26, 2, 8, 18, 12, 29, 5, 21, 10, 3, 24] final_perm :: Bits64 -> Bits64 final_perm kb = map ((!!) kb) i where i = [39, 7, 47, 15, 55, 23, 63, 31, 38, 6, 46, 14, 54, 22, 62, 30, 37, 5, 45, 13, 53, 21, 61, 29, 36, 4, 44, 12, 52, 20, 60, 28, 35, 3, 43, 11, 51, 19, 59, 27, 34, 2, 42, 10, 50, 18, 58, 26, 33, 1, 41, 9, 49, 17, 57, 25, 32, 0, 40 , 8, 48, 16, 56, 24] takeDrop :: Int -> [a] -> ([a], [a]) takeDrop _ [] = ([], []) takeDrop 0 xs = ([], xs) takeDrop n (x:xs) = (x:ys, zs) where (ys, zs) = takeDrop (n-1) xs -- | Basic DES encryption which takes a key and a block of plaintext -- and returns the encrypted block of ciphertext according to the standard. encrypt :: Word64 -> Block -> Block encrypt = flip des_enc -- | Basic DES decryption which takes a key and a block of ciphertext and -- returns the decrypted block of plaintext according to the standard. decrypt :: Word64 -> Block -> Block decrypt = flip des_dec cipher-des-0.0.6/Tests/0000755000000000000000000000000012232141256013026 5ustar0000000000000000cipher-des-0.0.6/Tests/Tests.hs0000644000000000000000000001121712232141256014466 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} module Main where import Control.Applicative import Control.Monad import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck import Test.QuickCheck.Test import Data.Byteable import qualified Data.ByteString as B import Data.ByteString.Char8 () -- orphan IsString for older bytestring versions import qualified Crypto.Cipher.DES as DES import Crypto.Cipher.Types import Crypto.Cipher.Tests vectors_ecb = -- key plaintext ciphertext [ KAT_ECB "\x00\x00\x00\x00\x00\x00\x00\x00" "\x00\x00\x00\x00\x00\x00\x00\x00" "\x8C\xA6\x4D\xE9\xC1\xB1\x23\xA7" , KAT_ECB "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x73\x59\xB2\x16\x3E\x4E\xDC\x58" , KAT_ECB "\x30\x00\x00\x00\x00\x00\x00\x00" "\x10\x00\x00\x00\x00\x00\x00\x01" "\x95\x8E\x6E\x62\x7A\x05\x55\x7B" , KAT_ECB "\x11\x11\x11\x11\x11\x11\x11\x11" "\x11\x11\x11\x11\x11\x11\x11\x11" "\xF4\x03\x79\xAB\x9E\x0E\xC5\x33" , KAT_ECB "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\x11\x11\x11\x11\x11\x11\x11\x11" "\x17\x66\x8D\xFC\x72\x92\x53\x2D" , KAT_ECB "\x11\x11\x11\x11\x11\x11\x11\x11" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\x8A\x5A\xE1\xF8\x1A\xB8\xF2\xDD" , KAT_ECB "\x00\x00\x00\x00\x00\x00\x00\x00" "\x00\x00\x00\x00\x00\x00\x00\x00" "\x8C\xA6\x4D\xE9\xC1\xB1\x23\xA7" , KAT_ECB "\xFE\xDC\xBA\x98\x76\x54\x32\x10" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\xED\x39\xD9\x50\xFA\x74\xBC\xC4" , KAT_ECB "\x7C\xA1\x10\x45\x4A\x1A\x6E\x57" "\x01\xA1\xD6\xD0\x39\x77\x67\x42" "\x69\x0F\x5B\x0D\x9A\x26\x93\x9B" , KAT_ECB "\x01\x31\xD9\x61\x9D\xC1\x37\x6E" "\x5C\xD5\x4C\xA8\x3D\xEF\x57\xDA" "\x7A\x38\x9D\x10\x35\x4B\xD2\x71" , KAT_ECB "\x07\xA1\x13\x3E\x4A\x0B\x26\x86" "\x02\x48\xD4\x38\x06\xF6\x71\x72" "\x86\x8E\xBB\x51\xCA\xB4\x59\x9A" , KAT_ECB "\x38\x49\x67\x4C\x26\x02\x31\x9E" "\x51\x45\x4B\x58\x2D\xDF\x44\x0A" "\x71\x78\x87\x6E\x01\xF1\x9B\x2A" , KAT_ECB "\x04\xB9\x15\xBA\x43\xFE\xB5\xB6" "\x42\xFD\x44\x30\x59\x57\x7F\xA2" "\xAF\x37\xFB\x42\x1F\x8C\x40\x95" , KAT_ECB "\x01\x13\xB9\x70\xFD\x34\xF2\xCE" "\x05\x9B\x5E\x08\x51\xCF\x14\x3A" "\x86\xA5\x60\xF1\x0E\xC6\xD8\x5B" , KAT_ECB "\x01\x70\xF1\x75\x46\x8F\xB5\xE6" "\x07\x56\xD8\xE0\x77\x47\x61\xD2" "\x0C\xD3\xDA\x02\x00\x21\xDC\x09" , KAT_ECB "\x43\x29\x7F\xAD\x38\xE3\x73\xFE" "\x76\x25\x14\xB8\x29\xBF\x48\x6A" "\xEA\x67\x6B\x2C\xB7\xDB\x2B\x7A" , KAT_ECB "\x07\xA7\x13\x70\x45\xDA\x2A\x16" "\x3B\xDD\x11\x90\x49\x37\x28\x02" "\xDF\xD6\x4A\x81\x5C\xAF\x1A\x0F" , KAT_ECB "\x04\x68\x91\x04\xC2\xFD\x3B\x2F" "\x26\x95\x5F\x68\x35\xAF\x60\x9A" "\x5C\x51\x3C\x9C\x48\x86\xC0\x88" , KAT_ECB "\x37\xD0\x6B\xB5\x16\xCB\x75\x46" "\x16\x4D\x5E\x40\x4F\x27\x52\x32" "\x0A\x2A\xEE\xAE\x3F\xF4\xAB\x77" , KAT_ECB "\x1F\x08\x26\x0D\x1A\xC2\x46\x5E" "\x6B\x05\x6E\x18\x75\x9F\x5C\xCA" "\xEF\x1B\xF0\x3E\x5D\xFA\x57\x5A" , KAT_ECB "\x58\x40\x23\x64\x1A\xBA\x61\x76" "\x00\x4B\xD6\xEF\x09\x17\x60\x62" "\x88\xBF\x0D\xB6\xD7\x0D\xEE\x56" , KAT_ECB "\x02\x58\x16\x16\x46\x29\xB0\x07" "\x48\x0D\x39\x00\x6E\xE7\x62\xF2" "\xA1\xF9\x91\x55\x41\x02\x0B\x56" , KAT_ECB "\x49\x79\x3E\xBC\x79\xB3\x25\x8F" "\x43\x75\x40\xC8\x69\x8F\x3C\xFA" "\x6F\xBF\x1C\xAF\xCF\xFD\x05\x56" , KAT_ECB "\x4F\xB0\x5E\x15\x15\xAB\x73\xA7" "\x07\x2D\x43\xA0\x77\x07\x52\x92" "\x2F\x22\xE4\x9B\xAB\x7C\xA1\xAC" , KAT_ECB "\x49\xE9\x5D\x6D\x4C\xA2\x29\xBF" "\x02\xFE\x55\x77\x81\x17\xF1\x2A" "\x5A\x6B\x61\x2C\xC2\x6C\xCE\x4A" , KAT_ECB "\x01\x83\x10\xDC\x40\x9B\x26\xD6" "\x1D\x9D\x5C\x50\x18\xF7\x28\xC2" "\x5F\x4C\x03\x8E\xD1\x2B\x2E\x41" , KAT_ECB "\x1C\x58\x7F\x1C\x13\x92\x4F\xEF" "\x30\x55\x32\x28\x6D\x6F\x29\x5A" "\x63\xFA\xC0\xD0\x34\xD9\xF7\x93" , KAT_ECB "\x01\x01\x01\x01\x01\x01\x01\x01" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\x61\x7B\x3A\x0C\xE8\xF0\x71\x00" , KAT_ECB "\x1F\x1F\x1F\x1F\x0E\x0E\x0E\x0E" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\xDB\x95\x86\x05\xF8\xC8\xC6\x06" , KAT_ECB "\xE0\xFE\xE0\xFE\xF1\xFE\xF1\xFE" "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\xED\xBF\xD1\xC6\x6C\x29\xCC\xC7" , KAT_ECB "\x00\x00\x00\x00\x00\x00\x00\x00" "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x35\x55\x50\xB2\x15\x0E\x24\x51" , KAT_ECB "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x00\x00\x00\x00\x00\x00\x00\x00" "\xCA\xAA\xAF\x4D\xEA\xF1\xDB\xAE" , KAT_ECB "\x01\x23\x45\x67\x89\xAB\xCD\xEF" "\x00\x00\x00\x00\x00\x00\x00\x00" "\xD5\xD4\x4F\xF7\x20\x68\x3D\x0D" , KAT_ECB "\xFE\xDC\xBA\x98\x76\x54\x32\x10" "\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF" "\x2A\x2B\xB0\x08\xDF\x97\xC2\xF2" ] kats = defaultKATs { kat_ECB = vectors_ecb } main = defaultMain [ testBlockCipher kats (undefined :: DES.DES) ]