    {-# 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 a. [a] -> 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 b a. (b -> a -> b) -> b -> [a] -> b
    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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [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. HasCallStack => [a] -> Int -> a
    !! Int
    row) [Word8] -> Int -> Word8
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    col
     where row :: Int
    row = [Int] -> Int
    forall a. Num a => [a] -> a
    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 a. Num a => [a] -> a
    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. HasCallStack => [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. HasCallStack => [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
    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