💾 Archived View for wunderbrick.me › technical › otp-guide › otpguide.hs.gmi captured on 2022-04-28 at 18:21:59. Gemini links have been rewritten to link to archived content

View Raw

More Information

-=-=-=-=-=-=-

import Control.Applicative (liftA2)
import Data.List (concat, replicate, sort, zipWith5)
import Data.Maybe (fromMaybe)

{-

This file attempts to make screen reader friendly output for tables used in the construction of a simple alphanumeric one-time-pad.
The output corresponds to the table images that a friend made years ago included with this guide.

-}

-- | Print one-time-pad guide tables in a way that makes sense for screen readers.
main :: IO ()
main = do
    putStrLn "Table 1: Unbiased Random Numbers from Two Six-Sided Dice"
    printTable randomNumbersFromDiceTable
    putStrLn "\n"
    putStrLn "Table 2: Alphanumeric Mapping to Digits 0 through 35"
    printTable modularArithmeticTable
    putStrLn "\n"
    putStrLn "Table 3: Alphanumeric Tabula Recta Outcomes When Encrypting"
    printTable $ encryptionTabulaRecta
    putStrLn "\n"
    putStrLn "Table 4: Alphanumeric Tabula Recta Outcomes When Decrypting"
    printTable $ decryptionTabulaRecta

-- | Print a list of strings from a pure function to make a table.
printTable :: [String] -> IO ()
printTable = mapM_ putStrLn

-- | Build a table that shows the results of rolling two six-sided dice to generate random numbers without introducing bias.
randomNumbersFromDiceTable :: [String]
randomNumbersFromDiceTable =
    zipWith5 (\a b c d e -> a <> b <> c <> d <> e) firstNumberColumn andColumn secondNumberColumn givesColumn resultsColumn
  where
    firstNumberColumn = show <{body}gt; (replicate 6 1 ++ replicate 6 2 ++ replicate 6 3 ++ replicate 6 4 ++ replicate 6 5 ++ replicate 6 6)
    andColumn = replicate 36 " and "
    secondNumberColumn = concat $ replicate 6 (show <{body}gt; [1 .. 6])
    givesColumn = replicate 36 " makes "
    resultsColumn = show <{body}gt; [0 .. 35]

-- | Build a table that prints the values of a modular arithmetic representation of A through Z and 0 through 9 that map to the numbers 0 through 35.
modularArithmeticTable :: [String]
modularArithmeticTable =
    zipWith (<>) numbersColumn alphaNumericStr ++ ["Start at 0 again as if you are making another rotation around a clock face."]
  where
    numbersColumn = (\str -> str <> determinePadding str) <{body}gt; (show <{body}gt; [0 .. 35])
    determinePadding = \str -> if Prelude.length str == 1 then "    " else "   "

alphaNumericStr :: [String]
alphaNumericStr = ["A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"]

-- | Build the results of consulting an alpha numeric tabula recta for encryption. This is very naive and uses a lot of list processing with no attention given to performance.
encryptionTabulaRecta :: [String]
encryptionTabulaRecta =
    zipWith encryptionFunctionForTable combinedPositionalPairs indicesOfCipherTextChars

-- | Build the results of consulting an alpha numeric tabula recta for decryption. This is very naive and uses a lot of list processing with no attention given to performance.
decryptionTabulaRecta :: [String]
decryptionTabulaRecta =
    snd splitList ++ fst splitList -- Want numbers to come after letters for consistency.
  where
    unsortedStrs = zipWith decryptionFunctionForTable combinedPositionalPairs indicesOfCipherTextChars
    splitList = splitAt 360 $ sort unsortedStrs

-- | Type alias for the position of a character in alphaNumericStr starting at 1 instead of 0 followed by the character itself.
type PositionalPair = (Int, String)

-- | Encryption values (yields ciphertext).
encryptionFunctionForTable :: (PositionalPair, PositionalPair) -> Int -> String
encryptionFunctionForTable allPossiblePositionsAndChars indexOfCharInAlphaNumStr =
      "Plaintext "
        <> plainTextCharacter allPossiblePositionsAndChars
        <> " and key character "
        <> keyCharacter allPossiblePositionsAndChars
        <> " gives ciphertext "
        <> cipherTextCharacter indexOfCharInAlphaNumStr
        <> " when encrypting"

-- | Decryption values (yields plaintext).
decryptionFunctionForTable :: (PositionalPair, PositionalPair) -> Int -> String
decryptionFunctionForTable allPossiblePositionsAndChars indexOfCharInAlphaNumStr =
      "Key character "
        <> keyCharacter allPossiblePositionsAndChars
        <> " and ciphertext "
        <> cipherTextCharacter indexOfCharInAlphaNumStr
        <> " gives plaintext "
        <> plainTextCharacter allPossiblePositionsAndChars
        <> " when decrypting"

-- | Helper used to get the plaintext character.
plainTextCharacter :: (PositionalPair, PositionalPair) -> String
plainTextCharacter allPossiblePositionsAndChars = snd $ fst allPossiblePositionsAndChars

-- | Helper used to get the key character.
keyCharacter :: (PositionalPair, PositionalPair) -> String
keyCharacter allPossiblePositionsAndChars = snd $ snd allPossiblePositionsAndChars

-- | Helper used to get the ciphertext character.
cipherTextCharacter :: Int -> String
cipherTextCharacter indexOfCharInAlphaNumStr = alphaNumericStr !! indexOfCharInAlphaNumStr

-- | Use applicative to get all the possible combinations of characters.
combinedPositionalPairs :: [(PositionalPair, PositionalPair)]
combinedPositionalPairs = liftA2 (,) positionalPairs positionalPairs

-- | A is at position 1, 9 is at position 36. Items in alphaNumericStr are referred to as characters but are really of type String.
positionalPairs :: [PositionalPair]
positionalPairs = makePositionalPairs 1 alphaNumericStr []

-- | Use recursion to actually make the positional pairs.
makePositionalPairs :: Int -> [String] -> [PositionalPair] -> [PositionalPair]
makePositionalPairs pos (str : strs) acc = makePositionalPairs (pos + 1) strs (acc ++ [(pos, str)])
makePositionalPairs pos [] acc = acc

-- | This is how we figure out where the character we need for the ciphertext is in alphaNumericStr.
indicesOfCipherTextChars :: [Int]
indicesOfCipherTextChars =
    zipWith
        (\a b -> (a + b - 2) `mod` 36)
        (fst . fst <{body}gt; combinedPositionalPairs)
        (fst . snd <{body}gt; combinedPositionalPairs)