1{-# LANGUAGE FlexibleInstances #-} 2 3----------------------------------------------------------------------------- 4-- | 5-- Module : Crypto.Cipher.DES.Primitive 6-- License : BSD-style 7-- 8-- This module is copy of DES module from Crypto package. 9-- http://hackage.haskell.org/package/Crypto 10-- 11----------------------------------------------------------------------------- 12 13 14module Crypto.Cipher.DES.Primitive 15 ( encrypt 16 , decrypt 17 , Block(..) 18 ) where 19 20import Data.Word 21import Data.Bits 22 23-- | a DES block (64 bits) 24newtype Block = Block { unBlock :: Word64 } 25 26type Rotation = Int 27type Key = Word64 28 29type Bits4 = [Bool] 30type Bits6 = [Bool] 31type Bits32 = [Bool] 32type Bits48 = [Bool] 33type Bits56 = [Bool] 34type Bits64 = [Bool] 35 36desXor :: [Bool] -> [Bool] -> [Bool] 37desXor a b = zipWith (/=) a b 38 39desRotate :: [Bool] -> Int -> [Bool] 40desRotate bits rot = drop rot' bits ++ take rot' bits 41 where rot' = rot `mod` length bits 42 43bitify :: Word64 -> Bits64 44bitify w = map (\b -> w .&. (shiftL 1 b) /= 0) [63,62..0] 45 46unbitify :: Bits64 -> Word64 47unbitify bs = foldl (\i b -> if b then 1 + shiftL i 1 else shiftL i 1) 0 bs 48 49initial_permutation :: Bits64 -> Bits64 50initial_permutation mb = map ((!!) mb) i 51 where i = [57, 49, 41, 33, 25, 17, 9, 1, 59, 51, 43, 35, 27, 19, 11, 3, 52 61, 53, 45, 37, 29, 21, 13, 5, 63, 55, 47, 39, 31, 23, 15, 7, 53 56, 48, 40, 32, 24, 16, 8, 0, 58, 50, 42, 34, 26, 18, 10, 2, 54 60, 52, 44, 36, 28, 20, 12, 4, 62, 54, 46, 38, 30, 22, 14, 6] 55 56{- 57"\x39\x31\x29\x21\x19\x11\x09\x01\x3b\x33\x2b\x23\x1b\x13\ 58\\x0b\x03\x3d\x35\x2d\x25\x1d\x15\x0d\x05\x3f\x37\x2f\x27\ 59\\x1f\x17\x0f\x07\x38\x30\x28\x20\x18\x10\x08\x00\x3a\x32\ 60\\x2a\x22\x1a\x12\x0a\x02\x3c\x34\x2c\x24\x1c\x14\x0c\x04\ 61\\x3e\x36\x2e\x26\x1e\x16\x0e\x06" 62-} 63 64key_transformation :: Bits64 -> Bits56 65key_transformation kb = map ((!!) kb) i 66 where i = [56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17, 67 9, 1, 58, 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35, 68 62, 54, 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 21, 69 13, 5, 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3] 70{- 71"\x38\x30\x28\x20\x18\x10\x08\x00\x39\x31\x29\x21\x19\x11\ 72\\x09\x01\x3a\x32\x2a\x22\x1a\x12\x0a\x02\x3b\x33\x2b\x23\ 73\\x3e\x36\x2e\x26\x1e\x16\x0e\x06\x3d\x35\x2d\x25\x1d\x15\ 74\\x0d\x05\x3c\x34\x2c\x24\x1c\x14\x0c\x04\x1b\x13\x0b\x03" 75-} 76 77 78des_enc :: Block -> Key -> Block 79des_enc = do_des [1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28] 80 81des_dec :: Block -> Key -> Block 82des_dec = do_des [28,27,25,23,21,19,17,15,14,12,10,8,6,4,2,1] 83 84do_des :: [Rotation] -> Block -> Key -> Block 85do_des rots (Block m) k = Block $ des_work rots (takeDrop 32 mb) kb 86 where kb = key_transformation $ bitify k 87 mb = initial_permutation $ bitify m 88 89des_work :: [Rotation] -> (Bits32, Bits32) -> Bits56 -> Word64 90des_work [] (ml, mr) _ = unbitify $ final_perm $ (mr ++ ml) 91des_work (r:rs) mb kb = des_work rs mb' kb 92 where mb' = do_round r mb kb 93 94do_round :: Rotation -> (Bits32, Bits32) -> Bits56 -> (Bits32, Bits32) 95do_round r (ml, mr) kb = (mr, m') 96 where kb' = get_key kb r 97 comp_kb = compression_permutation kb' 98 expa_mr = expansion_permutation mr 99 res = comp_kb `desXor` expa_mr 100 res' = tail $ iterate (trans 6) ([], res) 101 trans n (_, b) = (take n b, drop n b) 102 res_s = concat $ zipWith (\f (x,_) -> f x) [s_box_1, s_box_2, 103 s_box_3, s_box_4, 104 s_box_5, s_box_6, 105 s_box_7, s_box_8] res' 106 res_p = p_box res_s 107 m' = res_p `desXor` ml 108 109get_key :: Bits56 -> Rotation -> Bits56 110get_key kb r = kb' 111 where (kl, kr) = takeDrop 28 kb 112 kb' = desRotate kl r ++ desRotate kr r 113 114compression_permutation :: Bits56 -> Bits48 115compression_permutation kb = map ((!!) kb) i 116 where i = [13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9, 117 22, 18, 11, 3, 25, 7, 15, 6, 26, 19, 12, 1, 118 40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47, 119 43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31] 120 121expansion_permutation :: Bits32 -> Bits48 122expansion_permutation mb = map ((!!) mb) i 123 where i = [31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 124 7, 8, 9, 10, 11, 12, 11, 12, 13, 14, 15, 16, 125 15, 16, 17, 18, 19, 20, 19, 20, 21, 22, 23, 24, 126 23, 24, 25, 26, 27, 28, 27, 28, 29, 30, 31, 0] 127 128s_box :: [[Word8]] -> Bits6 -> Bits4 129s_box s [a,b,c,d,e,f] = to_bool 4 $ (s !! row) !! col 130 where row = sum $ zipWith numericise [a,f] [1, 0] 131 col = sum $ zipWith numericise [b,c,d,e] [3, 2, 1, 0] 132 numericise :: Bool -> Int -> Int 133 numericise = (\x y -> if x then 2^y else 0) 134 135 to_bool :: Int -> Word8 -> [Bool] 136 to_bool 0 _ = [] 137 to_bool n i = ((i .&. 8) == 8):to_bool (n-1) (shiftL i 1) 138s_box _ _ = error "DES: internal error bits6 more than 6 elements" 139 140s_box_1 :: Bits6 -> Bits4 141s_box_1 = s_box i 142 where i = [[14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7], 143 [ 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8], 144 [ 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0], 145 [15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13]] 146 147s_box_2 :: Bits6 -> Bits4 148s_box_2 = s_box i 149 where i = [[15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10], 150 [3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5], 151 [0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15], 152 [13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9]] 153 154s_box_3 :: Bits6 -> Bits4 155s_box_3 = s_box i 156 where i = [[10, 0, 9, 14 , 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8], 157 [13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1], 158 [13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7], 159 [1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12]] 160 161s_box_4 :: Bits6 -> Bits4 162s_box_4 = s_box i 163 where i = [[7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15], 164 [13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9], 165 [10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4], 166 [3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14]] 167 168s_box_5 :: Bits6 -> Bits4 169s_box_5 = s_box i 170 where i = [[2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9], 171 [14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6], 172 [4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14], 173 [11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3]] 174 175s_box_6 :: Bits6 -> Bits4 176s_box_6 = s_box i 177 where i = [[12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11], 178 [10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8], 179 [9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6], 180 [4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13]] 181 182s_box_7 :: Bits6 -> Bits4 183s_box_7 = s_box i 184 where i = [[4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1], 185 [13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6], 186 [1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2], 187 [6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12]] 188 189s_box_8 :: Bits6 -> Bits4 190s_box_8 = s_box i 191 where i = [[13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7], 192 [1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2], 193 [7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8], 194 [2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11]] 195 196p_box :: Bits32 -> Bits32 197p_box kb = map ((!!) kb) i 198 where i = [15, 6, 19, 20, 28, 11, 27, 16, 0, 14, 22, 25, 4, 17, 30, 9, 199 1, 7, 23, 13, 31, 26, 2, 8, 18, 12, 29, 5, 21, 10, 3, 24] 200 201final_perm :: Bits64 -> Bits64 202final_perm kb = map ((!!) kb) i 203 where i = [39, 7, 47, 15, 55, 23, 63, 31, 38, 6, 46, 14, 54, 22, 62, 30, 204 37, 5, 45, 13, 53, 21, 61, 29, 36, 4, 44, 12, 52, 20, 60, 28, 205 35, 3, 43, 11, 51, 19, 59, 27, 34, 2, 42, 10, 50, 18, 58, 26, 206 33, 1, 41, 9, 49, 17, 57, 25, 32, 0, 40 , 8, 48, 16, 56, 24] 207 208takeDrop :: Int -> [a] -> ([a], [a]) 209takeDrop _ [] = ([], []) 210takeDrop 0 xs = ([], xs) 211takeDrop n (x:xs) = (x:ys, zs) 212 where (ys, zs) = takeDrop (n-1) xs 213 214 215-- | Basic DES encryption which takes a key and a block of plaintext 216-- and returns the encrypted block of ciphertext according to the standard. 217encrypt :: Word64 -> Block -> Block 218encrypt = flip des_enc 219 220-- | Basic DES decryption which takes a key and a block of ciphertext and 221-- returns the decrypted block of plaintext according to the standard. 222decrypt :: Word64 -> Block -> Block 223decrypt = flip des_dec 224