PbjcUNS7

1module MiniCrypto where
2
3{-
4  PP, Laboratorul 7
5
6  Laboratorul presupune implementarea unei mini-biblioteci de primitive
7  criptografice: cifrări flux, cifrări bazate pe substituție (Caesar,
8  Vigenere, One Time Pad).
9-}
10
11import Data.List
12import Data.Word
13import Data.Bits
14import Data.Char
15import System.Random hiding (randoms)
16import TestPP
17
18{-
19Testare:
20- Pentru a rula toate testele apelati functia check
21> check
22
23- Pentru a rula testele asociate exercitiului cu indicele 'i', apelati 'checki'
24De exemplu, pentru a verifica exercitiul 6:
25> check6 
26-}
27
28{-
29  Funcții auxiliare: conversie Char-Word
30-}
31charToWord :: Char -> Word8
32charToWord = fromIntegral . fromEnum
33
34wordToChar :: Word8 -> Char
35wordToChar = toEnum . fromIntegral
36        
37{-
38  1. (1p)  
39  Construiți funcția myCycle, care ia ca argument o listă și întoarce lista
40  repetată la infinit. Ex: myCycle [1,2,3] = [1,2,3,1,2,3,1,2,3,1,2,3,..]
41
42  Hint: Puteți defini funcția „point-free”, folosind funcții din cadrul
43  modulului Data.List.
44  http://hackage.haskell.org/package/base-4.6.0.1/docs/Data-List.html
45
46  Observaţie: Nu folosiți în implementare funcția cycle. :-)
47-}
48
49test1 :: TestPP ()
50test1 = testOne 1 $ testVal (take 42 $ myCycle xs) (take 42 $ cycle xs) "myCycle" 1
51  where xs = [1,2,3,4]
52
53myCycle :: [a] -> [a]
54myCycle = concat . repeat
55
56{-
57  2. (2p)
58  Construiţi o progresie aritmetică şi o progresie geometrică pornind de la 
59  primul termen şi raţia în fiecare dintre cazuri.
60  Ex: arithmetic 1 3 = [1,4,7,..]
61      geometric  2 3 = [2,6,18,..]
62
63  Hint: folosiţi funcţia iterate din cadrul modulului Data.List.
64  http://hackage.haskell.org/package/base-4.6.0.1/docs/Data-List.html
65-}
66
67test2 :: TestPP ()
68test2 = tests 2 2
69  [ testVal (take 10 $ arithmetic initial r) [5,11,17,23,29,35,41,47,53,59] "arithmetic" 1
70  , testVal (take 10 $ geometric initial q) [5,10,20,40,80,160,320,640,1280,2560] "geometric" 1
71  ]
72  where { initial = 5 ; r = 6 ; q = 2 }
73
74arithmetic :: Num a => a -> a -> [a]
75arithmetic initial ratio = iterate (+ ratio) initial
76
77geometric :: Num a => a -> a -> [a]
78geometric initial ratio = iterate (* ratio) initial
79
80{-
81  3. (2p)
82  Construiți o funcție care întoarce un șir infinit de numere pseudo-aleatoare,
83  plecând de la o valoare „seed” întreagă. 
84  
85  Tipul elementelor listei va fi Word8 (numerele vor fi între 0 și 255). 
86  Folosiți fromIntegral pentru a realiza conversii între tipuri numerice întregi.
87  
88  Folosiți funcțiile definite în modulul System.Random pentru a genera numere.
89  http://www.haskell.org/ghc/docs/6.12.2/html/libraries/random-1.0.0.2/System-Random.html
90
91  Ex: > take 10 $ randoms 42
92  [38,166,220,81,67,142,213,118,105,10]
93
94  Hint: Folosiți-vă de mkStdGen, next și (eventual) alte funcții din
95  System.Random. *Nu* este necesară folosirea de funcții care întorc
96  valori de tipul IO.
97-}
98
99test3 :: TestPP ()
100test3 = testOne 3 $ testVal (take 10 $ randoms 42) [38,166,220,81,67,142,213,118,105,10] "randoms" 2
101
102randoms :: Int -> [Word8]
103randoms seed = tail $ map (fromIntegral . fst) $ iterate (next . snd) (0, mkStdGen seed)
104
105{-
106    4. (1p)
107    Implementați o funcție care convertește un element de tipul Word8 (0 - 255) într-un caracter
108    alfabetic ('a' - 'z').
109    
110    Ex: > map wordToAlpha [0, 1, 2, 3, 26, 27, 28, 29]
111    "abcdabcd"
112       
113    Recomandare: folosiți o clauză where sau let.
114       
115    Hint: Puteți folosi funcțiile 'ord' si 'chr' din Data.Char.
116    https://hackage.haskell.org/package/base-4.11.0.0/docs/Data-Char.html#g:6
117    
118    Hint: Puteți folosi funcțiile fromIntegral, mod.
119-}
120
121test4 :: TestPP ()
122test4 = testOne 4 $ testVal (map wordToAlpha [0..255]) (take 256 $ cycle ['a'..'z']) "wordToAlpha" 1
123
124wordToAlpha :: Word8 -> Char
125wordToAlpha x = chr $ base + idx
126    where
127        base = ord 'a'
128        idx  = fromIntegral $ x `mod` 26
129
130{-
131    4. (1p)
132    Implementați o funcție care generează o secvență infinită de caractere alfabetice
133    pseudo-aleatoare, plecând de la o valoare "seed" întreagă.
134    
135    Observație: Implementați funcția „point-free”.
136    Hint: Folosiți funcțiile randoms si wordToAlpha de la exercițiile anterioare.
137-}
138
139test5 :: TestPP ()
140test5 = testOne 5 $ testVal (take 10 $ randomAlphaKey 42) "mkmdpmfobk" "randomAlphaKey" 1
141
142randomAlphaKey :: Int -> String
143randomAlphaKey = map wordToAlpha . randoms
144
145{-
146  6. (3p)
147  Implementați funcția tableToFunc, care primește o listă de asocieri
148  (caracter-clar, caracter-criptat) și întoarce o funcție de substituție.
149
150  Implementați funcția substCrypt, care primește o listă de asocieri
151  (caracter-clar, caracter-criptat) și un
152  șir de caractere și întoarce șirul de caractere criptat pe baza tabelei.
153
154  Observație: tableToFunc va fi implementată obligatoriu utilizând o clauză
155  where/let, cu pattern matching.
156
157  Observație: substCrypt va fi implementată obligatoriu „point-free” (nu va
158  avea parametri expliciți), folosind funcționale și/sau clauze let/where.
159-}
160
161test6 :: TestPP ()
162test6 = tests 6 3
163  [ testVal (substCrypt rot13Table str) cryptstr "substCrypt" 2
164  , testVal (tableToFunc rot13Table 'd') 'q' "tableToFunc" 1
165  ]
166  where
167   str      = "thequickbrownfoxjumpsoverthelazydog"
168   cryptstr = "gurdhvpxoebjasbkwhzcfbiregurynmlqbt"
169
170rot13Table = [('a','n'),('b','o'),('c','p'),('d','q'),('e','r'),
171              ('f','s'),('g','t'),('h','u'),('i','v'),('j','w'),
172              ('k','x'),('l','y'),('m','z'),('n','a'),('o','b'),
173              ('p','c'),('q','d'),('r','e'),('s','f'),('t','g'),
174              ('u','h'),('v','i'),('w','j'),('x','k'),('y','l'),
175              ('z','m')]   
176
177tableToFunc :: [(Char, Char)] -> Char -> Char
178tableToFunc t key = value
179    where
180    (_, value) : _ = filter ((key ==) . fst) t
181        
182substCrypt :: [(Char, Char)] -> String -> String
183substCrypt = map . tableToFunc
184
185{-
186    7. (Bonus - 2p)
187    
188    Implementați funcția getRotTable, care produce o listă de asocieri 
189    (caracter-clar, caracter-criptat). Funcția primește un parametru 'offset' și 
190    va construi o asociere între fiecare caracter alfabetic (litere mici) și 
191    caracterul aflat după următoarele 'offset' poziții.
192    
193    Ex: > getRotTable 1 
194    [('a','b'),('b','c'),('c','d'),('d','e'),('e','f'),('f','g'),('g','h'),
195     ('h','i'),('i','j'),('j','k'),('k','l'),('l','m'),('m','n'),('n','o'),
196     ('o','p'),('p','q'),('q','r'),('r','s'),('s','t'),('t','u'),('u','v'),
197     ('v','w'),('w','x'),('x','y'),('y','z'),('z','a')]
198    
199    Ex: > getRotTable 13 
200    [('a','n'),('b','o'),('c','p'),('d','q'),('e','r'),('f','s'),('g','t'),
201     ('h','u'),('i','v'),('j','w'),('k','x'),('l','y'),('m','z'),('n','a'),
202     ('o','b'),('p','c'),('q','d'),('r','e'),('s','f'),('t','g'),('u','h'),
203     ('v','i'),('w','j'),('x','k'),('y','l'),('z','m')]    
204    
205    Hint: Puteți să folosiți zip sau zipWith
206    http://hackage.haskell.org/package/base-4.11.0.0/docs/Prelude.html#g:20
207    
208    Hint: Pentru a genera lista cu toate caracterele din alfabet, 
209    puteți folosi expresia: ['a'..'z']
210-}
211
212test7 :: TestPP ()
213test7 = tests 7 2
214  [ testVal
215    (genRotTable 1)
216    [('a','b'),('b','c'),('c','d'),('d','e'),('e','f'),('f','g'),('g','h'),('h','i'),
217         ('i','j'),('j','k'),('k','l'),('l','m'),('m','n'),('n','o'),('o','p'),('p','q'),
218         ('q','r'),('r','s'),('s','t'),('t','u'),('u','v'),('v','w'),('w','x'),('x','y'),
219         ('y','z'),('z','a')]
220    "genRotTable 1" 1
221  , testVal
222    (genRotTable 13)
223    [('a','n'),('b','o'),('c','p'),('d','q'),('e','r'),('f','s'),('g','t'),('h','u'),
224        ('i','v'),('j','w'),('k','x'),('l','y'),('m','z'),('n','a'),('o','b'),('p','c'),
225        ('q','d'),('r','e'),('s','f'),('t','g'),('u','h'),('v','i'),('w','j'),('x','k'),
226        ('y','l'),('z','m')]
227    "genRotTable 2" 1
228  ]
229
230genRotTable :: Int -> [(Char, Char)]
231genRotTable offset = zip alfa new_seq
232    where
233        alfa    = ['a'..'z']
234        new_seq = drop offset $ myCycle alfa
235                
236{-  8. (Bonus - 2p)
237
238    Ne propunem să implementăm o funcție de criptare numită encryptVigenere.
239    Mai multe despre aceasta tehnică de criptare:
240    http://practicalcryptography.com/ciphers/classical-era/vigenere-gronsfeld-and-autokey/
241    
242    Funcția encryptVigenere primește următoarele argumente: șirul de caractere alfabetice 
243    care trebuie criptat (plaintext) și o cheie secreta (secret-key).
244        
245    Fie `xi`, indexul caracterului alfabetic de pe pozitia 'i' din sirul de caractere original.
246    Fie `yi`, indexul caracterului alfabetic de pe pozitia 'i' din cheia secreta generată la pasul anterior.
247    
248    Caracterul criptat de pe pozitia 'i' va putea fi obținut alegând cel de-al `xi` caracter
249    din alfabet, dacă alfabetul ar fi rotit cu `yi` poziții. (vom considera alfabetul indexat de la 0)
250    
251    Ex:
252    plaintext: 'def'
253    secretkey: 'bcd'
254    
255    Pentru prima poziție din șir: 
256    `xi` = 'd' (caracterul cu indexul 3 din alfabet)
257    `yi` = 'b' (caracterul cu indexul 1 din alfabet)
258    Alfabetul rotit cu 1 pozitie: "bcdefghijklmnopqrstuvwxyza"
259    Prin urmare, primul caracter criptat va fi: 'e' (al 3-lea element din alfabetul rotit)
260
261    Daca cheia are o lungime mai mică decat șirul care trebuie criptat, 
262    va fi duplicată pană va ajunge la aceeași dimensiune.
263    
264    > encryptVigenere "attackatdawn" "lemon"
265    "lxfopvefrnhr"    
266-}
267
268
269test8 :: TestPP ()
270test8 = tests 8 2
271  [ testVal
272    (encryptVigenere "attackatdawn" "lemon")
273    "lxfopvefrnhr"
274    "encryptVigenere 1" 1
275  , testVal
276    (encryptVigenere "theturtlemoves" "bcd")
277    "ujhuwuunhnqyfu"
278    "encryptVigenere 2" 1
279  ]
280
281encryptVigenere :: String -> String -> String
282encryptVigenere plain secret = zipWith encryptChar plain $ cycle secret
283    where
284        base = ord 'a'
285        encryptChar plain_ch key_ch = chr $ base + (ord plain_ch `mod` base + ord key_ch `mod` base) `mod` 26
286
287--O solutie alternativa:
288--encryptVigenere plain secret = zipWith tableToFunc rotTables plain
289  --where
290  --offsets = map (\c -> ord c - ord 'a') secret
291  --rotTables = cycle $ map genRotTable offsets
292
293{-
294    9. (Bonus - 1p)     
295    
296    Ne propunem să implementăm o funcție de criptare numită oneTimePad.
297    Mai multe despre aceasta tehnică de criptare:
298    http://practicalcryptography.com/ciphers/classical-era/running-key/
299    
300    Funcția primește următoarele argumente: șirul de caractere care trebuie criptat (plain)
301    și o valoare întreaga `seed`.
302    
303    1. Vom folosi parametrul `seed` pentru a genera o cheie secreta pseudo-aleatoare, de lungime egala
304    cu lungimea șirului care trebuie criptat. 
305    Hint: Apelați funcția randomAlphaKey
306    
307    2. In continuare, vom folosi aceeasi schema de criptare ca la exercitiul anterior.
308    
309    Observație: Implementați funcția „point-free” (doar primul parametru al
310    funcției va fi explicit).
311-}
312
313
314test9 :: TestPP ()
315test9 = testOne 5 $ testVal (oneTimePad "itsbettertolightacandlethancursethedarkness" 42) 
316                                        "udeetfyssdinlvwvoyiscebmqrgbwixmmilrnsvfbhv" "oneTimePad" 1
317        
318oneTimePad :: String -> Int -> String
319oneTimePad plain = encryptVigenere plain . randomAlphaKey
320
321{-
322Helpers for testing :)
323-}
324allTests = [test1, test2, test3, test4, test5, test6, test7, test8, test9]
325check = runTestPP $ sequence_ allTests
326[check1, check2, check3, check4, check5, check6, check7, check8, check9] = map runTestPP allTests