crypto-classical 0.2.0 → 0.2.1

raw patch · 30 files changed

+973/−991 lines, 30 filesdep +crypto-classicaldep −randomdep −random-shuffledep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: crypto-classical

Dependencies removed: random, random-shuffle

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• Crypto/Classical.hs +0/−23
• Crypto/Classical/Cipher.hs +0/−23
• Crypto/Classical/Cipher/Affine.hs +0/−54
• Crypto/Classical/Cipher/Caesar.hs +0/−50
• Crypto/Classical/Cipher/Enigma.hs +0/−84
• Crypto/Classical/Cipher/Stream.hs +0/−57
• Crypto/Classical/Cipher/Substitution.hs +0/−46
• Crypto/Classical/Cipher/Vigenere.hs +0/−48
• Crypto/Classical/Letter.hs +0/−24
• Crypto/Classical/Shuffle.hs +0/−80
• Crypto/Classical/Test.hs +0/−119
• Crypto/Classical/Types.hs +0/−193
• Crypto/Classical/Util.hs +0/−100
• LICENSE +1/−1
• README.md +11/−0
• crypto-classical.cabal +87/−89
• lib/Crypto/Classical.hs +21/−0
• lib/Crypto/Classical/Cipher.hs +23/−0
• lib/Crypto/Classical/Cipher/Affine.hs +52/−0
• lib/Crypto/Classical/Cipher/Caesar.hs +47/−0
• lib/Crypto/Classical/Cipher/Enigma.hs +83/−0
• lib/Crypto/Classical/Cipher/Stream.hs +54/−0
• lib/Crypto/Classical/Cipher/Substitution.hs +44/−0
• lib/Crypto/Classical/Cipher/Vigenere.hs +48/−0
• lib/Crypto/Classical/Letter.hs +12/−0
• lib/Crypto/Classical/Shuffle.hs +80/−0
• lib/Crypto/Classical/Types.hs +190/−0
• lib/Crypto/Classical/Util.hs +100/−0
• test/Test.hs +115/−0

@@ -0,0 +1,5 @@+# crypto-classical++## 0.2.1++- Bumped bounds and modernized the library.

@@ -1,23 +0,0 @@--- |--- Module    : Crypto.Classical--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>------ A reexport of every module.--module Crypto.Classical-  ( module Crypto.Classical.Cipher-  , module Crypto.Classical.Letter-  , module Crypto.Classical.Shuffle-  , module Crypto.Classical.Test-  , module Crypto.Classical.Types-  , module Crypto.Classical.Util-  ) where--import Crypto.Classical.Cipher-import Crypto.Classical.Letter-import Crypto.Classical.Shuffle-import Crypto.Classical.Test-import Crypto.Classical.Types-import Crypto.Classical.Util

@@ -1,23 +0,0 @@--- |--- Module    : Crypto.Classical--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>---- A reexport of every Cipher module.--module Crypto.Classical.Cipher-   ( module Crypto.Classical.Cipher.Affine-   , module Crypto.Classical.Cipher.Caesar-   , module Crypto.Classical.Cipher.Enigma-   , module Crypto.Classical.Cipher.Stream-   , module Crypto.Classical.Cipher.Substitution-   , module Crypto.Classical.Cipher.Vigenere-   ) where--import Crypto.Classical.Cipher.Affine-import Crypto.Classical.Cipher.Caesar-import Crypto.Classical.Cipher.Enigma-import Crypto.Classical.Cipher.Stream-import Crypto.Classical.Cipher.Substitution-import Crypto.Classical.Cipher.Vigenere

@@ -1,54 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}---- |--- Module    : Crypto.Classical.Affine--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Cipher.Affine where--import           Control.Applicative-import           Crypto.Classical.Types-import           Crypto.Classical.Util-import qualified Data.ByteString.Lazy.Char8 as B-import           Data.Char-import           Data.Modular-import           Lens.Micro-import           Lens.Micro.TH--------- | An Affine Cipher is a non-random Substitution Cipher, such that a--- character `x` is mapped to a cipher character according to the equation:------ f(x) = ax + b (mod 26)------ Also known as a Linear Cipher.-newtype Affine a = Affine { _affine :: a } deriving (Eq,Show,Functor)-makeLenses ''Affine--instance Applicative Affine where-  pure = Affine-  Affine f <*> Affine a = Affine $ f a--instance Monad Affine where-  return = pure-  Affine a >>= f = f a--instance Cipher (ℤ/26,ℤ/26) Affine where-  encrypt (a,b) = pure . B.map f-    where f c | isLower c = f $ toUpper c-              | not $ isLetter c = c-              | otherwise = letter $ a * int c + b--  decrypt (a,b) = pure . B.map f-    where f c | isLower c = f $ toUpper c-              | not $ isLetter c = c-              | otherwise = letter $ (int c - b) * inverse a

@@ -1,50 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}---- |--- Module    : Crypto.Classical.Caesar--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Cipher.Caesar where--import           Control.Applicative-import           Crypto.Classical.Types-import           Crypto.Classical.Util-import qualified Data.ByteString.Lazy.Char8 as B-import           Data.Char-import           Data.Modular-import           Lens.Micro-import           Lens.Micro.TH--------- | A simple Shift Cipher. The key is a number by which to shift each--- letter in the alphabet. Example:------ >>> encrypt 3 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ^. caesar--- "DEFGHIJKLMNOPQRSTUVWXYZABC"-newtype Caesar a = Caesar { _caesar :: a } deriving (Eq,Show,Functor)-makeLenses ''Caesar--instance Applicative Caesar where-  pure = Caesar-  Caesar f <*> Caesar a = Caesar $ f a--instance Monad Caesar where-  return = pure-  Caesar a >>= f = f a--instance Cipher (ℤ/26) Caesar where-  encrypt k = pure . B.map f-    where f c | isLower c = f $ toUpper c-              | not $ isLetter c = c-              | otherwise = letter $ int c + k--  decrypt k = encrypt (-k)

@@ -1,84 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeOperators #-}---- |--- Module    : Crypto.Classical.Cipher.Enigma--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Cipher.Enigma where--import           Control.Applicative-import           Control.Monad.Trans.State.Lazy-import           Crypto.Classical.Types-import           Crypto.Classical.Util-import qualified Data.ByteString.Lazy.Char8 as B-import           Data.Char-import           Data.Map.Lazy (Map)-import qualified Data.Map.Lazy as M-import           Data.Maybe (fromJust)-import           Data.Modular-import           Lens.Micro-import           Lens.Micro.TH-------newtype Enigma a = Enigma { _enigma :: a } deriving (Eq,Show,Functor)-makeLenses ''Enigma--instance Applicative Enigma where-  pure = Enigma-  Enigma f <*> Enigma a = Enigma $ f a--instance Monad Enigma where-  return = pure-  Enigma a >>= f = f a---- | When a machine operator presses a key, the Rotors rotate.--- A circuit is then completed as they hold the key down, and a bulb--- is lit. Here, we make sure to rotate the Rotors before encrypting--- the character.--- NOTE: Decryption is the same as encryption.-instance Cipher EnigmaKey Enigma where-  decrypt = encrypt-  encrypt k m = pure . B.pack $ evalState (traverse f $ B.unpack m) k'-    where k' = withInitPositions k-          f c | not $ isLetter c = return c-              | isLower c = f $ toUpper c-              | otherwise = do-                  modify (& rotors %~ turn)-                  (EnigmaKey rots _ rl pl) <- get-                  let rs  = rots ^.. traverse . circuit-                      rs' = reverse $ map mapInverse rs-                      pl' = mapInverse pl-                      cmp = foldl1 compose-                      e   = pl |.| cmp rs |.| rl |.| cmp rs' |.| pl'-                  return . letter . fromJust . flip M.lookup e $ int c---- | Applies the initial Rotor settings as defined in the Key to--- the Rotors themselves. These initial rotations do not trigger--- the turnover of neighbouring Rotors as usual.-withInitPositions :: EnigmaKey -> EnigmaKey-withInitPositions k = k & rotors .~ zipWith f (k ^. rotors) (k ^. settings)-  where f r s = (r & circuit %~ rotate (int s)-                   & turnover %~ (\n -> n - int s))---- | Turn the (machine's) right-most (left-most in List) Rotor by one--- position. If its turnover value wraps back to 25, then turn the next--- Rotor as well.-turn :: [Rotor] -> [Rotor]-turn []     = []-turn (r:rs) = if (r' ^. turnover) == 25 then r' : turn rs else r' : rs-  where r' = r & circuit %~ rotate 1 & turnover %~ (\n -> n - 1)---- | Rotate a Rotor by `n` positions. By subtracting 1 from every key--- and value, we perfectly simulate rotation. Example:------ >>> rotate $ M.fromList [(0,2),(1,0),(2,3),(3,4),(4,1)]--- M.fromList [(4,1),(0,4),(1,2),(2,3),(3,0)]-rotate :: ℤ/26 -> Map (ℤ/26) (ℤ/26) -> Map (ℤ/26) (ℤ/26)-rotate n r = M.fromList (M.toList r & traverse . both %~ (\n' -> n' - n))

@@ -1,57 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}---- |--- Module    : Crypto.Classical.Stream--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Cipher.Stream where--import           Control.Applicative-import           Crypto.Classical.Types-import           Crypto.Classical.Util-import qualified Data.ByteString.Lazy.Char8 as B-import           Data.Char-import           Data.Modular-import           Lens.Micro-import           Lens.Micro.TH--------- | A Cipher with pseudorandom keys as long as the plaintext.--- Since Haskell is lazy, our keys here are actually of infinite length.------ If for whatever reason a key of finite length is given to `encrypt`,--- the ciphertext is cutoff to match the key length. Example:------ >>> encrypt [1,2,3] "ABCDEF" ^. stream--- "BDF"-newtype Stream a = Stream { _stream :: a } deriving (Eq,Show,Functor)-makeLenses ''Stream--instance Applicative Stream where-  pure = Stream-  Stream f <*> Stream a = Stream $ f a--instance Monad Stream where-  return = pure-  Stream a >>= f = f a--instance Cipher [ℤ/26] Stream where-  encrypt k = pure . B.pack . f k . B.unpack-    where f _ [] = []-          f [] _ = []-          f (kc:ks) (m:ms) -            | isLower m = f (kc:ks) (toUpper m : ms)-            | not $ isLetter m = m : f ks ms-            | otherwise = letter (int m + kc) : f ks ms--  decrypt k = encrypt k'-    where k' = map (* (-1)) k

@@ -1,46 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}---- |--- Module    : Crypto.Classical.Substitution--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Cipher.Substitution where--import           Control.Applicative-import           Crypto.Classical.Types-import           Crypto.Classical.Util-import qualified Data.ByteString.Lazy.Char8 as B-import           Data.Char-import           Data.Map.Lazy (Map)-import qualified Data.Map.Lazy as M-import           Lens.Micro-import           Lens.Micro.TH--------- | A Cipher whose key is a (pseudo)random mapping of characters--- to other characters. A character may map to itself.-newtype Substitution a = Substitution { _substitution :: a }-                       deriving (Eq,Show,Functor)-makeLenses ''Substitution--instance Applicative Substitution where-  pure = Substitution-  Substitution f <*> Substitution a = Substitution $ f a--instance Monad Substitution where-  return = pure-  Substitution a >>= f = f a--instance Cipher (Map Char Char) Substitution where-  encrypt m = pure . B.map f-    where f c | isLower c = f $ toUpper c-              | otherwise = M.findWithDefault c c m--  decrypt m = encrypt (mapInverse m)

@@ -1,48 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators #-}---- |--- Module    : Crypto.Classical.Vigenere--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Cipher.Vigenere where--import           Control.Applicative-import           Crypto.Classical.Cipher.Stream-import           Crypto.Classical.Types-import qualified Data.ByteString.Lazy.Char8 as B-import           Data.Modular-import           Lens.Micro-import           Lens.Micro.TH--------- | A Vigenère Cipher is just a Stream Cipher with a finite key,--- shorter than the length of the plaintext. The key is repeated for--- the entire length of the plaintext.-newtype Vigenère a = Vigenère { _vigenère :: a } deriving (Eq,Show,Functor)-makeLenses ''Vigenère--instance Applicative Vigenère where-  pure = Vigenère-  Vigenère f <*> Vigenère a = Vigenère $ f a--instance Monad Vigenère where-  return = pure-  Vigenère a >>= f = f a--instance Cipher [ℤ/26] Vigenère where-  encrypt k m = pure . (^. stream) . encrypt (vigKey m k) $ m-  decrypt k m = pure . (^.  stream) . decrypt (vigKey m k) $ m---- | Determine a Vigenère key from a Stream key.--- Weakness here: key length is a factor of the plaintext length.-vigKey :: B.ByteString -> [ℤ/26] -> [ℤ/26]-vigKey m k = concat . repeat . take (n+1) $ k-  where n = floor . logBase 2 . fromIntegral . B.length $ m

@@ -1,24 +0,0 @@--- |--- Module    : Crypto.Classical.Letter--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Letter where--import Control.Applicative ((<$>))-import Data.Char-import Test.QuickCheck--------- | A `Letter` is a capital Ascii letter (A-Z)-data Letter = Letter { _char :: Char } deriving (Eq,Show)--instance Arbitrary Letter where-  arbitrary = Letter <$> c-    where c = do-            c' <- arbitrary-            if isAsciiUpper c'-               then return c'-               else c

@@ -1,80 +0,0 @@--- |--- Module    : Crypto.Classical.Shuffle--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>------ Code borrowed from `random-shuffle` and modified to match--- crypto-random data types.--module Crypto.Classical.Shuffle-  (-    -- * List Scrambling-    shuffle-  ) where--import Crypto.Classical.Util-import Crypto.Random-import Data.Function (fix)--------- A complete binary tree, of leaves and internal nodes.--- Internal node: Node card l r--- where card is the number of leaves under the node.--- Invariant: card >=2. All internal tree nodes are always full.-data Tree a = Leaf !a-            | Node !Integer !(Tree a) !(Tree a)-            deriving Show---- Convert a sequence (e1...en) to a complete binary tree-buildTree :: [a] -> Tree a-buildTree = (fix growLevel) . (map Leaf)-  where growLevel _ [node] = node-        growLevel self l = self $ inner l--        inner [] = []-        inner [e] = [e]-        inner (e1 : e2 : es) = e1 `seq` e2 `seq` (join e1 e2) : inner es--        join l@(Leaf _)       r@(Leaf _)       = Node 2 l r-        join l@(Node ct _ _)  r@(Leaf _)       = Node (ct + 1) l r-        join l@(Leaf _)       r@(Node ct _ _)  = Node (ct + 1) l r-        join l@(Node ctl _ _) r@(Node ctr _ _) = Node (ctl + ctr) l r---- | Given a sequence (e1,...en) to shuffle, its length, and a random--- generator, compute the corresponding permutation of the input--- sequence.-shuffle :: CPRG g => g -> [a] -> Integer -> [a]-shuffle g elements = shuffle' elements . rseq g---- | Given a sequence (e1,...en) to shuffle, and a sequence--- (r1,...r[n-1]) of numbers such that r[i] is an independent sample--- from a uniform random distribution [0..n-i], compute the--- corresponding permutation of the input sequence.-shuffle' :: [a] -> [Integer] -> [a]-shuffle' elements = shuffleTree (buildTree elements)-  where shuffleTree (Leaf e) [] = [e]-        shuffleTree tree (r : rs) =-          let (b, rest) = extractTree r tree-          in b : (shuffleTree rest rs)-        shuffleTree _ _ = error "[shuffle] called with lists of different lengths"--        -- Extracts the n-th element from the tree and returns-        -- that element, paired with a tree with the element-        -- deleted.-        -- The function maintains the invariant of the completeness-        -- of the tree: all internal nodes are always full.-        extractTree 0 (Node _ (Leaf e) r) = (e, r)-        extractTree 1 (Node 2 (Leaf l) (Leaf r)) = (r, Leaf l)-        extractTree n (Node c (Leaf l) r) =-          let (e, r') = extractTree (n - 1) r-          in (e, Node (c - 1) (Leaf l) r')-        extractTree n (Node n' l (Leaf e))-          | n + 1 == n' = (e, l)-        extractTree n (Node c l@(Node cl _ _) r)-          | n < cl = let (e, l') = extractTree n l-                     in (e, Node (c - 1) l' r)-          | otherwise = let (e, r') = extractTree (n - cl) r-                        in (e, Node (c - 1) l r')-        extractTree _ _ = error "[extractTree] impossible"

@@ -1,119 +0,0 @@-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE OverloadedStrings #-}---- |--- Module    : Crypto.Classical.Test--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Test-  (-    -- * Cipher Tests-    cycleT-  , notSelfT-  , diffKeyT-  , noSelfMappingT-    -- * Misc. Tests-  , stretchT-  , plugFromT-    -- * Batch Tests-  , testAll-  ) where--import           Lens.Micro-import           Control.Monad (void)-import           Crypto.Classical.Cipher-import           Crypto.Classical.Letter-import           Crypto.Classical.Types-import           Crypto.Classical.Util-import           Data.ByteString.Lazy.Char8 (ByteString)-import qualified Data.ByteString.Lazy.Char8 as B-import qualified Data.Foldable as F-import           Test.QuickCheck--------- Not to be exported, as this only generates ByteStrings--- of capital Ascii characters.-instance Arbitrary ByteString where-  arbitrary = B.pack . map _char <$> arbitrary--------- | Run every test on every Cipher.-testAll :: IO ()-testAll = void . sequence $ cipherTs ++ otherTs--cipherTs :: [IO ()]-cipherTs = [ cycleT $ (^. caesar)-           , cycleT $ (^. affine)-           , cycleT $ (^. substitution)-           , cycleT $ (^. stream)-           , cycleT $ (^. vigenère)-           , cycleT $ (^. enigma)-           , notSelfT $ (^. caesar)-           , notSelfT $ (^. affine)-           , notSelfT $ (^. substitution)-           , notSelfT $ (^. stream)-           , notSelfT $ (^. vigenère)-           , notSelfT $ (^. enigma)-           , diffKeyT $ (^. caesar)-           , diffKeyT $ (^. affine)-           , diffKeyT $ (^. substitution)-           , diffKeyT $ (^. stream)-           , diffKeyT $ (^. vigenère)-           , diffKeyT $ (^. enigma)-           , noSelfMappingT-           ]--otherTs :: [IO ()]-otherTs = [ stretchT, plugFromT ]---- | An encrypted message should decrypt to the original plaintext.-cycleT :: (Monad c, Cipher k c) => (c ByteString -> ByteString) -> IO ()-cycleT f = do-  k <- key <$> prng-  quickCheck (\m -> f (encrypt k m >>= decrypt k) == m)---- | A message should never encrypt to itself.-notSelfT :: (Monad c, Cipher k c) => (c ByteString -> ByteString) -> IO ()-notSelfT f = do-  k <- key <$> prng-  quickCheck (\m -> B.length m > 1 ==> m /= e f k m)---- | Different keys should yield different encryptions.-diffKeyT :: (Eq k,Monad c,Cipher k c) => (c ByteString -> ByteString) -> IO ()-diffKeyT f = do-  k  <- key <$> prng-  k' <- key <$> prng-  quickCheck (\m -> k /= k' && B.length m > 1 ==> e f k m /= e f k' m)---- | A letter can never encrypt to itself.-noSelfMappingT :: IO ()-noSelfMappingT = do-  k <- key <$> prng-  quickCheck (\m -> all (\(a,b) -> a /= b) $ B.zip m (e _enigma k m))---- | Encrypt and unwrap a message.-e :: Cipher k a => (a ByteString -> t) -> k -> ByteString -> t-e f k m = f $ encrypt k m---- | A small manual test of Enigma.-enig :: IO ByteString-enig = do-  k <- key <$> prng-  return $ encrypt k "Das ist ein Wetterbericht. Heil Hitler." ^. enigma---- | A stretch should always double the length.-stretchT :: IO ()-stretchT = quickCheck prop-  where prop :: [Int] -> Property-        prop xs = let l = length xs in l > 0 ==> length (stretch xs) == 2 * l---- | Any list of pairs should always result in a Plugboard of 26 mappings.-plugFromT :: IO ()-plugFromT = quickCheck prop-  where prop :: [(Letter,Letter)] -> Bool-        prop xs = let xs' = xs & traverse . both %~ _char in-                   F.length (plugFrom xs') == 26

@@ -1,193 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}---- |--- Module    : Crypto.Classical.Types--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Types-  (-    -- * Cipher-    Cipher(..)-    -- * Keys-  , Key(..)-    -- * Enigma Types-  , 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--------- | A Cipher must be able to encrypt and decrypt. The Cipher type--- determines the Key type.-class Key k => Cipher k a | a -> k where-  encrypt :: k -> ByteString -> a ByteString-  decrypt :: k -> ByteString -> a ByteString---- | Keys can appear in a number of different forms.--- E.g. a single number, a tuple, a mapping, etc.--- Each needs to be interpreted uniquely by a Cipher's--- `encrypt` and `decrypt` algorithms.-class Key a where-  -- | Randomly generate a Key.-  key :: CPRG g => g -> a--instance Key (ℤ/26) where-  key g = toMod . fst $ generateBetween g 1 25---- | For Affine Ciphers.--- `a` must be coprime with 26, or else a^-1 won't exist and--- and we can't decrypt.-instance Key (ℤ/26,ℤ/26) where-  key g = (a,b) & _1 %~ toMod-    where a = head $ shuffle g ([1,3..25] \\ [13]) 12-          b = key g---- | Key for Substitution Cipher. The Key is the Mapping itself.-instance Key (Map Char Char) where-  key g = M.fromList $ zip ['A'..'Z'] $ shuffle g ['A'..'Z'] 26---- | Key for Stream/Vigenère Cipher.-instance Key [ℤ/26] where-  key g = n : key g'-    where (n,g') = generateMax g 26 & _1 %~ toMod--------- | A Rotor (German: Walze) is a wheel labelled A to Z, with internal--- wirings from each entry point to exit point. There is also a turnover--- point, upon which a Rotor would turn its left neighbour as well.--- Typically said turnover point is thought of in terms of letters--- (e.g. Q->R for Rotor I). Here, we represent the turnover point as--- a distance from A (or 0, the first entry point). As the Rotor rotates,--- this value decrements. When it rolls back to 25 (modular arithmetic),--- we rotate the next Rotor.------ Our Rotors are letter-agnostic. That is, they only map numeric--- entry points to exit points. This allows us to simulate rotation--- very simply with Lenses.-data Rotor = Rotor { _name     :: Text-                   , _turnover :: ℤ/26-                   , _circuit  :: Map (ℤ/26) (ℤ/26) } deriving (Eq,Show)-makeLenses ''Rotor---- | Rotor I: Turnover from Q to R.-rI :: Rotor-rI = Rotor "I" (int 'Q') $ M.fromList (pairs & traverse . both %~ int)-  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "EKMFLGDQVZNTOWYHXUSPAIBRCJ"---- | Rotor II: Turnover from E to F.-rII :: Rotor-rII = Rotor "II" (int 'E') $ M.fromList (pairs & traverse . both %~ int)-  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "AJDKSIRUXBLHWTMCQGZNPYFVOE"---- | Rotor III: Turnover from V to W.-rIII :: Rotor-rIII = Rotor "III" (int 'V') $ M.fromList (pairs & traverse . both %~ int)-  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "BDFHJLCPRTXVZNYEIWGAKMUSQO"---- | Rotor IV: Turnover from J to K.-rIV :: Rotor-rIV = Rotor "IV" (int 'J') $ M.fromList (pairs & traverse . both %~ int)-  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "ESOVPZJAYQUIRHXLNFTGKDCMWB"---- | Rotor V: Turnover from Z to A.-rV :: Rotor-rV = Rotor "V" (int 'Z') $ M.fromList (pairs & traverse . both %~ int)-  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "VZBRGITYUPSDNHLXAWMJQOFECK"---- | A unmoving map, similar to the Rotors, which feeds the electrical--- current back into Rotors. This would never feed the left Rotor's letter--- back to itself, meaning a plaintext character would never encrypt--- to itself. This was a major weakness in scheme which allowed the Allies--- to make Known Plaintext Attacks against the machine.-type Reflector = Map (ℤ/26) (ℤ/26)--ukwB :: Reflector-ukwB = M.fromList (pairs & traverse . both %~ int)-  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "YRUHQSLDPXNGOKMIEBFZCWVJAT"---- | A set of 10 pairs of connected letters which would map letters--- to other ones both before and after being put through the Rotors.--- The remaining six unpaired letters can be thought of mapping to themselves.-type Plugboard = Map (ℤ/26) (ℤ/26)---- | Essentially the machine itself. It is made up of:--- 1. Three rotor choices from five, in a random placement.--- 2. Initial settings of those Rotors.--- 3. The Reflector model in use.--- 4. Plugboard settings (pairs of characters).-data EnigmaKey = EnigmaKey { _rotors    :: [Rotor]-                           , _settings  :: [Char]-                           , _reflector :: Reflector-                           , _plugboard :: Plugboard-                           } deriving (Eq,Show)-makeLenses ''EnigmaKey---- | Note that the randomly generated initial Rotor positions are not--- applied to the Rotors when the key is generated. They have to--- be applied before first use.-instance Key EnigmaKey where-  key g = EnigmaKey rs ss ukwB $ randPlug g-    where rn = 3  -- Number of Rotors to use.-          rs = take rn $ shuffle g [rI,rII,rIII,rIV,rV] 5-          ss = randChars g rn---- | Generate random start positions for the Rotors.-randChars :: CPRG g => g -> Int -> [Char]-randChars _ 0 = []-randChars g n = c : randChars g' (n-1)-  where (c,g') = generateBetween g 0 25 & _1 %~ letter . toMod---- | Generate settings for the Plugboard. Ten pairs of characters will--- be mapped to each other, and the remaining six characters will map--- to themselves.-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---- | Given a list of letter pairs, generates a Plugboard.--- Any letters left out of the pair list will be mapped to themselves.-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

@@ -1,100 +0,0 @@-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DataKinds #-}---- |--- Module    : Crypto.Classical.Util--- Copyright : (c) Colin Woodbury, 2015--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Crypto.Classical.Util-  (-    -- * Character Conversion-    letter-  , int-    -- * Modular Arithmetic-  , inverse-    -- * Random Numbers-  , prng-  , rseq-    -- * Map function-  , mapInverse-  , compose-  , (|.|)-    -- * Miscellaneous-  , uniZip-  , stretch-  ) where--import           Lens.Micro-import           Crypto.Number.Generate-import           Crypto.Number.ModArithmetic (inverseCoprimes)-import           Crypto.Random-import           Data.Char-import           Data.Map.Lazy (Map)-import qualified Data.Map.Lazy as M-import           Data.Modular-------letter :: ℤ/26 -> Char-letter l = chr $ ord 'A' + (fromIntegral $ unMod l)--int :: Char -> ℤ/26-int c = toMod . toInteger $ ord c - ord 'A'---- | Must be passed a number coprime with 26.-inverse :: ℤ/26 -> ℤ/26-inverse a = toMod $ inverseCoprimes (unMod a) 26--prng :: IO SystemRNG-prng = fmap cprgCreate createEntropyPool---- | The sequence (r1,...r[n-1]) of numbers such that r[i] is an--- independent sample from a uniform random distribution--- [0..n-i]-rseq :: CPRG g => g -> Integer -> [Integer]-rseq g n = rseq' g (n - 1) ^.. traverse . _1-  where rseq' :: CPRG g => g -> Integer -> [(Integer, g)]-        rseq' _ 0  = []-        rseq' g' i = (j, g') : rseq' g'' (i - 1)-          where (j, g'') = generateBetween g' 0 i---- | Invert a Map. Keys become values, values become keys.--- Note that this operation may result in a smaller Map than the original.-mapInverse :: (Ord k, Ord v) => Map k v -> Map v k-mapInverse = M.foldrWithKey (\k v acc -> M.insert v k acc) M.empty---- | Compose two Maps. If some key `v` isn't present in the second--- Map, then `k` will be left out of the result.------ 2015 April 16 @ 13:56--- Would it be possible to make a Category for Map like this?-compose :: (Ord k, Ord v) => Map k v -> Map v v' -> Map k v'-compose s t = M.foldrWithKey f M.empty s-  where f k v acc = case M.lookup v t of-                     Nothing -> acc-                     Just v' -> M.insert k v' acc---- | An alias for compose. Works left-to-right.-(|.|) :: (Ord k, Ord v) => Map k v -> Map v v' -> Map k v'-(|.|) = compose---- | Zip a list on itself. Takes pairs of values and forms a tuple.--- Example:------ >>> uniZip [1,2,3,4,5,6]--- [(1,2),(3,4),(5,6)]-uniZip :: [a] -> [(a,a)]-uniZip []       = []-uniZip [_]      = []-uniZip (a:b:xs) = (a,b) : uniZip xs---- | Stretch the contents of a list. List becomes twice a long.--- List must be finite.--- Example:------ >>> stretch [1,2,3,4]--- [1,1,2,2,3,3,4,4]-stretch :: [a] -> [a]-stretch = foldr (\x acc -> x : x : acc) []

@@ -1,4 +1,4 @@-Copyright (c) 2015, Colin Woodbury+Copyright (c) 2015 - 2020, Colin Woodbury  All rights reserved. 

@@ -0,0 +1,11 @@+# `crypto-classical`++An educational tool for studying classical cryptography schemes. Do not encrypt anything of worth with this library.++Included Ciphers:+ - Caesar+ - Affine (Linear)+ - Substitution+ - Stream+ - Vigenere+ - Enigma (Wehrmacht Enigma I)

@@ -1,96 +1,94 @@-name:                crypto-classical--version:             0.2.0--synopsis:            An educational tool for studying classical cryptography schemes.--description:         An educational tool for studying classical cryptography-                     schemes. Do not encrypt anything of worth with this-                     library.-                     .-                     /Included Ciphers:/-                     .-                     * Caesar-                     .-                     * Affine (Linear)-                     .-                     * Substitution-                     .-                     * Stream-                     .-                     * Vigenere-                     .-                     * Enigma (Wehrmacht Enigma I)-                     .-                     Thanks to polymorphism, we can generate keys and encrypt-                     ByteStrings without worrying much about types:-                     .-                     > > import Crypto.Classical-                     > > import Lens.Micro-                     > > :set -XOverloadedStrings-                     > > (\k -> encrypt k "What a great day for an attack!" ^. enigma) . key <$> prng-                     > "PXQS D KXSGB CFC AYK XJ DEGMON!"-                     > > (\k -> encrypt k "What a great day for an attack!" ^. caesar) . key <$> prng-                     > "RCVO V BMZVO YVT AJM VI VOOVXF!"--homepage:            https://github.com/fosskers/crypto-classical--license:             BSD3+cabal-version:      2.2+name:               crypto-classical+version:            0.2.1+synopsis:+  An educational tool for studying classical cryptography schemes. -license-file:        LICENSE+description:+  An educational tool for studying classical cryptography+  schemes. Do not encrypt anything of worth with this+  library.+  .+  /Included Ciphers:/+  .+  * Caesar+  .+  * Affine (Linear)+  .+  * Substitution+  .+  * Stream+  .+  * Vigenere+  .+  * Enigma (Wehrmacht Enigma I)+  .+  Thanks to polymorphism, we can generate keys and encrypt+  ByteStrings without worrying much about types:+  .+  > > import Crypto.Classical+  > > import Lens.Micro+  > > :set -XOverloadedStrings+  > > (\k -> encrypt k "What a great day for an attack!" ^. enigma) . key <$> prng+  > "PXQS D KXSGB CFC AYK XJ DEGMON!"+  > > (\k -> encrypt k "What a great day for an attack!" ^. caesar) . key <$> prng+  > "RCVO V BMZVO YVT AJM VI VOOVXF!" -author:              Colin Woodbury+homepage:           https://github.com/fosskers/crypto-classical+license:            BSD-3-Clause+license-file:       LICENSE+author:             Colin Woodbury+maintainer:         colin@fosskers.ca+category:           Cryptography+build-type:         Simple+extra-source-files:+  README.md+  CHANGELOG.md -maintainer:          colingw@gmail.com+common commons+  default-language: Haskell2010+  ghc-options:+    -Wall -Wpartial-fields -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Widentities -category:            Cryptography+  build-depends:+    , base        >=4.7     && <4.14+    , bytestring+    , microlens   >=0.2.0.0 -build-type:          Simple+library+  import:          commons+  hs-source-dirs:  lib+  exposed-modules:+    Crypto.Classical+    Crypto.Classical.Cipher+    Crypto.Classical.Cipher.Affine+    Crypto.Classical.Cipher.Caesar+    Crypto.Classical.Cipher.Enigma+    Crypto.Classical.Cipher.Stream+    Crypto.Classical.Cipher.Substitution+    Crypto.Classical.Cipher.Vigenere+    Crypto.Classical.Letter+    Crypto.Classical.Shuffle+    Crypto.Classical.Types+    Crypto.Classical.Util -cabal-version:       >=1.10+  build-depends:+    , base                >=4.7     && <4.14+    , containers          >=0.5.5.1+    , crypto-numbers      >=0.2.7+    , crypto-random+    , microlens-th        >=0.2.1.1+    , modular-arithmetic  >=1.2.0.0+    , text                >=1.2.0.4+    , transformers        >=0.4.2.0 -source-repository head-  type:     git-  location: git://github.com/fosskers/crypto-classical.git-                     -library-  exposed-modules:     Crypto.Classical-                     , Crypto.Classical.Cipher-                     , Crypto.Classical.Letter-                     , Crypto.Classical.Shuffle-                     , Crypto.Classical.Types-                     , Crypto.Classical.Test-                     , Crypto.Classical.Util-                     , Crypto.Classical.Cipher.Caesar-                     , Crypto.Classical.Cipher.Affine-                     , Crypto.Classical.Cipher.Stream-                     , Crypto.Classical.Cipher.Substitution-                     , Crypto.Classical.Cipher.Vigenere-                     , Crypto.Classical.Cipher.Enigma-  -  -- Modules included in this library but not exported.-  -- other-modules:       -  -  -- LANGUAGE extensions used by modules in this package.-  -- other-extensions:    -  -  -- Other library packages from which modules are imported.-  build-depends:       QuickCheck >= 2.8.1-                     , base >=4.7 && <4.9-                     , bytestring-                     , containers >= 0.5.5.1-                     , crypto-numbers >= 0.2.7-                     , crypto-random-                     , microlens >= 0.2.0.0-                     , microlens-th >= 0.2.1.1-                     , modular-arithmetic >= 1.2.0.0-                     , random-                     , random-shuffle >= 0.0.4-                     , text >= 1.2.0.4-                     , transformers >= 0.4.2.0-  -  -- Directories containing source files.-  -- hs-source-dirs:      -  -  -- Base language which the package is written in.-  default-language:    Haskell2010+test-suite crypto-classical-test+  import:         commons+  type:           exitcode-stdio-1.0+  main-is:        Test.hs+  hs-source-dirs: test+  ghc-options:    -threaded -with-rtsopts=-N+  build-depends:+    , crypto-classical+    , QuickCheck        >=2.8.1

@@ -0,0 +1,21 @@+-- |+-- Module    : Crypto.Classical+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- A reexport of every module.++module Crypto.Classical+  ( module Crypto.Classical.Cipher+  , module Crypto.Classical.Letter+  , module Crypto.Classical.Shuffle+  , module Crypto.Classical.Types+  , module Crypto.Classical.Util+  ) where++import Crypto.Classical.Cipher+import Crypto.Classical.Letter+import Crypto.Classical.Shuffle+import Crypto.Classical.Types+import Crypto.Classical.Util

@@ -0,0 +1,23 @@+-- |+-- Module    : Crypto.Classical+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++-- A reexport of every Cipher module.++module Crypto.Classical.Cipher+   ( module Crypto.Classical.Cipher.Affine+   , module Crypto.Classical.Cipher.Caesar+   , module Crypto.Classical.Cipher.Enigma+   , module Crypto.Classical.Cipher.Stream+   , module Crypto.Classical.Cipher.Substitution+   , module Crypto.Classical.Cipher.Vigenere+   ) where++import Crypto.Classical.Cipher.Affine+import Crypto.Classical.Cipher.Caesar+import Crypto.Classical.Cipher.Enigma+import Crypto.Classical.Cipher.Stream+import Crypto.Classical.Cipher.Substitution+import Crypto.Classical.Cipher.Vigenere

@@ -0,0 +1,52 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeOperators         #-}++-- |+-- Module    : Crypto.Classical.Affine+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Cipher.Affine where++import           Crypto.Classical.Types+import           Crypto.Classical.Util+import qualified Data.ByteString.Lazy.Char8 as B+import           Data.Char+import           Data.Modular+import           Lens.Micro.TH++---++-- | An Affine Cipher is a non-random Substitution Cipher, such that a+-- character `x` is mapped to a cipher character according to the equation:+--+-- f(x) = ax + b (mod 26)+--+-- Also known as a Linear Cipher.+newtype Affine a = Affine { _affine :: a } deriving (Eq,Show,Functor)+makeLenses ''Affine++instance Applicative Affine where+  pure = Affine+  Affine f <*> Affine a = Affine $ f a++instance Monad Affine where+  return = pure+  Affine a >>= f = f a++instance Cipher (ℤ/26,ℤ/26) Affine where+  encrypt (a,b) = pure . B.map f+    where f c | isLower c = f $ toUpper c+              | not $ isLetter c = c+              | otherwise = letter $ a * int c + b++  decrypt (a,b) = pure . B.map f+    where f c | isLower c = f $ toUpper c+              | not $ isLetter c = c+              | otherwise = letter $ (int c - b) * inverse a

@@ -0,0 +1,47 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeOperators         #-}++-- |+-- Module    : Crypto.Classical.Caesar+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Cipher.Caesar where++import           Crypto.Classical.Types+import           Crypto.Classical.Util+import qualified Data.ByteString.Lazy.Char8 as B+import           Data.Char+import           Data.Modular+import           Lens.Micro.TH++---++-- | A simple Shift Cipher. The key is a number by which to shift each+-- letter in the alphabet. Example:+--+-- >>> encrypt 3 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ^. caesar+-- "DEFGHIJKLMNOPQRSTUVWXYZABC"+newtype Caesar a = Caesar { _caesar :: a } deriving (Eq,Show,Functor)+makeLenses ''Caesar++instance Applicative Caesar where+  pure = Caesar+  Caesar f <*> Caesar a = Caesar $ f a++instance Monad Caesar where+  return = pure+  Caesar a >>= f = f a++instance Cipher (ℤ/26) Caesar where+  encrypt k = pure . B.map f+    where f c | isLower c = f $ toUpper c+              | not $ isLetter c = c+              | otherwise = letter $ int c + k++  decrypt k = encrypt (-k)

@@ -0,0 +1,83 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeOperators         #-}++-- |+-- Module    : Crypto.Classical.Cipher.Enigma+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Cipher.Enigma where++import           Control.Monad.Trans.State.Strict+import           Crypto.Classical.Types+import           Crypto.Classical.Util+import qualified Data.ByteString.Lazy.Char8 as B+import           Data.Char+import           Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import           Data.Maybe (fromJust)+import           Data.Modular+import           Lens.Micro+import           Lens.Micro.TH++---++newtype Enigma a = Enigma { _enigma :: a } deriving (Eq, Show, Functor)+makeLenses ''Enigma++instance Applicative Enigma where+  pure = Enigma+  Enigma f <*> Enigma a = Enigma $ f a++instance Monad Enigma where+  return = pure+  Enigma a >>= f = f a++-- | When a machine operator presses a key, the Rotors rotate.+-- A circuit is then completed as they hold the key down, and a bulb+-- is lit. Here, we make sure to rotate the Rotors before encrypting+-- the character.+-- NOTE: Decryption is the same as encryption.+instance Cipher EnigmaKey Enigma where+  decrypt = encrypt+  encrypt k m = pure . B.pack $ evalState (traverse f $ B.unpack m) k'+    where k' = withInitPositions k+          f c | not $ isLetter c = return c+              | isLower c = f $ toUpper c+              | otherwise = do+                  modify (& rotors %~ turn)+                  (EnigmaKey rots _ rl pl) <- get+                  let rs  = rots ^.. traverse . circuit+                      rs' = reverse $ map mapInverse rs+                      pl' = mapInverse pl+                      cmp = foldl1 compose+                      e   = pl |.| cmp rs |.| rl |.| cmp rs' |.| pl'+                  return . letter . fromJust . flip M.lookup e $ int c++-- | Applies the initial Rotor settings as defined in the Key to+-- the Rotors themselves. These initial rotations do not trigger+-- the turnover of neighbouring Rotors as usual.+withInitPositions :: EnigmaKey -> EnigmaKey+withInitPositions k = k & rotors .~ zipWith f (k ^. rotors) (k ^. settings)+  where f r s = r & circuit %~ rotate (int s)+                  & turnover %~ (\n -> n - int s)++-- | Turn the (machine's) right-most (left-most in List) Rotor by one+-- position. If its turnover value wraps back to 25, then turn the next+-- Rotor as well.+turn :: [Rotor] -> [Rotor]+turn []     = []+turn (r:rs) = if (r' ^. turnover) == 25 then r' : turn rs else r' : rs+  where r' = r & circuit %~ rotate 1 & turnover %~ (\n -> n - 1)++-- | Rotate a Rotor by `n` positions. By subtracting 1 from every key+-- and value, we perfectly simulate rotation. Example:+--+-- >>> rotate $ M.fromList [(0,2),(1,0),(2,3),(3,4),(4,1)]+-- M.fromList [(4,1),(0,4),(1,2),(2,3),(3,0)]+rotate :: ℤ/26 -> Map (ℤ/26) (ℤ/26) -> Map (ℤ/26) (ℤ/26)+rotate n r = M.fromList (M.toList r & traverse . both %~ (\n' -> n' - n))

@@ -0,0 +1,54 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeOperators         #-}++-- |+-- Module    : Crypto.Classical.Stream+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Cipher.Stream where++import           Crypto.Classical.Types+import           Crypto.Classical.Util+import qualified Data.ByteString.Lazy.Char8 as B+import           Data.Char+import           Data.Modular+import           Lens.Micro.TH++---++-- | A Cipher with pseudorandom keys as long as the plaintext.+-- Since Haskell is lazy, our keys here are actually of infinite length.+--+-- If for whatever reason a key of finite length is given to `encrypt`,+-- the ciphertext is cutoff to match the key length. Example:+--+-- >>> encrypt [1,2,3] "ABCDEF" ^. stream+-- "BDF"+newtype Stream a = Stream { _stream :: a } deriving (Eq,Show,Functor)+makeLenses ''Stream++instance Applicative Stream where+  pure = Stream+  Stream f <*> Stream a = Stream $ f a++instance Monad Stream where+  return = pure+  Stream a >>= f = f a++instance Cipher [ℤ/26] Stream where+  encrypt k = pure . B.pack . f k . B.unpack+    where f _ [] = []+          f [] _ = []+          f (kc:ks) (m:ms)+            | isLower m = f (kc:ks) (toUpper m : ms)+            | not $ isLetter m = m : f ks ms+            | otherwise = letter (int m + kc) : f ks ms++  decrypt k = encrypt k'+    where k' = map (* (-1)) k

@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TemplateHaskell       #-}++-- |+-- Module    : Crypto.Classical.Substitution+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Cipher.Substitution where++import           Crypto.Classical.Types+import           Crypto.Classical.Util+import qualified Data.ByteString.Lazy.Char8 as B+import           Data.Char+import           Data.Map.Lazy (Map)+import qualified Data.Map.Lazy as M+import           Lens.Micro.TH++---++-- | A Cipher whose key is a (pseudo)random mapping of characters+-- to other characters. A character may map to itself.+newtype Substitution a = Substitution { _substitution :: a }+                       deriving (Eq,Show,Functor)+makeLenses ''Substitution++instance Applicative Substitution where+  pure = Substitution+  Substitution f <*> Substitution a = Substitution $ f a++instance Monad Substitution where+  return = pure+  Substitution a >>= f = f a++instance Cipher (Map Char Char) Substitution where+  encrypt m = pure . B.map f+    where f c | isLower c = f $ toUpper c+              | otherwise = M.findWithDefault c c m++  decrypt m = encrypt (mapInverse m)

@@ -0,0 +1,48 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeOperators         #-}++-- |+-- Module    : Crypto.Classical.Vigenere+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Cipher.Vigenere where++import           Crypto.Classical.Cipher.Stream+import           Crypto.Classical.Types+import qualified Data.ByteString.Lazy.Char8 as B+import           Data.Modular+import           Lens.Micro+import           Lens.Micro.TH++---++-- | A Vigenère Cipher is just a Stream Cipher with a finite key,+-- shorter than the length of the plaintext. The key is repeated for+-- the entire length of the plaintext.+newtype Vigenère a = Vigenère { _vigenère :: a } deriving (Eq,Show,Functor)+makeLenses ''Vigenère++instance Applicative Vigenère where+  pure = Vigenère+  Vigenère f <*> Vigenère a = Vigenère $ f a++instance Monad Vigenère where+  return = pure+  Vigenère a >>= f = f a++instance Cipher [ℤ/26] Vigenère where+  encrypt k m = pure . (^. stream) . encrypt (vigKey m k) $ m+  decrypt k m = pure . (^.  stream) . decrypt (vigKey m k) $ m++-- | Determine a Vigenère key from a Stream key.+-- Weakness here: key length is a factor of the plaintext length.+vigKey :: B.ByteString -> [ℤ/26] -> [ℤ/26]+vigKey m = concat . repeat . take (n+1)+  where n = floor @Double . logBase 2 . fromIntegral . B.length $ m

@@ -0,0 +1,12 @@+-- |+-- Module    : Crypto.Classical.Letter+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Letter where++---++-- | A `Letter` is a capital Ascii letter (A-Z)+newtype Letter = Letter { _char :: Char } deriving (Eq,Show)

@@ -0,0 +1,80 @@+-- |+-- Module    : Crypto.Classical.Shuffle+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- Code borrowed from `random-shuffle` and modified to match+-- crypto-random data types.++module Crypto.Classical.Shuffle+  (+    -- * List Scrambling+    shuffle+  ) where++import Crypto.Classical.Util+import Crypto.Random+import Data.Function (fix)++---++-- A complete binary tree, of leaves and internal nodes.+-- Internal node: Node card l r+-- where card is the number of leaves under the node.+-- Invariant: card >=2. All internal tree nodes are always full.+data Tree a = Leaf !a+            | Node !Integer !(Tree a) !(Tree a)+            deriving Show++-- Convert a sequence (e1...en) to a complete binary tree+buildTree :: [a] -> Tree a+buildTree = fix growLevel . map Leaf+  where growLevel _ [node] = node+        growLevel self l   = self $ inner l++        inner []             = []+        inner [e]            = [e]+        inner (e1 : e2 : es) = e1 `seq` e2 `seq` join e1 e2 : inner es++        join l@(Leaf _)       r@(Leaf _)       = Node 2 l r+        join l@(Node ct _ _)  r@(Leaf _)       = Node (ct + 1) l r+        join l@(Leaf _)       r@(Node ct _ _)  = Node (ct + 1) l r+        join l@(Node ctl _ _) r@(Node ctr _ _) = Node (ctl + ctr) l r++-- | Given a sequence (e1,...en) to shuffle, its length, and a random+-- generator, compute the corresponding permutation of the input+-- sequence.+shuffle :: CPRG g => g -> [a] -> Integer -> [a]+shuffle g elements = shuffle' elements . rseq g++-- | Given a sequence (e1,...en) to shuffle, and a sequence+-- (r1,...r[n-1]) of numbers such that r[i] is an independent sample+-- from a uniform random distribution [0..n-i], compute the+-- corresponding permutation of the input sequence.+shuffle' :: [a] -> [Integer] -> [a]+shuffle' elements = shuffleTree (buildTree elements)+  where shuffleTree (Leaf e) [] = [e]+        shuffleTree tree (r : rs) =+          let (b, rest) = extractTree r tree+          in b : shuffleTree rest rs+        shuffleTree _ _ = error "[shuffle] called with lists of different lengths"++        -- Extracts the n-th element from the tree and returns+        -- that element, paired with a tree with the element+        -- deleted.+        -- The function maintains the invariant of the completeness+        -- of the tree: all internal nodes are always full.+        extractTree 0 (Node _ (Leaf e) r) = (e, r)+        extractTree 1 (Node 2 (Leaf l) (Leaf r)) = (r, Leaf l)+        extractTree n (Node c (Leaf l) r) =+          let (e, r') = extractTree (n - 1) r+          in (e, Node (c - 1) (Leaf l) r')+        extractTree n (Node n' l (Leaf e))+          | n + 1 == n' = (e, l)+        extractTree n (Node c l@(Node cl _ _) r)+          | n < cl = let (e, l') = extractTree n l+                     in (e, Node (c - 1) l' r)+          | otherwise = let (e, r') = extractTree (n - cl) r+                        in (e, Node (c - 1) l r')+        extractTree _ _ = error "[extractTree] impossible"

@@ -0,0 +1,190 @@+{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE OverloadedStrings      #-}+{-# LANGUAGE TemplateHaskell        #-}+{-# LANGUAGE TypeOperators          #-}++-- |+-- Module    : Crypto.Classical.Types+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Types+  (+    -- * Cipher+    Cipher(..)+    -- * Keys+  , Key(..)+    -- * Enigma Types+  , 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.Text (Text)+import           Lens.Micro+import           Lens.Micro.TH++---++-- | A Cipher must be able to encrypt and decrypt. The Cipher type+-- determines the Key type.+class Key k => Cipher k a | a -> k where+  encrypt :: k -> ByteString -> a ByteString+  decrypt :: k -> ByteString -> a ByteString++-- | Keys can appear in a number of different forms.+-- E.g. a single number, a tuple, a mapping, etc.+-- Each needs to be interpreted uniquely by a Cipher's+-- `encrypt` and `decrypt` algorithms.+class Key a where+  -- | Randomly generate a Key.+  key :: CPRG g => g -> a++instance Key (ℤ/26) where+  key g = toMod . fst $ generateBetween g 1 25++-- | For Affine Ciphers.+-- `a` must be coprime with 26, or else a^-1 won't exist and+-- and we can't decrypt.+instance Key (ℤ/26,ℤ/26) where+  key g = (a,b) & _1 %~ toMod+    where a = head $ shuffle g ([1,3..25] \\ [13]) 12+          b = key g++-- | Key for Substitution Cipher. The Key is the Mapping itself.+instance Key (Map Char Char) where+  key g = M.fromList $ zip ['A'..'Z'] $ shuffle g ['A'..'Z'] 26++-- | Key for Stream/Vigenère Cipher.+instance Key [ℤ/26] where+  key g = n : key g'+    where (n,g') = generateMax g 26 & _1 %~ toMod++---++-- | A Rotor (German: Walze) is a wheel labelled A to Z, with internal+-- wirings from each entry point to exit point. There is also a turnover+-- point, upon which a Rotor would turn its left neighbour as well.+-- Typically said turnover point is thought of in terms of letters+-- (e.g. Q->R for Rotor I). Here, we represent the turnover point as+-- a distance from A (or 0, the first entry point). As the Rotor rotates,+-- this value decrements. When it rolls back to 25 (modular arithmetic),+-- we rotate the next Rotor.+--+-- Our Rotors are letter-agnostic. That is, they only map numeric+-- entry points to exit points. This allows us to simulate rotation+-- very simply with Lenses.+data Rotor = Rotor { _name     :: Text+                   , _turnover :: ℤ/26+                   , _circuit  :: Map (ℤ/26) (ℤ/26) } deriving (Eq,Show)+makeLenses ''Rotor++-- | Rotor I: Turnover from Q to R.+rI :: Rotor+rI = Rotor "I" (int 'Q') $ M.fromList (pairs & traverse . both %~ int)+  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "EKMFLGDQVZNTOWYHXUSPAIBRCJ"++-- | Rotor II: Turnover from E to F.+rII :: Rotor+rII = Rotor "II" (int 'E') $ M.fromList (pairs & traverse . both %~ int)+  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "AJDKSIRUXBLHWTMCQGZNPYFVOE"++-- | Rotor III: Turnover from V to W.+rIII :: Rotor+rIII = Rotor "III" (int 'V') $ M.fromList (pairs & traverse . both %~ int)+  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "BDFHJLCPRTXVZNYEIWGAKMUSQO"++-- | Rotor IV: Turnover from J to K.+rIV :: Rotor+rIV = Rotor "IV" (int 'J') $ M.fromList (pairs & traverse . both %~ int)+  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "ESOVPZJAYQUIRHXLNFTGKDCMWB"++-- | Rotor V: Turnover from Z to A.+rV :: Rotor+rV = Rotor "V" (int 'Z') $ M.fromList (pairs & traverse . both %~ int)+  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "VZBRGITYUPSDNHLXAWMJQOFECK"++-- | A unmoving map, similar to the Rotors, which feeds the electrical+-- current back into Rotors. This would never feed the left Rotor's letter+-- back to itself, meaning a plaintext character would never encrypt+-- to itself. This was a major weakness in scheme which allowed the Allies+-- to make Known Plaintext Attacks against the machine.+type Reflector = Map (ℤ/26) (ℤ/26)++ukwB :: Reflector+ukwB = M.fromList (pairs & traverse . both %~ int)+  where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "YRUHQSLDPXNGOKMIEBFZCWVJAT"++-- | A set of 10 pairs of connected letters which would map letters+-- to other ones both before and after being put through the Rotors.+-- The remaining six unpaired letters can be thought of mapping to themselves.+type Plugboard = Map (ℤ/26) (ℤ/26)++-- | Essentially the machine itself. It is made up of:+-- 1. Three rotor choices from five, in a random placement.+-- 2. Initial settings of those Rotors.+-- 3. The Reflector model in use.+-- 4. Plugboard settings (pairs of characters).+data EnigmaKey = EnigmaKey { _rotors    :: [Rotor]+                           , _settings  :: String+                           , _reflector :: Reflector+                           , _plugboard :: Plugboard+                           } deriving (Eq,Show)+makeLenses ''EnigmaKey++-- | Note that the randomly generated initial Rotor positions are not+-- applied to the Rotors when the key is generated. They have to+-- be applied before first use.+instance Key EnigmaKey where+  key g = EnigmaKey rs ss ukwB $ randPlug g+    where rn = 3  -- Number of Rotors to use.+          rs = take rn $ shuffle g [rI,rII,rIII,rIV,rV] 5+          ss = randChars g rn++-- | Generate random start positions for the Rotors.+randChars :: CPRG g => g -> Int -> String+randChars _ 0 = []+randChars g n = c : randChars g' (n-1)+  where (c,g') = generateBetween g 0 25 & _1 %~ letter . toMod++-- | Generate settings for the Plugboard. Ten pairs of characters will+-- be mapped to each other, and the remaining six characters will map+-- to themselves.+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  = map (\v -> (v,v)) ss++-- | Given a list of letter pairs, generates a Plugboard.+-- Any letters left out of the pair list will be mapped to themselves.+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

@@ -0,0 +1,100 @@+{-# LANGUAGE DataKinds     #-}+{-# LANGUAGE TypeOperators #-}++-- |+-- Module    : Crypto.Classical.Util+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Crypto.Classical.Util+  (+    -- * Character Conversion+    letter+  , int+    -- * Modular Arithmetic+  , inverse+    -- * Random Numbers+  , prng+  , rseq+    -- * Map function+  , mapInverse+  , compose+  , (|.|)+    -- * Miscellaneous+  , uniZip+  , stretch+  ) where++import           Crypto.Number.Generate+import           Crypto.Number.ModArithmetic (inverseCoprimes)+import           Crypto.Random+import           Data.Char+import           Data.Map.Lazy (Map)+import qualified Data.Map.Lazy as M+import           Data.Modular+import           Lens.Micro++---++letter :: ℤ/26 -> Char+letter l = chr $ ord 'A' + fromIntegral (unMod l)++int :: Char -> ℤ/26+int c = toMod . toInteger $ ord c - ord 'A'++-- | Must be passed a number coprime with 26.+inverse :: ℤ/26 -> ℤ/26+inverse a = toMod $ inverseCoprimes (unMod a) 26++prng :: IO SystemRNG+prng = fmap cprgCreate createEntropyPool++-- | The sequence (r1,...r[n-1]) of numbers such that r[i] is an+-- independent sample from a uniform random distribution+-- [0..n-i]+rseq :: CPRG g => g -> Integer -> [Integer]+rseq g n = rseq' g (n - 1) ^.. traverse . _1+  where rseq' :: CPRG g => g -> Integer -> [(Integer, g)]+        rseq' _ 0  = []+        rseq' g' i = (j, g') : rseq' g'' (i - 1)+          where (j, g'') = generateBetween g' 0 i++-- | Invert a Map. Keys become values, values become keys.+-- Note that this operation may result in a smaller Map than the original.+mapInverse :: (Ord k, Ord v) => Map k v -> Map v k+mapInverse = M.foldrWithKey (\k v acc -> M.insert v k acc) M.empty++-- | Compose two Maps. If some key `v` isn't present in the second+-- Map, then `k` will be left out of the result.+--+-- 2015 April 16 @ 13:56+-- Would it be possible to make a Category for Map like this?+compose :: (Ord k, Ord v) => Map k v -> Map v v' -> Map k v'+compose s t = M.foldrWithKey f M.empty s+  where f k v acc = case M.lookup v t of+                     Nothing -> acc+                     Just v' -> M.insert k v' acc++-- | An alias for compose. Works left-to-right.+(|.|) :: (Ord k, Ord v) => Map k v -> Map v v' -> Map k v'+(|.|) = compose++-- | Zip a list on itself. Takes pairs of values and forms a tuple.+-- Example:+--+-- >>> uniZip [1,2,3,4,5,6]+-- [(1,2),(3,4),(5,6)]+uniZip :: [a] -> [(a,a)]+uniZip []       = []+uniZip [_]      = []+uniZip (a:b:xs) = (a,b) : uniZip xs++-- | Stretch the contents of a list. List becomes twice a long.+-- List must be finite.+-- Example:+--+-- >>> stretch [1,2,3,4]+-- [1,1,2,2,3,3,4,4]+stretch :: [a] -> [a]+stretch = foldr (\x acc -> x : x : acc) []

@@ -0,0 +1,115 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module    : Crypto.Classical.Test+-- Copyright : (c) Colin Woodbury, 2015 - 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Main where++import           Control.Monad (void)+import           Crypto.Classical.Cipher+import           Crypto.Classical.Letter+import           Crypto.Classical.Types+import           Crypto.Classical.Util+import           Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import           Data.Char+import qualified Data.Foldable as F+import           Lens.Micro+import           Test.QuickCheck++---++-- Not to be exported, as this only generates ByteStrings+-- of capital Ascii characters.+instance Arbitrary ByteString where++  arbitrary = B.pack . map _char <$> arbitrary+instance Arbitrary Letter where+  arbitrary = Letter <$> c+    where c = do+            c' <- arbitrary+            if isAsciiUpper c'+               then return c'+               else c++---++-- | Run every test on every Cipher.+main :: IO ()+main = void . sequence $ cipherTs ++ otherTs++cipherTs :: [IO ()]+cipherTs = [ cycleT (^. caesar)+           , cycleT (^. affine)+           , cycleT (^. substitution)+           , cycleT (^. stream)+           , cycleT (^. vigenère)+           , cycleT (^. enigma)+           , notSelfT (^. caesar)+           , notSelfT (^. affine)+           , notSelfT (^. substitution)+           , notSelfT (^. stream)+           , notSelfT (^. vigenère)+           , notSelfT (^. enigma)+           , diffKeyT (^. caesar)+           , diffKeyT (^. affine)+           , diffKeyT (^. substitution)+           , diffKeyT (^. stream)+           , diffKeyT (^. vigenère)+           , diffKeyT (^. enigma)+           , noSelfMappingT+           ]++otherTs :: [IO ()]+otherTs = [ stretchT, plugFromT ]++-- | An encrypted message should decrypt to the original plaintext.+cycleT :: (Monad c, Cipher k c) => (c ByteString -> ByteString) -> IO ()+cycleT f = do+  k <- key <$> prng+  quickCheck (\m -> f (encrypt k m >>= decrypt k) == m)++-- | A message should never encrypt to itself.+notSelfT :: (Monad c, Cipher k c) => (c ByteString -> ByteString) -> IO ()+notSelfT f = do+  k <- key <$> prng+  quickCheck (\m -> B.length m > 1 ==> m /= e f k m)++-- | Different keys should yield different encryptions.+diffKeyT :: (Eq k,Monad c,Cipher k c) => (c ByteString -> ByteString) -> IO ()+diffKeyT f = do+  k  <- key <$> prng+  k' <- key <$> prng+  quickCheck (\m -> k /= k' && B.length m > 1 ==> e f k m /= e f k' m)++-- | A letter can never encrypt to itself.+noSelfMappingT :: IO ()+noSelfMappingT = do+  k <- key <$> prng+  quickCheck (\m -> all (uncurry (/=)) $ B.zip m (e _enigma k m))++-- | Encrypt and unwrap a message.+e :: Cipher k a => (a ByteString -> t) -> k -> ByteString -> t+e f k m = f $ encrypt k m++-- | A small manual test of Enigma.+-- enig :: IO ByteString+-- enig = do+--   k <- key <$> prng+--   return $ encrypt k "Das ist ein Wetterbericht. Heil Hitler." ^. enigma++-- | A stretch should always double the length.+stretchT :: IO ()+stretchT = quickCheck prop+  where prop :: [Int] -> Property+        prop xs = let l = length xs in l > 0 ==> length (stretch xs) == 2 * l++-- | Any list of pairs should always result in a Plugboard of 26 mappings.+plugFromT :: IO ()+plugFromT = quickCheck prop+  where prop :: [(Letter,Letter)] -> Bool+        prop xs = let xs' = xs & traverse . both %~ _char in+                   F.length (plugFrom xs') == 26