logic.hs

-- Boolean XOR (NOT is defined in the system)                                                                                                       
xor :: Bool -> Bool -> Bool
xor False False = False
xor False True = True
xor True False = True
xor True True = False

-- a 4-bit Boolean (that can be printed and tested for equality automagically)                                                                      
data Nibble a = Nibble a a a a deriving (Show, Eq)

-- binary and unary Nibble operators                                                                                                                
op2 :: (a -> a -> a) -> Nibble a -> Nibble a -> Nibble a
op2 f (Nibble a  b  c  d) (Nibble a'  b'  c'  d') = Nibble (f a a') (f b b') (f c c') (f d d')

op1 :: (a -> a) -> Nibble a -> Nibble a
op1 f (Nibble a  b  c  d) = Nibble (f a) (f b) (f c) (f d)

-- Nibble operations                                                                                                                                
ror :: Nibble a -> Nibble a
ror (Nibble a  b  c  d) = Nibble d a b c

rol :: Nibble a -> Nibble a
rol (Nibble a  b  c  d) = Nibble b c d a

xorN :: Nibble Bool -> Nibble Bool -> Nibble Bool
xorN = op2 xor

notN :: Nibble Bool -> Nibble Bool
notN = op1 not

-- Nibble Codec                                                                                                                                     
encode :: Nibble Bool -> Nibble Bool -> Nibble Bool
encode k = rol . notN . xorN k

decode :: Nibble Bool -> Nibble Bool -> Nibble Bool
decode k = xorN k . notN . ror

-- all possible (key,message) pairs                                                                                                                 
kms = let boold = [False, True]
          nibbled = [ Nibble a b c d |
                      a <- boold,
                      b <- boold,
                      c <- boold,
                      d <- boold ]
      in [ (k,m) | k <- nibbled, m <- nibbled ]

-- does every decoding of every encoded message equal that message?                                                                                 
-- should eval to True                                                                                                                              
good = let f (k, m) = (decode k . encode k) m == m
           rs = map f kms
       in foldl (==) True rs