Apoyo Urgente

[lolimarq]

Buenas Tardes:

Tengo que presentar en haskell el metodo de encriptación des. Y esa
presentación la necesito de forma urgente porque mi presentación es
mañana.

Lo que ocurre es que tengo el codigo y trabaja para datos numericos
pero no así para datos alfanumericos y no consigo que lo haga. Porque
realmente no conozco mucho de este lenguaje.

Alguien me sugirio que podría hacer pero resulta que no tengo idea de
donde colocar las sugerencias que esta persona me hizo si alguien
puede ayudarme se los agradecería mucho.

el código es

-- En Ghc se aplica el Flexible Instance para que sea una instancia
aceptable

{-# LANGUAGE FlexibleInstances #-}

import Data.Word
import Data.Bits

type Rotacion = Int
type Llave = Word64
type Mensaje = Word64
type Enc = Word64

type BitsX = [Bool]
type Bits4 = [Bool]
type Bits6 = [Bool]
type Bits32 = [Bool]
type Bits48 = [Bool]
type Bits56 = [Bool]
type Bits64 = [Bool]

instance Num [Bool]

instance Bits [Bool] where
a `xor` b = (zipWith (\x y -> (not x && y) || (x && not y)) a b)
rotate bits rot = drop rot' bits ++ take rot' bits
where rot' = rot `mod` (length bits)

-- | Encriptación Des básica tomando una Llave, un bloque de texto
plano y lo transforma en un texto encriptado de acuerdo al estándar.

encriptar :: Word64 -> Word64 -> Word64
encriptar = flip encrip_des

-- | Caso contrario. Dada una Llave y un texto encriptado se realiza
la conversión del Mensaje original.
desencriptar :: Word64 -> Word64 -> Word64
desencriptar = flip desencrip_des


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

-- | Realizar la siguiente permutación en la clave de 64 bits
-- |reduciéndose la misma a 56 bits (El bit 1, el más
-- |significativo, de la clave transformada es el bit 57 de la
-- |clave original, el bit 2 pasa a ser el bit 49, etc.).
permutacion_inicial :: Bits64 -> Bits64
permutacion_inicial 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]
-- los bit que se le quitan (8)son de paridad
transformar_Llave :: Bits64 -> Bits56
transformar_Llave 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]

encrip_des :: Mensaje -> Llave -> Enc
encrip_des = hacer_encrip_des
[1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28]

desencrip_des :: Mensaje -> Llave -> Enc
desencrip_des = hacer_encrip_des
[28,27,25,23,21,19,17,15,14,12,10,8,6,4,2,1]

hacer_encrip_des :: [Rotacion] -> Mensaje -> Llave -> Enc
hacer_encrip_des rots m k = des_trabajo rots (takeDrop 32 mb) kb
where kb = transformar_Llave $ bitify k
mb = permutacion_inicial $ bitify m

des_trabajo :: [Rotacion] -> (Bits32, Bits32) -> Bits56 -> Enc
des_trabajo [] (ml, mr) _ = unbitify $ final_perm $ (mr ++ ml)
des_trabajo (r:rs) mb kb = des_trabajo rs mb' kb
where mb' = hacer_la_ronda r mb kb

hacer_la_ronda :: Rotacion -> (Bits32, Bits32) -> Bits56 -> (Bits32,
Bits32)
hacer_la_ronda r (ml, mr) kb = (mr, m')
where kb' = get_Llave kb r
comp_kb = compression_permutation kb'
expa_mr = expansion_permutation mr
res = comp_kb `xor` 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) [caja_des_1,
caja_des_2,
caja_des_3,
caja_des_4,
caja_des_5,
caja_des_6,
caja_des_7,
caja_des_8] res'
res_p = p_box res_s
m' = res_p `xor` ml

get_Llave :: Bits56 -> Rotacion -> Bits56
get_Llave kb r = kb'
where (kl, kr) = takeDrop 28 kb
kb' = rotateL kl r ++ rotateL 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]

caja_des :: [[Word8]] -> Bits6 -> Bits4
caja_des 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 = (\x y -> if x then 2^y else 0)
to_bool 0 _ = []
to_bool n i = ((i .&. 8) == 8):to_bool (n-1) (shiftL i 1)

caja_des_1 :: Bits6 -> Bits4
caja_des_1 = caja_des 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]]

caja_des_2 :: Bits6 -> Bits4
caja_des_2 = caja_des 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]]

caja_des_3 :: Bits6 -> Bits4
caja_des_3 = caja_des 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]]

caja_des_4 :: Bits6 -> Bits4
caja_des_4 = caja_des 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]]

caja_des_5 :: Bits6 -> Bits4
caja_des_5 = caja_des 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]]

caja_des_6 :: Bits6 -> Bits4
caja_des_6 = caja_des 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]]

caja_des_7 :: Bits6 -> Bits4
caja_des_7 = caja_des 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]]

caja_des_8 :: Bits6 -> Bits4
caja_des_8 = caja_des 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

_______________

y Esta es la sugerencia que me hicieron pero que no sé como agregarla
a mi código


En la librería Data.Char tienes la función ord :: Char -> Int que
convierte un caracter a su valor ASCII. En ghci puedes ver

Prelude> :m Data.Char
Prelude Data.Char> map ord "foo"
[102,111,111]

La función encrypt requiere un Word64, o sea, por lo menos 8 bytes.
Así
que debes tomar de a ocho bytes de la lista y combinarlos en un sólo
valor: el primero es el más significativo así que puedes ir haciendo
el
proceso haciendo shifts izquierdos de ocho posiciones (o multiplicar
por
ocho) y sumando lo que viene. Si tienes una lista de ocho números,
algo
como

import Data.Word

toWord64 :: [Integer] -> Word64
toWord64 (i:is) = foldl (\c v -> 8*c + (fromInteger v :: Word64) )
(fromInteger i :: Word64) is

toWord64List :: [Integer] -> [Word64]
toWord64List is =
case chunkSize of
0 -> []
8 -> toWord64 chunk : toWord64List rest
_ -> [ toWord64 $ chunk ++ (take (8-chunkSize) $ repeat 0) ]
where (chunk,rest) = splitAt 8 is
chunkSize = length chunk

___________________

Agradezco a quien me apoye