crypto-classical 0.0.3 → 0.1.0

raw patch · 4 files changed

+70/−23 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Crypto/Classical/Test.hs +47/−22
• Crypto/Classical/Types.hs +12/−0
• Crypto/Classical/Util.hs +10/−0
• crypto-classical.cabal +1/−1

@@ -9,9 +9,14 @@  module Crypto.Classical.Test   (-    -- * Single Tests+    -- * Cipher Tests     cycleT   , notSelfT+  , diffKeyT+  , noSelfMappingT+    -- * Misc. Tests+  , stretchT+  , plugFromT     -- * Batch Tests   , testAll   ) where@@ -22,9 +27,10 @@ import           Crypto.Classical.Cipher import           Crypto.Classical.Letter import           Crypto.Classical.Types-import           Crypto.Classical.Util (prng)+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  ---@@ -38,27 +44,33 @@  -- | Run every test on every Cipher. testAll :: IO ()-testAll = void $ sequence [ cycleT $ view caesar-                          , cycleT $ view affine-                          , cycleT $ view substitution-                          , cycleT $ view stream-                          , cycleT $ view vigenère-                          , cycleT $ view enigma-                          , notSelfT $ view caesar-                          , notSelfT $ view affine-                          , notSelfT $ view substitution-                          , notSelfT $ view stream-                          , notSelfT $ view vigenère-                          , notSelfT $ view enigma-                          , diffKeyT $ view caesar-                          , diffKeyT $ view affine-                          , diffKeyT $ view substitution-                          , diffKeyT $ view stream-                          , diffKeyT $ view vigenère-                          , diffKeyT $ view enigma-                          , noSelfMappingT-                          ]+testAll = void . sequence $ cipherTs ++ otherTs +cipherTs :: [IO ()]+cipherTs = [ cycleT $ view caesar+           , cycleT $ view affine+           , cycleT $ view substitution+           , cycleT $ view stream+           , cycleT $ view vigenère+           , cycleT $ view enigma+           , notSelfT $ view caesar+           , notSelfT $ view affine+           , notSelfT $ view substitution+           , notSelfT $ view stream+           , notSelfT $ view vigenère+           , notSelfT $ view enigma+           , diffKeyT $ view caesar+           , diffKeyT $ view affine+           , diffKeyT $ view substitution+           , diffKeyT $ view stream+           , diffKeyT $ view vigenère+           , diffKeyT $ view 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@@ -93,3 +105,16 @@ 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

@@ -31,6 +31,7 @@   , settings   , reflector   , plugboard+  , plugFrom   ) where  import           Control.Lens@@ -39,6 +40,7 @@ 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@@ -178,3 +180,13 @@         (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

@@ -23,6 +23,7 @@   , (|.|)     -- * Miscellaneous   , uniZip+  , stretch   ) where  import           Control.Lens@@ -88,3 +89,12 @@ 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,6 +1,6 @@ name:                crypto-classical -version:             0.0.3+version:             0.1.0  synopsis:            An educational tool for studying classical cryptography schemes.