diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,5 @@ -A list of key changes in [Hackage releases], -along with planned features of some expected future releases (in parentheses). +A list of key changes in [Hackage releases], along with planned features of some expected future releases (in +parentheses). See also: @@ -8,23 +8,32 @@ * [closed milestones]; and * [issues]. -### (0.0.2.?) +### [0.0.3.1] -* ([First stable release].) -* (Unicode checking for messages and letters.) -* (Force characters into map range or catch indexing errors in - encoding.) -* (Further workflow changes: stack integration, Stackage, etc.) +Latest [release version] adding [new CLI] with significant +[refactoring and additional features](https://github.com/orome/crypto-enigma-hs/compare/0.0.2.14...0.0.3.1): +* [Add](https://github.com/orome/crypto-enigma-hs/issues/13) + [command line interface](https://github.com/orome/crypto-enigma-hs#functionality-command-line), + using [optparse-applicative](http://hackage.haskell.org/package/optparse-applicative). +* Refactor display functions, deprecating `show...` functions and adding new display options. +* Encapsulate `EnigmaConfig` display options in + [`DisplayOpts`](https://hackage.haskell.org/package/crypto-enigma/docs/Crypto-Enigma-Display.html#DisplayOptsA) + with a total constructor (coercing any bad values to defaults). +* More consistent and robust error handling in `EnigmaConfig` constructors + (including restoring `readSpec` compliance in `read`). +* Add (export existing) [total constructor](https://hackage.haskell.org/package/crypto-enigma/docs/Crypto-Enigma.html#v:configEnigmaExcept) + for `EnigmaConfig`. + ### [0.0.2.14] -* Update for GHC 8.6.1 -* Travis CI infrastructure and resolver updates +* Update for GHC 8.6.1. +* Travis CI infrastructure and resolver updates. ### [0.0.2.13] -* Update for GHC 8.4.3 -* Travis CI infrastructure and resolver updates +* Update for GHC 8.4.3. +* Travis CI infrastructure and resolver updates. ### [0.0.2.12] @@ -56,10 +65,11 @@ ### [0.0.2.6] * Add [QuickCheck](https://hackage.haskell.org/package/QuickCheck) tests. -* Remove (disabled) assertions from [`configEnigma`](https://hackage.haskell.org/package/crypto-enigma/docs/Crypto-Enigma.html#v:configEnigma) - and fail with an error when bad arguments are given. -* 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)). +* Remove (disabled) assertions from + [`configEnigma`](https://hackage.haskell.org/package/crypto-enigma/docs/Crypto-Enigma.html#v:configEnigma) and fail + with an error when bad arguments are given. +* 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] @@ -109,8 +119,8 @@ ### [0.0.1.3] -Initial Hackage version. First upload of package to Hackage, -without ([successful](https://hackage.haskell.org/package/crypto-enigma-0.0.1.3/reports/1)) Hacakge-built documentation. +Initial Hackage version. First upload of package to Hackage, without +([successful](https://hackage.haskell.org/package/crypto-enigma-0.0.1.3/reports/1)) Hackage-built documentation. Stable enough for use, but not reviewed. [Hackage releases]: https://hackage.haskell.org/package/crypto-enigma @@ -121,6 +131,12 @@ [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 + +[release version]: https://github.com/orome/crypto-enigma-hs/tree/hackage +[development version]: https://github.com/orome/crypto-enigma-hs/tree/develop +[new CLI]: https://github.com/orome/crypto-enigma-hs/tree/new/cli + +[0.0.3.1]: https://github.com/orome/crypto-enigma-hs/releases/tag/0.0.3.1 [0.0.2.14]: https://github.com/orome/crypto-enigma-hs/releases/tag/0.0.2.14 [0.0.2.13]: https://github.com/orome/crypto-enigma-hs/releases/tag/0.0.2.13 [0.0.2.12]: https://github.com/orome/crypto-enigma-hs/releases/tag/0.0.2.12 diff --git a/Crypto/Enigma.hs b/Crypto/Enigma.hs --- a/Crypto/Enigma.hs +++ b/Crypto/Enigma.hs @@ -1,5 +1,5 @@ {-# OPTIONS_HADDOCK show-extensions #-} ---{-# OPTIONS_GHC -fno-ignore-asserts #-} -- REV - Use to keep asserts for valid 'Message'? <<< +--{-# OPTIONS_GHC -fno-ignore-asserts #-} --REV: Use to keep asserts for valid 'Message'? <<< {-| Module : Crypto.Enigma Description : Enigma machine simulator @@ -13,9 +13,8 @@ Richer display is provided by "Crypto.Enigma.Display". -} ---{-# LANGUAGE MultiWayIf #-} ---{-# LANGUAGE Trustworthy #-} ---{-# LANGUAGE Safe #-} + +{-# LANGUAGE Safe #-} module Crypto.Enigma ( -- * Machine components Component, @@ -30,6 +29,7 @@ reflectors, -- * Machine configurations and transitions EnigmaConfig, + configEnigmaExcept, configEnigma, stages, components, @@ -55,81 +55,68 @@ ) where import Control.Arrow -import Control.Exception (assert) +--import Control.Exception (assert) import Control.Monad (unless) import Control.Monad.Except -import Control.Monad.Zip -import Control.Applicative -import Data.Monoid +--import Control.Monad.Zip +--import Control.Applicative +import Data.Monoid ((<>)) -- For GHC < 8.4.3 - https://stackoverflow.com/a/53024485/656912 import Data.List import Data.List.Split (splitOn) ---import Data.Ix (inRange) import qualified Data.Map as M import Data.Maybe import Text.Printf (printf) import Data.Char (toUpper) -import Data.String.Utils (replace) +import Data.Text (replace, pack, unpack) import Crypto.Enigma.Utils ---import Data.Map (Map) -{-# ANN module ("HLint: ignore Use infix"::String) #-} -{-# ANN module ("HLint: ignore Use mappend"::String) #-} -{-# ANN module ("HLint: ignore Use fmap"::String) #-} -{-# ANN module ("HLint: error Redundant $"::String) #-} -{-# ANN module ("HLint: ignore Use ."::String) #-} --- TBD - Use lenses - --- TBD - Use modular arithmetic package - http://hackage.haskell.org/package/modular-arithmetic --- TBD - Use Arrow more? --- TBD - EnigmaMachine as Monad instance? --- TBD - Add more walkthroughs to documentation (either README or Haddock)? --- REV - Move plugboard last (it's 'optional'?)? --- TBD - Note how this implementation differs by preserving all letters and full mappings so they can be examined. <<< --- REV - Have lists and display omit plugboard stage if not used or present; distinguishing non-use and absence? --- REV - Show degenerate case in list and display examples? --- REV - Add and use _make_valid... and _is_valid... from Python version? <<< --- ASK - Retina figures? <<< --- TBD - Move HLint config info to .hlint.yaml ? <<< - - - -- Enigma mechanics ========================================================== -- Machine components -------------------------------------------------------- --- 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 --- (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'. +{-| +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 +(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'. +-} +--REV: Actually any string that does not contain periods will be taken as no plugboard; see 'component'. type Name = String --- | The 'Mapping' established by the physical wiring of a 'Component', when 01 is at the window position for rotors, --- and by the plug arrangement for the plugboard. See 'wiring'. + +{-| +The 'Mapping' established by the physical wiring of a 'Component', when 01 is at the window position for rotors, +and by the plug arrangement for the plugboard. See 'wiring'. +-} type Wiring = Mapping --- | The list of letters on the rotor's ring that appear at the window when a 'Component''s ring is in the turnover --- position. --- Not applicable (and empty) for the plugboard and for reflectors. See 'turnovers'. +{-| +The list of letters on the rotor's ring that appear at the window when a 'Component''s ring is in the turnover +position. +Not applicable (and empty) for the plugboard and for reflectors. See 'turnovers'. +-} type Turnovers = String --- | A component used to construct an Enigma machine (embodied in an 'EnigmaConfig') identified by its 'name', and --- characterized by its physical 'wiring' and additionally — for rotors other than the reflector — by 'turnovers' --- which govern the 'step'ping of the machine in which it is installed. +{-| +A component used to construct an Enigma machine (embodied in an 'EnigmaConfig') identified by its 'name', and +characterized by its physical 'wiring' and additionally — for rotors other than the reflector — by 'turnovers' +which govern the 'step'ping of the machine in which it is installed. +-} data Component = Component { name :: !Name, -- ^ The component's 'Name'. wiring :: !Wiring, -- ^ The component's 'Wiring'. turnovers :: !Turnovers -- ^ The component's 'Turnovers'. } --- REV - \c -> (name c, c) instead of (name &&& id) ? +--REV: \c -> (name c, c) instead of (name &&& id) ? -- Definitions of rotor Components; people died for this information -rots :: M.Map Name Component -rots = M.fromList $ (name &&& id) <$> [ +rots_ :: M.Map Name Component +rots_ = M.fromList $ (name &&& id) <$> [ -- rotors Component "I" "EKMFLGDQVZNTOWYHXUSPAIBRCJ" "Q", Component "II" "AJDKSIRUXBLHWTMCQGZNPYFVOE" "E", @@ -141,8 +128,8 @@ Component "VIII" "FKQHTLXOCBJSPDZRAMEWNIUYGV" "ZM", Component "β" "LEYJVCNIXWPBQMDRTAKZGFUHOS" "", Component "γ" "FSOKANUERHMBTIYCWLQPZXVGJD" ""] -refs :: M.Map Name Component -refs = M.fromList $ (name &&& id) <$> [ +refs_ :: M.Map Name Component +refs_ = M.fromList $ (name &&& id) <$> [ -- reflectors Component "A" "EJMZALYXVBWFCRQUONTSPIKHGD" "", Component "B" "YRUHQSLDPXNGOKMIEBFZCWVJAT" "", @@ -150,129 +137,154 @@ Component "b" "ENKQAUYWJICOPBLMDXZVFTHRGS" "", Component "c" "RDOBJNTKVEHMLFCWZAXGYIPSUQ" ""] -- base case (e.g. for "unplugged" plugboard, or the keyboard) -kbd = M.fromList [("",Component "" "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "")] +kbd_ = M.fromList [("",Component "" "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "")] -comps :: M.Map Name Component -comps = rots `M.union` refs `M.union` kbd +comps_ :: M.Map Name Component +comps_ = rots_ `M.union` refs_ `M.union` kbd_ --- | The list of valid 'Component' 'Name's for rotors. +{-| +The list of valid 'Component' 'Name's for rotors. +-} rotors :: [Name] -rotors = M.keys rots +rotors = M.keys rots_ --- | The list of valid 'Component' 'Name's for reflectors. +{-| +The list of valid 'Component' 'Name's for reflectors. +-} reflectors :: [Name] -reflectors = M.keys refs +reflectors = M.keys refs_ --- | The 'Component' with the specified 'Name'. +{-| +The 'Component' with the specified 'Name'. +-} component :: Name -> Component -component n = fromMaybe (Component n (foldr plug letters (splitOn "." n)) "") (M.lookup n comps) +component n = fromMaybe (Component n (foldr plug letters (splitOn "." n)) "") (M.lookup n comps_) -- Either lookup the rotor or reflector by name, or use the plugboard spec to -- generate a component with wiring in which the specified letter pairs are exchanged. where - c = find ((== n).name) comps plug [p1,p2] = map (\ch -> if ch == p1 then p2 else if ch == p2 then p1 else ch) plug _ = id -- Anything but a .-separated pair will have no effect (configEnigma assertion) -- Machine configurations and transitions ------------------------------------ --- | The (zero-based) index of the processing stage occupied by a 'Component' in an 'EngmaConfig'. See 'stages'. +{-| +The (zero-based) index of the processing stage occupied by a 'Component' in an 'EngmaConfig'. See 'stages'. +-} type Stage = Int --- | The generalized rotational position of a 'Component'. For rotors, this is denoted by number on the rotor --- (not letter ring) that is at the "window position". For other components the only meaningful position is @1@ --- (see 'positions'). --- --- This (alone) determines the permutations applied to the component's --- 'Wiring' to produce its current 'Mapping' (see 'componentMapping'). +{-| +The generalized rotational position of a 'Component'. For rotors, this is denoted by number on the rotor +(not letter ring) that is at the "window position". For other components the only meaningful position is @1@ +(see 'positions'). + +This (alone) determines the permutations applied to the component's 'Wiring' to produce its current 'Mapping' +(see 'componentMapping'). +-} type Position = Int --- | The complete description of the state of an Enigma machine, consisting of 'components', 'positions', and 'rings'. +{-| +The complete description of the state of an Enigma machine, consisting of 'components', 'positions', and 'rings'. + +Two functions ('configEnigmaExcept' and 'configEnigma') are provided for creating 'EnigmaConfig', which differ in +their handling of errors in the provided arguments specifying the configuration (the only potential source of errors, +since all other arguments throught the package are coerced to valid values). +-} data EnigmaConfig = EnigmaConfig { - -- | The 'Name' of each 'Component' in an 'EnigmaConfig', in processing order. - -- Unchanged by 'step'. - -- - -- >>> 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 characters are - -- as their Unicode value: - -- here @"\\946" == "β"@.) + {-| + The 'Name' of each 'Component' in an 'EnigmaConfig', in processing order. + Unchanged by 'step'. + + >>> 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 characters are + as their Unicode value: + here @"\\946" == "β"@.) + -} components :: ![Name], - -- | The 'Position' of each 'Component' in an 'EnigmaConfig', in machine processing order. - -- May be changed by 'step'. - -- - -- >>> positions $ configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZL" "16.01.21.11" - -- [1,25,2,17,23,1] - -- - -- For plugboard and reflector, this will always be @1@ since the former cannot rotate, - -- and the latter does not (neither will be changed by 'step'): - -- - -- prop> head (positions cfg) == 1 - -- prop> last (positions cfg) == 1 - -- - -- This determines the encoding performed by a component (see 'componentMapping'). + {-| + The 'Position' of each 'Component' in an 'EnigmaConfig', in machine processing order. + May be changed by 'step'. + + >>> positions $ configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZL" "16.01.21.11" + [1,25,2,17,23,1] + + For plugboard and reflector, this will always be @1@ since the former cannot rotate, + and the latter does not (neither will be changed by 'step'): + + prop> head (positions cfg) == 1 + prop> last (positions cfg) == 1 + + This determines the encoding performed by a component (see 'componentMapping'). + -} positions :: ![Position], - -- | The location of ring letter 'A' on the rotor for each 'Component' in an 'EnigmaConfig', - -- in machine processing order. - -- Unchanged by 'step'. - -- - -- >>> rings $ configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZL" "16.01.21.11" - -- [1,11,21,1,16,1] - -- - -- 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 when turnovers occur): - -- - -- prop> head (rings cfg) == 1 - -- prop> last (rings cfg) == 1 + {-| + The location of ring letter 'A' on the rotor for each 'Component' in an 'EnigmaConfig', + in machine processing order. + Unchanged by 'step'. + + >>> rings $ configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZL" "16.01.21.11" + [1,11,21,1,16,1] + + 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 when turnovers occur): + + prop> head (rings cfg) == 1 + prop> last (rings cfg) == 1 + -} rings :: ![Int] } deriving Eq --- REV - Is this needed anywhere but in display functions? The Python version can avoid it. --- | The sequential, (forward) processing-order, 'Stage' occupied by each 'Component' in an 'EnigmaConfig', starting --- with @0@ for the plugboard and ending with the reflector. --- --- >>> stages $ configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZL" "16.01.21.11" --- [0,1,2,3,4,5] --- --- prop> components cfg == ((components cfg !!) <$> stages cfg) --- --- The term \'stage\' (lowercase) is also used here to encompass subsequent reverse processing order stages --- (see, for example, 'stageMappingList'). +{-| +The sequential, (forward) processing-order, 'Stage' occupied by each 'Component' in an 'EnigmaConfig', starting +with @0@ for the plugboard and ending with the reflector. + +>>> stages $ configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZL" "16.01.21.11" +[0,1,2,3,4,5] + +prop> components cfg == ((components cfg !!) <$> stages cfg) + +The term \'stage\' (lowercase) is also used here to encompass subsequent reverse processing order stages +(see, for example, 'stageMappingList'). +-} +-- REV: Is this needed anywhere but in display functions? The Python version can avoid it. stages :: EnigmaConfig -> [Stage] stages ec = [0..(length $ components ec)-1] --- REV - Could take a ring and a position and dispense with st --- TBD - Some properties showing only 'position' changes? +-- REV: Could take a ring and a position and dispense with st +-- REV: Some properties showing only 'position' changes? -- The letter at the window for a given stage. -- Used in 'windows', and in 'step' to identify when a rotor ring is in the turnover position windowLetter :: EnigmaConfig -> Stage -> Char windowLetter ec st = chrA0 $ mod (positions ec !! st + rings ec !! st - 2) 26 --- | Step the machine to a new 'EnigmaConfig' by rotating the rightmost (first) rotor one position, and other rotors --- as determined by the 'positions' of rotors in the machine. --- In the physical machine, a step occurs in response to each operator keypress, --- prior to processing that key's letter. (See 'enigmaEncoding'.) --- --- Stepping leaves the 'components', 'stages' and 'rings' of a configuration unchanged, changing only 'positions', --- which is manifest in changes of the letters at the 'windows': --- --- >>> let cfg = configEnigma "c-γ-V-I-II" "LXZO" "UX.MO.KZ.AY.EF.PL" "03.17.04.01" --- >>> putStr $ unlines $ show <$> take 5 (iterate step cfg) --- c-γ-V-I-II LXZO UX.MO.KZ.AY.EF.PL 03.17.04.01 --- c-γ-V-I-II LXZP UX.MO.KZ.AY.EF.PL 03.17.04.01 --- c-γ-V-I-II LXZQ UX.MO.KZ.AY.EF.PL 03.17.04.01 --- c-γ-V-I-II LXZR UX.MO.KZ.AY.EF.PL 03.17.04.01 --- c-γ-V-I-II LXZS UX.MO.KZ.AY.EF.PL 03.17.04.01 --- --- >>> let cfg = configEnigma "c-γ-V-I-II" "LXZO" "UX.MO.KZ.AY.EF.PL" "03.17.04.01" --- >>> take 5 $ map windows $ iterate step cfg --- ["LXZO","LXZP","LXZQ","LXZR","LXZS"] --- --- >>> let cfg = configEnigma "c-γ-V-I-II" "LXZO" "UX.MO.KZ.AY.EF.PL" "03.17.04.01" --- >>> take 5 $ map positions $ iterate step cfg --- [[1,15,23,8,10,1],[1,16,23,8,10,1],[1,17,23,8,10,1],[1,18,23,8,10,1],[1,19,23,8,10,1]] +{-| +Step the machine to a new 'EnigmaConfig' by rotating the rightmost (first) rotor one position, and other rotors +as determined by the 'positions' of rotors in the machine. +In the physical machine, a step occurs in response to each operator keypress, +prior to processing that key's letter. (See 'enigmaEncoding'.) + +Stepping leaves the 'components', 'stages' and 'rings' of a configuration unchanged, changing only 'positions', +which is manifest in changes of the letters at the 'windows': + +>>> let cfg = configEnigma "c-γ-V-I-II" "LXZO" "UX.MO.KZ.AY.EF.PL" "03.17.04.01" +>>> putStr $ unlines $ show <$> take 5 (iterate step cfg) +c-γ-V-I-II LXZO UX.MO.KZ.AY.EF.PL 03.17.04.01 +c-γ-V-I-II LXZP UX.MO.KZ.AY.EF.PL 03.17.04.01 +c-γ-V-I-II LXZQ UX.MO.KZ.AY.EF.PL 03.17.04.01 +c-γ-V-I-II LXZR UX.MO.KZ.AY.EF.PL 03.17.04.01 +c-γ-V-I-II LXZS UX.MO.KZ.AY.EF.PL 03.17.04.01 + +>>> let cfg = configEnigma "c-γ-V-I-II" "LXZO" "UX.MO.KZ.AY.EF.PL" "03.17.04.01" +>>> take 5 $ map windows $ iterate step cfg +["LXZO","LXZP","LXZQ","LXZR","LXZS"] + +>>> let cfg = configEnigma "c-γ-V-I-II" "LXZO" "UX.MO.KZ.AY.EF.PL" "03.17.04.01" +>>> take 5 $ map positions $ iterate step cfg +[[1,15,23,8,10,1],[1,16,23,8,10,1],[1,17,23,8,10,1],[1,18,23,8,10,1],[1,19,23,8,10,1]] +-} step :: EnigmaConfig -> EnigmaConfig step ec = ec { positions = steppedPosition <$> stages ec } -- only positions change when stepped where @@ -290,52 +302,61 @@ isTurn j = elem (windowLetter ec j) (turnovers $ component (components ec !! j)) --- REV - Plugboard omission happens more generally; see 'Name'. -- Instantiation, display, and reading --------------------------------------- --- | The letters at the window in an 'EnigmaConfig', in physical, conventional order. --- 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" +{-| +The letters at the window in an 'EnigmaConfig', in physical, conventional order. +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" +-} windows :: EnigmaConfig -> String windows ec = reverse $ tail.init $ windowLetter ec <$> (stages ec) --- REV - Add check that last components' is in reflectors; all of head.tail components' are in rotors? <<< --- REV - Add checks for historical combinations of machine elements? --- | A (safe public, ) constructor that does validation and takes --- a conventional specification as input, in the form of four strings: --- --- * 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 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 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 --- at the rotor stage, and trivial degenerate machines; --- e.g., @configEnigma "-" \"A\" "" "01"@), and any number of (non-contradictory) plugboard wirings (including none). --- Invalid arguments result in an error. -configEnigma :: String -> String -> String -> String -> EnigmaConfig -configEnigma rots winds plug rngs = case runExcept (configEnigmaExcept rots winds plug rngs) of - Right cfg -> cfg - Left err -> error (show err) +{-| +Create an 'EnigmaConfig' from a conventional specification. --- REV - Enable, possibly passing errors from EnigmaConfig where checks could happen using classes; see issue 12 <<< --- A safe (total) constructor; not currently exposed +A (safe public, , total) constructor intended +for use in pure code that does validation and takes a conventional specification as input, in the form of four strings: + +* 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 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 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 +at the rotor stage, and trivial degenerate machines; +e.g., @configEnigma "-" \"A\" "" "01"@), and any number of (non-contradictory) plugboard wirings (including none). +Invalid arguments return an 'EnigmaError': + +>>> configEnigmaExcept "c-β-V-III-II" "LQVI" "AM.EU.ZiL" "16.01.21.11" +ExceptT (Identity (Left Bad plugboard : AM.EU.ZiL)) +-} +-- REV: Add checks for historical combinations of machine elements? configEnigmaExcept :: String -> String -> String -> String -> Except EnigmaError EnigmaConfig configEnigmaExcept rots winds plug rngs = do unless (and $ (==(length components')) <$> [length winds', length rngs']) (throwError BadNumbers) - unless (and $ [(>=1),(<=26)] <*> rngs') (throwError (BadRotors rngs)) + unless (rngs == (filter (`elem` "0123456789.") rngs)) (throwError (BadRings rngs)) + unless (and $ [(>=1),(<=26)] <*> rngs') (throwError (BadRings rngs)) unless (and $ (`elem` letters) <$> winds') (throwError (BadWindows winds)) unless (plug `elem` ["~",""," "] || ((and $ (==2).length <$> splitOn "." plug) && (and $ (`elem` letters) <$> filter (/='.') plug) && ((\s -> s == nub s) $ filter (/='.') plug)) ) (throwError (BadPlugs plug)) - unless (and $ (`M.member` comps) <$> tail components') (throwError (BadRotors rots)) + unless (and $ (`M.member` comps_) <$> tail components') + (throwError (BadComponents rots $ unwords $ filter (`notElem` (rotors ++ reflectors)) (init (tail components')) )) + -- REV: Disallow no-op "keyboard" as component; disallow rotors as reflectors and vice versa <<< +-- unless (and $ (`M.member` (rots_ `M.union` refs_)) <$> tail components') +-- (throwError (BadComponents rots $ unwords $ filter (`notElem` (rotors ++ reflectors)) (init (tail components')) )) +-- unless (and $ (`M.member` rots_) <$> init (tail components')) +-- (throwError (BadRotors rots $ unwords $ filter (`notElem` rotors) (init (tail components')))) +-- unless ((last $ components') `M.member` refs_) +-- (throwError (BadReflector rots (last $ components'))) return EnigmaConfig { components = components', positions = zipWith (\w r -> (mod (numA0 w - r + 1) 26) + 1) winds' rngs', @@ -353,7 +374,9 @@ | BadRings String | BadWindows String | BadPlugs String - | BadRotors String + | BadComponents String String + | BadRotors String String + | BadReflector String String | MiscError String instance Show EnigmaError where @@ -361,34 +384,62 @@ show (BadRings s) = "Bad ring settings: " ++ s show (BadWindows s) = "Bad windows: " ++ s show (BadPlugs s) = "Bad plugboard : " ++ s - show (BadRotors s) = "Bad rotors : " ++ s + show (BadComponents arg s) = "Bad components : " ++ s ++ " in " ++ arg + show (BadRotors arg s) = "Bad rotors: " ++ s ++ " in " ++ arg + show (BadReflector arg s) = "Bad reflector: " ++ s ++ " in " ++ arg show (MiscError s) = s --- TBD - Some checking, e.g. that four "words" have been provided? --- | Read the elements of a conventional specification (see 'configEnigma') joined by spaces into a single string. --- --- >>> let cfg = configEnigma "b-β-V-VIII-III" "XQVI" "UX.MO.KZ.AY.EF.PL" "03.17.24.11" --- >>> let cfg' = read "b-β-V-VIII-III XQVI UX.MO.KZ.AY.EF.PL 03.17.24.11" :: EnigmaConfig --- >>> cfg == cfg' --- True +{-| +Create an 'EnigmaConfig' from a conventional specification. + +A thin convenience wrapper on @configEnigmaExcept@ intended for most uses (e.g., interactive) that takes the same +arguments but errors with an informative message and a stack trace: + +>>> configEnigma "c-β-V-III-II" "LQVI" "AM.EU.ZiL" "16.01.21.11" +*** Exception: Bad plugboard : AM.EU.ZiL +CallStack (from HasCallStack): + error, called at crypto-enigma/Crypto/Enigma.hs:317:21 in main:Crypto.Enigma + +This should be used instead of @read@, which cannot report error details: + +>>> read "c-β-V-III-II LQVI AM.EU.ZiL 16.01.21.11" :: EnigmaConfig +*** Exception: Prelude.read: no parse +-} +configEnigma :: String -> String -> String -> String -> EnigmaConfig +configEnigma rots winds plug rngs = case runExcept (configEnigmaExcept rots winds plug rngs) of + Right cfg -> cfg + Left err -> error (show err) + +{-| +Read the elements of a conventional specification (see 'configEnigma') as a single string. + +>>> let cfgstr = "c-β-V-III-II LQVI AM.EU.ZL 16.01.21.11" +>>> read cfgstr == (\[c, w, s, r] -> configEnigma c w s r) (words cfgstr) +True +-} instance Read EnigmaConfig where - readsPrec _ i = case runExcept (configEnigmaExcept c w s r) of - Right cfg -> [(cfg, "")] - Left err -> [] -- Looses error information, but conforms to specification of 'readsPrec' in 'Read' - where [c, w, s, r] = words i --- readsPrec _ i = [(configEnigma c w s r, "")] where [c, w, s, r] = words i + readsPrec _ i = if ((length $ words i) /= 4) + then [] + else case runExcept (configEnigmaExcept c w s r) of + Right cfg -> [(cfg, "")] + Left _ -> [] + where [c, w, s, r] = words i --- | Show the elements of a conventional specification (see 'configEnigma') joined by spaces into a single string. --- --- >>> configEnigma "b-β-V-VIII-II" "XQVI" "UX.MO.KZ.AY.EF.PL" "03.17.24.11" --- "b-β-V-VIII-III XQVI UX.MO.KZ.AY.EF.PL 03.17.24.11" +{-| +Show the elements of a conventional specification (see 'configEnigmaExcept') joined by spaces into a single string. + +>>> configEnigma "b-β-V-VIII-II" "XQVI" "UX.MO.KZ.AY.EF.PL" "03.17.24.11" +"b-β-V-VIII-III XQVI UX.MO.KZ.AY.EF.PL 03.17.24.11" +-} instance Show EnigmaConfig where show ec = unwords [intercalate "-" $ reverse.tail $ components ec, windows ec, head $ components ec, intercalate "." $ reverse.tail.init $ (printf "%02d") <$> (rings ec)] --- | Show a 'Component' as a formatted string consisting of its 'name', 'wiring', and 'turnovers' (if any). +{-| +Show a 'Component' as a formatted string consisting of its 'name', 'wiring', and 'turnovers' (if any). +-} instance Show Component where show c = printf "%-5.5s" (name c) ++ " " ++ wiring c ++ " " ++ turnovers c @@ -396,46 +447,54 @@ -- 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 --- . --- This is expressed as a string of letters indicating the mapped-to letter --- for the letter at that position in the alphabet — i.e., as a permutation of the alphabet. --- For example, the mapping @EKMFLGDQVZNTOWYHXUSPAIBRCJ@ encodes @A@ to @E@, @B@ to @K@, @C@ to @M@, ... --- @Y@ to @C@, and @Z@ to @J@. +{-| +The mapping used by a component (see 'wiring' and 'componentMapping') +or by the machine (see 'enigmaMapping') to perform a +. + +This is expressed as a string of letters indicating the mapped-to letter +for the letter at that position in the alphabet — i.e., as a permutation of the alphabet. +For example, the mapping @EKMFLGDQVZNTOWYHXUSPAIBRCJ@ encodes @A@ to @E@, @B@ to @K@, @C@ to @M@, ... +@Y@ to @C@, and @Z@ to @J@. +-} +--REV: Enforce as a class (in encoding functions too)' (#12) << type Mapping = String -- Enigma encoding logic ----------------------------------------------------- --- REV - These only need to be exposed to allow componentMapping to be exposed; necessary? <<< --- | The direction that a signal flows through a 'Component'. During encoding of a character, the signal --- passes first through the wiring of each component, from right to left in the machine, in a forward ('Fwd') --- direction, then through the reflector, and then, from left to right, through each component again, --- in reverse ('Rev'). --- This direction affects the encoding performed by the component (see 'componentMapping'). +{-| +The direction that a signal flows through a 'Component'. During encoding of a character, the signal +passes first through the wiring of each component, from right to left in the machine, in a forward ('Fwd') +direction, then through the reflector, and then, from left to right, through each component again, +in reverse ('Rev'). + +This direction affects the encoding performed by the component (see 'componentMapping'). +-} +--REV: These only need to be exposed to allow componentMapping to be exposed; necessary? <<< data Direction = Fwd | Rev --- REV - Add assertion to make sure plugboard is not rotated ; assert not in keys? --- | The 'Mapping' performed by a 'Component' as a function of its 'Position' and the 'Direction' of the --- signal passing through it. --- --- The base encoding of a 'Component', performed with rotor position @1@ at the window, is set by its 'wiring'. --- --- prop> componentMapping Fwd comp 1 == wiring comp --- --- For all other positions, the encoding is a cyclic permutation this mapping's inputs (backward) --- and outputs (forward) by the rotational offset of the rotor away from the @1@ position --- (though in an actual 'EmigmaConfig' such positions occur only for rotors; see 'positions'). --- --- Note that because the wiring of reflectors generates mappings that consist entirely of paired exchanges --- of letters, reflectors (at any position) produce the same mapping in both directions (the same is true --- of the plugboard): --- --- >>> let tst c n = componentMapping Fwd (component c) n == componentMapping Rev (component c) n --- >>> and $ tst <$> ["A","B","C","b","c"] <*> [1..26] --- True +{-| +The 'Mapping' performed by a 'Component' as a function of its 'Position' and the 'Direction' of the +signal passing through it. + +The base encoding of a 'Component', performed with rotor position @1@ at the window, is set by its 'wiring'. + +prop> componentMapping Fwd comp 1 == wiring comp + +For all other positions, the encoding is a cyclic permutation this mapping's inputs (backward) +and outputs (forward) by the rotational offset of the rotor away from the @1@ position +(though in an actual 'EmigmaConfig' such positions occur only for rotors; see 'positions'). + +Note that because the wiring of reflectors generates mappings that consist entirely of paired exchanges +of letters, reflectors (at any position) produce the same mapping in both directions (the same is true +of the plugboard): + +>>> let tst c n = componentMapping Fwd (component c) n == componentMapping Rev (component c) n +>>> and $ tst <$> ["A","B","C","b","c"] <*> [1..26] +True +-} +--REV: Add assertion to make sure plugboard is not rotated ; assert not in keys? componentMapping:: Direction -> Component -> Position -> Mapping componentMapping d c p = case d of Fwd -> map (\ch -> rotMap (1-p) letters !! (numA0 ch)) (rotMap (p-1) (wiring c)) @@ -444,89 +503,97 @@ rotMap :: Int -> Wiring -> Mapping rotMap o w = take 26 . drop (mod o 26) . cycle $ w --- | The list of 'Mapping's for each stage of an 'EnigmaConfig': the encoding performed by the --- 'Component' /at that point/ in the progress through the machine. --- --- These are arranged in processing order, beginning with the encoding performed by the plugboard, --- followed by the forward encoding performed by each rotor (see 'componentMapping'), then the reflector, --- followed by the reverse encodings by each rotor, and finally by the plugboard again. --- --- >>> putStr $ unlines $ stageMappingList (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") --- YBCDFEGHIJZPONMLQRSTXVWUAK --- LORVFBQNGWKATHJSZPIYUDXEMC --- BJYINTKWOARFEMVSGCUDPHZQLX --- ILHXUBZQPNVGKMCRTEJFADOYSW --- YDSKZPTNCHGQOMXAUWJFBRELVI --- ENKQAUYWJICOPBLMDXZVFTHRGS --- PUIBWTKJZSDXNHMFLVCGQYROAE --- UFOVRTLCASMBNJWIHPYQEKZDXG --- JARTMLQVDBGYNEIUXKPFSOHZCW --- LFZVXEINSOKAYHBRGCPMUDJWTQ --- YBCDFEGHIJZPONMLQRSTXVWUAK --- --- Note that, because plugboard 'Mapping' is established by paired exchanges of letters --- (see 'componentMapping'), --- --- prop> head (stageMappingList cfg) == last (stageMappingList cfg) --- --- As noted (see 'stages') the term \'stage\' here encompasses reverse processing: --- --- prop> length (stageMappingList cfg) == 2 * length (stages cfg) - 1 --- --- A richer example of how this list is used, and how it can be interpreted, --- can be found in "Crypto.Enigma.Display#showEnigmaConfigInternalEG". +{-| +The list of 'Mapping's for each stage of an 'EnigmaConfig': the encoding performed by the +'Component' /at that point/ in the progress through the machine. + +These are arranged in processing order, beginning with the encoding performed by the plugboard, +followed by the forward encoding performed by each rotor (see 'componentMapping'), then the reflector, +followed by the reverse encodings by each rotor, and finally by the plugboard again. + +>>> putStr $ unlines $ stageMappingList (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") +YBCDFEGHIJZPONMLQRSTXVWUAK +LORVFBQNGWKATHJSZPIYUDXEMC +BJYINTKWOARFEMVSGCUDPHZQLX +ILHXUBZQPNVGKMCRTEJFADOYSW +YDSKZPTNCHGQOMXAUWJFBRELVI +ENKQAUYWJICOPBLMDXZVFTHRGS +PUIBWTKJZSDXNHMFLVCGQYROAE +UFOVRTLCASMBNJWIHPYQEKZDXG +JARTMLQVDBGYNEIUXKPFSOHZCW +LFZVXEINSOKAYHBRGCPMUDJWTQ +YBCDFEGHIJZPONMLQRSTXVWUAK + +Note that, because plugboard 'Mapping' is established by paired exchanges of letters +(see 'componentMapping'), + +prop> head (stageMappingList cfg) == last (stageMappingList cfg) + +As noted (see 'stages') the term \'stage\' here encompasses reverse processing: + +prop> length (stageMappingList cfg) == 2 * length (stages cfg) - 1 + +A richer example of how this list is used, and how it can be interpreted, +can be found in "Crypto.Enigma.Display#displayEnigmaConfigInternalEG". +-} stageMappingList:: EnigmaConfig -> [Mapping] stageMappingList ec = ((stageMapping Fwd) <$>) <> ((stageMapping Rev) <$>).tail.reverse $ stages ec where stageMapping :: Direction -> Stage -> Mapping stageMapping d sn = componentMapping d (component $ components ec !! sn) (positions ec !! sn) --- | The list of 'Mapping's an 'EnigmaConfig' has performed by each stage: --- the encoding performed by the 'EnigmaConfig' /up to that point/ in the progress through the machine. --- --- >>> putStr $ unlines $ enigmaMappingList (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") --- YBCDFEGHIJZPONMLQRSTXVWUAK --- MORVBFQNGWCSJHTAZPIYEDXULK --- EVCHJTGMKZYUAWDBXSOLNIQPFR --- UDHQNFZKVWSAIOXLYJCGMPTRBE --- BKNUMPIGREJYCXLQVHSTOAFWDZ --- NCBFPMJYXAIGKRODTWZVLEUHQS --- HIUTFNSAOPZKDVMBGREYXWQJLC --- CAEQTJYUWIGMVKNFLPRXDZHSBO --- RJMXFBCSHDQNOGELYUKZTWVPAI --- COYWEFZPNVGHBIXATUKQMJDRLS --- CMAWFEKLNVGHBIUYTXZQOJDRPS --- --- Since these may be thought of as cumulative encodings, --- --- prop> enigmaMapping cfg == last (enigmaMappingList cfg) +{-| +The list of 'Mapping's an 'EnigmaConfig' has performed by each stage: +the encoding performed by the 'EnigmaConfig' /up to that point/ in the progress through the machine. + +>>> putStr $ unlines $ enigmaMappingList (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") +YBCDFEGHIJZPONMLQRSTXVWUAK +MORVBFQNGWCSJHTAZPIYEDXULK +EVCHJTGMKZYUAWDBXSOLNIQPFR +UDHQNFZKVWSAIOXLYJCGMPTRBE +BKNUMPIGREJYCXLQVHSTOAFWDZ +NCBFPMJYXAIGKRODTWZVLEUHQS +HIUTFNSAOPZKDVMBGREYXWQJLC +CAEQTJYUWIGMVKNFLPRXDZHSBO +RJMXFBCSHDQNOGELYUKZTWVPAI +COYWEFZPNVGHBIXATUKQMJDRLS +CMAWFEKLNVGHBIUYTXZQOJDRPS + +Since these may be thought of as cumulative encodings, + +prop> enigmaMapping cfg == last (enigmaMappingList cfg) +-} enigmaMappingList :: EnigmaConfig -> [Mapping] enigmaMappingList ec = scanl1 (flip encode') (stageMappingList ec) --- | The 'Mapping' performed by the Enigma machine. --- --- >>> enigmaMapping (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") --- "CMAWFEKLNVGHBIUYTXZQOJDRPS" --- --- A example of a richer display of this information can be found in "Crypto.Enigma.Display#showEnigmaConfigEG". +{-| +The 'Mapping' performed by the Enigma machine. + +>>> enigmaMapping (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") +"CMAWFEKLNVGHBIUYTXZQOJDRPS" + +A example of a richer display of this information can be found in "Crypto.Enigma.Display#displayEnigmaSingleEG". +-} enigmaMapping :: EnigmaConfig -> Mapping enigmaMapping ec = last $ enigmaMappingList ec -- The final stage's progressive encoding --- | Encode a 'Message' using a given (starting) machine configuration, by 'step'ping the configuration prior to --- processing each character of the message. This produces a new configuration (with new 'positions' only) --- for encoding each character, which serves as the "starting" configuration for subsequent --- processing of the message. --- --- >>> enigmaEncoding (configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") "KRIEG" --- "GOWNW" --- --- The details of this encoding and its relationship to stepping from one configuration to another are --- illustrated in "Crypto.Enigma.Display#showEnigmaOperationEG". --- --- Note that because of the way the Enigma machine is designed, it is always the case (provided that 'msg' is --- all uppercase letters) that --- --- prop> enigmaEncoding cfg (enigmaEncoding cfg msg) == msg +{-| +Encode a 'Message' using a given (starting) machine configuration, by 'step'ping the configuration prior to +processing each character of the message. This produces a new configuration (with new 'positions' only) +for encoding each character, which serves as the "starting" configuration for subsequent +processing of the message. + +>>> enigmaEncoding (configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") "KRIEG" +"GOWNW" + +The details of this encoding and its relationship to stepping from one configuration to another are +illustrated in "Crypto.Enigma.Display#displayEnigmaOperationEG". + +Note that because of the way the Enigma machine is designed, it is always the case (provided that 'msg' is +all uppercase letters) that + +prop> enigmaEncoding cfg (enigmaEncoding cfg msg) == msg +-} enigmaEncoding :: EnigmaConfig -> Message -> String enigmaEncoding ec str = -- The encoding of a string is the sequence encodings of each character @@ -536,22 +603,28 @@ -- Message entry ------------------------------------------------------------- --- | A ( for) 'String', indicating that 'message' will be applied --- to the corresponding 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 --- automatically to 'Message' arguments for functions defined here. +{-| +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 +automatically to 'String's suppied as 'Message' arguments to functions in this package. +-} +-- REV: Awkward pack/unpack patch to remove dependency on MissingH (#29) message :: String -> Message -message s = filter (`elem` letters) $ foldl1 fmap (uncurry replace <$> subs) $ toUpper <$> s +message s = filter (`elem` letters) $ foldl1 fmap (uncurry replace' <$> subs) $ toUpper <$> s where subs = [(" ",""),(".","X"),(",","Y"),("'","J"),(">","J"),("<","J"),("!","X"), ("?","UD"),("-","YY"),(":","XX"),("(","KK"),(")","KK"), ("1","YQ"),("2","YW"),("3","YE"),("4","YR"),("5","YT"), ("6","YZ"),("7","YU"),("8","YI"),("9","YO"),("0","YP")] + replace' a b c = unpack $ replace (pack a) (pack b) (pack c) --- REV - Rejected (#12) alternate version in which 'Message' is at class (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 @@ -11,272 +11,625 @@ A module for rich display of the state of and encoding performed by Enigma machines defined in "Crypto.Enigma". -} +{-# LANGUAGE Safe #-} module Crypto.Enigma.Display ( + -- * Display options + DisplayOpts, + displayOpts, + format, + showencoding, + markerspec, + showsteps, + steps, + Format, + MarkerSpec, + DisplaySteps, -- * Configuration display + displayEnigmaConfig, showEnigmaConfig, showEnigmaConfigInternal, -- * Operation display + displayEnigmaOperation, + listEnigmaOperation, showEnigmaOperation, showEnigmaOperationInternal, -- * Encoding display + displayEnigmaEncoding, showEnigmaEncoding ) where -import Control.Applicative -import Data.Monoid -import Data.Char +--import Control.Applicative +import Data.Monoid ((<>)) -- For GHC < 8.4.3 - https://stackoverflow.com/a/53024485/656912 +--import Data.Char import Data.List import Data.List.Split (chunksOf) -import Data.String.Utils (replace) import Text.Printf (printf) - +import Data.Char (toLower, isAscii) import Crypto.Enigma.Utils import Crypto.Enigma -{-# ANN module ("HLint: ignore Use infix"::String) #-} -{-# ANN module ("HLint: ignore Use mappend"::String) #-} -{-# ANN module ("HLint: error Redundant $"::String) #-} -{-# ANN module ("HLint: ignore Use ."::String) #-} +-- REV: Final newline in show... functions is a bit inconsistent --- TBD - Fix name of more detailed display -> ..EnigmConfigSchematic ? <<< --- REV - Final newline in show... functions is a bit inconsistent +-- Machine display =========================================================== --- Helpers =================================================================== +-- Display options ----------------------------------------------------------- --- Message display ----------------------------------------------------------- +{-| +A ( for) 'String', indicating that this option will be coerced to a valid +valid 'format' when used by display functions. +-} +type Format = String --- TBD - Don't remove spaces (at least in showEnigmaOperation and instead put a blank line?) --- Standard formatting of encoded messages -postproc :: String -> String -postproc = unlines . chunksOf 60 . unwords . chunksOf 4 +-- The various possible formats +fmtsSingle_ = ["single", "summary"] +fmtsInternal_ = ["internal", "detailed", "schematic"] +fmtsWindows_ = ["windows", "winds"] +fmtsConfig_ = ["config", "configuration", "spec", "specification"] +fmtsEncoding_ = ["encoding"] +fmts_ = fmtsInternal_ ++ fmtsSingle_ ++ fmtsWindows_ ++ fmtsConfig_ ++ fmtsEncoding_ +-- TBD: Debug --- Mapping markup ----------------------------------------------------------- +{-| +A ( for) 'String', indicating that this option will be coerced to a valid +valid 'markerspec' when used by display functions. +-} +type MarkerSpec = String --- TBD Move up (closer to encoding?) --- TBD - Can't use below unless encode handles ch == ' ' --- locate the index of the encoding with m of ch, in s -locCar :: Char -> String -> Mapping -> Maybe Int -locCar ch s m = elemIndex (encode m ch) s +-- REV: Expose with markerFunc? +-- A function specifying how to highlight an encoded character in an 'EnigmaConfig', created using 'markerFunc'. +data MarkerFunc_ = MarkerFunc_ (Char -> String) + +-- REV: Export to support arbitrary user-defined functions? +-- Create a 'MarkerFunc_' from a string specification. Ignores unrecognized/invalid values +markerFunc_ :: MarkerSpec -> MarkerFunc_ +markerFunc_ spec = MarkerFunc_ (case spec of + "*" -> \_ -> "*" + "lower" -> \c -> [toLower c] + "omit" -> \_ -> " " + "bars" -> \ch -> ch:"\818\773" + "legacy" -> \c -> [ '[', c, ']' ] + "red" -> \c -> escape_ "31;1m" c + "blue" -> \c -> escape_ "34;1m" c + "green" -> \c -> escape_ "32;1m" c + "bold" -> \c -> escape_ "1m" c + "underline" -> \c -> escape_ "4m" c + "highlight" -> \c -> escape_ "7m" c + "cyan" -> \c -> escape_ "36;1m" c + "yellow" -> \c -> escape_ "33;1m" c +-- "51" -> \c -> esc ++ "51m" ++ [c] ++ esc ++ "0m" +-- "52" -> \c -> esc ++ "52m" ++ [c] ++ esc ++ "0m" + -- TBD: More colors and other escapes + [l, r] -> \c -> [l, c, r] + _ -> \c -> [c]) -decorate :: Char -> String -decorate ch = ch:"\818\773" ---decorate ch = ['[',ch,']'] -- version that works when Unicode fails to display properly (e.g. IHaskell as of 0.7.1.0) +mark_ :: MarkerFunc_ -> Char -> String +mark_ (MarkerFunc_ f) c = f c -markedMapping :: Maybe Int -> Mapping -> String -markedMapping (Just loc) e = take loc <> decorate.(!!loc) <> drop (loc + 1) $ e -markedMapping Nothing e = e +-- !!! - Assumes that MarkerFuncs that add visible length to marked character always add exactly two characters +markerWidth_ :: MarkerFunc_ -> Int +markerWidth_ mf | (length $ filter isAscii (mark_ mf 'X')) == 3 = 1 -- Property enforced by markerFunc_ + | otherwise = 0 +{-| +A ( for) 'Int', indicating that this option will be coerced to a valid +valid 'steps' value when used by display functions. +-} +type DisplaySteps = Int --- Character restriction ---------------------------------------------------- +{-| +Options for 'displayEnigmaConfig', 'displayEnigmaOperation', and 'listEnigmaOperation', created using 'displayOpts'. +All fields are coerced to valid values by display functions. #DisplayOptsA# +-} +data DisplayOpts = DisplayOpts { + {-| + A 'Format' specifying the format used to display 'EnigmaConfig' machine configuration(s) that should be one of + @"single"@, @"internal"@, @"windows"@, @"config"@, and @"encoding"@: --- 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 ' ' + [@"single"@] 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'). + Any valid letter being encoded (see 'showencoding') by the configuration is indicated as input, + and the encoding of the letter is marked (see 'markerspec'). + For example, #displayEnigmaSingleEG# --- Machine operation display ================================================= + > K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 --- 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)) + shows the process of encoding of the letter __@\'K\'@__ to __@\'G\'@__. + [@"internal"@] An expaned schematic of the configuration showing the encoding (see 'Mapping') + performed by each stage (see 'stageMappingList'), along with an indication of the stage (rotor number, + @\"P\"@ for plugboard, or @\"R\"@ for reflector), window letter (see 'windows'), 'Position' + (see 'positions') and 'Name', followed by the encoding for the machine as a whole, and preceded by + a (trivial, no-op) keyboard \"encoding\" for reference. + Any valid letter being encoded (see 'showencoding') by the configuration is indicated as input, + and its encoding at each stage is marked (see 'markerspec'). + + For example, #displayEnigmaConfigInternalEG# + + @ + K > ABCDEFGHIJK̲̅LMNOPQRSTUVWXYZ + P YBCDFEGHIJZ̲̅PONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL + 1 LORVFBQNGWKATHJSZPIYUDXEMC̲̅ Q 07 II + 2 BJY̲̅INTKWOARFEMVSGCUDPHZQLX A 24 VIII + 3 ILHXUBZQPNVGKMCRTEJFADOYS̲̅W F 16 V + 4 YDSKZPTNCHGQOMXAUWJ̲̅FBRELVI L 10 γ + R ENKQAUYWJI̲̅COPBLMDXZVFTHRGS b + 4 PUIBWTKJZ̲̅SDXNHMFLVCGQYROAE γ + 3 UFOVRTLCASMBNJWIHPYQEKZDXG̲̅ V + 2 JARTMLQ̲̅VDBGYNEIUXKPFSOHZCW VIII + 1 LFZVXEINSOKAYHBRG̲̅CPMUDJWTQ II + P YBCDFEG̲̅HIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL + G < CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS + @ + + shows the "internals" of the same proccess as avove using the same machine configuration: + the encoding of the letter __@\'K\'@__ to __@\'G\'@__: + + * __@\'K\'@__ is entered at the keyboard, which is then + * encoded by the plugboard (@\'P\'@), which includes @\"KZ\"@ in its specification (see 'Name'), + to __@\'Z\'@__, which is then + * encoded by the first rotor (@\'1\'@), a @\"II\"@ rotor in the @07@ position (and @\'Q\'@ at the window), + to __@\'C\'@__, which is then + * encoded by the second rotor (@\'2\'@), a @\"VIII\"@ rotor in the @24@ position (and @\'A\'@ at the window), + to __@\'Y\'@__, which is then + * encoded by the third rotor (@\'3\'@), a @\"V\"@ rotor in the @16@ position (and @\'F\'@ at the window), + to __@\'S\'@__, which is then + * encoded by the fourth rotor (@\'4\'@), a @\"γ\"@ rotor in the @10@ position (and @\'L\'@ at the window), + to __@\'J\'@__, which is then + * encoded by the reflector rotor (@\'U\'@), a @\"b\"@ reflector, + to __@\'I\'@__, which reverses the signal sending it back through the rotors, where it is then + * encoded in reverse by the fourth rotor (@\'4\'@), + to __@\'Z\'@__, which is then + * encoded in reverse by the third rotor (@\'3\'@), to __@\'G\'@__, which is then + * encoded in reverse by the second rotor (@\'2\'@), to __@\'Q\'@__, which is then + * encoded in reverse by the first rotor (@\'1\'@), to __@\'G\'@__, which is then + * left unchanged by the plugboard (@\'P\'@), and finally + * displayed as __@\'G\'@__ + + Note that (as follows from 'Mapping') the position of the marked letter at each stage is the + alphabetic position of the marked letter at the previous stage. + + This can be represented schematically (with input arriving and output exiting on the left) as #showEnigmaConfigInternalFIG# + + <> + + [@"windows"@] The letters at the window (see 'windows'): + + > LFAQ + + [@"config"@] The specification of the configuration (see 'configEnigmaExcept') in the same format used by + @configEnigma@ and @configEnigmaExcept@, as a single string: + + > b-γ-V-VIII-II LFAQ UX.MO.KZ.AY.EF.PL 03.17.04.11 + + [@"encoding"@] The encoding of any valid letter being encoded (see 'showencoding'): + + > K > G + + + Note the "windows" and config" effectively display the same format as 'windows' and @show@, and are most + useful in conjunction with other options (e.g. 'showencoding' and 'showsteps', respectively) and for showing + operation with 'displayEnigmaOperation'. + + See 'displayEnigmaConfig' for further examples. + + Display functions are forgiving about the supplied format and will accept a range of reasonable substitutes + (e.g., @"detailed"@ or @"schematic"@ for @"internal"@), and will treat unrecognized formats as the default, + @"single"@. + -} + format :: !Format, + {-| + A @Bool@ indicating whether to show encoding if not normally shown for the specified format. + + If a valid letter is being encoded (one is either provided as an argument to 'displayEnigmaConfig', or there + is a message provided as an argument to 'displayEnigmaOperation' with a letter at the displayed step) the letter + and its encoding are indicated. + + This setting applies only to @"windows"@ and @"config"@. For example, where "windows" normally shows just + + > LFAQ + + setting @showencoding@ to @True@ produces + + > LFAQ K > G + -} + showencoding :: !Bool, + {-| + A 'MarkerSpec' that should be either a pair or characters (e.g. @"[]"@) or a specification of a color + (e.g, @"red"@) or style (@"bars"@) to use to highlight the encoded character in formats that + show encoding. For example the default @markerspec@ of @"bars"@ highlights the encoding (in, e.g., + the @"single"@ format with a bar above and below the encoding + + > K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 + + and supplying a @markerspec@ of @"[]"@ instead highlights the encoding of the letter by placing a @"["@ to + the left and a @"]"@ to the right of the encoding + + > K > CMAWFEKLNV[G]HBIUYTXZQOJDRPS LFAQ 10 16 24 07 + + Invalid or unrecognized highlight specifications are treated as the @"bars"@. + -} + markerspec :: !MarkerSpec, + markerfunction_ :: !MarkerFunc_, -- REV: Internal only; expose for custom marker functions? + {-| + A @Bool@ indicating whether to show step numbers, defaults to @False@. + + Only relevant for operation display functions. See 'displayEnigmaOperation' for examples. + -} + showsteps :: !Bool, + {-| + An @Int@ indicating the number of steps to display, which defaults to the length of a message if one is + being displayed, and to @1@ otherwise. Values less than @1@ are treated as the default. + + Only relevant for operation display functions. See 'displayEnigmaOperation' for examples. + -} + steps :: !DisplaySteps +} + +allSteps_ = (-1) + +{-| +Default 'DisplayOpts' equivalent to @DisplayOpts{format="single",showencoding=False,markerspec="bars",...}@. +See individual options below for defaults values. This is the sole method for providing and setting options for +display functions. E.g. to supply specify a 'format' of @"windows"@ which shows encoding (see 'showencoding') provide + +@ +displayOpts{format="windows",showencoding=True} +@ + +as the @DisplayOpts@ argument to a display finction. +-} +displayOpts = DisplayOpts { + format = "single", + showencoding = False, + markerspec = "bars", + markerfunction_ = markerFunc_ "bars", + showsteps = False, + steps = allSteps_ +} + +-- Internal function used by all display functions to coerce all display options to valid values. +validOpts_ :: DisplayOpts -> DisplayOpts +validOpts_ opts = DisplayOpts { + format = case fmt of + f | elem f fmts_ -> f + | otherwise -> fmtsSingle_!!0, + showencoding = se, + markerspec = ms, + markerfunction_ = markerFunc_ ms, + showsteps = ss, + steps = if ns > 0 then ns else allSteps_ + } + where + fmt = (format opts) + se = (showencoding opts) + ms = (markerspec opts) + ss = (showsteps opts) + ns = (steps opts) + + -- Configuration display ----------------------------------------------------- --- | 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 an uppercase letter is provided, indicate that as input and mark the encoded letter. --- Other characters will be ignored. --- --- For example, #showEnigmaConfigEG# --- --- >>> putStr $ showEnigmaConfig (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") 'K' --- K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 --- --- shows the process of encoding of the letter __@\'K\'@__ to __@\'G\'@__. -showEnigmaConfig :: EnigmaConfig -> Char -> String -showEnigmaConfig ec ch = fmt ech (markedMapping (locCar ech enc enc) enc) - (windows ec) - (reverse $ tail.init $ positions ec) +{-| +A @String@ representation of an 'EnigmaConfig' using the specified 'DisplayOpts'. + +If an uppercase letter is provided, indicate that as input show its encoding(s), as determined by the the 'format' +and 'showencoding' and, where for the @format@, 'markerspec'. Other characters will be ignored. + +For example, the illustrations given in the discussion of the 'format' option above can be created using (in order) + +>>> let cfg = step $ configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11" +>>> putStrLn $ displayEnigmaConfig cfg 'K' displayOpts{format="single"} +K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 +>>> putStrLn $ displayEnigmaConfig cfg 'K' displayOpts{format="internal"} +K > ABCDEFGHIJK̲̅LMNOPQRSTUVWXYZ + P YBCDFEGHIJZ̲̅PONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL + 1 LORVFBQNGWKATHJSZPIYUDXEMC̲̅ Q 07 II + 2 BJY̲̅INTKWOARFEMVSGCUDPHZQLX A 24 VIII + 3 ILHXUBZQPNVGKMCRTEJFADOYS̲̅W F 16 V + 4 YDSKZPTNCHGQOMXAUWJ̲̅FBRELVI L 10 γ + R ENKQAUYWJI̲̅COPBLMDXZVFTHRGS b + 4 PUIBWTKJZ̲̅SDXNHMFLVCGQYROAE γ + 3 UFOVRTLCASMBNJWIHPYQEKZDXG̲̅ V + 2 JARTMLQ̲̅VDBGYNEIUXKPFSOHZCW VIII + 1 LFZVXEINSOKAYHBRG̲̅CPMUDJWTQ II + P YBCDFEG̲̅HIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL +G < CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS + +>>> putStrLn $ displayEnigmaConfig cfg 'K' displayOpts{format="windows"} +LFAQ + +>>> putStrLn $ displayEnigmaConfig cfg 'K' displayOpts{format="config"} +b-γ-V-VIII-II LFAQ UX.MO.KZ.AY.EF.PL 03.17.04.11 + +>>> putStrLn $ displayEnigmaConfig cfg 'K' displayOpts{format="encoding"} +K > G + +and other options can be freely combined (or omitted), for example + +>>> putStrLn $ displayEnigmaConfig cfg 'K' displayOpts{format="single",markerspec="()"} +K > CMAWFEKLNV(G)HBIUYTXZQOJDRPS LFAQ 10 16 24 07 + +>>> putStrLn $ displayEnigmaConfig cfg 'K' displayOpts{format="config",showencoding=True} +b-γ-V-VIII-II LFAQ UX.MO.KZ.AY.EF.PL 03.17.04.11 K > G + +>>> putStrLn $ displayEnigmaConfig cfg 'K' displayOpts +K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 +-} +displayEnigmaConfig :: EnigmaConfig -> Char -> DisplayOpts -> String +displayEnigmaConfig ec ch optsin = + case (format optsin) of + x | elem x fmtsSingle_ -> showEnigmaConfig_ + x | elem x fmtsInternal_ -> showEnigmaConfigInternal_ + x | elem x fmtsWindows_ -> (windows ec) ++ encs + x | elem x fmtsConfig_ -> (show ec) ++ encs + x | elem x fmtsEncoding_ -> drop 2 encs + _ -> showEnigmaConfig_ -- Should not happen: all display option arguments are coerced by validOpts_ where - ech = enigmaChar ch + -- Ensure valid arguments enc = enigmaMapping ec - fmt ch e ws ps = printf "%s %s %s %s" lbl e ws ps' - where - lbl = if ch == ' ' then " " else ch:" >" - ps' = unwords $ (printf "%02d") <$> ps + ech = enigmaChar ch + opts = validOpts_ optsin --- TBD - Improve resolution of figure showing mapping <<< --- | Display a summary of the Enigma machine configuration as a schematic showing the encoding (see 'Mapping') --- performed by each stage (see 'stageMappingList'), along with an indication of the stage --- (rotor number, @\"P\"@ for plugboard, or @\"R\"@ for reflector), window letter (see 'windows'), --- 'Position' (see 'positions') and 'Name', --- followed by the encoding for the machine, and preceded by a (trivial, no-op) keyboard \"encoding\" --- for reference. --- --- If 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# --- --- >>> putStr $ showEnigmaConfigInternal (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") 'K' --- K > ABCDEFGHIJK̲̅LMNOPQRSTUVWXYZ --- P YBCDFEGHIJZ̲̅PONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL --- 1 LORVFBQNGWKATHJSZPIYUDXEMC̲̅ Q 07 II --- 2 BJY̲̅INTKWOARFEMVSGCUDPHZQLX A 24 VIII --- 3 ILHXUBZQPNVGKMCRTEJFADOYS̲̅W F 16 V --- 4 YDSKZPTNCHGQOMXAUWJ̲̅FBRELVI L 10 γ --- R ENKQAUYWJI̲̅COPBLMDXZVFTHRGS b --- 4 PUIBWTKJZ̲̅SDXNHMFLVCGQYROAE γ --- 3 UFOVRTLCASMBNJWIHPYQEKZDXG̲̅ V --- 2 JARTMLQ̲̅VDBGYNEIUXKPFSOHZCW VIII --- 1 LFZVXEINSOKAYHBRG̲̅CPMUDJWTQ II --- P YBCDFEG̲̅HIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL --- G < CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS --- --- shows the process of encoding of the letter __@\'K\'@__ to __@\'G\'@__: --- --- * __@\'K\'@__ is entered at the keyboard, which is then --- * encoded by the plugboard (@\'P\'@), which includes @\"KZ\"@ in its specification (see 'Name'), --- to __@\'Z\'@__, which is then --- * encoded by the first rotor (@\'1\'@), a @\"II\"@ rotor in the @07@ position (and @\'Q\'@ at the window), --- to __@\'C\'@__, which is then --- * encoded by the second rotor (@\'2\'@), a @\"VIII\"@ rotor in the @24@ position (and @\'A\'@ at the window), --- to __@\'Y\'@__, which is then --- * encoded by the third rotor (@\'3\'@), a @\"V\"@ rotor in the @16@ position (and @\'F\'@ at the window), --- to __@\'S\'@__, which is then --- * encoded by the fourth rotor (@\'4\'@), a @\"γ\"@ rotor in the @10@ position (and @\'L\'@ at the window), --- to __@\'J\'@__, which is then --- * encoded by the reflector rotor (@\'U\'@), a @\"b\"@ reflector, --- to __@\'I\'@__, which reverses the signal sending it back through the rotors, where it is then --- * encoded in reverse by the fourth rotor (@\'4\'@), --- to __@\'Z\'@__, which is then --- * encoded in reverse by the third rotor (@\'3\'@), --- to __@\'G\'@__, which is then --- * encoded in reverse by the second rotor (@\'2\'@), --- to __@\'Q\'@__, which is then --- * encoded in reverse by the first rotor (@\'1\'@), --- to __@\'G\'@__, which is then --- * left unchanged by the plugboard (@\'P\'@), and finally --- * displayed as __@\'G\'@__ --- --- Note that (as follows from 'Mapping') the position of the marked letter at each stage is the alphabetic position --- of the marked letter at the previous stage. --- --- This can be represented schematically (with input arriving and output exiting on the left) as #showEnigmaConfigInternalFIG# --- --- <> + encs = if (elem ech letters) && (( showencoding opts) || elem (format opts) fmtsEncoding_) + then " " ++ [ech] ++ " > " ++ [(encode (enigmaMapping ec) ech)] + else "" + + -- REV: Can't use below unless encode handles ch == ' ' + -- Locate the index of the encoding with m of ch, in s + --locCar :: Char -> String -> Mapping -> Maybe Int + locCar ch s m = elemIndex (encode m ch) s + + --markedMapping :: Maybe Int -> Mapping -> MarkerFunc_ -> String + markedMapping (Just loc) e mf = take loc <> (mark_ mf).(!!loc) <> drop (loc + 1) $ e + markedMapping Nothing e mf = buff ++ e ++ buff where buff = replicate (markerWidth_ mf) ' ' + -- Pad to align unmarked encoding if visible length is changed by marking + + -- 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 ' ' + + showEnigmaConfig_ = fmt ech (markedMapping (locCar ech enc enc) enc (markerfunction_ opts)) + (windows ec) + (reverse $ tail.init $ positions ec) + where + fmt ch e ws ps = printf "%s %s %s %s" lbl e ws ps' + where + lbl = if ch == ' ' then " " else ch:" >" + ps' = unwords $ (printf "%02d") <$> ps + + showEnigmaConfigInternal_ = + unlines $ [fmt (if ech == ' ' then "" else ech:" >") (markedMapping (head charLocs) letters (markerfunction_ opts)) ' ' 0 ""] ++ + (zipWith5 fmt (init <> reverse $ ["P"] ++ (show <$> (tail.init $ stages ec)) ++ ["R"]) + (zipWith3 markedMapping (tail.init $ charLocs) (stageMappingList ec) (cycle [markerfunction_ opts])) + (" " ++ (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 ech == ' ' then "" else (encode (enigmaMapping ec) ech):" <") + (markedMapping (last charLocs) (enigmaMapping ec) (markerfunction_ opts)) ' ' 0 ""] + where + 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 + where + p' = if p == 0 then " " else printf "%02d" (p::Int) + +{-# DEPRECATED showEnigmaConfig "This has been replaced by 'displayEnigmaConfig'" #-} +{-| +Equivalent to 'displayEnigmaConfig' with @displayOpts{format="single"}@. +-} +showEnigmaConfig :: EnigmaConfig -> Char -> String +showEnigmaConfig ec ch = displayEnigmaConfig ec ch displayOpts + +{-# DEPRECATED showEnigmaConfigInternal "This has been replaced by 'displayEnigmaConfig'" #-} +{-| +Equivalent to 'displayEnigmaConfig' with @displayOpts{format="internal"}@. +-} showEnigmaConfigInternal :: EnigmaConfig -> Char -> String -showEnigmaConfigInternal ec ch = - 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 ech == ' ' then "" else (encode (enigmaMapping ec) ech):" <") - (markedMapping (last charLocs) (enigmaMapping ec)) ' ' 0 ""] - where - 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 - where - p' = if p == 0 then " " else printf "%02d" (p::Int) +showEnigmaConfigInternal ec ch = displayEnigmaConfig ec ch displayOpts{format="internal"} -- 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# --- --- >>> 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 --- K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 --- R > HXETCUMASQNZGKRYJO̲̅IDFWVBPL LFAR 10 16 24 08 --- I > FGRJUABYW̲̅DZSXVQTOCLPENIMHK LFAS 10 16 24 09 --- E > SJWYN̲̅UZPQBVXRETHIMAOFKCLDG LFAT 10 16 24 10 --- G > EOKPAQW̲̅JLHCISTBDFVMNXRGUZY LFAU 10 16 24 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'. +{-| +A 'String' representation of an Enigma machine's internal configuration (see 'displayEnigmaConfig' for details) +and for each subsequent configuration as it processes each letter of a 'Message', subject to the provided 'DisplayOpts'. + +In addition to the options that apply to the representation of each individual configuration, @DisplayOpts@ for this +function include options for specifying whether to run for a specific number of steps and whether to include a step +number in the representations. + +For example, these options applied to the default @"single"@ 'format' #displayEnigmaOperationEG# + +>>> let cfg = configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11" +>>> putStr $ displayEnigmaOperation cfg "KRIEG" displayOpts + OHNKJYSBTEDMLCARWPGIXZQUFV LFAP 10 16 24 06 +K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 +R > HXETCUMASQNZGKRYJO̲̅IDFWVBPL LFAR 10 16 24 08 +I > FGRJUABYW̲̅DZSXVQTOCLPENIMHK LFAS 10 16 24 09 +E > SJWYN̲̅UZPQBVXRETHIMAOFKCLDG LFAT 10 16 24 10 +G > EOKPAQW̲̅JLHCISTBDFVMNXRGUZY LFAU 10 16 24 11 + +>>> putStr $ displayEnigmaOperation cfg "KRIEG" displayOpts{showsteps=True} +000 OHNKJYSBTEDMLCARWPGIXZQUFV LFAP 10 16 24 06 +001 K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 +002 R > HXETCUMASQNZGKRYJO̲̅IDFWVBPL LFAR 10 16 24 08 +003 I > FGRJUABYW̲̅DZSXVQTOCLPENIMHK LFAS 10 16 24 09 +004 E > SJWYN̲̅UZPQBVXRETHIMAOFKCLDG LFAT 10 16 24 10 +005 G > EOKPAQW̲̅JLHCISTBDFVMNXRGUZY LFAU 10 16 24 11 + +>>> putStr $ displayEnigmaOperation cfg "KRIEG" displayOpts{showsteps=False,steps=2} + OHNKJYSBTEDMLCARWPGIXZQUFV LFAP 10 16 24 06 +K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 +R > HXETCUMASQNZGKRYJO̲̅IDFWVBPL LFAR 10 16 24 08 + +>>> putStr $ displayEnigmaOperation cfg "KRIEG" displayOpts{showsteps=False,steps=10} + OHNKJYSBTEDMLCARWPGIXZQUFV LFAP 10 16 24 06 +K > CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS LFAQ 10 16 24 07 +R > HXETCUMASQNZGKRYJO̲̅IDFWVBPL LFAR 10 16 24 08 +I > FGRJUABYW̲̅DZSXVQTOCLPENIMHK LFAS 10 16 24 09 +E > SJWYN̲̅UZPQBVXRETHIMAOFKCLDG LFAT 10 16 24 10 +G > EOKPAQW̲̅JLHCISTBDFVMNXRGUZY LFAU 10 16 24 11 + IKOEDUXWAMBPJYCLSZQVFTHGNR LFAV 10 16 24 12 + RSWOUZNXTQLKPGDMJABIEYCHVF LFAW 10 16 24 13 + CUAMOTILGNWHDJERSPQFBZKYXV LFAX 10 16 24 14 + HXPVYZKAOTGSRWICUMLJQDNBEF LFAY 10 16 24 15 + QSXTPJNRUFMVKGZEAHBDILYCWO LFAZ 10 16 24 16 + +to the @"internal"@ 'format' + +>>> putStr $ displayEnigmaOperation cfg "KRIEG" displayOpts{format="internal",showsteps=False,steps=2} + ABCDEFGHIJKLMNOPQRSTUVWXYZ + P YBCDFEGHIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL + 1 DMPSWGCROHXLBUIKTAQJZVEYFN P 06 II + 2 BJYINTKWOARFEMVSGCUDPHZQLX A 24 VIII + 3 ILHXUBZQPNVGKMCRTEJFADOYSW F 16 V + 4 YDSKZPTNCHGQOMXAUWJFBRELVI L 10 γ + R ENKQAUYWJICOPBLMDXZVFTHRGS b + 4 PUIBWTKJZSDXNHMFLVCGQYROAE γ + 3 UFOVRTLCASMBNJWIHPYQEKZDXG V + 2 JARTMLQVDBGYNEIUXKPFSOHZCW VIII + 1 RMGAWYFJOTPLBZICSHDQNVEKXU II + P YBCDFEGHIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL + OHNKJYSBTEDMLCARWPGIXZQUFV + +K > ABCDEFGHIJK̲̅LMNOPQRSTUVWXYZ + P YBCDFEGHIJZ̲̅PONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL + 1 LORVFBQNGWKATHJSZPIYUDXEMC̲̅ Q 07 II + 2 BJY̲̅INTKWOARFEMVSGCUDPHZQLX A 24 VIII + 3 ILHXUBZQPNVGKMCRTEJFADOYS̲̅W F 16 V + 4 YDSKZPTNCHGQOMXAUWJ̲̅FBRELVI L 10 γ + R ENKQAUYWJI̲̅COPBLMDXZVFTHRGS b + 4 PUIBWTKJZ̲̅SDXNHMFLVCGQYROAE γ + 3 UFOVRTLCASMBNJWIHPYQEKZDXG̲̅ V + 2 JARTMLQ̲̅VDBGYNEIUXKPFSOHZCW VIII + 1 LFZVXEINSOKAYHBRG̲̅CPMUDJWTQ II + P YBCDFEG̲̅HIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL +G < CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS + +R > ABCDEFGHIJKLMNOPQR̲̅STUVWXYZ + P YBCDFEGHIJZPONMLQR̲̅STXVWUAK UX.MO.KZ.AY.EF.PL + 1 NQUEAPMFVJZSGIRYOH̲̅XTCWDLBK R 08 II + 2 BJYINTKW̲̅OARFEMVSGCUDPHZQLX A 24 VIII + 3 ILHXUBZQPNVGKMCRTEJFADO̲̅YSW F 16 V + 4 YDSKZPTNCHGQOMX̲̅AUWJFBRELVI L 10 γ + R ENKQAUYWJICOPBLMDXZVFTHR̲̅GS b + 4 PUIBWTKJZSDXNHMFLV̲̅CGQYROAE γ + 3 UFOVRTLCASMBNJWIHPYQEK̲̅ZDXG V + 2 JARTMLQVDBG̲̅YNEIUXKPFSOHZCW VIII + 1 EYUWDHM̲̅RNJZXGAQFBOLTCIVSPK II + P YBCDFEGHIJZPO̲̅NMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL +O < HXETCUMASQNZGKRYJO̲̅IDFWVBPL + +and to some of the other 'format's + +>>> putStr $ displayEnigmaOperation cfg "KRIEG" displayOpts{showencoding=True,format="windows",showsteps=True,steps=8} +000 LFAP +001 LFAQ K > G +002 LFAR R > O +003 LFAS I > W +004 LFAT E > N +005 LFAU G > W +006 LFAV +007 LFAW +008 LFAX + +>>> putStr $ displayEnigmaOperation cfg "KRIEG" displayOpts{format="config",showsteps=True,steps=8,showencoding=True} +000 b-γ-V-VIII-II LFAP UX.MO.KZ.AY.EF.PL 03.17.04.11 +001 b-γ-V-VIII-II LFAQ UX.MO.KZ.AY.EF.PL 03.17.04.11 K > G +002 b-γ-V-VIII-II LFAR UX.MO.KZ.AY.EF.PL 03.17.04.11 R > O +003 b-γ-V-VIII-II LFAS UX.MO.KZ.AY.EF.PL 03.17.04.11 I > W +004 b-γ-V-VIII-II LFAT UX.MO.KZ.AY.EF.PL 03.17.04.11 E > N +005 b-γ-V-VIII-II LFAU UX.MO.KZ.AY.EF.PL 03.17.04.11 G > W +006 b-γ-V-VIII-II LFAV UX.MO.KZ.AY.EF.PL 03.17.04.11 +007 b-γ-V-VIII-II LFAW UX.MO.KZ.AY.EF.PL 03.17.04.11 +008 b-γ-V-VIII-II LFAX UX.MO.KZ.AY.EF.PL 03.17.04.11 + +>>> putStr $ displayEnigmaOperation cfg "KRIEG" displayOpts{format="encoding",showsteps=True,showencoding=False} +000 +001 K > G +002 R > O +003 I > W +004 E > N +005 G > W + +Note that first step of each of these displays represents the initial configuration of the machine, +but does not perform any encoding (as explained in 'step'). + +Also also that the second block of the @"internal"@ display example is the same as one illustrated for +the @"internal"@ 'format', where it is explained in detail. +-} +displayEnigmaOperation :: EnigmaConfig -> Message -> DisplayOpts -> String +displayEnigmaOperation ec str opts = unlines $ listEnigmaOperation ec str opts + +{-| +A list representation of the operation of an enigma machine, equivalent to + +> lines $ displayEnigmaOperation +-} +-- 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 'displayEnigmaOperation' indicate a 'Message' argument, it is this function that applies 'message'. +listEnigmaOperation :: EnigmaConfig -> Message -> DisplayOpts -> [String] +listEnigmaOperation ec str optsin = zipWith3 (\n sec scr -> (fmtN (showsteps opts) n) ++ (displayEnigmaConfig sec scr opts)) + [0..(if (steps opts) < 0 then max (length msg) 1 else (steps opts))] + (iterate step ec) + (' ':msg ++ [' ',' '..]) + where + -- Ensure valid arguments + msg = message str + opts = validOpts_ optsin + + --fmtN :: Bool -> Int -> String + fmtN True n = (printf "%04d " n) ++ (if elem (format opts) fmtsInternal_ then "\n" else "") + fmtN False _ = "" + +{-# DEPRECATED showEnigmaOperation "This has been replaced by 'displayEnigmaOperation'" #-} +{-| +Equivalent to 'displayEnigmaOperation' with @displayOpts{format="single"}@. +-} showEnigmaOperation :: EnigmaConfig -> Message -> String -showEnigmaOperation ec str = showEnigmaOperation_ showEnigmaConfig ec str +showEnigmaOperation ec str = displayEnigmaOperation ec str displayOpts{format="single"} --- | 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'. --- --- >>> putStr $ showEnigmaOperationInternal (configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") "KR" --- ABCDEFGHIJKLMNOPQRSTUVWXYZ --- P YBCDFEGHIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL --- 1 DMPSWGCROHXLBUIKTAQJZVEYFN P 06 II --- 2 BJYINTKWOARFEMVSGCUDPHZQLX A 24 VIII --- 3 ILHXUBZQPNVGKMCRTEJFADOYSW F 16 V --- 4 YDSKZPTNCHGQOMXAUWJFBRELVI L 10 γ --- R ENKQAUYWJICOPBLMDXZVFTHRGS b --- 4 PUIBWTKJZSDXNHMFLVCGQYROAE γ --- 3 UFOVRTLCASMBNJWIHPYQEKZDXG V --- 2 JARTMLQVDBGYNEIUXKPFSOHZCW VIII --- 1 RMGAWYFJOTPLBZICSHDQNVEKXU II --- P YBCDFEGHIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL --- OHNKJYSBTEDMLCARWPGIXZQUFV --- --- K > ABCDEFGHIJK̲̅LMNOPQRSTUVWXYZ --- P YBCDFEGHIJZ̲̅PONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL --- 1 LORVFBQNGWKATHJSZPIYUDXEMC̲̅ Q 07 II --- 2 BJY̲̅INTKWOARFEMVSGCUDPHZQLX A 24 VIII --- 3 ILHXUBZQPNVGKMCRTEJFADOYS̲̅W F 16 V --- 4 YDSKZPTNCHGQOMXAUWJ̲̅FBRELVI L 10 γ --- R ENKQAUYWJI̲̅COPBLMDXZVFTHRGS b --- 4 PUIBWTKJZ̲̅SDXNHMFLVCGQYROAE γ --- 3 UFOVRTLCASMBNJWIHPYQEKZDXG̲̅ V --- 2 JARTMLQ̲̅VDBGYNEIUXKPFSOHZCW VIII --- 1 LFZVXEINSOKAYHBRG̲̅CPMUDJWTQ II --- P YBCDFEG̲̅HIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL --- G < CMAWFEKLNVG̲̅HBIUYTXZQOJDRPS --- --- R > ABCDEFGHIJKLMNOPQR̲̅STUVWXYZ --- P YBCDFEGHIJZPONMLQR̲̅STXVWUAK UX.MO.KZ.AY.EF.PL --- 1 NQUEAPMFVJZSGIRYOH̲̅XTCWDLBK R 08 II --- 2 BJYINTKW̲̅OARFEMVSGCUDPHZQLX A 24 VIII --- 3 ILHXUBZQPNVGKMCRTEJFADO̲̅YSW F 16 V --- 4 YDSKZPTNCHGQOMX̲̅AUWJFBRELVI L 10 γ --- R ENKQAUYWJICOPBLMDXZVFTHR̲̅GS b --- 4 PUIBWTKJZSDXNHMFLV̲̅CGQYROAE γ --- 3 UFOVRTLCASMBNJWIHPYQEK̲̅ZDXG V --- 2 JARTMLQVDBG̲̅YNEIUXKPFSOHZCW VIII --- 1 EYUWDHM̲̅RNJZXGAQFBOLTCIVSPK II --- P YBCDFEGHIJZPO̲̅NMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL --- O < HXETCUMASQNZGKRYJO̲̅IDFWVBPL --- --- 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 -> Message -> String -showEnigmaOperationInternal ec str = showEnigmaOperation_ showEnigmaConfigInternal ec str +{-# DEPRECATED showEnigmaOperationInternal "This has been replaced by 'displayEnigmaOperation'" #-} +{-| +Equivalent to 'displayEnigmaOperation' with @displayOpts{format="internal"}@. +-} +showEnigmaOperationInternal :: EnigmaConfig -> Message -> String +showEnigmaOperationInternal ec str = displayEnigmaOperation ec str displayOpts{format="internal"} -- Encoding display ========================================================== --- | Show the conventionally formatted encoding of a 'Message' by an (initial) Enigma machine configuration. --- --- >>> let cfg = configEnigma "c-β-V-VI-VIII" "CDTJ" "AE.BF.CM.DQ.HU.JN.LX.PR.SZ.VW" "05.16.05.12" --- >>> putStr $ showEnigmaEncoding cfg "FOLGENDES IST SOFORT BEKANNTZUGEBEN" --- RBBF PMHP HGCZ XTDY GAHG UFXG EWKB LKGJ +{-| +Show the conventionally formatted encoding of a 'Message' by an (initial) Enigma machine configuration. + +>>> let cfg = configEnigma "c-β-V-VI-VIII" "CDTJ" "AE.BF.CM.DQ.HU.JN.LX.PR.SZ.VW" "05.16.05.12" +>>> putStr $ displayEnigmaEncoding cfg "FOLGENDES IST SOFORT BEKANNTZUGEBEN" +RBBF PMHP HGCZ XTDY GAHG UFXG EWKB LKGJ +-} +-- TBD: Add new arguments for formatting (and use in cli) +displayEnigmaEncoding :: EnigmaConfig -> Message -> String +displayEnigmaEncoding ec str = postproc $ enigmaEncoding ec (message str) + where + -- Standard formatting of encoded messages + --postproc :: String -> String + postproc = unlines . chunksOf 60 . unwords . chunksOf 4 + +{-# DEPRECATED showEnigmaEncoding "This has been replaced by 'displayEnigmaEncoding'" #-} +{-| +Equivalent to 'displayEnigmaEncoding'. +-} showEnigmaEncoding :: EnigmaConfig -> Message -> String -showEnigmaEncoding ec str = postproc $ enigmaEncoding ec (message str) +showEnigmaEncoding ec str = displayEnigmaEncoding ec str diff --git a/Crypto/Enigma/Utils.hs b/Crypto/Enigma/Utils.hs --- a/Crypto/Enigma/Utils.hs +++ b/Crypto/Enigma/Utils.hs @@ -2,6 +2,7 @@ {-| Module : Crypto.Enigma.Utils -} + module Crypto.Enigma.Utils where import Data.Char (chr, ord) @@ -34,3 +35,9 @@ -- standard simple-substitution cypher encoding encode' :: String -> String -> String encode' m s = (encode m) <$> s + + +-- Patch ANSI escapes -------------------------------------------------------- + +-- REV: Remove/review patch of escaping: https://github.com/carymrobbins/intellij-haskforce/issues/372 <<< +escape_ mu ch = ("\ESC[") ++ mu ++ [ch] ++ ("\ESC[") ++ "0m" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,7 @@ [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)](https://www.haskell.org) [![Hackage](https://img.shields.io/hackage/v/crypto-enigma.svg)](https://hackage.haskell.org/package/crypto-enigma) +[![Stackage](https://www.stackage.org/package/crypto-enigma/badge/lts?label=lts)](https://www.stackage.org/lts/package/crypto-enigma) ![Hackage Dependencies](https://img.shields.io/hackage-deps/v/crypto-enigma.svg) [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://github.com/orome/crypto-enigma-hs/blob/hackage/LICENSE) [![Build Status](https://travis-ci.org/orome/crypto-enigma-hs.svg?branch=hackage)](https://travis-ci.org/orome/crypto-enigma-hs/branches) @@ -9,14 +10,14 @@ An Enigma machine simulator with state and encoding display. -Currently support is only provided for those [machine models] in most widespread general use during the war years: -the [I], [M3], and [M4]. +Currently support is only provided for those [machine models] in most widespread general use during the war years: the +[I], [M3], and [M4]. -This is adapted, as an exercise in learning Haskell, from an earlier learning project written in Mathematica. -It is my first Haskell program. A [Python version] with substantially the same API, plus a command line interface, is -also available. +This is adapted, as an exercise in learning Haskell, from an earlier learning project written in Mathematica. It is my +first Haskell program. A [Python version] with substantially the same API, plus a command line interface, is also +available. -### Functionality +### Functionality: package API Perform [message encoding]: @@ -56,16 +57,69 @@ E > SJWYN̲̅UZPQBVXRETHIMAOFKCLDG LFAT 10 16 24 10 G > EOKPAQW̲̅JLHCISTBDFVMNXRGUZY LFAU 10 16 24 11 +## Functionality: command line + +A command line executable, `enigma` (accessible if installed on the path or through `stack exec -- enigma`) for local +Haskell installations, provides almost all the functionality of the API. + +Encode messages: + + $ enigma encode "B-I-III-I EMO UX.MO.AY 13.04.11" "TESTINGXTESTINGUD" + OZQKPFLPYZRPYTFVU + + $ enigma encode "B-I-III-I EMO UX.MO.AY 13.04.11" "OZQKPFLPYZRPYTFVU" + TESTINGXTESTINGUD + +Show configuration details (explained in more detail in the command line help): + + $ enigma show "B-I-III-I EMO UX.MO.AY 13.04.11" -l 'X' -H'()' -f internal + X > ABCDEFGHIJKLMNOPQRSTUVW(X)YZ + P YBCDEFGHIJKLONMPQRSTXVW(U)AZ UX.MO.AY + 1 HCZMRVJPKSUDTQOLWEXN(Y)FAGIB O 05 I + 2 KOMQEPVZNXRBDLJHFSUWYACT(G)I M 10 III + 3 AXIQJZ(K)RMSUNTOLYDHVBWEGPFC E 19 I + R YRUHQSLDPX(N)GOKMIEBFZCWVJAT B + 3 ATZQVYWRCEGOI(L)NXDHJMKSUBPF I + 2 VLWMEQYPZOA(N)CIBFDKRXSGTJUH III + 1 WZBLRVXAYGIPD(T)OHNEJMKFQSUC I + P YBCDEFGHIJKLONMPQRS(T)XVWUAZ UX.MO.AY + T < CNAUJVQSLEMIKBZRGPHXDFY(T)WO + +Simulate machine operation (explained in more detail command line help): + + $ enigma run "B-I-III-I EMO UX.MO.AY 13.04.11" -m "TESTING" -t -H'()' + 0000 CNAUJVQSLEMIKBZRGPHXDFYTWO EMO 19 10 05 + 0001 T > UNXKGVERLYDIQBTWMHZ(O)AFPCJS EMP 19 10 06 + 0002 E > QTYJ(Z)XUPKDIMLSWHAVNBGROFCE EMQ 19 10 07 + 0003 S > DMXAPTRWKYINBLUESG(Q)FOZHCJV ENR 19 11 08 + 0004 T > IUSMHRPEAQTVDYWGJFC(K)BLOZNX ENS 19 11 09 + 0005 I > WMVXQRLS(P)YOGBTKIEFHNZCADJU ENT 19 11 10 + 0006 N > WKIQXNRSCVBOY(F)LUDGHZPJAEMT ENU 19 11 11 + 0007 G > RVPTWS(L)KYXHGNMQCOAFDZBEJIU ENV 19 11 12 + +Watch the machine as it runs for 500 steps: + + $ enigma run "c-β-VIII-VII-VI QMLI UX.MO.AY 01.13.04.11" -s 500 -t -f internal -o + ### Limitations -Note that the correct display of some characters used to represent components -(thin Naval rotors) assumes support for Unicode, while some aspects of the display of machine state -depend on support for combining Unicode. This is a [known limitation](https://github.com/orome/crypto-enigma-hs/issues/10) -that will be addressed in a future release. +Note that the correct display of some characters used to represent components (thin Naval rotors) assumes support for +Unicode, while some aspects of the display of machine state depend on support for combining Unicode. This is a +[known limitation](https://github.com/orome/crypto-enigma-hs/issues/10) that will be addressed in a future release. +### Compatability + +[Versions](https://www.stackage.org/package/crypto-enigma/snapshots) of this package have been part of [Stackage] LTS +Haskell since LTS 7.24, and the current version will work with LTS since 3.2.2. For information on which GHC versions +are supported by each release, see the +[package's Hackage Matrix](https://matrix.hackage.haskell.org/package/crypto-enigma). + ### Documentation Full [documentation] — for the latest [release version] — is available on Hackage. +[Documentation](https://www.stackage.org/haddock/lts/crypto-enigma/Crypto-Enigma.html) for the [current Stackage +LTS version](https://hackage.haskell.org/package/crypto-enigma) — generally identical to the latest release version — +is avalable on Stackage. ### Alternatives @@ -76,19 +130,23 @@ * [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. +This package served as the basis for a [Python version], with essentially the same API, though more active maintenance +of this verson has resulted in some minor divergence. ### Development status [![Build Status](https://travis-ci.org/orome/crypto-enigma-hs.svg?branch=develop)](https://travis-ci.org/orome/crypto-enigma-hs/branches) -I'm currently learning and experimenting with some Haskell language -features and can't promise the [development version] will work. More -detail about planned releases and activities can be found the list of -scheduled [milestones] and in the list of [open issues]. For information -on which GHC versions are supported by each release, see the [package's -Hackage Matrix](https://matrix.hackage.haskell.org/package/crypto-enigma). +I'm currently learning and experimenting with some Haskell language features and can't promise the [development version] +will work. More detail about planned releases and activities can be found the list of scheduled [milestones] and in the +list of [open issues]. Some recent activity includes: +* [changes since](https://github.com/orome/crypto-enigma-hs/compare/hackage...develop#files_bucket) the latest Hackage + release version; and +* the [addition of a command line interface](https://github.com/orome/crypto-enigma-hs/issues/13) + which incorporates [extensive changes](https://github.com/orome/crypto-enigma-hs/compare/1d303d3d...eb249974) + [including](https://github.com/orome/crypto-enigma-hs/blob/develop/CHANGELOG.md#0031) refactoring of display functions. + [Python version]: https://pypi.python.org/pypi/crypto-enigma [documentation]: https://hackage.haskell.org/package/crypto-enigma [release version]: https://github.com/orome/crypto-enigma-hs/tree/hackage @@ -104,3 +162,5 @@ [I]: http://www.cryptomuseum.com/crypto/enigma/i/index.htm [M3]: http://www.cryptomuseum.com/crypto/enigma/m3/index.htm [M4]: http://www.cryptomuseum.com/crypto/enigma/m4/index.htm + +[Stackage]: https://www.stackage.org diff --git a/cli/enigma.hs b/cli/enigma.hs new file mode 100644 --- /dev/null +++ b/cli/enigma.hs @@ -0,0 +1,446 @@ +{-# LANGUAGE Safe, CPP #-} +module Main where + +import Options.Applicative -- http://hackage.haskell.org/package/optparse-applicative +import Options.Applicative.Help.Pretty (string) -- Necessary to format help text -- https://github.com/pcapriotti/optparse-applicative/issues/90#issuecomment-49868254 +import System.Console.ANSI + +import Data.Monoid ((<>)) -- REV: For GHC 8.0 through 8.2 +import Control.Concurrent (threadDelay) +import Control.Monad.Except (runExcept) +import Control.Monad (replicateM_) + +import Crypto.Enigma +import Crypto.Enigma.Display + + + +-- Definitions ============================================================== + + +-- Functions and constants --------------------------------------------------- + +cliName_ = "Enigma Machine (Haskell crypto-enigma) CLI" + +#if __GLASGOW_HASKELL__ < 800 +cliError e = error (e ++ " (see help)") +#else +cliError e = errorWithoutStackTrace (e ++ " (see help)") +#endif + +stepInterval_ = 125000 + + +-- Command and option definitions -------------------------------------------- + +data Subcommand = + Encode { config :: String, message :: String } | + Show { config :: String, letterO :: + Maybe String, formatO :: Maybe String, highlightO :: Maybe String, encodingO :: Maybe Bool } | + Run { config :: String, messageO :: + Maybe String, formatO :: Maybe String, highlightO :: Maybe String, encodingO :: Maybe Bool, + showstepsO :: Maybe Bool, numstepsO :: Int, + speedO :: Int, overwriteO :: Maybe Bool, noinitialO :: Maybe Bool } + deriving Show + +data Options = Options { subcommand :: Subcommand } deriving Show + +commandO = Options <$> subcommandO + +subcommandO :: Parser Subcommand +subcommandO = + subparser ( + command "encode" (info (Encode <$> configArg "encode" <*> messageArg + <**> helper) + (helpText encodeCmdDesc "ENCODE" encodeCmdArgsFoot encodeCmdExamples)) <> + command "show" (info (Show <$> configArg "show" <*> letterOpt <*> + formatOpt <*> highlightOpt <*> encodingOpt + <**> helper) + (helpText showCmdDesc "SHOW" showCmdArgsFoot showCmdExamples)) <> + command "run" (info (Run <$> configArg "run" <*> messageOpt <*> + formatOpt <*> highlightOpt <*> encodingOpt <*> + showstepOpt <*> stepsOpt <*> + speedOpt <*> overwriteOpt <*> noinitialOpt + <**> helper) + (helpText runCmdDesc "RUN" runCmdArgsFoot runCmdExamples)) + ) + where + configArg cmd = strArgument $ metavar "CONFIG" <> + help (configArgHelp cmd) + messageArg = strArgument $ metavar "MESSAGE" <> + help messageArgHelp + messageOpt = optional $ strOption ( long "message" <> short 'm' <> metavar "MESSAGE" <> value " " <> + help messageOptHelp) + letterOpt = optional $ strOption ( long "letter" <> short 'l' <> metavar "LETTER" <> value " " <> + help letterOptHelp) + formatOpt = optional $ strOption ( long "format" <> short 'f' <> metavar "FORMAT" <> value "single" <> + help formatOptHelp) + highlightOpt = optional $ strOption ( long "highlight" <> short 'H' <> metavar "HH|SPEC" <> value "bars" <> + help highlightOptHelp) + encodingOpt = optional $ switch ( long "showencoding" <> short 'e' <> + help showencodingOptHelp) + + showstepOpt = optional $ switch ( long "showstep" <> short 't' <> + help "Show step numbers") + stepsOpt :: Parser Int + stepsOpt = option auto (long "steps" <> short 's' <> metavar "STEPS" <> value (-1) <> + help stepsOptHelp) + + speedOpt :: Parser Int + speedOpt = option auto (long "speed" <> short 'S' <> metavar "SPEED" <> value 0 <> + help speedOptHelp) + overwriteOpt = optional $ switch ( long "overwrite" <> short 'o' <> + help overwriteOptHelp) + + noinitialOpt = optional $ switch ( long "noinitial" <> short 'n' <> + help noinitialOptHelp) + + helpText desc cmd argsFoot examplesFoot = (progDesc desc <> + header (cliName_ ++ ": "++ cmd ++" command") <> + footerDoc (Just $ string $ unlines ["Argument notes:\n", argsFoot, "Examples:\n", examplesFoot])) + + + +-- Command line script ======================================================= + + +main :: IO () +main = do + opts <- execParser optsParser + case subcommand opts of + Encode config message -> + putStr $ displayEnigmaEncoding (configEnigmaFromString config) + message + Show config (Just (letter:_)) + (Just format) (Just highlight) (Just showenc) -> + putStrLn $ displayEnigmaConfig (configEnigmaFromString config) + letter + (displayOpts{format=format,showencoding=showenc,markerspec=highlight}) + Run config (Just message) + (Just format) (Just highlight) (Just showenc) + (Just showstps) stps + speed (Just overwrite) (Just noinitial) -> + mapM_ (printConfig (max speed (if overwrite then 1 else 0)) overwrite) + ((if noinitial then tail else id) $ listEnigmaOperation (configEnigmaFromString config) + message + (displayOpts{format=format,showencoding=showenc,markerspec=highlight, + showsteps=showstps,steps=stps})) + cmd -> putStrLn $ "Unmatched command: " ++ (show cmd) + where + optsParser :: ParserInfo Options + optsParser = info (helper <*> commandO) + (fullDesc <> progDesc topDesc <> header cliName_ <> footerDoc (Just $ string topFoot)) + + -- Like 'configEnigma' but without stack trace and with check for 4 words in a single string + configEnigmaFromString :: String -> EnigmaConfig + configEnigmaFromString i = if ((length $ words i) /= 4) + then cliError ("Enigma machine configuration has the format 'rotors windows plugboard rings'") + else case runExcept (configEnigmaExcept c w s r) of + Right cfg -> cfg + Left err -> cliError (show err) + where [c, w, s, r] = words i + + printConfig s True c = printConfig s False c >> + replicateM_ ((length $ lines c) + (if (length $ lines c) > 1 then 1 else 0)) + (clearLine >> cursorUpLine 1) + printConfig s False c = putStrLn c >> + (threadDelay (s * stepInterval_)) + + + +-- Help text ================================================================= + +topDesc = "A simple Enigma machine simulator with rich display of machine configurations." + +encodeCmdDesc = "Show the encoding of a message." +showCmdDesc = "Show an Enigma machine configuration in the specified format, " ++ + "optionally indicating the encoding of a specified character." +runCmdDesc = "Show the operation of the Enigma machine as a series of configurations, " ++ + "as it encodes a message and/or for a specified number of steps. " + +configArgHelp cmd = case cmd of + "encode" -> unlines ["The machine configuration at the start of encoding (see below)"] + "show" -> unlines ["The machine configuration to show (see below)"] + "run" -> unlines ["The machine setup at the start of operation (see below)"] + -- Should not happen: optparse-applicative should have caught this + _ -> error "ERROR: Unrecognized command: '" ++ cmd ++ "''!" + +messageArgHelp = messageOptHelp + +messageOptHelp = unlines [ + "A message to encode; characters that are not letters" , + "will be replaced with standard Naval substitutions or", + "be removed"] + +letterOptHelp = unlines [ + "An optional input letter to highlight as it is" , + "processed by the configuration; defaults to nothing"] + +formatOptHelp = unlines [ + "The format used to display machine configuration(s)" , + "(see below)"] + +highlightOptHelp = unlines [ + "Either a pair or characters to use to highlight encoded" , + "characters in a machine configuration's encoding or a" , + "specification of a color or style (see below)"] + +showencodingOptHelp = unlines [ + "Show the encoding if not normally shown for the" , + "specified FORMAT"] + +stepsOptHelp = unlines [ + "A number of steps to run; if omitted when a message is" , + "provided, will default to the length of the message;" , + "otherwise defaults to 1"] + +speedOptHelp = unlines [ + "Pause between display of each step for SPEED*" ++ show ((fromIntegral stepInterval_) / 1000000) ++ "s;", + "1 is the minimum speed with --overwrite; defaults to 0" , + "otherwise"] + +overwriteOptHelp = unlines [ + "Overwrite each step after a pause (may result in" , + "garbled output on some systems)"] + +noinitialOptHelp = unlines [ + "Don't show the initial starting step"] + +encodeCmdArgsFoot = init $ unlines [configArgFoot, omitArgFoot "encode"] +showCmdArgsFoot = init $ unlines [configArgFoot, formatArgFoot "show", highlightArgFoot, omitArgFoot "show"] +runCmdArgsFoot = init $ unlines [configArgFoot, formatArgFoot "run", highlightArgFoot, omitArgFoot "run"] + +configArgFoot = unlines [ + "CONFIG specifies an Enigma machine configuration as a string based on common", + "historical conventions and consists of four elements, separated by spaces:", + " + names for components, in physical order (starting with the reflector, on the", + " left, and ending with the 'first' rotor, on the right), separated by '-'s;", + " + letters visible at the machine windows (in physical order);", + " + a plugboard specification, consisting of exchanged (i.e. wired-together)", + " letter paris, separated by '.'s; and", + " + the locations of ring letter A on the rotor for each rotor", + " (in physical order)"] + +formatArgFoot cmd = unlines $ [ + "FORMAT will determine how a configuration is represented; possible values", + "include:", + " + 'single' (the default) which will show a single line representing the", + " mapping (a string in which the letter at each position indicates the letter", + " encoded to by letter at that position in the alphabet) preformed by the", + " machine as a whole, followed by window letters (as 'windows') and", + " positions, and indicating a letter and its encoding, if provided;", + " + 'internal', which will show a detailed schematic of each processing stage", + " (proceeding from top to bottom), in which", + " - each line indicates the mapping (see 'single') preformed by the", + " component at that stage;", + " - each line begins with an indication of the stage (rotor number, \"P\" for", + " plugboard, or \"R\" for reflector), and ends with the specification of the", + " component at that stage;", + " - rotors also indicate their window letter, and position;", + " - the letter being encoded it is indicated as input and its encoding at", + " each stage is marked;", + " the schematic is followed by the mapping for the machine as a whole (as", + " 'single'), and preceded by a (trivial, no-op) keyboard 'mapping'", + " for reference;", + " + 'windows', which shows just the letters visible at the windows;", + " and", + " + 'config', which simply shows the specification of the", + " configuration (in the same format as CONFIG).", + "For formats that indicate a letter and its encoding, these will correspond to"] + ++ letterSoruce ++ + ["The program is forgiving about forgotten format values and will accept a", + "range of reasonable substitutes (e.g., 'detailed' or 'schematic' for", + "'internal')."] + where letterSoruce | cmd == "run" = + ["the the letter at that step of the entry of the (symbol substituted) MESSAGE ", + "provided as an argument."] + | otherwise = ["the LETTER provided as an argument."] + +highlightArgFoot = unlines [ + "HH can be used to determine how any encoded-to characters in mappings", + "(see 'single' in the note on FORMAT) are highlighted. By default", + "this highlighting is done with combining Unicode characters, which may not", + "work on all systems, and as an alternative, any two characters provided as", + "HH will be used to 'bracket' the highlighted character. To avoid errors,", + "these characters should be enclosed in quotes. Additionally certain", + "predefined SPEC values, such as 'red' or 'highlight' are also supported."] + + +omitArgFoot cmd = unlines [ + "Note that providing no value, a value of '', or just spaces or invalid", + "characters for " ++ omittedArg ++ " is the same as omitting it."] + where omittedArg | cmd == "show" = "LETTER" + | otherwise = "MESSAGE" + +topFoot = "Examples:\n" ++ topExamples ++ "\nThis command line interface is part of the Haskell crypto-enigma package." + +topExamples = unlines [ + " $ enigma encode \"B-I-III-I EMO UX.MO.AY 13.04.11\" \"TESTINGXTESTINGUD\"", + " $ enigma encode \"B-I-III-I EMO UX.MO.AY 13.04.11\" \"TESTINGXTESTINGUD\" -f", + " $ enigma encode \"B-I-III-I EMO UX.MO.AY 13.04.11\" \"TESTING! testing?\" -f", + " $ enigma show \"B-I-III-I EMO UX.MO.AY 13.04.11\" -l 'X'", + " $ enigma show \"B-I-III-I EMO UX.MO.AY 13.04.11\" -l 'X' -H '()'", + " $ enigma show \"B-I-III-I EMO UX.MO.AY 13.04.11\" -l 'X' -H '()' -f internal", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -s 10 -t", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -H '()'", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -H '()' -f internal", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -H '()' -f internal -o -SS", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -f config -e", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -f internal -e", + " $ enigma run \"c-β-VIII-VII-VI QMLI UX.MO.AY 01.13.04.11\" -s 500 -t -f internal -o", + "", + "More information about each of these examples is available in the help for the respective", + "commands."] + +encodeCmdExamples = init $ unlines [ + " Encode a message:", + " $ enigma encode \"B-I-III-I EMO UX.MO.AY 13.04.11\" \"TESTINGXTESTINGUD\"", + " OZQKPFLPYZRPYTFVU", + " $ enigma encode \"B-I-III-I EMO UX.MO.AY 13.04.11\" \"OZQKPFLPYZRPYTFVU\"", + " TESTINGXTESTINGUD", + "", + " Encode a message and break the output into blocks of 4:", + " $ enigma encode \"B-I-III-I EMO UX.MO.AY 13.04.11\" \"TESTINGXTESTINGUD\" -f", + " OZQK PFLP YZRP YTFV U", + "", + " Standard Naval subistitutions for non-letter characters are performed", + " before encoding:", + " $ enigma encode \"B-I-III-I EMO UX.MO.AY 13.04.11\" \"TESTING! testing?\" -f", + " OZQK PFLP YZRP YTFV U"] + +showCmdExamples = init $ unlines [ + " Show an Enigma machine configuration as its mapping (see 'single'", + " in the note on FORMAT), followed by the window letters and ring settings,", + " and indicate how a letter is encoded; here X is encoded to T (A would be", + " encoded to C, B to N ... Y to W, Z to O):", + " $ enigma show \"B-I-III-I EMO UX.MO.AY 13.04.11\" -l 'X'", + " X > CNAUJVQSLEMIKBZRGPHXDFYT̲̅WO EMO 19 10 05", + "", + " Use an alternate method for highlighting the encoded-to letter:", + " $ enigma show \"B-I-III-I EMO UX.MO.AY 13.04.11\" -l 'X' -H '()'", + " X > CNAUJVQSLEMIKBZRGPHXDFY(T)WO EMO 19 10 05", + "", + " Show a detailed stage-by-stage schematic (see 'internal' in the note", + " on FORMAT) of the mappings preformed by a configuration:", + " $ enigma show \"B-I-III-I EMO UX.MO.AY 13.04.11\" -l 'X' -H '()' -f internal", + " X > ABCDEFGHIJKLMNOPQRSTUVW(X)YZ", + " P YBCDEFGHIJKLONMPQRSTXVW(U)AZ UX.MO.AY", + " 1 HCZMRVJPKSUDTQOLWEXN(Y)FAGIB O 05 I", + " 2 KOMQEPVZNXRBDLJHFSUWYACT(G)I M 10 III", + " 3 AXIQJZ(K)RMSUNTOLYDHVBWEGPFC E 19 I", + " R YRUHQSLDPX(N)GOKMIEBFZCWVJAT B", + " 3 ATZQVYWRCEGOI(L)NXDHJMKSUBPF I", + " 2 VLWMEQYPZOA(N)CIBFDKRXSGTJUH III", + " 1 WZBLRVXAYGIPD(T)OHNEJMKFQSUC I", + " P YBCDEFGHIJKLONMPQRS(T)XVWUAZ UX.MO.AY", + " T < CNAUJVQSLEMIKBZRGPHXDFY(T)WO", + "", + " Just show the configuration in conventional format (as used in CONFIG):", + " $ enigma show \"B-I-III-I EMO UX.MO.AY 13.04.11\" -l 'X' -f config", + " B-I-III-I EMO UX.MO.AY 13.04.11", + "", + " As above, but show the encoding too (not shown my default for 'config'):", + " $ enigma show \"B-I-III-I EMO UX.MO.AY 13.04.11\" -l 'X' -f config -e", + " B-I-III-I EMO UX.MO.AY 13.04.11 X > T"] + +runCmdExamples = init $ unlines [ + "(For details on differences among formats used for displaying each step, see the", + "examples in the examples for the 'show' command.)", + "", + " Show the operation of a machine for 10 steps, indicating step numbers (see", + " 'single' in the note on FORMAT):", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -s 10 -t", + " 0000 CNAUJVQSLEMIKBZRGPHXDFYTWO EMO 19 10 05", + " 0001 UNXKGVERLYDIQBTWMHZOAFPCJS EMP 19 10 06", + " 0002 QTYJZXUPKDIMLSWHAVNBGROFCE EMQ 19 10 07", + " 0003 DMXAPTRWKYINBLUESGQFOZHCJV ENR 19 11 08", + " 0004 IUSMHRPEAQTVDYWGJFCKBLOZNX ENS 19 11 09", + " 0005 WMVXQRLSPYOGBTKIEFHNZCADJU ENT 19 11 10", + " 0006 WKIQXNRSCVBOYFLUDGHZPJAEMT ENU 19 11 11", + " 0007 RVPTWSLKYXHGNMQCOAFDZBEJIU ENV 19 11 12", + " 0008 IYTKRVSMALDJHZWXUEGCQFOPBN ENW 19 11 13", + " 0009 PSWGMODULZVIERFAXNBYHKCQTJ ENX 19 11 14", + " 0010 IVOWZKHGARFSPUCMXJLYNBDQTE ENY 19 11 15", + "", + " Show the operation of a machine as it encodes a message, with step numbers:", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -H '()'", + " 0000 CNAUJVQSLEMIKBZRGPHXDFYTWO EMO 19 10 05", + " 0001 T > UNXKGVERLYDIQBTWMHZ(O)AFPCJS EMP 19 10 06", + " 0002 E > QTYJ(Z)XUPKDIMLSWHAVNBGROFCE EMQ 19 10 07", + " 0003 S > DMXAPTRWKYINBLUESG(Q)FOZHCJV ENR 19 11 08", + " 0004 T > IUSMHRPEAQTVDYWGJFC(K)BLOZNX ENS 19 11 09", + " 0005 I > WMVXQRLS(P)YOGBTKIEFHNZCADJU ENT 19 11 10", + " 0006 N > WKIQXNRSCVBOY(F)LUDGHZPJAEMT ENU 19 11 11", + " 0007 G > RVPTWS(L)KYXHGNMQCOAFDZBEJIU ENV 19 11 12", + "", + " Show the operation of a machine as it encodes a message in more detail (see", + " 'internal' in the note on FORMAT), with step numbers (only some", + " steps shown here):", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -H '()' -f internal", + " 0000", + " ...", + " 0001", + " T > ABCDEFGHIJKLMNOPQRS(T)UVWXYZ", + " P YBCDEFGHIJKLONMPQRS(T)XVWUAZ UX.MO.AY", + " 1 BYLQUIOJRTCSPNKVDWM(X)EZFHAG P 06 I", + " 2 KOMQEPVZNXRBDLJHFSUWYAC(T)GI M 10 III", + " 3 AXIQJZKRMSUNTOLYDHV(B)WEGPFC E 19 I", + " R Y(R)UHQSLDPXNGOKMIEBFZCWVJAT B", + " 3 ATZQVYWRCEGOILNXD(H)JMKSUBPF I", + " 2 VLWMEQY(P)ZOANCIBFDKRXSGTJUH III", + " 1 YAKQUWZXFHOCSNG(M)DILJEPRTBV I", + " P YBCDEFGHIJKL(O)NMPQRSTXVWUAZ UX.MO.AY", + " O < UNXKGVERLYDIQBTWMHZ(O)AFPCJS", + " ...", + " 0007", + " G > ABCDEF(G)HIJKLMNOPQRSTUVWXYZ", + " P YBCDEF(G)HIJKLONMPQRSTXVWUAZ UX.MO.AY", + " 1 IDLNWM(J)HEPXQGRYTZBUAVSFKOC V 12 I", + " 2 NLPDOUYMW(Q)ACKIGERTVXZBSFHJ N 11 III", + " 3 AXIQJZKRMSUNTOLY(D)HVBWEGPFC E 19 I", + " R YRU(H)QSLDPXNGOKMIEBFZCWVJAT B", + " 3 ATZQVYW(R)CEGOILNXDHJMKSUBPF I", + " 2 KVLDPXOYNZMBHAECJ(Q)WRFSITGU III", + " 1 TRZBIWMHAGXCFDYJ(L)NVPSUEKOQ I", + " P YBCDEFGHIJK(L)ONMPQRSTXVWUAZ UX.MO.AY", + " L < RVPTWS(L)KYXHGNMQCOAFDZBEJIU", + "", + " Show the steps as above, but (slowly) in place (if the platform supports it)", + " rather than on a new line for each; only the last step is visible on", + " completion (as shown here):", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -H '()' -f internal -o -SS", + " 0007", + " G > ABCDEF(G)HIJKLMNOPQRSTUVWXYZ", + " P YBCDEF(G)HIJKLONMPQRSTXVWUAZ UX.MO.AY", + " 1 IDLNWM(J)HEPXQGRYTZBUAVSFKOC V 12 I", + " 2 NLPDOUYMW(Q)ACKIGERTVXZBSFHJ N 11 III", + " 3 AXIQJZKRMSUNTOLY(D)HVBWEGPFC E 19 I", + " R YRU(H)QSLDPXNGOKMIEBFZCWVJAT B", + " 3 ATZQVYW(R)CEGOILNXDHJMKSUBPF I", + " 2 KVLDPXOYNZMBHAECJ(Q)WRFSITGU III", + " 1 TRZBIWMHAGXCFDYJ(L)NVPSUEKOQ I", + " P YBCDEFGHIJK(L)ONMPQRSTXVWUAZ UX.MO.AY", + " L < RVPTWS(L)KYXHGNMQCOAFDZBEJIU", + "", + " Stepping a configuration only changes the window letters:", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -f config -e", + " 0000 B-I-III-I EMO UX.MO.AY 13.04.11", + " 0001 B-I-III-I EMP UX.MO.AY 13.04.11 T > O", + " 0002 B-I-III-I EMQ UX.MO.AY 13.04.11 E > Z", + " 0003 B-I-III-I ENR UX.MO.AY 13.04.11 S > Q", + " 0004 B-I-III-I ENS UX.MO.AY 13.04.11 T > K", + " 0005 B-I-III-I ENT UX.MO.AY 13.04.11 I > P", + " 0006 B-I-III-I ENU UX.MO.AY 13.04.11 N > F", + " 0007 B-I-III-I ENV UX.MO.AY 13.04.11 G > L", + " $ enigma run \"B-I-III-I EMO UX.MO.AY 13.04.11\" -m \"TESTING\" -t -f windows -e", + " 0000 EMO", + " 0001 EMP T > O", + " 0002 EMQ E > Z", + " 0003 ENR S > Q", + " 0004 ENS T > K", + " 0005 ENT I > P", + " 0006 ENU N > F", + " 0007 ENV G > L", + "", + " Watch the machine run for 500 steps:", + " $ enigma run \"c-β-VIII-VII-VI QMLI UX.MO.AY 01.13.04.11\" -s 500 -t -f internal -o"] diff --git a/crypto-enigma.cabal b/crypto-enigma.cabal --- a/crypto-enigma.cabal +++ b/crypto-enigma.cabal @@ -3,8 +3,8 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.0.2.14 -synopsis: An Enigma machine simulator with display. +version: 0.0.3.1 +synopsis: An Enigma machine simulator with display. description: The crypto-enigma package is an Enigma machine simulator with rich display and machine state details. . @@ -45,10 +45,10 @@ type: git location: git://github.com/orome/crypto-enigma-hs.git branch: hackage - tag: 0.0.2.14 + tag: 0.0.3.1 library - -- default-extensions: Trustworthy + -- default-extensions: Safe exposed-modules: Crypto.Enigma, Crypto.Enigma.Display other-modules: Crypto.Enigma.Utils @@ -57,8 +57,24 @@ containers >=0.5.5.1, split >=0.2.2, mtl >=2.2, - MissingH >=1.3.0.1 + text >=1.2.2.0 -- hs-source-dirs: + default-language: Haskell2010 + +executable enigma + main-is: enigma.hs + hs-source-dirs: ., cli + other-modules: Crypto.Enigma, + Crypto.Enigma.Display, + Crypto.Enigma.Utils + build-depends: base >=4.8.1.0 && <=4.12.0.0, + containers >=0.5.5.1, + split >=0.2.2, + mtl >=2.2, + text >=1.2.2.0, + optparse-applicative >=0.11.0.2, + ansi-terminal >=0.6.2.3, + crypto-enigma default-language: Haskell2010 test-suite crypto-enigma-check diff --git a/test/Check.hs b/test/Check.hs --- a/test/Check.hs +++ b/test/Check.hs @@ -1,3 +1,4 @@ +--{-# OPTIONS_GHC -Wno-name-shadowing -Wno-orphans -Wno-missing-signatures #-} module Main where -- import Test.HUnit @@ -5,13 +6,12 @@ import Test.QuickCheck.Test (isSuccess) import Control.Monad (unless, replicateM) import System.Exit -import Data.List (sort,intercalate) +import Data.List (intercalate) import Text.Printf (printf) import Crypto.Enigma import Crypto.Enigma.Display -{-# ANN module ("HLint: ignore Use mappend"::String) #-} capitals = ['A'..'Z'] diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,3 +1,4 @@ +--{-# OPTIONS_GHC -Wno-name-shadowing -Wno-orphans -Wno-missing-signatures #-} module Main where import Test.HUnit @@ -7,7 +8,6 @@ import Crypto.Enigma import Crypto.Enigma.Display -{-# ANN module ("HLint: ignore Use mappend"::String) #-} testRotorNames :: Test testRotorNames = TestCase $ assertEqual "Invalid rotor list" @@ -56,6 +56,17 @@ enc (enigmaEncoding cfg msg) +-- TBD - More argument values in test reporting +testDisplayConfig :: EnigmaConfig -> Char -> String -> Bool -> String -> String -> Test +testDisplayConfig cfg ch fmt se hl scfg = TestCase $ assertEqual ("Incorrect config display for " ++ show cfg) + scfg + (displayEnigmaConfig cfg ch displayOpts{format="single",markerspec=hl}) + +testDisplayConfigInternal :: EnigmaConfig -> Char -> String -> [String] -> Test +testDisplayConfigInternal cfg ch hl scfg = TestCase $ assertEqual ("Incorrect config display for " ++ show cfg) + scfg + (lines $ displayEnigmaConfig cfg ch displayOpts{format="internal",markerspec=hl}) + testShowConfig :: EnigmaConfig -> Char -> String -> Test testShowConfig cfg ch scfg = TestCase $ assertEqual ("Incorrect config display for " ++ show cfg) scfg @@ -66,11 +77,22 @@ scfg (lines $ showEnigmaConfigInternal cfg ch) +testDisplayOperation :: EnigmaConfig -> String -> String -> [String] -> Test +testDisplayOperation cfg msg hl scfg = TestCase $ assertEqual ("Incorrect operation internal display for " ++ show cfg) + scfg + (lines $ displayEnigmaOperation cfg msg displayOpts{format="single",markerspec=hl}) + + testShowOperation :: EnigmaConfig -> String -> [String] -> Test testShowOperation cfg msg sop = TestCase $ assertEqual ("Incorrect operation display for " ++ show cfg) sop (lines $ showEnigmaOperation cfg msg) +testDisplayOperationInternal :: EnigmaConfig -> String -> String -> [String] -> Test +testDisplayOperationInternal cfg msg hl scfg = TestCase $ assertEqual ("Incorrect operation internal display for " ++ show cfg) + scfg + (lines $ displayEnigmaOperation cfg msg displayOpts{format="internal",markerspec=hl}) + testShowOperationInternal :: EnigmaConfig -> String -> [String] -> Test testShowOperationInternal cfg msg sop = TestCase $ assertEqual ("Incorrect operation internal display for " ++ show cfg) sop @@ -106,6 +128,7 @@ putStrLn "Encoding display test:" putStrLn $ showEnigmaEncoding (configEnigma "----" "AAAA" " " "01.01.10.01") (concatMap (replicate 8) ['A'..'Z']) results <- runTestTT $ TestList [ + testRotorNames, testReflectorNames, testPlugboardWiring "UX.PO.KY.AZ.EF.ML" "ZBCDFEGHIJYMLNPOQRSTXVWUKA", @@ -135,20 +158,39 @@ (configEnigma "c-β-V-VI-VIII" (enigmaEncoding (configEnigma "c-β-V-VI-VIII" "NAEM" "AE.BF.CM.DQ.HU.JN.LX.PR.SZ.VW" "05.16.05.12") "QEOB") "AE.BF.CM.DQ.HU.JN.LX.PR.SZ.VW" "05.16.05.12") "KRKRALLEXXFOLGENDESISTSOFORTBEKANNTZUGEBENXXICHHABEFOLGELNBEBEFEHLERHALTENXXJANSTERLEDESBISHERIGXNREICHSMARSCHALLSJGOERINGJSETZTDERFUEHRERSIEYHVRRGRZSSADMIRALYALSSEINENNACHFOLGEREINXSCHRIFTLSCHEVOLLMACHTUNTERWEGSXABSOFORTSOLLENSIESAEMTLICHEMASSNAHMENVERFUEGENYDIESICHAUSDERGEGENWAERTIGENLAGEERGEBENXGEZXREICHSLEITEIKKTULPEKKJBORMANNJXXOBXDXMMMDURNHFKSTXKOMXADMXUUUBOOIEXKP" "LANOTCTOUARBBFPMHPHGCZXTDYGAHGUFXGEWKBLKGJWLQXXTGPJJAVTOCKZFSLPPQIHZFXOEBWIIEKFZLCLOAQJULJOYHSSMBBGWHZANVOIIPYRBRTDJQDJJOQKCXWDNBBTYVXLYTAPGVEATXSONPNYNQFUDBBHHVWEPYEYDOHNLXKZDNWRHDUWUJUMWWVIIWZXIVIUQDRHYMNCYEFUAPNHOTKHKGDNPSAKNUAGHJZSMJBMHVTREQEDGXHLZWIFUSKDQVELNMIMITHBHDBWVHDFYHJOQIHORTDJDBWXEMEAYXGYQXOHFDMYUXXNOJAZRSGHPLWMLRECWWUTLRTTVLBHYOORGLGOWUXNXHMHYFAACQEKTHSJW", + + testDisplayConfig (configEnigma "C-III-II-I" "XYZ" "MJ.NH.RF.PL.ZS.DC" "09.25.19") 'E' "single" False "bars" + "E > HEMVB\818\773GFAKZIWCQSXNTORYDLPUJ XYZ 16 01 08", + testDisplayConfig (configEnigma "A-I-II-III" "ABC" "OI.XC.QA.PL.FG.ER.TY" "02.07.25") ' ' "single" False "bars" + " YPLOUWXRMQTCIZDBJHVKESFGAN ABC 26 22 05", testShowConfig (configEnigma "C-III-II-I" "XYZ" "MJ.NH.RF.PL.ZS.DC" "09.25.19") 'E' "E > HEMVB\818\773GFAKZIWCQSXNTORYDLPUJ XYZ 16 01 08", testShowConfig (configEnigma "A-I-II-III" "ABC" "OI.XC.QA.PL.FG.ER.TY" "02.07.25") ' ' " YPLOUWXRMQTCIZDBJHVKESFGAN ABC 26 22 05", + + testDisplayConfigInternal (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") 'K' "bars" + ["K > ABCDEFGHIJK\818\773LMNOPQRSTUVWXYZ "," P YBCDFEGHIJZ\818\773PONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL"," 1 LORVFBQNGWKATHJSZPIYUDXEMC\818\773 Q 07 II"," 2 BJY\818\773INTKWOARFEMVSGCUDPHZQLX A 24 VIII"," 3 ILHXUBZQPNVGKMCRTEJFADOYS\818\773W F 16 V"," 4 YDSKZPTNCHGQOMXAUWJ\818\773FBRELVI L 10 \947"," R ENKQAUYWJI\818\773COPBLMDXZVFTHRGS b"," 4 PUIBWTKJZ\818\773SDXNHMFLVCGQYROAE \947"," 3 UFOVRTLCASMBNJWIHPYQEKZDXG\818\773 V"," 2 JARTMLQ\818\773VDBGYNEIUXKPFSOHZCW VIII"," 1 LFZVXEINSOKAYHBRG\818\773CPMUDJWTQ II"," P YBCDFEG\818\773HIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL","G < CMAWFEKLNVG\818\773HBIUYTXZQOJDRPS "], + testDisplayConfigInternal (configEnigma "A-I-II-III" "LZR" "OI.XC.QA.PL.FG.ER.TY" "09.02.16") ' ' "bars" + [" ABCDEFGHIJKLMNOPQRSTUVWXYZ "," P QBXDRGFHOJKPMNILAESYUVWCTZ OI.XC.QA.PL.FG.ER.TY"," 1 DFHJANPRVTXLWCGUEYIKSQOMZB R 03 III"," 2 QGCLFMUKTWZDNJYVOESIBPRAHX Z 25 II"," 3 CIDANSWKQLTVEURPMXFYOZGBHJ L 04 I"," R EJMZALYXVBWFCRQUONTSPIKHGD A"," 3 DXACMSWYBZHJQEUPIOFKNLGRTV I"," 2 XUCLREBYTNHDFMQVAWSIGPJZOK II"," 1 EZNAQBOCSDTLXFWGVHUJPIMKRY III"," P QBXDRGFHOJKPMNILAESYUVWCTZ OI.XC.QA.PL.FG.ER.TY"," XPOSZNUVJIRQWFCBLKDYGHMATE "], testShowConfigIntenral (configEnigma "b-γ-V-VIII-II" "LFAQ" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") 'K' ["K > ABCDEFGHIJK\818\773LMNOPQRSTUVWXYZ "," P YBCDFEGHIJZ\818\773PONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL"," 1 LORVFBQNGWKATHJSZPIYUDXEMC\818\773 Q 07 II"," 2 BJY\818\773INTKWOARFEMVSGCUDPHZQLX A 24 VIII"," 3 ILHXUBZQPNVGKMCRTEJFADOYS\818\773W F 16 V"," 4 YDSKZPTNCHGQOMXAUWJ\818\773FBRELVI L 10 \947"," R ENKQAUYWJI\818\773COPBLMDXZVFTHRGS b"," 4 PUIBWTKJZ\818\773SDXNHMFLVCGQYROAE \947"," 3 UFOVRTLCASMBNJWIHPYQEKZDXG\818\773 V"," 2 JARTMLQ\818\773VDBGYNEIUXKPFSOHZCW VIII"," 1 LFZVXEINSOKAYHBRG\818\773CPMUDJWTQ II"," P YBCDFEG\818\773HIJZPONMLQRSTXVWUAK UX.MO.KZ.AY.EF.PL","G < CMAWFEKLNVG\818\773HBIUYTXZQOJDRPS "], testShowConfigIntenral (configEnigma "A-I-II-III" "LZR" "OI.XC.QA.PL.FG.ER.TY" "09.02.16") ' ' [" ABCDEFGHIJKLMNOPQRSTUVWXYZ "," P QBXDRGFHOJKPMNILAESYUVWCTZ OI.XC.QA.PL.FG.ER.TY"," 1 DFHJANPRVTXLWCGUEYIKSQOMZB R 03 III"," 2 QGCLFMUKTWZDNJYVOESIBPRAHX Z 25 II"," 3 CIDANSWKQLTVEURPMXFYOZGBHJ L 04 I"," R EJMZALYXVBWFCRQUONTSPIKHGD A"," 3 DXACMSWYBZHJQEUPIOFKNLGRTV I"," 2 XUCLREBYTNHDFMQVAWSIGPJZOK II"," 1 EZNAQBOCSDTLXFWGVHUJPIMKRY III"," P QBXDRGFHOJKPMNILAESYUVWCTZ OI.XC.QA.PL.FG.ER.TY"," XPOSZNUVJIRQWFCBLKDYGHMATE "], - testShowOperation (configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") "KRIEG" + + testDisplayOperation (configEnigma "c-β-VI-VIII-V" "OMLQ" "AI.JF.CM.DQ.HU.LX.PR.SZ" "03.16.04.11") "UBOOT" "bars" + [" LQZRYKTWJIFAXUVSBDPGNOHMEC OMLQ 13 24 09 07","U > TDRBJWSNVEPMLHUKXCGAO\818\773IFQZY OMLR 13 24 09 08","B > VK\818\773JTYSXMLCBIHRZWUNFDQAPGEO OMLS 13 24 09 09","O > VTSFJDZWNEPRUIY\818\773KXLCBMAHQOG OMLT 13 24 09 10","O > VYPSMILKFQHGEZW\818\773CJUDXRAOTBN OMLU 13 24 09 11","T > BARPQGFWLTUIZXVDECYJ\818\773KOHNSM OMLV 13 24 09 12"], + testDisplayOperation (configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") "KRIEG" "bars" [" OHNKJYSBTEDMLCARWPGIXZQUFV LFAP 10 16 24 06","K > CMAWFEKLNVG\818\773HBIUYTXZQOJDRPS LFAQ 10 16 24 07","R > HXETCUMASQNZGKRYJO\818\773IDFWVBPL LFAR 10 16 24 08","I > FGRJUABYW\818\773DZSXVQTOCLPENIMHK LFAS 10 16 24 09","E > SJWYN\818\773UZPQBVXRETHIMAOFKCLDG LFAT 10 16 24 10","G > EOKPAQW\818\773JLHCISTBDFVMNXRGUZY LFAU 10 16 24 11"], testShowOperation (configEnigma "c-β-VI-VIII-V" "OMLQ" "AI.JF.CM.DQ.HU.LX.PR.SZ" "03.16.04.11") "UBOOT" [" LQZRYKTWJIFAXUVSBDPGNOHMEC OMLQ 13 24 09 07","U > TDRBJWSNVEPMLHUKXCGAO\818\773IFQZY OMLR 13 24 09 08","B > VK\818\773JTYSXMLCBIHRZWUNFDQAPGEO OMLS 13 24 09 09","O > VTSFJDZWNEPRUIY\818\773KXLCBMAHQOG OMLT 13 24 09 10","O > VYPSMILKFQHGEZW\818\773CJUDXRAOTBN OMLU 13 24 09 11","T > BARPQGFWLTUIZXVDECYJ\818\773KOHNSM OMLV 13 24 09 12"], + testShowOperation (configEnigma "b-γ-V-VIII-II" "LFAP" "UX.MO.KZ.AY.EF.PL" "03.17.04.11") "KRIEG" + [" OHNKJYSBTEDMLCARWPGIXZQUFV LFAP 10 16 24 06","K > CMAWFEKLNVG\818\773HBIUYTXZQOJDRPS LFAQ 10 16 24 07","R > HXETCUMASQNZGKRYJO\818\773IDFWVBPL LFAR 10 16 24 08","I > FGRJUABYW\818\773DZSXVQTOCLPENIMHK LFAS 10 16 24 09","E > SJWYN\818\773UZPQBVXRETHIMAOFKCLDG LFAT 10 16 24 10","G > EOKPAQW\818\773JLHCISTBDFVMNXRGUZY LFAU 10 16 24 11"], + + testDisplayOperationInternal (configEnigma "b-β-II-IV-V" "MLKQ" "UJ.LK.BV.SF.ZX.QA" "11.12.19.01") "SIE" "bars" + [" ABCDEFGHIJKLMNOPQRSTUVWXYZ "," P QVCDESGHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA"," 1 KGWTAYPOMUFJLBQSDIEZCNXRVH Q 17 V"," 2 BOSLKUEJMAWDXHRIGYCQZPFTVN K 19 IV"," 3 AJDKSIRUXBLHWTMCQGZNPYFVOE L 01 II"," 4 WHTALGVUNZOKBPRYIXEDSFMQJC M 03 \946"," R ENKQAUYWJICOPBLMDXZVFTHRGS b"," 4 DMZTSVFBQYLEWIKNXOUCHGARPJ \946"," 3 AJPCZWRLFBDKOTYUQGENHXMIVS II"," 2 JASLGWQNPHEDIZBVTOCXFYKMRU IV"," 1 ENUQSKBZRLAMIVHGOXPDJYCWFT V"," P QVCDESGHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA"," IENSBJTYAFXQUCZVLWDGMPRKHO ","","S > ABCDEFGHIJKLMNOPQRS\818\773TUVWXYZ "," P QVCDESGHIULKMNOPARF\818\773TJBWZYX UJ.LK.BV.SF.ZX.QA"," 1 FVSZXO\818\773NLTEIKAPRCHDYBMWQUGJ R 18 V"," 2 BOSLKUEJMAWDXHR\818\773IGYCQZPFTVN K 19 IV"," 3 AJDKSIRUXBLHWTMCQG\818\773ZNPYFVOE L 01 II"," 4 WHTALGV\818\773UNZOKBPRYIXEDSFMQJC M 03 \946"," R ENKQAUYWJICOPBLMDXZVFT\818\773HRGS b"," 4 DMZTSVFBQYLEWIKNXOUC\818\773HGARPJ \946"," 3 AJP\818\773CZWRLFBDKOTYUQGENHXMIVS II"," 2 JASLGWQNPHEDIZBV\818\773TOCXFYKMRU IV"," 1 MTPRJAYQKZLHUGFNWOCIXB\818\773VESD V"," P QV\818\773CDESGHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA","V < XTYNLIMZFRQEGDWUKJV\818\773BPSOACH ","","I > ABCDEFGHI\818\773JKLMNOPQRSTUVWXYZ "," P QVCDESGHI\818\773ULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA"," 1 URYWNMKSD\818\773HJZOQBGCXALVPTFIE S 19 V"," 2 BOSL\818\773KUEJMAWDXHRIGYCQZPFTVN K 19 IV"," 3 AJDKSIRUXBLH\818\773WTMCQGZNPYFVOE L 01 II"," 4 WHTALGVU\818\773NZOKBPRYIXEDSFMQJC M 03 \946"," R ENKQAUYWJICOPBLMDXZVF\818\773THRGS b"," 4 DMZTSV\818\773FBQYLEWIKNXOUCHGARPJ \946"," 3 AJPCZWRLFBDKOTYUQGENHX\818\773MIVS II"," 2 JASLGWQNPHEDIZBVTOCXFYKM\818\773RU IV"," 1 SOQIZXPJYKGTF\818\773EMVNBHWAUDRCL V"," P QVCDES\818\773GHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA","S < XKWOFEZPS\818\773MBUJVDHTYIQLNCARG ","","E > ABCDE\818\773FGHIJKLMNOPQRSTUVWXYZ "," P QVCDE\818\773SGHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA"," 1 QXVML\818\773JRCGIYNPAFBWZKUOSEHDT T 20 V"," 2 BOSLKUEJMAWD\818\773XHRIGYCQZPFTVN K 19 IV"," 3 AJDK\818\773SIRUXBLHWTMCQGZNPYFVOE L 01 II"," 4 WHTALGVUNZO\818\773KBPRYIXEDSFMQJC M 03 \946"," R ENKQAUYWJICOPBL\818\773MDXZVFTHRGS b"," 4 DMZTSVFBQYLE\818\773WIKNXOUCHGARPJ \946"," 3 AJPCZ\818\773WRLFBDKOTYUQGENHXMIVS II"," 2 JASLGWQNPHEDIZBVTOCXFYKMRU\818\773 IV"," 1 NPHYWOIXJFSEDLUMAGVZT\818\773CQBKR V"," P QVCDESGHIULKMNOPARFT\818\773JBWZYX UJ.LK.BV.SF.ZX.QA","T < PIJYT\818\773OQWBCNXRKFAGMZEVUHLDS ",""], testShowOperationInternal (configEnigma "b-β-II-IV-V" "MLKQ" "UJ.LK.BV.SF.ZX.QA" "11.12.19.01") "SIE" [" ABCDEFGHIJKLMNOPQRSTUVWXYZ "," P QVCDESGHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA"," 1 KGWTAYPOMUFJLBQSDIEZCNXRVH Q 17 V"," 2 BOSLKUEJMAWDXHRIGYCQZPFTVN K 19 IV"," 3 AJDKSIRUXBLHWTMCQGZNPYFVOE L 01 II"," 4 WHTALGVUNZOKBPRYIXEDSFMQJC M 03 \946"," R ENKQAUYWJICOPBLMDXZVFTHRGS b"," 4 DMZTSVFBQYLEWIKNXOUCHGARPJ \946"," 3 AJPCZWRLFBDKOTYUQGENHXMIVS II"," 2 JASLGWQNPHEDIZBVTOCXFYKMRU IV"," 1 ENUQSKBZRLAMIVHGOXPDJYCWFT V"," P QVCDESGHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA"," IENSBJTYAFXQUCZVLWDGMPRKHO ","","S > ABCDEFGHIJKLMNOPQRS\818\773TUVWXYZ "," P QVCDESGHIULKMNOPARF\818\773TJBWZYX UJ.LK.BV.SF.ZX.QA"," 1 FVSZXO\818\773NLTEIKAPRCHDYBMWQUGJ R 18 V"," 2 BOSLKUEJMAWDXHR\818\773IGYCQZPFTVN K 19 IV"," 3 AJDKSIRUXBLHWTMCQG\818\773ZNPYFVOE L 01 II"," 4 WHTALGV\818\773UNZOKBPRYIXEDSFMQJC M 03 \946"," R ENKQAUYWJICOPBLMDXZVFT\818\773HRGS b"," 4 DMZTSVFBQYLEWIKNXOUC\818\773HGARPJ \946"," 3 AJP\818\773CZWRLFBDKOTYUQGENHXMIVS II"," 2 JASLGWQNPHEDIZBV\818\773TOCXFYKMRU IV"," 1 MTPRJAYQKZLHUGFNWOCIXB\818\773VESD V"," P QV\818\773CDESGHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA","V < XTYNLIMZFRQEGDWUKJV\818\773BPSOACH ","","I > ABCDEFGHI\818\773JKLMNOPQRSTUVWXYZ "," P QVCDESGHI\818\773ULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA"," 1 URYWNMKSD\818\773HJZOQBGCXALVPTFIE S 19 V"," 2 BOSL\818\773KUEJMAWDXHRIGYCQZPFTVN K 19 IV"," 3 AJDKSIRUXBLH\818\773WTMCQGZNPYFVOE L 01 II"," 4 WHTALGVU\818\773NZOKBPRYIXEDSFMQJC M 03 \946"," R ENKQAUYWJICOPBLMDXZVF\818\773THRGS b"," 4 DMZTSV\818\773FBQYLEWIKNXOUCHGARPJ \946"," 3 AJPCZWRLFBDKOTYUQGENHX\818\773MIVS II"," 2 JASLGWQNPHEDIZBVTOCXFYKM\818\773RU IV"," 1 SOQIZXPJYKGTF\818\773EMVNBHWAUDRCL V"," P QVCDES\818\773GHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA","S < XKWOFEZPS\818\773MBUJVDHTYIQLNCARG ","","E > ABCDE\818\773FGHIJKLMNOPQRSTUVWXYZ "," P QVCDE\818\773SGHIULKMNOPARFTJBWZYX UJ.LK.BV.SF.ZX.QA"," 1 QXVML\818\773JRCGIYNPAFBWZKUOSEHDT T 20 V"," 2 BOSLKUEJMAWD\818\773XHRIGYCQZPFTVN K 19 IV"," 3 AJDK\818\773SIRUXBLHWTMCQGZNPYFVOE L 01 II"," 4 WHTALGVUNZO\818\773KBPRYIXEDSFMQJC M 03 \946"," R ENKQAUYWJICOPBL\818\773MDXZVFTHRGS b"," 4 DMZTSVFBQYLE\818\773WIKNXOUCHGARPJ \946"," 3 AJPCZ\818\773WRLFBDKOTYUQGENHXMIVS II"," 2 JASLGWQNPHEDIZBVTOCXFYKMRU\818\773 IV"," 1 NPHYWOIXJFSEDLUMAGVZT\818\773CQBKR V"," P QVCDESGHIULKMNOPARFT\818\773JBWZYX UJ.LK.BV.SF.ZX.QA","T < PIJYT\818\773OQWBCNXRKFAGMZEVUHLDS ",""], + testShowEncoding (configEnigma "c-β-V-VI-VIII" (enigmaEncoding (configEnigma "c-β-V-VI-VIII" "NAEM" "AE.BF.CM.DQ.HU.JN.LX.PR.SZ.VW" "05.16.05.12") "QEOB") "AE.BF.CM.DQ.HU.JN.LX.PR.SZ.VW" "05.16.05.12") "KRKR ALLE XX FOLGENDES IST SOFORT BEKANNTZUGEBEN XX ICH HABE FOLGELNBE BEFEHL ERHALTEN XX J ANSTERLE DES BISHERIGXN REICHSMARSCHALLS J GOERING J SETZT DER FUEHRER SIE Y HVRR GRZSSADMIRAL Y ALS SEINEN NACHFOLGER EIN X SCHRIFTLSCHE VOLLMACHT UNTERWEGS X ABSOFORT SOLLEN SIE SAEMTLICHE MASSNAHMEN VERFUEGEN Y DIE SICH AUS DER GEGENWAERTIGEN LAGE ERGEBEN X GEZ X REICHSLEITEI KK TULPE KK J BORMANN J XX OB.D.MMM DURNH FKST.KOM.ADM.UUU BOOIE.KP" ["LANO TCTO UARB BFPM HPHG CZXT DYGA HGUF XGEW KBLK GJWL QXXT ","GPJJ AVTO CKZF SLPP QIHZ FXOE BWII EKFZ LCLO AQJU LJOY HSSM ","BBGW HZAN VOII PYRB RTDJ QDJJ OQKC XWDN BBTY VXLY TAPG VEAT ","XSON PNYN QFUD BBHH VWEP YEYD OHNL XKZD NWRH DUWU JUMW WVII ","WZXI VIUQ DRHY MNCY EFUA PNHO TKHK GDNP SAKN UAGH JZSM JBMH ","VTRE QEDG XHLZ WIFU SKDQ VELN MIMI THBH DBWV HDFY HJOQ IHOR ","TDJD BWXE MEAY XGYQ XOHF DMYU XXNO JAZR SGHP LWML RECW WUTL ","RTTV LBHY OORG LGOW UXNX HMHY FAAC QEKT HSJW"],