crypto-classical 0.2.1 → 0.3.0

raw patch · 11 files changed

+126/−139 lines, 11 filesdep −microlensdep −microlens-thPVP ok

version bump matches the API change (PVP)

Dependencies removed: microlens, microlens-th

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• crypto-classical.cabal +3/−5
• lib/Crypto/Classical/Cipher/Affine.hs +0/−3
• lib/Crypto/Classical/Cipher/Caesar.hs +1/−4
• lib/Crypto/Classical/Cipher/Enigma.hs +38/−34
• lib/Crypto/Classical/Cipher/Stream.hs +1/−4
• lib/Crypto/Classical/Cipher/Substitution.hs +3/−6
• lib/Crypto/Classical/Cipher/Vigenere.hs +2/−6
• lib/Crypto/Classical/Types.hs +37/−46
• lib/Crypto/Classical/Util.hs +12/−8
• test/Test.hs +23/−23

@@ -1,5 +1,11 @@ # crypto-classical +## 0.3.0++#### Removed++- Dependency on `microlens` and all auto-generated lenses.+ ## 0.2.1  - Bumped bounds and modernized the library.

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               crypto-classical-version:            0.2.1+version:            0.3.0 synopsis:   An educational tool for studying classical cryptography schemes. @@ -29,9 +29,9 @@   > > import Crypto.Classical   > > import Lens.Micro   > > :set -XOverloadedStrings-  > > (\k -> encrypt k "What a great day for an attack!" ^. enigma) . key <$> prng+  > > (\k -> _enigma $ encrypt k "What a great day for an attack!") . key <$> prng   > "PXQS D KXSGB CFC AYK XJ DEGMON!"-  > > (\k -> encrypt k "What a great day for an attack!" ^. caesar) . key <$> prng+  > > (\k -> _caesar $ encrypt k "What a great day for an attack!") . key <$> prng   > "RCVO V BMZVO YVT AJM VI VOOVXF!"  homepage:           https://github.com/fosskers/crypto-classical@@ -54,7 +54,6 @@   build-depends:     , base        >=4.7     && <4.14     , bytestring-    , microlens   >=0.2.0.0  library   import:          commons@@ -78,7 +77,6 @@     , 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

@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeOperators         #-}  -- |@@ -19,7 +18,6 @@ import qualified Data.ByteString.Lazy.Char8 as B import           Data.Char import           Data.Modular-import           Lens.Micro.TH  --- @@ -30,7 +28,6 @@ -- -- Also known as a Linear Cipher. newtype Affine a = Affine { _affine :: a } deriving (Eq,Show,Functor)-makeLenses ''Affine  instance Applicative Affine where   pure = Affine

@@ -2,7 +2,6 @@ {-# LANGUAGE DeriveFunctor         #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeOperators         #-}  -- |@@ -18,17 +17,15 @@ 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+-- >>> _caesar $ encrypt 3 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" -- "DEFGHIJKLMNOPQRSTUVWXYZABC" newtype Caesar a = Caesar { _caesar :: a } deriving (Eq,Show,Functor)-makeLenses ''Caesar  instance Applicative Caesar where   pure = Caesar

@@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds             #-} {-# LANGUAGE DeriveFunctor         #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeOperators         #-}  -- |@@ -21,13 +20,10 @@ 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@@ -37,47 +33,55 @@   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.+-- | 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+    where+      k' :: EnigmaKey+      k' = withInitPositions k --- | 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.+      f :: Char -> State EnigmaKey Char+      f c | not $ isLetter c = return c+          | isLower c = f $ toUpper c+          | otherwise = do+              modify (\x -> x { _rotors = turn $ _rotors x })+              EnigmaKey rots _ rl pl <- get+              let rs  = map _circuit rots+                  rs' = reverse $ map mapInverse rs+                  pl' = mapInverse pl+                  cmp = foldl1 compose+                  e   = pl |.| cmp rs |.| rl |.| cmp rs' |.| pl'+              pure . 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)+withInitPositions k = k { _rotors = zipWith f (_rotors k) (_settings k) }+  where+    f :: Rotor -> Char -> Rotor+    f r s = r { _circuit = rotate (int s) $ _circuit r+              , _turnover = (\n -> n - int s) $ _turnover r } --- | 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 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)+turn (r:rs) = if _turnover r' == 25 then r' : turn rs else r' : rs+  where+    r' :: Rotor+    r' = r { _circuit = rotate 1 $ _circuit r+           , _turnover = pred $ _turnover r } --- | Rotate a Rotor by `n` positions. By subtracting 1 from every key--- and value, we perfectly simulate rotation. Example:+-- | 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))+rotate n r = M.fromList . map (both (\n' -> n' - n)) $ M.toList r

@@ -2,7 +2,6 @@ {-# LANGUAGE DeriveFunctor         #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeOperators         #-}  -- |@@ -18,7 +17,6 @@ import qualified Data.ByteString.Lazy.Char8 as B import           Data.Char import           Data.Modular-import           Lens.Micro.TH  --- @@ -28,10 +26,9 @@ -- 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+-- >>> _stream $ encrypt [1,2,3] "ABCDEF" -- "BDF" newtype Stream a = Stream { _stream :: a } deriving (Eq,Show,Functor)-makeLenses ''Stream  instance Applicative Stream where   pure = Stream

@@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TemplateHaskell       #-}  -- | -- Module    : Crypto.Classical.Substitution@@ -16,17 +15,15 @@ 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+import           Data.Map.Strict (Map)+import qualified Data.Map.Strict as M  ---  -- | 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+  deriving (Eq,Show,Functor)  instance Applicative Substitution where   pure = Substitution

@@ -2,7 +2,6 @@ {-# LANGUAGE DeriveFunctor         #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeApplications      #-} {-# LANGUAGE TypeOperators         #-} @@ -18,8 +17,6 @@ import           Crypto.Classical.Types import qualified Data.ByteString.Lazy.Char8 as B import           Data.Modular-import           Lens.Micro-import           Lens.Micro.TH  --- @@ -27,7 +24,6 @@ -- 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@@ -38,8 +34,8 @@   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+  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.

@@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE OverloadedStrings      #-}-{-# LANGUAGE TemplateHaskell        #-} {-# LANGUAGE TypeOperators          #-}  -- |@@ -22,13 +21,6 @@   , Rotor(..)   , Reflector   , Plugboard-  , name-  , turnover-  , circuit-  , rotors-  , settings-  , reflector-  , plugboard   , plugFrom   ) where @@ -39,12 +31,10 @@ 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.Map.Strict (Map)+import qualified Data.Map.Strict as M import           Data.Modular import           Data.Text (Text)-import           Lens.Micro-import           Lens.Micro.TH  --- @@ -69,8 +59,8 @@ -- `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+  key g = (a, b)+    where a = toMod . head $ shuffle g ([1,3..25] \\ [13]) 12           b = key g  -- | Key for Substitution Cipher. The Key is the Mapping itself.@@ -79,51 +69,52 @@  -- | Key for Stream/Vigenère Cipher. instance Key [ℤ/26] where-  key g = n : key g'-    where (n,g') = generateMax g 26 & _1 %~ toMod+  key g = toMod n : key g'+    where (n,g') = generateMax g 26  --- --- | 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.+-- | 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+-- Our Rotors are letter-agnostic. That is, they only map numeric entry points+-- to exit points.+data Rotor = Rotor+  { _name     :: Text+  , _turnover :: ℤ/26+  , _circuit  :: Map (ℤ/26) (ℤ/26) }+  deriving (Eq, Show)  -- | 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"+rI = Rotor "I" (int 'Q') . M.fromList $ map (both int) pairs+  where+    pairs :: [(Char, Char)]+    pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "EKMFLGDQVZNTOWYHXUSPAIBRCJ"  -- | Rotor II: Turnover from E to F. rII :: Rotor-rII = Rotor "II" (int 'E') $ M.fromList (pairs & traverse . both %~ int)+rII = Rotor "II" (int 'E') . M.fromList $ map (both int) pairs   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)+rIII = Rotor "III" (int 'V') . M.fromList $ map (both int) pairs   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)+rIV = Rotor "IV" (int 'J') . M.fromList $ map (both int) pairs   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)+rV = Rotor "V" (int 'Z') . M.fromList $ map (both int) pairs   where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "VZBRGITYUPSDNHLXAWMJQOFECK"  -- | A unmoving map, similar to the Rotors, which feeds the electrical@@ -134,7 +125,7 @@ type Reflector = Map (ℤ/26) (ℤ/26)  ukwB :: Reflector-ukwB = M.fromList (pairs & traverse . both %~ int)+ukwB = M.fromList $ map (both int) pairs   where pairs = zip "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "YRUHQSLDPXNGOKMIEBFZCWVJAT"  -- | A set of 10 pairs of connected letters which would map letters@@ -147,12 +138,12 @@ -- 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+data EnigmaKey = EnigmaKey+  { _rotors    :: [Rotor]+  , _settings  :: String+  , _reflector :: Reflector+  , _plugboard :: Plugboard }+  deriving (Eq, Show)  -- | Note that the randomly generated initial Rotor positions are not -- applied to the Rotors when the key is generated. They have to@@ -166,8 +157,8 @@ -- | 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+randChars g n = letter (toMod c) : randChars g' (n-1)+  where (c,g') = generateBetween g 0 25  -- | Generate settings for the Plugboard. Ten pairs of characters will -- be mapped to each other, and the remaining six characters will map

@@ -24,16 +24,16 @@     -- * Miscellaneous   , uniZip   , stretch+  , both   ) 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.Map.Strict (Map)+import qualified Data.Map.Strict as M import           Data.Modular-import           Lens.Micro  --- @@ -54,11 +54,12 @@ -- 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+rseq g n = map fst $ rseq' g (n - 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.@@ -98,3 +99,6 @@ -- [1,1,2,2,3,3,4,4] stretch :: [a] -> [a] stretch = foldr (\x acc -> x : x : acc) []++both :: (a -> b) -> (a, a) -> (b, b)+both f (x, y) = (f x, f y)

@@ -17,7 +17,6 @@ import qualified Data.ByteString.Lazy.Char8 as B import           Data.Char import qualified Data.Foldable as F-import           Lens.Micro import           Test.QuickCheck  ---@@ -42,24 +41,24 @@ 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)+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            ] @@ -99,7 +98,7 @@ -- enig :: IO ByteString -- enig = do --   k <- key <$> prng---   return $ encrypt k "Das ist ein Wetterbericht. Heil Hitler." ^. enigma+--   pure . _enigma $ encrypt k "Das ist ein Wetterbericht. Heil Hitler."  -- | A stretch should always double the length. stretchT :: IO ()@@ -110,6 +109,7 @@ -- | 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+  where+    prop :: [(Letter, Letter)] -> Bool+    prop xs = let xs' = map (both _char) xs+      in F.length (plugFrom xs') == 26