{-# 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

-- | a DES block (64 bits)
newtype Block = Block { Block -> Word64
unBlock :: 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 :: [Bool] -> [Bool] -> [Bool]
desXor [Bool]
a [Bool]
b = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Eq a => a -> a -> Bool
(/=) [Bool]
a [Bool]
b

desRotate :: [Bool] -> Int -> [Bool]
desRotate :: [Bool] -> Int -> [Bool]
desRotate [Bool]
bits Int
rot = forall a. Int -> [a] -> [a]
drop Int
rot' [Bool]
bits forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
rot' [Bool]
bits
  where rot' :: Int
rot' = Int
rot forall a. Integral a => a -> a -> a
`mod` forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bits

bitify :: Word64 -> Bits64
bitify :: Word64 -> [Bool]
bitify Word64
w = forall a b. (a -> b) -> [a] -> [b]
map (\Int
b -> Word64
w forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => a -> Int -> a
shiftL Word64
1 Int
b) forall a. Eq a => a -> a -> Bool
/= Word64
0) [Int
63,Int
62..Int
0]

unbitify :: Bits64 -> Word64
unbitify :: [Bool] -> Word64
unbitify [Bool]
bs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Word64
i Bool
b -> if Bool
b then Word64
1 forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL Word64
i Int
1 else forall a. Bits a => a -> Int -> a
shiftL Word64
i Int
1) Word64
0 [Bool]
bs

initial_permutation :: Bits64 -> Bits64
initial_permutation :: [Bool] -> [Bool]
initial_permutation [Bool]
mb = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Int -> a
(!!) [Bool]
mb) [Int]
i
 where i :: [Int]
i = [Int
57, Int
49, Int
41, Int
33, Int
25, Int
17,  Int
9, Int
1, Int
59, Int
51, Int
43, Int
35, Int
27, Int
19, Int
11, Int
3,
            Int
61, Int
53, Int
45, Int
37, Int
29, Int
21, Int
13, Int
5, Int
63, Int
55, Int
47, Int
39, Int
31, Int
23, Int
15, Int
7,
            Int
56, Int
48, Int
40, Int
32, Int
24, Int
16,  Int
8, Int
0, Int
58, Int
50, Int
42, Int
34, Int
26, Int
18, Int
10, Int
2,
            Int
60, Int
52, Int
44, Int
36, Int
28, Int
20, Int
12, Int
4, Int
62, Int
54, Int
46, Int
38, Int
30, Int
22, Int
14, Int
6]

{-
"\x39\x31\x29\x21\x19\x11\x09\x01\x3b\x33\x2b\x23\x1b\x13\
\\x0b\x03\x3d\x35\x2d\x25\x1d\x15\x0d\x05\x3f\x37\x2f\x27\
\\x1f\x17\x0f\x07\x38\x30\x28\x20\x18\x10\x08\x00\x3a\x32\
\\x2a\x22\x1a\x12\x0a\x02\x3c\x34\x2c\x24\x1c\x14\x0c\x04\
\\x3e\x36\x2e\x26\x1e\x16\x0e\x06"
-}

key_transformation :: Bits64 -> Bits56
key_transformation :: [Bool] -> [Bool]
key_transformation [Bool]
kb = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Int -> a
(!!) [Bool]
kb) [Int]
i
 where i :: [Int]
i = [Int
56, Int
48, Int
40, Int
32, Int
24, Int
16,  Int
8,  Int
0, Int
57, Int
49, Int
41, Int
33, Int
25, Int
17,
             Int
9,  Int
1, Int
58, Int
50, Int
42, Int
34, Int
26, Int
18, Int
10,  Int
2, Int
59, Int
51, Int
43, Int
35,
            Int
62, Int
54, Int
46, Int
38, Int
30, Int
22, Int
14,  Int
6, Int
61, Int
53, Int
45, Int
37, Int
29, Int
21,
            Int
13,  Int
5, Int
60, Int
52, Int
44, Int
36, Int
28, Int
20, Int
12,  Int
4, Int
27, Int
19, Int
11,  Int
3]
{-
"\x38\x30\x28\x20\x18\x10\x08\x00\x39\x31\x29\x21\x19\x11\
\\x09\x01\x3a\x32\x2a\x22\x1a\x12\x0a\x02\x3b\x33\x2b\x23\
\\x3e\x36\x2e\x26\x1e\x16\x0e\x06\x3d\x35\x2d\x25\x1d\x15\
\\x0d\x05\x3c\x34\x2c\x24\x1c\x14\x0c\x04\x1b\x13\x0b\x03"
-}


des_enc :: Block -> Key -> Block
des_enc :: Block -> Word64 -> Block
des_enc = [Int] -> Block -> Word64 -> Block
do_des [Int
1,Int
2,Int
4,Int
6,Int
8,Int
10,Int
12,Int
14,Int
15,Int
17,Int
19,Int
21,Int
23,Int
25,Int
27,Int
28]

des_dec :: Block -> Key -> Block
des_dec :: Block -> Word64 -> Block
des_dec = [Int] -> Block -> Word64 -> Block
do_des [Int
28,Int
27,Int
25,Int
23,Int
21,Int
19,Int
17,Int
15,Int
14,Int
12,Int
10,Int
8,Int
6,Int
4,Int
2,Int
1]

do_des :: [Rotation] -> Block -> Key -> Block
do_des :: [Int] -> Block -> Word64 -> Block
do_des [Int]
rots (Block Word64
m) Word64
k = Word64 -> Block
Block forall a b. (a -> b) -> a -> b
$ [Int] -> ([Bool], [Bool]) -> [Bool] -> Word64
des_work [Int]
rots (forall a. Int -> [a] -> ([a], [a])
takeDrop Int
32 [Bool]
mb) [Bool]
kb
 where kb :: [Bool]
kb = [Bool] -> [Bool]
key_transformation forall a b. (a -> b) -> a -> b
$ Word64 -> [Bool]
bitify Word64
k
       mb :: [Bool]
mb = [Bool] -> [Bool]
initial_permutation forall a b. (a -> b) -> a -> b
$ Word64 -> [Bool]
bitify Word64
m

des_work :: [Rotation] -> (Bits32, Bits32) -> Bits56 -> Word64
des_work :: [Int] -> ([Bool], [Bool]) -> [Bool] -> Word64
des_work [] ([Bool]
ml, [Bool]
mr) [Bool]
_ = [Bool] -> Word64
unbitify forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool]
final_perm forall a b. (a -> b) -> a -> b
$ ([Bool]
mr forall a. [a] -> [a] -> [a]
++ [Bool]
ml)
des_work (Int
r:[Int]
rs) ([Bool], [Bool])
mb [Bool]
kb = [Int] -> ([Bool], [Bool]) -> [Bool] -> Word64
des_work [Int]
rs ([Bool], [Bool])
mb' [Bool]
kb
 where mb' :: ([Bool], [Bool])
mb' = Int -> ([Bool], [Bool]) -> [Bool] -> ([Bool], [Bool])
do_round Int
r ([Bool], [Bool])
mb [Bool]
kb

do_round :: Rotation -> (Bits32, Bits32) -> Bits56 -> (Bits32, Bits32)
do_round :: Int -> ([Bool], [Bool]) -> [Bool] -> ([Bool], [Bool])
do_round Int
r ([Bool]
ml, [Bool]
mr) [Bool]
kb = ([Bool]
mr, [Bool]
m')
 where kb' :: [Bool]
kb' = [Bool] -> Int -> [Bool]
get_key [Bool]
kb Int
r
       comp_kb :: [Bool]
comp_kb = [Bool] -> [Bool]
compression_permutation [Bool]
kb'
       expa_mr :: [Bool]
expa_mr = [Bool] -> [Bool]
expansion_permutation [Bool]
mr
       res :: [Bool]
res = [Bool]
comp_kb [Bool] -> [Bool] -> [Bool]
`desXor` [Bool]
expa_mr
       res' :: [([Bool], [Bool])]
res' = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate (forall {a} {a}. Int -> (a, [a]) -> ([a], [a])
trans Int
6) ([], [Bool]
res)
       trans :: Int -> (a, [a]) -> ([a], [a])
trans Int
n (a
_, [a]
b) = (forall a. Int -> [a] -> [a]
take Int
n [a]
b, forall a. Int -> [a] -> [a]
drop Int
n [a]
b)
       res_s :: [Bool]
res_s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Bool] -> [Bool]
f ([Bool]
x,[Bool]
_) -> [Bool] -> [Bool]
f [Bool]
x) [[Bool] -> [Bool]
s_box_1, [Bool] -> [Bool]
s_box_2,
                                                   [Bool] -> [Bool]
s_box_3, [Bool] -> [Bool]
s_box_4,
                                                   [Bool] -> [Bool]
s_box_5, [Bool] -> [Bool]
s_box_6,
                                                   [Bool] -> [Bool]
s_box_7, [Bool] -> [Bool]
s_box_8] [([Bool], [Bool])]
res'
       res_p :: [Bool]
res_p = [Bool] -> [Bool]
p_box [Bool]
res_s
       m' :: [Bool]
m' = [Bool]
res_p [Bool] -> [Bool] -> [Bool]
`desXor` [Bool]
ml

get_key :: Bits56 -> Rotation -> Bits56
get_key :: [Bool] -> Int -> [Bool]
get_key [Bool]
kb Int
r = [Bool]
kb'
 where ([Bool]
kl, [Bool]
kr) = forall a. Int -> [a] -> ([a], [a])
takeDrop Int
28 [Bool]
kb
       kb' :: [Bool]
kb' = [Bool] -> Int -> [Bool]
desRotate [Bool]
kl Int
r forall a. [a] -> [a] -> [a]
++ [Bool] -> Int -> [Bool]
desRotate [Bool]
kr Int
r

compression_permutation :: Bits56 -> Bits48
compression_permutation :: [Bool] -> [Bool]
compression_permutation [Bool]
kb = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Int -> a
(!!) [Bool]
kb) [Int]
i
 where i :: [Int]
i = [Int
13, Int
16, Int
10, Int
23,  Int
0,  Int
4,  Int
2, Int
27, Int
14,  Int
5, Int
20,  Int
9,
            Int
22, Int
18, Int
11,  Int
3, Int
25,  Int
7, Int
15,  Int
6, Int
26, Int
19, Int
12,  Int
1,
            Int
40, Int
51, Int
30, Int
36, Int
46, Int
54, Int
29, Int
39, Int
50, Int
44, Int
32, Int
47,
            Int
43, Int
48, Int
38, Int
55, Int
33, Int
52, Int
45, Int
41, Int
49, Int
35, Int
28, Int
31]

expansion_permutation :: Bits32 -> Bits48
expansion_permutation :: [Bool] -> [Bool]
expansion_permutation [Bool]
mb = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Int -> a
(!!) [Bool]
mb) [Int]
i
 where i :: [Int]
i = [Int
31,  Int
0,  Int
1,  Int
2,  Int
3,  Int
4,  Int
3,  Int
4,  Int
5,  Int
6,  Int
7,  Int
8,
             Int
7,  Int
8,  Int
9, Int
10, Int
11, Int
12, Int
11, Int
12, Int
13, Int
14, Int
15, Int
16,
            Int
15, Int
16, Int
17, Int
18, Int
19, Int
20, Int
19, Int
20, Int
21, Int
22, Int
23, Int
24,
            Int
23, Int
24, Int
25, Int
26, Int
27, Int
28, Int
27, Int
28, Int
29, Int
30, Int
31,  Int
0]

s_box :: [[Word8]] -> Bits6 -> Bits4
s_box :: [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
s [Bool
a,Bool
b,Bool
c,Bool
d,Bool
e,Bool
f] = Int -> Word8 -> [Bool]
to_bool Int
4 forall a b. (a -> b) -> a -> b
$ ([[Word8]]
s forall a. [a] -> Int -> a
!! Int
row) forall a. [a] -> Int -> a
!! Int
col
 where row :: Int
row = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Int -> Int
numericise [Bool
a,Bool
f]     [Int
1, Int
0]
       col :: Int
col = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Int -> Int
numericise [Bool
b,Bool
c,Bool
d,Bool
e] [Int
3, Int
2, Int
1, Int
0]
       numericise :: Bool -> Int -> Int
       numericise :: Bool -> Int -> Int
numericise = (\Bool
x Int
y -> if Bool
x then Int
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
y else Int
0)

       to_bool :: Int -> Word8 -> [Bool]
       to_bool :: Int -> Word8 -> [Bool]
to_bool Int
0 Word8
_ = []
       to_bool Int
n Word8
i = ((Word8
i forall a. Bits a => a -> a -> a
.&. Word8
8) forall a. Eq a => a -> a -> Bool
== Word8
8)forall a. a -> [a] -> [a]
:Int -> Word8 -> [Bool]
to_bool (Int
nforall a. Num a => a -> a -> a
-Int
1) (forall a. Bits a => a -> Int -> a
shiftL Word8
i Int
1)
s_box [[Word8]]
_ [Bool]
_             = forall a. HasCallStack => [Char] -> a
error [Char]
"DES: internal error bits6 more than 6 elements"

s_box_1 :: Bits6 -> Bits4
s_box_1 :: [Bool] -> [Bool]
s_box_1 = [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
i
 where i :: [[Word8]]
i = [[Word8
14,  Word8
4, Word8
13,  Word8
1,  Word8
2, Word8
15, Word8
11,  Word8
8,  Word8
3, Word8
10,  Word8
6, Word8
12,  Word8
5,  Word8
9,  Word8
0,  Word8
7],
            [ Word8
0, Word8
15,  Word8
7,  Word8
4, Word8
14,  Word8
2, Word8
13,  Word8
1, Word8
10,  Word8
6, Word8
12, Word8
11,  Word8
9,  Word8
5,  Word8
3,  Word8
8],
            [ Word8
4,  Word8
1, Word8
14,  Word8
8, Word8
13,  Word8
6,  Word8
2, Word8
11, Word8
15, Word8
12,  Word8
9,  Word8
7,  Word8
3, Word8
10,  Word8
5,  Word8
0],
            [Word8
15, Word8
12,  Word8
8,  Word8
2,  Word8
4,  Word8
9,  Word8
1,  Word8
7,  Word8
5, Word8
11,  Word8
3, Word8
14, Word8
10,  Word8
0,  Word8
6, Word8
13]]

s_box_2 :: Bits6 -> Bits4
s_box_2 :: [Bool] -> [Bool]
s_box_2 = [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
i
 where i :: [[Word8]]
i = [[Word8
15,  Word8
1,  Word8
8, Word8
14,  Word8
6, Word8
11,  Word8
3,  Word8
4,  Word8
9,  Word8
7,  Word8
2, Word8
13, Word8
12,  Word8
0,  Word8
5, Word8
10],
            [Word8
3,  Word8
13,  Word8
4,  Word8
7, Word8
15,  Word8
2,  Word8
8, Word8
14, Word8
12,  Word8
0,  Word8
1, Word8
10,  Word8
6,  Word8
9,  Word8
11, Word8
5],
            [Word8
0,  Word8
14,  Word8
7, Word8
11, Word8
10,  Word8
4, Word8
13,  Word8
1,  Word8
5,  Word8
8, Word8
12,  Word8
6,  Word8
9,  Word8
3,  Word8
2, Word8
15],
            [Word8
13,  Word8
8, Word8
10,  Word8
1,  Word8
3, Word8
15,  Word8
4,  Word8
2, Word8
11,  Word8
6,  Word8
7, Word8
12,  Word8
0,  Word8
5,  Word8
14, Word8
9]]

s_box_3 :: Bits6 -> Bits4
s_box_3 :: [Bool] -> [Bool]
s_box_3 = [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
i
 where i :: [[Word8]]
i = [[Word8
10,  Word8
0,  Word8
9, Word8
14 , Word8
6,  Word8
3, Word8
15,  Word8
5,  Word8
1, Word8
13, Word8
12,  Word8
7, Word8
11,  Word8
4,  Word8
2,  Word8
8],
            [Word8
13,  Word8
7,  Word8
0,  Word8
9,  Word8
3,  Word8
4,  Word8
6, Word8
10,  Word8
2,  Word8
8,  Word8
5, Word8
14, Word8
12, Word8
11, Word8
15,  Word8
1],
            [Word8
13,  Word8
6,  Word8
4,  Word8
9,  Word8
8, Word8
15,  Word8
3,  Word8
0, Word8
11,  Word8
1,  Word8
2, Word8
12,  Word8
5, Word8
10, Word8
14,  Word8
7],
            [Word8
1,  Word8
10, Word8
13,  Word8
0,  Word8
6,  Word8
9,  Word8
8,  Word8
7,  Word8
4, Word8
15, Word8
14,  Word8
3, Word8
11,  Word8
5,  Word8
2, Word8
12]]

s_box_4 :: Bits6 -> Bits4
s_box_4 :: [Bool] -> [Bool]
s_box_4 = [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
i
 where i :: [[Word8]]
i = [[Word8
7,  Word8
13, Word8
14,  Word8
3,  Word8
0,  Word8
6,  Word8
9, Word8
10,  Word8
1,  Word8
2,  Word8
8,  Word8
5, Word8
11, Word8
12,  Word8
4, Word8
15],
            [Word8
13,  Word8
8, Word8
11,  Word8
5,  Word8
6, Word8
15,  Word8
0,  Word8
3,  Word8
4,  Word8
7,  Word8
2, Word8
12,  Word8
1, Word8
10, Word8
14,  Word8
9],
            [Word8
10,  Word8
6,  Word8
9,  Word8
0, Word8
12, Word8
11,  Word8
7, Word8
13, Word8
15,  Word8
1,  Word8
3, Word8
14,  Word8
5,  Word8
2,  Word8
8,  Word8
4],
            [Word8
3,  Word8
15,  Word8
0,  Word8
6, Word8
10,  Word8
1, Word8
13,  Word8
8,  Word8
9,  Word8
4,  Word8
5, Word8
11, Word8
12,  Word8
7,  Word8
2, Word8
14]]

s_box_5 :: Bits6 -> Bits4
s_box_5 :: [Bool] -> [Bool]
s_box_5 = [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
i
 where i :: [[Word8]]
i = [[Word8
2,  Word8
12,  Word8
4,  Word8
1,  Word8
7, Word8
10, Word8
11,  Word8
6,  Word8
8,  Word8
5,  Word8
3, Word8
15, Word8
13,  Word8
0, Word8
14,  Word8
9],
            [Word8
14, Word8
11,  Word8
2, Word8
12,  Word8
4,  Word8
7, Word8
13,  Word8
1,  Word8
5,  Word8
0, Word8
15, Word8
10,  Word8
3,  Word8
9,  Word8
8,  Word8
6],
            [Word8
4,   Word8
2,  Word8
1, Word8
11, Word8
10, Word8
13,  Word8
7,  Word8
8, Word8
15,  Word8
9, Word8
12,  Word8
5,  Word8
6,  Word8
3,  Word8
0, Word8
14],
            [Word8
11,  Word8
8, Word8
12,  Word8
7,  Word8
1, Word8
14,  Word8
2, Word8
13,  Word8
6, Word8
15,  Word8
0,  Word8
9, Word8
10,  Word8
4,  Word8
5,  Word8
3]]

s_box_6 :: Bits6 -> Bits4
s_box_6 :: [Bool] -> [Bool]
s_box_6 = [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
i
 where i :: [[Word8]]
i = [[Word8
12,  Word8
1, Word8
10, Word8
15,  Word8
9,  Word8
2,  Word8
6,  Word8
8,  Word8
0, Word8
13,  Word8
3,  Word8
4, Word8
14,  Word8
7,  Word8
5, Word8
11],
            [Word8
10, Word8
15,  Word8
4,  Word8
2,  Word8
7, Word8
12,  Word8
9,  Word8
5,  Word8
6,  Word8
1, Word8
13, Word8
14,  Word8
0, Word8
11,  Word8
3,  Word8
8],
            [Word8
9,  Word8
14, Word8
15,  Word8
5,  Word8
2,  Word8
8, Word8
12,  Word8
3,  Word8
7,  Word8
0,  Word8
4, Word8
10,  Word8
1, Word8
13, Word8
11,  Word8
6],
            [Word8
4,  Word8
3,   Word8
2, Word8
12,  Word8
9,  Word8
5, Word8
15, Word8
10, Word8
11, Word8
14,  Word8
1,  Word8
7,  Word8
6,  Word8
0,  Word8
8, Word8
13]]

s_box_7 :: Bits6 -> Bits4
s_box_7 :: [Bool] -> [Bool]
s_box_7 = [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
i
 where i :: [[Word8]]
i = [[Word8
4,  Word8
11,  Word8
2, Word8
14, Word8
15,  Word8
0,  Word8
8, Word8
13,  Word8
3, Word8
12,  Word8
9,  Word8
7,  Word8
5, Word8
10,  Word8
6,  Word8
1],
            [Word8
13, Word8
0,  Word8
11,  Word8
7,  Word8
4,  Word8
9,  Word8
1, Word8
10, Word8
14,  Word8
3,  Word8
5, Word8
12,  Word8
2, Word8
15,  Word8
8,  Word8
6],
            [Word8
1,  Word8
4,  Word8
11, Word8
13, Word8
12,  Word8
3,  Word8
7, Word8
14, Word8
10, Word8
15,  Word8
6,  Word8
8,  Word8
0,  Word8
5,  Word8
9,  Word8
2],
            [Word8
6,  Word8
11, Word8
13,  Word8
8,  Word8
1,  Word8
4, Word8
10,  Word8
7,  Word8
9,  Word8
5,  Word8
0, Word8
15, Word8
14,  Word8
2,  Word8
3, Word8
12]]

s_box_8 :: Bits6 -> Bits4
s_box_8 :: [Bool] -> [Bool]
s_box_8 = [[Word8]] -> [Bool] -> [Bool]
s_box [[Word8]]
i
 where i :: [[Word8]]
i = [[Word8
13,  Word8
2,  Word8
8,  Word8
4,  Word8
6, Word8
15, Word8
11,  Word8
1, Word8
10,  Word8
9,  Word8
3, Word8
14,  Word8
5,  Word8
0, Word8
12,  Word8
7],
            [Word8
1,  Word8
15, Word8
13,  Word8
8, Word8
10,  Word8
3,  Word8
7,  Word8
4, Word8
12,  Word8
5,  Word8
6, Word8
11,  Word8
0, Word8
14,  Word8
9,  Word8
2],
            [Word8
7,  Word8
11,  Word8
4,  Word8
1,  Word8
9, Word8
12, Word8
14,  Word8
2,  Word8
0,  Word8
6, Word8
10, Word8
13, Word8
15,  Word8
3,  Word8
5,  Word8
8],
            [Word8
2,   Word8
1, Word8
14,  Word8
7,  Word8
4, Word8
10,  Word8
8, Word8
13, Word8
15, Word8
12,  Word8
9,  Word8
0,  Word8
3,  Word8
5,  Word8
6, Word8
11]]

p_box :: Bits32 -> Bits32
p_box :: [Bool] -> [Bool]
p_box [Bool]
kb = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Int -> a
(!!) [Bool]
kb) [Int]
i
 where i :: [Int]
i = [Int
15, Int
6, Int
19, Int
20, Int
28, Int
11, Int
27, Int
16,  Int
0, Int
14, Int
22, Int
25,  Int
4, Int
17, Int
30,  Int
9,
             Int
1, Int
7, Int
23, Int
13, Int
31, Int
26,  Int
2,  Int
8, Int
18, Int
12, Int
29,  Int
5, Int
21, Int
10,  Int
3, Int
24]

final_perm :: Bits64 -> Bits64
final_perm :: [Bool] -> [Bool]
final_perm [Bool]
kb = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Int -> a
(!!) [Bool]
kb) [Int]
i
 where i :: [Int]
i = [Int
39, Int
7, Int
47, Int
15, Int
55, Int
23, Int
63, Int
31, Int
38, Int
6, Int
46, Int
14, Int
54, Int
22, Int
62, Int
30,
            Int
37, Int
5, Int
45, Int
13, Int
53, Int
21, Int
61, Int
29, Int
36, Int
4, Int
44, Int
12, Int
52, Int
20, Int
60, Int
28,
            Int
35, Int
3, Int
43, Int
11, Int
51, Int
19, Int
59, Int
27, Int
34, Int
2, Int
42, Int
10, Int
50, Int
18, Int
58, Int
26,
            Int
33, Int
1, Int
41,  Int
9, Int
49, Int
17, Int
57, Int
25, Int
32, Int
0, Int
40 , Int
8, Int
48, Int
16, Int
56, Int
24]

takeDrop :: Int -> [a] -> ([a], [a])
takeDrop :: forall a. Int -> [a] -> ([a], [a])
takeDrop Int
_ [] = ([], [])
takeDrop Int
0 [a]
xs = ([], [a]
xs)
takeDrop Int
n (a
x:[a]
xs) = (a
xforall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)
 where ([a]
ys, [a]
zs) = forall a. Int -> [a] -> ([a], [a])
takeDrop (Int
nforall a. Num a => a -> a -> a
-Int
1) [a]
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 :: Word64 -> Block -> Block
encrypt = forall a b c. (a -> b -> c) -> b -> a -> c
flip Block -> Word64 -> Block
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 :: Word64 -> Block -> Block
decrypt = forall a b c. (a -> b -> c) -> b -> a -> c
flip Block -> Word64 -> Block
des_dec