diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,17 @@ -See also: the list of [code releases] and [closed milestones]. +A list of key changes in [Hackage releases], +along with planned features of some expected future releases (in parentheses). +See also: + +* the list of [code releases]; +* [open milestones]; +* [closed milestones]; and +* [issues]. + +### [0.0.2.7] + +* Fix [testing (build) error](https://travis-ci.org/orome/crypto-enigma-hs/jobs/187207215). + ### [0.0.2.6] * Add [QuickCheck](https://hackage.haskell.org/package/QuickCheck) tests. @@ -8,7 +20,6 @@ * Convert all strings provided as `Message` arguments to valid machine input (see [`message`](https://hackage.haskell.org/package/crypto-enigma/docs/Crypto-Enigma.html#v:message)). - ### [0.0.2.5] * Test and abandon [Travis CI Hackage deployment](http://docs.travis-ci.com/user/deployment/hackage/). @@ -61,10 +72,15 @@ without ([successful](https://hackage.haskell.org/package/crypto-enigma-0.0.1.3/reports/1)) Hacakge-built documentation. Stable enough for use, but not reviewed. +[Hackage releases]: https://hackage.haskell.org/package/crypto-enigma [test figure]: https://hackage.haskell.org/package/crypto-enigma/docs/Crypto-Enigma-Display.html#showEnigmaConfigInternalFIG [build checks]: https://travis-ci.org/orome/crypto-enigma-hs/branches [code releases]: https://github.com/orome/crypto-enigma-hs/releases [closed milestones]: https://github.com/orome/crypto-enigma-hs/milestones?state=closed +[open milestones]: https://github.com/orome/crypto-enigma-hs/milestones?state=open +[issues]: https://github.com/orome/crypto-enigma-hs/issues?utf8=✓&q= +[First stable release]: https://github.com/orome/crypto-enigma-hs/milestones/First%20Stable%20Release +[0.0.2.7]: https://github.com/orome/crypto-enigma-hs/releases/tag/0.0.2.7 [0.0.2.6]: https://github.com/orome/crypto-enigma-hs/releases/tag/0.0.2.6 [0.0.2.5]: https://github.com/orome/crypto-enigma-hs/releases/tag/0.0.2.5 [0.0.2.4]: https://github.com/orome/crypto-enigma-hs/releases/tag/0.0.2.4 diff --git a/Crypto/Enigma.hs b/Crypto/Enigma.hs --- a/Crypto/Enigma.hs +++ b/Crypto/Enigma.hs @@ -100,7 +100,7 @@ -- REV - Actually any string that does not contain periods will be taken as no plugboard; see 'component'. -- | A string identifying a 'Component' of an Enigma machine. --- For rotors (including the reflector) this is one of the conventional letter or roman numeral designations +-- For rotors (including the reflector) this is one of the conventional letter or Roman numeral designations -- (e.g., @\"IV\"@ or @\"β\"@). For the plugboard this is the conventional string of letter pairs (separated by periods), -- indicating letters wired together by plugging (e.g., @\"AU.ZM.ZL.RQ\"@). -- Absence or non-use of a plugboard can be indicated with a lone "~". See 'name'. @@ -193,7 +193,7 @@ -- >>> components $ configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZL" "16.01.21.11" -- ["AM.EU.ZL","II","III","V","\946","c"] -- - -- (Note that any Unicode charcters are + -- (Note that any Unicode characters are -- as their Unicode value: -- here @"\\946" == "β"@.) components :: ![Name], @@ -220,7 +220,7 @@ -- -- For plugboard and reflector, this will always be @1@ since the former lacks a ring, -- and for latter ring position is irrelevant (the letter ring is not visible, and has - -- no effect on turnovers): + -- no effect on when turnovers occur): -- -- prop> head (rings cfg) == 1 -- prop> last (rings cfg) == 1 @@ -292,7 +292,7 @@ -- Instantiation, display, and reading --------------------------------------- -- | The letters at the window in an 'EnigmaConfig', in physical, conventional order. --- This is the (only) visible manifestations of configuration changes during operation. +-- This is the (only) visible manifestation of configuration changes during operation. -- -- >>> windows $ configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZL" "16.01.21.11" -- "LQVI" @@ -306,10 +306,10 @@ -- -- * The rotor 'Name's, separated by dashes (e.g. @\"C-V-I-II\"@); see 'Name'. -- * The letters visible at the windows (e.g. @\"MQR\"@); see 'windows'. --- * The plugboard specification (which may me omitted with @\"~\"@); see 'Name'. +-- * The plugboard specification (which may be omitted with @\"~\"@); see 'Name'. -- * The position of the letter ring on each rotor, separated by periods (e.g. @\"22.11.16\"@); see 'rings'. -- --- Following convention, the elements of these specifications are in physical machine order as the operator sees +-- Following convention, the elements of these strings are in physical machine order as the operator sees -- them, which is the reverse of the order in which they are encountered in processing (see 'stages'). -- -- Validation is permissive, allowing for ahistorical collections and numbers of rotors (including reflectors @@ -321,6 +321,7 @@ Right cfg -> cfg Left err -> error (show err) +-- REV - Enable, possibly passing errors from EnigmaConfig where checks could happen using classes; see issue 12 <<< -- A safe (total) constructor; not currently exposed configEnigmaExcept :: String -> String -> String -> String -> Except EnigmaError EnigmaConfig configEnigmaExcept rots winds plug rngs = do @@ -393,7 +394,7 @@ -- Mapping ================================================================== - +-- REV - Enforce as a calss (in encoding functions too)'; see issue 12 <<< -- | The mapping used by a component (see 'wiring' and 'componentMapping') -- or by the machine (see 'enigmaMapping') to perform a -- . @@ -531,21 +532,16 @@ zipWith encode (enigmaMapping <$> cfgs) (message str) where cfgs = iterate step (step ec) - --- REV - Decide what (if any) functions should force String->Message and which (if any) should requre as arg <<< --- (Currently all force internally). --- TBD - Fold message into message' and rename message; require Message for some funcs (list); check docs <<< - - -- Message entry ------------------------------------------------------------- --- | A 'String', to which 'message' is applied by functions taking it as an argument. +-- | A ( for) 'String', indicating that 'message' will be applied +-- to the corresponding argument. type Message = String -- | Convert a 'String' to valid Enigma machine input: replace any symbols for which there are standard Kriegsmarine --- substitutions, remove any remaining non letter characters, and convert to uppercase. This function is applied +-- substitutions, remove any remaining non-letter characters, and convert to uppercase. This function is applied -- automatically to 'Message' arguments for functions defined here. -message :: String -> String +message :: String -> Message message s = filter (`elem` letters) $ foldl1 fmap (uncurry replace <$> subs) $ toUpper <$> s where subs = [(" ",""),(".","X"),(",","Y"),("'","J"),(">","J"),("<","J"),("!","X"), @@ -553,7 +549,7 @@ ("1","YQ"),("2","YW"),("3","YE"),("4","YR"),("5","YT"), ("6","YZ"),("7","YU"),("8","YI"),("9","YO"),("0","YP")] --- REV - Possible future version in which 'Message' is at type (and caller is responsible for making Message). +-- REV - Rejected (#12) alternate version in which 'Message' is at class (and caller is responsible for making Message). -- data Message = Message String deriving Show -- -- message :: String -> Message diff --git a/Crypto/Enigma/Display.hs b/Crypto/Enigma/Display.hs --- a/Crypto/Enigma/Display.hs +++ b/Crypto/Enigma/Display.hs @@ -45,6 +45,7 @@ -- Helpers =================================================================== + -- Message display ----------------------------------------------------------- -- TBD - Don't remove spaces (at least in showEnigmaOperation and instead put a blank line?) @@ -57,9 +58,9 @@ -- TBD Move up (closer to encoding?) -- TBD - Can't use below unless encode handles ch == ' ' --- locate the index of the encoding with enc of ch, in s +-- locate the index of the encoding with m of ch, in s locCar :: Char -> String -> Mapping -> Maybe Int -locCar ch s enc = elemIndex (encode enc ch) s +locCar ch s m = elemIndex (encode m ch) s decorate :: Char -> String decorate ch = ch:"\818\773" @@ -70,11 +71,20 @@ markedMapping Nothing e = e +-- Character restriction ---------------------------------------------------- +-- If the character isn't in 'letters', treat it as blank (a special case for 'encode' and other functions) +enigmaChar :: Char -> Char +enigmaChar ch = if ch `elem` letters then ch else ' ' + + + -- Machine operation display ================================================= --- Preprocess a message and produce a configuration display for the starting configuration --- and for each character of the message, using the provided configuration display function. +-- Preprocess a string into a 'Message' (using 'message') and produce a configuration display for the +-- starting configuration and for each character of the message, using the provided configuration display function. +-- Note that while 'showEnigmaOperation' and 'showEnigmaOperationInternal' indicate a 'Message' argument, it is +-- this function, which both call, that applies 'message'. showEnigmaOperation_ :: (EnigmaConfig -> Char -> String) -> EnigmaConfig -> Message -> String showEnigmaOperation_ df ec str = unlines $ zipWith df (iterate step ec) (' ':(message str)) @@ -84,7 +94,8 @@ -- | Display a summary of the Enigma machine configuration as its encoding (see 'Mapping'), -- the letters at the windows (see 'windows'), and the 'Position's of the rotors (see 'positions'). -- --- If a valid 'Message' character is provided, indicate that as input and mark the encoded letter. +-- If a an uppercase letter is provided, indicate that as input and mark the encoded letter. +-- Other characters will be ignored. -- -- For example, #showEnigmaConfigEG# -- @@ -93,11 +104,11 @@ -- -- shows the process of encoding of the letter __@\'K\'@__ to __@\'G\'@__. showEnigmaConfig :: EnigmaConfig -> Char -> String -showEnigmaConfig ec ch = fmt mch (markedMapping (locCar mch enc enc) enc) +showEnigmaConfig ec ch = fmt ech (markedMapping (locCar ech enc enc) enc) (windows ec) (reverse $ tail.init $ positions ec) where - mch = messageChar ch + ech = enigmaChar ch enc = enigmaMapping ec fmt ch e ws ps = printf "%s %s %s %s" lbl e ws ps' where @@ -112,8 +123,8 @@ -- followed by the encoding for the machine, and preceded by a (trivial, no-op) keyboard \"encoding\" -- for reference. -- --- If a valid 'Message' character is provided, indicate that as input and mark the letter it is encoded to at --- each stage; mark its encoding as output. +-- If a an uppercase letter is provided, indicate that as input and mark the letter it is encoded to at +-- each stage; mark its encoding as output. Other characters will be ignored. -- -- For example, #showEnigmaConfigInternalEG# -- @@ -166,18 +177,18 @@ -- <> showEnigmaConfigInternal :: EnigmaConfig -> Char -> String showEnigmaConfigInternal ec ch = - unlines $ [fmt (if mch == ' ' then "" else mch:" >") (markedMapping (head charLocs) letters) ' ' 0 ""] ++ + unlines $ [fmt (if ech == ' ' then "" else ech:" >") (markedMapping (head charLocs) letters) ' ' 0 ""] ++ (zipWith5 fmt (init <> reverse $ ["P"] ++ (show <$> (tail.init $ stages ec)) ++ ["R"]) (zipWith markedMapping (tail.init $ charLocs) (stageMappingList ec)) (" " ++ (reverse $ windows ec) ++ replicate (length $ positions ec) ' ') ([0] ++ ((tail.init $ positions ec)) ++ replicate (length $ positions ec) 0 ) (components ec ++ (tail $ reverse $ components ec)) ) ++ - [fmt (if mch == ' ' then "" else (encode (enigmaMapping ec) mch):" <") + [fmt (if ech == ' ' then "" else (encode (enigmaMapping ec) ech):" <") (markedMapping (last charLocs) (enigmaMapping ec)) ' ' 0 ""] where - mch = messageChar ch - charLocs = zipWith (locCar mch) + ech = enigmaChar ch + charLocs = zipWith (locCar ech) ([letters] ++ stageMappingList ec ++ [enigmaMapping ec]) ([letters] ++ enigmaMappingList ec ++ [enigmaMapping ec]) fmt l e w p n = printf "%3.3s %s %s %s %s" l e (w:[]) p' n @@ -188,7 +199,7 @@ -- Operation display --------------------------------------------------------- -- | Show a summary of an Enigma machine configuration (see 'showEnigmaConfig') --- and for each subsequent configuration as it processes each letter of a message. #showEnigmaOperationEG# +-- and for each subsequent configuration as it processes each letter of a 'Message'. #showEnigmaOperationEG# -- -- >>> putStr $ showEnigmaOperation (configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") "KRIEG" -- OHNKJYSBTEDMLCARWPGIXZQUFV LFAP 10 16 24 06 @@ -201,11 +212,11 @@ -- Note that the first line of the display represents the initial configuration of the machine, but does not -- perform any encoding (as explained in 'step'). -- Note also that the second line of this display is the same as one displayed in the example for 'showEnigmaConfig'. -showEnigmaOperation :: EnigmaConfig -> String -> String +showEnigmaOperation :: EnigmaConfig -> Message -> String showEnigmaOperation ec str = showEnigmaOperation_ showEnigmaConfig ec str -- | Show a schematic of an Enigma machine's internal configuration (see 'showEnigmaConfigInternal' for details) --- and for each subsequent configuration as it processes each letter of a message. +-- and for each subsequent configuration as it processes each letter of a 'Message'. -- -- >>> putStr $ showEnigmaOperationInternal (configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") "KR" -- ABCDEFGHIJKLMNOPQRSTUVWXYZ @@ -253,7 +264,7 @@ -- Note that the first block of the display represents the initial configuration of the machine, but does not -- perform any encoding (as explained in 'step'). Note also that the second block of this display is the same -- as one displayed in the example for 'showEnigmaConfigInternal', where it is explained in more detail. -showEnigmaOperationInternal :: EnigmaConfig -> String -> String +showEnigmaOperationInternal :: EnigmaConfig -> Message -> String showEnigmaOperationInternal ec str = showEnigmaOperation_ showEnigmaConfigInternal ec str @@ -267,4 +278,5 @@ -- RBBF PMHP HGCZ XTDY GAHG UFXG EWKB LKGJ showEnigmaEncoding :: EnigmaConfig -> Message -> String showEnigmaEncoding ec str = postproc $ enigmaEncoding ec (message str) + diff --git a/Crypto/Enigma/Utils.hs b/Crypto/Enigma/Utils.hs --- a/Crypto/Enigma/Utils.hs +++ b/Crypto/Enigma/Utils.hs @@ -10,7 +10,6 @@ -- Some character utilities -------------------------------------------------- --- REV - Could make this [MsgChar] letters :: String letters = ['A'..'Z'] @@ -28,16 +27,10 @@ -- encode a single character encode :: String -> Char -> Char -encode e ' ' = ' ' -encode e ch = e !! (numA0 ch) +-- encode e ' ' = ' ' +-- encode e ch = e !! (numA0 ch) +encode m ch = if i `elem` [0..(length m)-1] then (m !! i) else ' ' where i = numA0 ch -- standard simple-substitution cypher encoding encode' :: String -> String -> String -encode' e s = (encode e) <$> s - - --- Character restriction ---------------------------------------------------- - --- If the character isn't in 'letters', treat it as blank (a special case for 'encode' and other functions) -messageChar :: Char -> Char -messageChar ch = if ch `elem` letters then ch else ' ' +encode' m s = (encode m) <$> s diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015, Roy Levien +Copyright (c) 2016, Roy Levien All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -75,6 +75,8 @@ * [enigma.lhs](https://gist.github.com/erantapaa/f071bc3f58d017f9280a) * [henigma](https://github.com/erantapaa/henigma) +This package served as the basis for a [Python version], with essentially the same API. + ### Development status [![Build Status](https://travis-ci.org/orome/crypto-enigma-hs.svg?branch=develop)](https://travis-ci.org/orome/crypto-enigma-hs/branches) diff --git a/crypto-enigma.cabal b/crypto-enigma.cabal --- a/crypto-enigma.cabal +++ b/crypto-enigma.cabal @@ -3,7 +3,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.0.2.6 +version: 0.0.2.7 synopsis: An Enigma machine simulator with display. description: The crypto-enigma package is an Enigma machine simulator with rich display and machine state details. @@ -28,7 +28,7 @@ license-file: LICENSE author: Roy Levien maintainer: royl@aldaron.com -copyright: (c) 2014-2015 Roy Levien +copyright: (c) 2014-2016 Roy Levien category: Cryptography, Education build-type: Simple extra-source-files: CHANGELOG.md @@ -41,11 +41,11 @@ location: git://github.com/orome/crypto-enigma-hs.git branch: develop ---source-repository this --- type: git --- location: git://github.com/orome/crypto-enigma-hs.git --- branch: hackage --- tag: 0.0.2.6 +source-repository this + type: git + location: git://github.com/orome/crypto-enigma-hs.git + branch: hackage + tag: 0.0.2.7 library -- default-extensions: Trustworthy @@ -53,7 +53,7 @@ Crypto.Enigma.Display other-modules: Crypto.Enigma.Utils -- other-extensions: - build-depends: base >=4.8.1.0 && <4.9, + build-depends: base >=4.8.1.0 && <=4.9.1.0, containers >=0.5.5.1, split >=0.2.2, mtl >=2.2, @@ -65,7 +65,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Check.hs - build-depends: base >=4.8.1.0 && <4.9, + build-depends: base >=4.8.1.0 && <=4.9.1.0, QuickCheck >=2.8, crypto-enigma -- ghc-options: -threaded -rtsopts -with-rtsopts=-N @@ -75,7 +75,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Test.hs - build-depends: base >=4.8.1.0 && <4.9, + build-depends: base >=4.8.1.0 && <=4.9.1.0, HUnit >=1.3, crypto-enigma -- ghc-options: -threaded -rtsopts -with-rtsopts=-N diff --git a/test/Check.hs b/test/Check.hs --- a/test/Check.hs +++ b/test/Check.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Main where -- import Test.HUnit @@ -14,15 +13,18 @@ {-# ANN module ("HLint: ignore Use mappend"::String) #-} -capitals = elements ['A'..'Z'] -anychars = elements (['A'..'Z'] ++ " .,'> (rs :: [Int])) --- REV - Requires TypeSynonymInstances, FlexibleInstances; find a better way <<< -instance Arbitrary String where - arbitrary = do - l <- choose (1,200) - replicateM l anychars - +data BadChar = BadChar {chr :: Char} deriving Show +instance Arbitrary BadChar where + arbitrary = do + f <- elements badchars + return $ BadChar f prop_ReadShowIsNoOp :: EnigmaConfig -> Bool prop_ReadShowIsNoOp cfg = cfg == (read (show cfg) :: EnigmaConfig) @@ -49,6 +50,15 @@ prop_NoEncodeIsMessage :: String -> Bool prop_NoEncodeIsMessage str = enigmaEncoding (configEnigma "----" "AAAA" "" "01.01.01.01") str == message str +prop_BadCharIsBlankInConfig :: EnigmaConfig -> BadChar -> Bool +prop_BadCharIsBlankInConfig cfg bchr = showEnigmaConfig cfg (chr bchr) == showEnigmaConfig cfg ' ' + +-- TBD - Confirm that this actually tests == +prop_StepEqual :: EnigmaConfig -> Bool +prop_StepEqual cfg = step cfg == step cfg + +-- TBD - Add test of stepped encoding start (see test_encoding_stepped_start) in Python version <<< + main :: IO () main = do putStrLn "\n==== QuickCheck Tests" @@ -71,5 +81,15 @@ result <- verboseCheckWithResult stdArgs { maxSuccess = 5, chatty = True } prop_NoEncodeIsMessage unless (isSuccess result) exitFailure result <- quickCheckWithResult stdArgs { maxSuccess = 100, chatty = True } prop_NoEncodeIsMessage + unless (isSuccess result) exitFailure + putStrLn "\nQuickCheck - bad chars blank in config:" + result <- verboseCheckWithResult stdArgs { maxSuccess = 10, chatty = True } prop_BadCharIsBlankInConfig + unless (isSuccess result) exitFailure + result <- quickCheckWithResult stdArgs { maxSuccess = 200, chatty = True } prop_BadCharIsBlankInConfig + unless (isSuccess result) exitFailure + putStrLn "\nQuickCheck - step once is equal:" + result <- verboseCheckWithResult stdArgs { maxSuccess = 10, chatty = True } prop_StepEqual + unless (isSuccess result) exitFailure + result <- quickCheckWithResult stdArgs { maxSuccess = 200, chatty = True } prop_StepEqual unless (isSuccess result) exitFailure putStrLn "\n" diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -93,7 +93,15 @@ putStrLn $ " Reflectors:\t" ++ (show reflectors) putStrLn "\nInternals display test:" putStrLn $ showEnigmaConfigInternal (configEnigma "----" "AAAA" "" "01.01.01.01") ' ' - putStrLn "Operation display test:" + putStrLn "\nDisplay test - '@':" + putStrLn $ showEnigmaConfig (configEnigma "----" "AAAA" "" "01.01.01.01") '@' + putStrLn "\nDisplay test - '\\':" + putStrLn $ showEnigmaConfig (configEnigma "----" "AAAA" "" "01.01.01.01") '\\' + putStrLn "\nDisplay test - ' ':" + putStrLn $ showEnigmaConfig (configEnigma "----" "AAAA" "" "01.01.01.01") ' ' + putStrLn "\nDisplay test - '.':" + putStrLn $ showEnigmaConfig (configEnigma "----" "AAAA" "" "01.01.01.01") '.' + putStrLn "\nOperation display test:" putStrLn $ showEnigmaOperation (configEnigma "----" "AAAA" "~" "01.01.10.01") ['A'..'Z'] putStrLn "Encoding display test:" putStrLn $ showEnigmaEncoding (configEnigma "----" "AAAA" " " "01.01.10.01") (concatMap (replicate 8) ['A'..'Z'])