(Re-upload of a private Gist) An enigma machine written in Haskell. Uses some weird IO code because of file dependencies (for the rotors and machine specification).

enigma.hs

{-# LANGUAGE ScopedTypeVariables #-}
import Data.Char
import Data.List
import Data.Maybe
import Data.IORef
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Generic.Mutable as MV
import Control.Monad
import System.Exit
import System.IO
import System.Environment

data Rotor =
  Rotor { forwardAlphabet :: [Int]
        , offset :: Int }

data Reflector =
  Reflector

data Plugboard =
  Plugboard { pbAlphabet :: [Int] }

data EnigmaMachine =
  EnigmaMachine { plugboard :: Plugboard
                , rotors :: [Rotor]
                , reflector :: Reflector }

main :: IO ()
main = do
  args <- getArgs
  let argc = length args
  plugboardFile <- readPlugboardFile $ args !! (argc - 1)
  let plb = Plugboard { pbAlphabet = plugboardFile }
      rotorCount = argc - 1
  rotorAlphabets <- case rotorCount of
    0 -> return []
    x -> mapM (readRotorFile args) [0..rotorCount - 1]
  let rs = flip map rotorAlphabets $
           (\f -> Rotor { forwardAlphabet=f, offset=1 })
  mc <- newIORef $ EnigmaMachine {plugboard=plb, rotors=rs, reflector=Reflector}
  forever $ do
    eof <- isEOF
    when eof $ exitSuccess
    input <- getChar
    machine <- readIORef mc
    if input `elem` "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      then do let alphabetIx = ord input - ord 'A'
              writeIORef mc (rotate machine)
              putChar . chr $ enigmaEncode machine alphabetIx + ord 'A'
      else return ()

readPlugboardFile :: String -> IO [Int]
readPlugboardFile path = do
  fileContents <- readFile path
  let processed = map (read :: String -> Int) . words $ fileContents
  return $ readContents processed (V.generate (26 :: Int) id)
  where
    readContents :: [Int] -> V.Vector Int -> [Int]
    readContents (a:a':as) vect =
      readContents as $
      V.modify (\v -> MV.write v a' a) $
      V.modify (\v -> MV.write v a a') vect
    readContents [] vect = V.toList vect

readRotorFile :: [String] -> Int -> IO [Int]
readRotorFile args ix = do
  fileContents <- readFile $ args !! ix
  let fwdAlphabet = map (read :: String -> Int) . words $ fileContents
  return fwdAlphabet

class Part a where
  encodeCharacter :: a -> Int -> Int
  encodeCharacterR :: a -> Int -> Int

instance Part Rotor where
  encodeCharacter r c =
   (((forwardAlphabet r) !! index) - offset r) `mod` 26
    where
      index = (c + offset r) `mod` 26

  encodeCharacterR r c =
    (filter (\x -> encodeCharacter r x == c) [0..25]) !! 0

instance Part Reflector where
  encodeCharacter r c =
    (c + 13) `mod` 26

instance Part Plugboard where
  encodeCharacter r c =
    (pbAlphabet r) !! c

addRotor :: Rotor -> EnigmaMachine -> EnigmaMachine
addRotor r e = e { rotors = r : rotors e }

enigmaEncode :: EnigmaMachine -> Int -> Int
enigmaEncode mc c =
  encodeCharacter pb backward
  where
    pb = plugboard mc; refl = reflector mc; rs = rotors mc
    input = encodeCharacter pb c
    forward = foldr ($) input (map encodeCharacter rs)
    reflected = encodeCharacter refl forward
    backward = foldr ($) reflected (map encodeCharacterR $ reverse rs)

rotate :: EnigmaMachine -> EnigmaMachine
rotate mc = mc { rotors = rotateAll True (rotors mc) }
  where
    rotateAll :: Bool -> [Rotor] -> [Rotor]
    rotateAll _ [] = []
    rotateAll b (r:rs) = let (bool, rotor) = rotateRotor (b, r) in
      rotor : rotateAll bool rs
    rotateRotor :: (Bool, Rotor) -> (Bool, Rotor)
    rotateRotor (False, r) = (False, r)
    rotateRotor (True, r) = let newOffset = (offset r + 1) `mod` 26 in
      (newOffset == 1, r { offset = newOffset })