An application to quickly determine the right password for RobCo terminals in "Fallout: New Vegas" (and possibly other installments of the series, too).

FalloutHacker.hs

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Applicative
import Control.Monad
import Data.Foldable (toList)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Text.Read
import Text.Printf (printf)

-- | Calculates how many elements are shared in the exact same place between
-- the two lists.
similarity :: Eq a => [a] -> [a] -> Int
similarity xs ys = length $ filter id $ zipWith (==) xs ys

-- | Removes all passwords from the whole list of passwords that are definitely
-- wrong given the evidence returned by the RobCo Terminal.
prunePasswords :: String -> Int -> Seq String -> Seq String
prunePasswords wrongPw numRight = Seq.filter $ \pw -> similarity pw wrongPw == numRight

-- | Reads the initial list of passwords.
readWords :: IO (Seq String)
readWords = do
  line <- getLine
  if null line
    then return Seq.empty
    else (line Seq.<|) <$> readWords

-- | Edits the given password in the sequence.
editPassword :: Seq String -> Int -> IO (Seq String)
editPassword pws idx = do
    printf "Change [%s] to:\n" (Seq.index pws idx)
    newPw <- getLine
    return $ Seq.update idx newPw pws

-- | Presents a list and a message asking the user to pick one of the passwords.
pickPassword :: Seq String -> String -> IO (Maybe Int)
pickPassword pws msg = do
  putStrLn "======= PASSWORDS ======="
  forM_ (zip [1 :: Int ..] $ toList pws) $ uncurry $ printf "%2d) %s\n"
  putStrLn "========================="
  putStrLn msg
  readMaybe <$> getLine >>= maybe (return Nothing) validate
  where
    validate idx
      | idx < 1 || idx > Seq.length pws = do
          putStrLn "ERROR: Invalid Index"
          pickPassword pws msg
      | otherwise = return $ Just $ idx - 1

-- | Reruns a monadic action returning a @Maybe@ until it produces a @Just@.
retrying :: Monad m => m (Maybe a) -> m a
retrying action = go where
  go = action >>= maybe go return

-- | Presents the list of passwords after initial input and asks for confirmation.
presentPasswords :: Seq String -> IO (Seq String)
presentPasswords pws = do
  let msg = "To change an entry, type its number and [Enter]. otherwise, confirm with [Enter]"
  pickPassword pws msg >>=
    maybe (return pws) (editPassword pws >=> presentPasswords)

-- | Asks the user to inquire evidence from the terminal.
crackPasswords :: Seq String -> IO ()
crackPasswords pws
  | Seq.length pws <= 0 = putStrLn "No passwords remaining, you made a mistake!"
  | Seq.length pws == 1 = do
      printf "The password is: %s\n" (Seq.index pws 0)
  | otherwise = do
      idx <- retrying $ pickPassword pws "Which one did you try?"
      putStrLn "How many characters are correct?"
      numRight <- retrying $ readMaybe <$> getLine
      crackPasswords $ prunePasswords (Seq.index pws idx) numRight pws

main :: IO ()
main = do
  putStrLn "==== ROBCO TERMINAL PASSWORD CRACKER ===="
  putStrLn "Enter possible passwords line by line:"
  readWords >>= presentPasswords >>= crackPasswords