{-# LANGUAGE ScopedTypeVariables,GeneralizedNewtypeDeriving #-}
{-
Copyright 2011 Ken Takusagawa

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

-}
module Main (main) where{
import Data.Maybe;
import Data.List;
import Data.Char;

main :: IO(());
main = example;
type Permutation a b = []((a, b));
enum_zero_size :: Int -> [](Int);
enum_zero_size length = (take length (enumFrom 0));
do_substitution :: (Eq (a)) => Permutation(a)(b) -> a -> b;
do_substitution p x = (fromJust((lookup x p)));
do_permutation :: [](Int) -> [](a) -> [](a);
do_permutation template l = (do{
  i :: Int <- (enum_zero_size (length l));
  (return ((!!) l ((!!) template i)));
});
bacon_list :: [](String);
bacon_list = (sequence((replicate 5)("ab")));
a32lphabet :: String;
a32lphabet = latin_alphabet_32;
punctuation_alphabet :: String;
punctuation_alphabet = ((++) alphabet26 ".,'-_\\");
latin_alphabet_32 :: String;
latin_alphabet_32 = ((++) alphabet26 (map toEnum [229, 233, 234, 243, 248, 252]));
alphabet26 :: String;
alphabet26 = (enumFromTo (head "a") (head "z"));
bacon_sep :: (String -> [](String));
bacon_sep = (substitution a32lphabet bacon_list);
bacon :: (String -> String);
bacon = (concat . bacon_sep);
un_bacon :: String -> String;
un_bacon s = ((map (do_substitution (zip bacon_list a32lphabet)))((n_chunk 5)(s)));
arrange_into_columns :: Int -> [](a) -> []([](a));
arrange_into_columns num_columns l = (transpose((n_chunk num_columns)(l)));
columnar_transposition :: [](Int) -> [](a) -> [](a);
columnar_transposition p l = (concat((do_permutation p)((arrange_into_columns (length p))(l))));
n_chunk :: Int -> [](a) -> []([](a));
n_chunk n l = (case l of {
  ([] )-> [];
  (_ )-> ((:) (take n l) (n_chunk n (drop n l)))
});
type Op a = (a -> a -> a);
encrypt_cipher_block_chain_for_scanl :: (ivtype -> ciphertype -> ivtype) -> (plaintype -> ciphertype) -> ivtype -> plaintype -> ivtype;
encrypt_cipher_block_chain_for_scanl xor cipher iv p = (xor iv (cipher p));
decrypt_cipher_block_chain :: forall plaintype ciphertype ivtype . (ivtype -> ivtype -> ciphertype) -> (ciphertype -> plaintype) -> ivtype -> [](ivtype) -> [](plaintype);
decrypt_cipher_block_chain unxor decipher iv civs = (case civs of {
  ([] )-> [];
  ((:) (civ ) (t ))-> (let {
c :: ciphertype;
c = (unxor civ iv)
}
 in ((:) (decipher c) (decrypt_cipher_block_chain unxor decipher civ t)))
});
index_alphabet :: (Eq (a)) => [](a) -> a -> Int;
index_alphabet alphabet x = (fromJust((lookup x)((zip alphabet)(enumFrom(0)))));
plus_cyclic_alphabet :: (Eq (a)) => [](a) -> a -> a -> a;
plus_cyclic_alphabet alphabet x y = ((!!) alphabet (mod ((+) (index_alphabet alphabet x) (index_alphabet alphabet y)) (length alphabet)));
minus_cyclic_alphabet :: (Eq (a)) => [](a) -> a -> a -> a;
minus_cyclic_alphabet alphabet x y = ((!!) alphabet (mod ((-) (index_alphabet alphabet x) (index_alphabet alphabet y)) (length alphabet)));
auto_cipher :: forall input ivtype output . (input -> ivtype) -> (ivtype -> [](input) -> [](output)) -> [](input) -> [](output);
auto_cipher input_to_iv cipher p = (case p of {
  ([] )-> [];
  ((:) (h ) (t ))-> (let {
iv :: ivtype;
iv = (input_to_iv h)
}
 in (cipher iv t))
});
newtype Iv a = Iv {un_Iv :: a} deriving (Show);
newtype Plain a = Plain {un_Plain :: a};
newtype Cipher a = Cipher {un_Cipher :: a};
cycle_encrypt :: String -> Iv(Char) -> Cipher(Char) -> Iv(Char);
cycle_encrypt alphabet iv c = (Iv (plus_cyclic_alphabet alphabet (un_Cipher c) (un_Iv iv)));
cycle_decrypt :: String -> Iv(Char) -> Iv(Char) -> Cipher(Char);
cycle_decrypt alphabet civ iv = (Cipher (minus_cyclic_alphabet alphabet (un_Iv civ) (un_Iv iv)));
id_cipher :: (Plain(a) -> Cipher(a));
id_cipher = (Cipher . un_Plain);
id_decipher :: (Cipher(a) -> Plain(a));
id_decipher = (Plain . un_Cipher);
p_to_iv :: (Plain(a) -> Iv(a));
p_to_iv = (Iv . un_Plain);
cbc_encrypt :: String -> (String -> String);
cbc_encrypt alphabet = ((map un_Iv) . (auto_cipher p_to_iv (scanl (encrypt_cipher_block_chain_for_scanl (cycle_encrypt alphabet) id_cipher))) . (map Plain));
cbc_decrypt :: String -> String -> String;
cbc_decrypt alphabet c = (case c of {
  ([] )-> [];
  _ -> ((:) (head c) ((map un_Plain)((auto_cipher id (decrypt_cipher_block_chain (cycle_decrypt alphabet) id_decipher))((map Iv)(c)))))
});
division_list :: Int -> Int -> [](Int);
division_list big small = (let {
dm :: (Int, Int);
dm = (divMod big small)
}
 in ((++) (replicate (snd dm) ((+) 1 (fst dm))) (replicate ((-) small (snd dm)) (fst dm))));
nm_chunk :: [](Int) -> [](a) -> []([](a));
nm_chunk ns as = (case ns of {
  ([] )-> [];
  ((:) (h ) (t ))-> ((:) (take h as) (nm_chunk t (drop h as)))
});
un_columnar_transposition :: [](Int) -> [](a) -> [](a);
un_columnar_transposition p l = (concat(transpose((do_permutation (inverse_permutation p))((nm_chunk (do_permutation p (division_list (length l) (length p))))(l)))));
inverse_permutation :: [](Int) -> [](Int);
inverse_permutation p = ((map (index_alphabet p))(enum_zero_size(length(p))));
data Template  = C(Char) | Upper | Lower deriving (Show);
make_template :: Char -> Template;
make_template c = (case (isAlpha c) of {
  False-> (C c);
  _ -> (case (isUpper c) of {
  True-> Upper;
  False-> Lower
})
});
fill_template :: [](Template) -> String -> String;
fill_template t s = (case t of {
  ([] )-> [];
  ((:) (h ) (t ))-> (let {
rest :: Char -> String -> String;
rest h s = ((:) h (fill_template t s))
}
 in (case h of {
  (C c)-> (rest c s);
  Lower-> (rest (head s) (tail s));
  Upper-> (rest (toUpper(head(s))) (tail s))
}))
});
get_lower :: (String -> String);
get_lower = ((map toLower) . (filter isAlpha));
wrap_template :: (String -> String) -> String -> String;
wrap_template f s = ((fill_template (map make_template s))(f(get_lower(s))));
first_amd :: String;
first_amd = "Congress shall make no law respecting an establishment of religion, or prohibiting the free exercise thereof; or abridging the freedom of speech, or of the press; or the right of the people peaceably to assemble, and to petition the Government for a redress of grievances.";
tfirst :: String;
tfirst = ((take 270 first_amd) ++ "b.");
permutation_32 :: [](Int);
permutation_32 = [19, 6, 24, 27, 1, 22, 2, 0, 12, 11, 26, 14, 17, 9, 15, 3, 4, 29, 7, 20, 30, 5, 13, 21, 16, 25, 18, 23, 31, 28, 10, 8];
letter_26_permutation :: String;
letter_26_permutation = "bmtisxlqnpwgkuzerfdavhcjyo";
sub32 :: (String -> String);
sub32 = (substitution a32lphabet (map ((!!) a32lphabet) permutation_32));
un_sub32 :: (String -> String);
un_sub32 = (un_substitution a32lphabet (map ((!!) a32lphabet) permutation_32));
sub26 :: (String -> String);
sub26 = (substitution alphabet26 letter_26_permutation);
un_sub26 :: (String -> String);
un_sub26 = (un_substitution alphabet26 letter_26_permutation);
substitution :: (Eq (a)) => [](a) -> [](b) -> [](a) -> [](b);
substitution as bs x = (map (do_substitution (zip as bs)) x);
un_substitution :: (Eq (b)) => [](a) -> [](b) -> [](b) -> [](a);
un_substitution as bs x = (map (do_substitution (zip bs as)) x);
perm :: ([](a) -> [](a));
perm = (columnar_transposition permutation_32);
un_perm :: ([](a) -> [](a));
un_perm = (un_columnar_transposition permutation_32);
cbc :: (String -> String);
cbc = (cbc_encrypt a32lphabet);
un_cbc :: (String -> String);
un_cbc = (cbc_decrypt a32lphabet);
run :: (String -> String) -> IO(());
run f = (putStrLn((wrap_template f)(first_amd)));
caesar_substitution :: Int -> String;
caesar_substitution n = (map (plus_cyclic_alphabet a32lphabet ((!!) a32lphabet n)) a32lphabet);
caesar :: Int -> (String -> String);
caesar n = (substitution a32lphabet (caesar_substitution n));
n_iterate :: Int -> (a -> a) -> a -> a;
n_iterate n f x = ((!!) (iterate f x) n);
example :: IO(());
example = (do{
  (putStrLn((intersperse (head " "))(latin_alphabet_32)));
  (putStrLn(unwords((map show)(permutation_32))));
  (putStrLn first_amd);
  (run (caesar 2));
  (run sub32);
  (run perm);
  (putStrLn(unwords(bacon_sep(get_lower(first_amd)))));
  (run (un_bacon . perm . bacon));
  (run cbc);
  (run (sub32 . cbc));
  (putStrLn "=========================");
  (putStrLn tfirst);
  (run (un_bacon . perm . bacon . sub32));
  (putStrLn((wrap_template (un_bacon . perm . bacon . sub32))(tfirst)));
  (putStrLn "=========================");
  let {
x :: (String -> String);
x = (cbc . un_bacon . perm . bacon . sub32);
y :: (String -> String);
y = (un_sub32 . un_bacon . un_perm . bacon . un_cbc)
};
  (run x);
  (putStrLn((wrap_template x)(tfirst)));
  (putStrLn "=========================");
  (run (x . x . x));
  (putStrLn((wrap_template (x . x . x))(tfirst)));
  (putStrLn "=========================");
  (run (y . y . y . x . x . x));
  (run (n_iterate 3 x));
  (run (n_iterate 1000000 x));
})
}