{-# 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 = (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(/=) [Bool]
a [Bool]
b

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

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

unbitify :: Bits64 -> Word64
unbitify :: [Bool] -> Word64
unbitify [Bool]
bs = (Word64 -> Bool -> Word64) -> Word64 -> [Bool] -> Word64
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Word64
i Bool
b -> if Bool
b then Word64
1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
i Int
1 else Word64 -> Int -> Word64
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 = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> Int -> Bool
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 = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> Int -> Bool
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 (Word64 -> Block) -> Word64 -> Block
forall a b. (a -> b) -> a -> b
$ [Int] -> ([Bool], [Bool]) -> [Bool] -> Word64
des_work [Int]
rots (Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
takeDrop Int
32 [Bool]
mb) [Bool]
kb
 where kb :: [Bool]
kb = [Bool] -> [Bool]
key_transformation ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ Word64 -> [Bool]
bitify Word64
k
       mb :: [Bool]
mb = [Bool] -> [Bool]
initial_permutation ([Bool] -> [Bool]) -> [Bool] -> [Bool]
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 ([Bool] -> Word64) -> [Bool] -> Word64
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool]
final_perm ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ ([Bool]
mr [Bool] -> [Bool] -> [Bool]
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' = [([Bool], [Bool])] -> [([Bool], [Bool])]
forall a. [a] -> [a]
tail ([([Bool], [Bool])] -> [([Bool], [Bool])])
-> [([Bool], [Bool])] -> [([Bool], [Bool])]
forall a b. (a -> b) -> a -> b
$ (([Bool], [Bool]) -> ([Bool], [Bool]))
-> ([Bool], [Bool]) -> [([Bool], [Bool])]
forall a. (a -> a) -> a -> [a]
iterate (Int -> ([Bool], [Bool]) -> ([Bool], [Bool])
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) = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
b, Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
b)
       res_s :: [Bool]
res_s = [[Bool]] -> [Bool]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Bool]] -> [Bool]) -> [[Bool]] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (([Bool] -> [Bool]) -> ([Bool], [Bool]) -> [Bool])
-> [[Bool] -> [Bool]] -> [([Bool], [Bool])] -> [[Bool]]
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) = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
takeDrop Int
28 [Bool]
kb
       kb' :: [Bool]
kb' = [Bool] -> Int -> [Bool]
desRotate [Bool]
kl Int
r [Bool] -> [Bool] -> [Bool]
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 = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> Int -> Bool
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 = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> Int -> Bool
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 (Word8 -> [Bool]) -> Word8 -> [Bool]
forall a b. (a -> b) -> a -> b
$ ([[Word8]]
s [[Word8]] -> Int -> [Word8]
forall a. [a] -> Int -> a
!! Int
row) [Word8] -> Int -> Word8
forall a. [a] -> Int -> a
!! Int
col
 where row :: Int
row = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Int -> Int) -> [Bool] -> [Int] -> [Int]
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 = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Int -> Int) -> [Bool] -> [Int] -> [Int]
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
2Int -> Int -> Int
forall 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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
8)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:Int -> Word8 -> [Bool]
to_bool (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
i Int
1)
s_box [[Word8]]
_ [Bool]
_             = [Char] -> [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 = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> Int -> Bool
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 = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> Int -> Bool
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 :: Int -> [a] -> ([a], [a])
takeDrop Int
_ [] = ([], [])
takeDrop Int
0 [a]
xs = ([], [a]
xs)
takeDrop Int
n (a
x:[a]
xs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)
 where ([a]
ys, [a]
zs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
takeDrop (Int
nInt -> Int -> Int
forall 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 = (Block -> Word64 -> Block) -> Word64 -> Block -> Block
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 = (Block -> Word64 -> Block) -> Word64 -> Block -> Block
forall a b c. (a -> b -> c) -> b -> a -> c
flip Block -> Word64 -> Block
des_dec