module Crypto.Classical.Types
(
Cipher(..)
, Key(..)
, EnigmaKey(..)
, Rotor(..)
, Reflector
, Plugboard
, name
, turnover
, circuit
, rotors
, settings
, reflector
, plugboard
, plugFrom
) where
import Crypto.Classical.Shuffle
import Crypto.Classical.Util
import Crypto.Number.Generate
import Crypto.Random (CPRG)
import Data.ByteString.Lazy (ByteString)
import Data.Char (isUpper)
import Data.List ((\\))
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Modular
import Data.Monoid ((<>))
import Data.Text (Text)
import Lens.Micro
import Lens.Micro.TH
class Key k => Cipher k a | a -> k where
encrypt :: k -> ByteString -> a ByteString
decrypt :: k -> ByteString -> a ByteString
class Key a where
key :: CPRG g => g -> a
instance Key (ℤ/26) where
key g = toMod . fst $ generateBetween g 1 25
instance Key (ℤ/26,ℤ/26) where
key g = (a,b) & _1 %~ toMod
where a = head $ shuffle g ([1,3..25] \\ [13]) 12
b = key g
instance Key (Map Char Char) where
key g = M.fromList $ zip ['A'..'Z'] $ shuffle g ['A'..'Z'] 26
instance Key [ℤ/26] where
key g = n : key g'
where (n,g') = generateMax g 26 & _1 %~ toMod
data Rotor = Rotor { _name :: Text
, _turnover :: ℤ/26
, _circuit :: Map (ℤ/26) (ℤ/26) } deriving (Eq,Show)
makeLenses ''Rotor
rI :: Rotor
rI = Rotor "I" (int 'Q') $ M.fromList (pairs & traverse . both %~ int)
where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "EKMFLGDQVZNTOWYHXUSPAIBRCJ"
rII :: Rotor
rII = Rotor "II" (int 'E') $ M.fromList (pairs & traverse . both %~ int)
where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "AJDKSIRUXBLHWTMCQGZNPYFVOE"
rIII :: Rotor
rIII = Rotor "III" (int 'V') $ M.fromList (pairs & traverse . both %~ int)
where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "BDFHJLCPRTXVZNYEIWGAKMUSQO"
rIV :: Rotor
rIV = Rotor "IV" (int 'J') $ M.fromList (pairs & traverse . both %~ int)
where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "ESOVPZJAYQUIRHXLNFTGKDCMWB"
rV :: Rotor
rV = Rotor "V" (int 'Z') $ M.fromList (pairs & traverse . both %~ int)
where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "VZBRGITYUPSDNHLXAWMJQOFECK"
type Reflector = Map (ℤ/26) (ℤ/26)
ukwB :: Reflector
ukwB = M.fromList (pairs & traverse . both %~ int)
where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "YRUHQSLDPXNGOKMIEBFZCWVJAT"
type Plugboard = Map (ℤ/26) (ℤ/26)
data EnigmaKey = EnigmaKey { _rotors :: [Rotor]
, _settings :: [Char]
, _reflector :: Reflector
, _plugboard :: Plugboard
} deriving (Eq,Show)
makeLenses ''EnigmaKey
instance Key EnigmaKey where
key g = EnigmaKey rs ss ukwB $ randPlug g
where rn = 3
rs = take rn $ shuffle g [rI,rII,rIII,rIV,rV] 5
ss = randChars g rn
randChars :: CPRG g => g -> Int -> [Char]
randChars _ 0 = []
randChars g n = c : randChars g' (n1)
where (c,g') = generateBetween g 0 25 & _1 %~ letter . toMod
randPlug :: CPRG g => g -> Plugboard
randPlug g = M.fromList (pairs <> singles)
where shuffled = shuffle g [0..25] 26
(ps,ss) = (take 20 shuffled, drop 20 shuffled)
pairs = foldr (\(k,v) acc -> (k,v) : (v,k) : acc) [] $ uniZip ps
singles = foldr (\v acc -> (v,v) : acc) [] ss
plugFrom :: [(Char,Char)] -> Plugboard
plugFrom = f []
where f acc [] = let rest = stretch (['A'..'Z'] \\ acc) in
M.fromList . uniZip . map int $ acc ++ rest
f acc ((a,b):ps) | a `notElem` acc && b `notElem` acc &&
isUpper a && isUpper b = f (a : b : b : a : acc) ps
| otherwise = f acc ps