Encryption¶

Caesar Cipher¶

In [1]:
caesarEnc :: Char -> Char
caesarEnc = succ . succ . succ

caesarDec :: Char -> Char
caesarDec = pred . pred . pred

enc :: String -> String
enc = map caesarEnc

dec :: String -> String
dec = map caesarDec

enc "CAESAR"
dec "DEF"

"FDHVDU"
"ABC"

Vigenere Cipher¶

In [3]:
data Alpha = 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 deriving (Eq, Show, Ord, Enum, Bounded)

bSucc :: (Enum a, Bounded a, Eq a) => a -> a
bSucc b = if b == maxBound then minBound else succ b

bPred :: (Enum a, Bounded a, Eq a) => a -> a
bPred b = if b == minBound then maxBound else pred b

nSucc :: (Enum a, Bounded a, Eq a) => Int -> a -> a
nSucc 0 = id
nSucc 1 = bSucc
nSucc (-1) = bPred
nSucc n
  | n > 1 = bSucc . nSucc (n-1)
  | n < -1 = bPred . nSucc (n+1)

subEnum :: (Ord a, Enum a) => a -> a -> Int
subEnum x y
  | x == y = 0
  | x > y = 1 + subEnum x (succ y)
  | x < y = subEnum (succ x) y - 1

vigEnc :: Alpha -> Alpha -> Alpha
vigEnc k = nSucc (k `subEnum` minBound)

-- vigEnc minBound A
-- bSucc E
-- bSucc A
-- C `subEnum` A
-- nSucc 2 A
-- vigEnc C A

enc :: [Alpha] -> [Alpha] -> [Alpha]
enc key pt = map (uncurry vigEnc) (zip (cycle key) pt)

enc [D,U,H] [C,R,Y,P,T,O]
Use zipWith
Found:
map (uncurry vigEnc) (zip (cycle key) pt)
Why Not:
zipWith (curry (uncurry vigEnc)) (cycle key) pt
[F,L,F,S,N,V]

How Ciphers Work¶

  • Permutation
    • Uniquely inversable transform from item to item
  • Mode of Operation
    • Uses a permutation to process messages of arbitrary size
In [ ]:
import Control.Lens
import Data.List.NonEmpty qualified as NE

data Alpha = 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 deriving (Eq, Show, Ord, Enum, Bounded)

bSucc :: (Enum a, Bounded a, Eq a) => a -> a
bSucc b = if b == maxBound then minBound else succ b

bPred :: (Enum a, Bounded a, Eq a) => a -> a
bPred b = if b == minBound then maxBound else pred b

-- I had to make this newtype wrapper because GHC complained about having Iso directly in a typeclass function type definition.newtype IsoAlpha = IsoAlpha (Iso' Alpha Alpha)

encoder :: IsoAlpha -> Alpha -> Alpha
encoder (IsoAlpha iso) = withIso (from iso) (\f _ -> f)

decoder :: IsoAlpha -> Alpha -> Alpha
decoder (IsoAlpha iso) = withIso (from iso) (\_ g -> g)

class Permutation p where
    permute :: p -> [IsoAlpha]

class (Permutation m) => Mode m where
  encrypt :: m -> [Alpha] -> [Alpha]
  decrypt :: m -> [Alpha] -> [Alpha]

-- Caesar ------------------------------------------------------------

data Caesar = Caesar

instance Permutation Caesar where
  permute _ = pure $ IsoAlpha (iso (bPred . bPred . bPred) (bSucc . bSucc . bSucc))

instance Mode Caesar where
  encrypt Caesar pt = let enc = head (permute Caesar) in map (encoder enc) pt
  decrypt Caesar et = let enc = head (permute Caesar) in map (decoder enc) et

let trans = head (permute Caesar) in encoder trans B

-- Vigenere ----------------------------------------------------------

newtype Vigenere = Vigenere (NE.NonEmpty Alpha)

nSucc :: (Enum a, Bounded a, Eq a) => Int -> a -> a
nSucc 0 = id
nSucc 1 = bSucc
nSucc (-1) = bPred
nSucc n
  | n > 1 = bSucc . nSucc (n-1)
  | n < -1 = bPred . nSucc (n+1)

subEnum :: (Ord a, Enum a) => a -> a -> Int
subEnum x y
  | x == y = 0
  | x > y = 1 + subEnum x (succ y)
  | x < y = subEnum (succ x) y - 1

vigEnc :: Alpha -> Alpha -> Alpha
vigEnc k = nSucc (k `subEnum` minBound)

vigDec :: Alpha -> Alpha -> Alpha
vigDec k = let x = k `subEnum` minBound in nSucc (-x)

instance Permutation Vigenere where
  permute (Vigenere key) = [ IsoAlpha $ iso (vigDec k) (vigEnc k) | k <- NE.toList $ NE.cycle key]

instance Mode Vigenere where
  encrypt v pt = let encs = permute v in zipWith encoder encs pt
  decrypt v ct = let encs = permute v in zipWith decoder encs ct

let ts = permute (Vigenere $ NE.fromList [D,U,H]) in [encoder f a | (f,a) <- zip ts [C,R,Y,P,T,O]]

vDUH = Vigenere $ NE.fromList [D,U,H]

encrypt vDUH [C,R,Y,P,T,O]
encrypt Caesar [C,R,Y,P,T,O]
decrypt Caesar [F,U,B,S,W,R]
decrypt vDUH [F,L,F,S,N,V]

One-Time Pad¶

In [36]:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ImportQualifiedPost #-}

import Control.Lens
import Data.List.NonEmpty qualified as NE
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Bits (xor)

data Alpha = 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 deriving (Eq, Show, Ord, Enum, Bounded)

bSucc :: (Enum a, Bounded a, Eq a) => a -> a
bSucc b = if b == maxBound then minBound else succ b

bPred :: (Enum a, Bounded a, Eq a) => a -> a
bPred b = if b == minBound then maxBound else pred b

nSucc :: (Enum a, Bounded a, Eq a) => Int -> a -> a
nSucc 0 = id
nSucc 1 = bSucc
nSucc (-1) = bPred
nSucc n
  | n > 1 = bSucc . nSucc (n-1)
  | n < -1 = bPred . nSucc (n+1)

-- Iso Wrapper -----------------------------------------------------

newtype UniqueEncoding plainText cipherText = UniqueEncoding (Iso' plainText cipherText)

mkUniqueEncoding :: (plainText -> cipherText) -> (cipherText -> plainText) -> UniqueEncoding plainText cipherText
mkUniqueEncoding enc dec = UniqueEncoding $ iso enc dec

encoder :: UniqueEncoding plainText cipherText -> plainText -> cipherText
encoder (UniqueEncoding iso) = withIso (from iso) (\_ f -> f)

decoder :: UniqueEncoding plainText cipherText -> cipherText -> plainText
decoder (UniqueEncoding iso) = withIso (from iso) (\g _ -> g)

-- Typeclasses ------------------------------------------------------

class Permutation p plainText cipherText where
  permute :: p -> NE.NonEmpty (UniqueEncoding plainText cipherText)

class (Permutation m plainText cipherText) => Mode m plainText cipherText where
  encrypt :: m -> [plainText] -> [cipherText]
  decrypt :: m -> [cipherText] -> [plainText]

-- Boolean Format --------------------------------------------------

data BooleanOneTimePad = BooleanOneTimePad [Bool]

instance Permutation BooleanOneTimePad Bool Bool where
  permute (BooleanOneTimePad [b]) = let f = xor b in pure $ mkUniqueEncoding f f
  permute (BooleanOneTimePad (b:bs)) = let f = xor b in mkUniqueEncoding f f `NE.cons` permute (BooleanOneTimePad bs)

instance Mode BooleanOneTimePad Bool Bool where
  encrypt botp pt = let perms = permute botp in zipWith encoder (NE.toList perms) pt
  decrypt botp ct = let perms = permute botp in zipWith decoder (NE.toList perms) ct

key1 :: BooleanOneTimePad
key1 = BooleanOneTimePad [True,False,True,True,False,True,False,False]

raw1 :: [Bool]
raw1 = [False,True,True,False,True,True,False,True]

msg1 :: [Bool]
msg1 = encrypt key1 raw1

raw1' :: [Bool]
raw1' = decrypt key1 msg1

msg1
raw1'
raw1 == raw1'

-- Alpha Format -----------------------------------------------------

data AlphaOneTimePad = AlphaOneTimePad [Int]

instance Permutation AlphaOneTimePad Alpha Alpha where
  permute (AlphaOneTimePad [s]) = let f = nSucc s; g = nSucc (-s) in pure $ mkUniqueEncoding f g
  permute (AlphaOneTimePad (s:ss)) = let f = nSucc s; g = nSucc (-s) in mkUniqueEncoding f g `NE.cons` permute (AlphaOneTimePad ss)

instance Mode AlphaOneTimePad Alpha Alpha where
  encrypt = stdEncrypter
  decrypt = stdDecrypter

stdEncrypter :: (Permutation x y z) => x -> [y] -> [z]
stdEncrypter p pt = let perms = permute p in zipWith encoder (NE.toList perms) pt

stdDecrypter :: (Permutation x y z) => x -> [z] -> [y]
stdDecrypter p ct = let perms = permute p in zipWith decoder (NE.toList perms) ct

key2 :: AlphaOneTimePad
key2 = AlphaOneTimePad [3,2,5,4,0,9,4,1,9,8,7,6]

raw2 :: [Alpha]
raw2 =                 [L,E,N,A,B,A,B,Y,G,I,R,L]

msg2 :: [Alpha]
msg2 = encrypt key2 raw2

raw2' :: [Alpha]
raw2' = decrypt key2 msg2

msg2
raw2'
raw2 == raw2'
Use const
Found:
\ g _ -> g
Why Not:
const
Use newtype instead of data
Found:
data BooleanOneTimePad = BooleanOneTimePad [Bool]
Why Not:
newtype BooleanOneTimePad = BooleanOneTimePad [Bool]
Use newtype instead of data
Found:
data AlphaOneTimePad = AlphaOneTimePad [Int]
Why Not:
newtype AlphaOneTimePad = AlphaOneTimePad [Int]
[True,True,False,True,True,False,False,True]
[False,True,True,False,True,True,False,True]
True
[O,G,S,E,B,J,F,Z,P,Q,Y,R]
[L,E,N,A,B,A,B,Y,G,I,R,L]
True

Encryption Security¶

  • This comment about the probability of something happening (specifically about finding the (a?) valid key) basically says that security is a ratio between truth and possibility. I think it's important to call out that just because some datatype may technically be able to represent some 2^256 space, that doesn't necessarily mean that all 2^256 options are possible. The algorithms of the key generation, for example, may be structured such that keys are only generated in some 2^8 subset. Then, you can say "I have a 256-bit key" all you want, but you don't actually have the purported level of security. Obviously, finding such a subset would require analyzing the algorithms and not just the public ciphertext.