denotational sematics

symetric encryption.hs

data Nibble a = Nibble a a a a deriving (Show, Eq)

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)

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

xor :: Bool -> Bool -> Bool
xor False False = False
xor False True = True
xor True False = True
xor True True = False

xorN = op2 xor
notN = op1 not

encode k m = rol $ notN $ (xorN k m)
decode k m = xorN k $ notN $ ror m

boolDomain = [False, True]
nibbleDomain domain  = [ Nibble a b c d |
                    a <- domain,
                    b <- domain,
                    c <- domain,
                    d <- domain ]

codeDomain = let d = boolDomain
             in [ (k,m) | k <- nibbleDomain d, m <- nibbleDomain d ]

-- this should be True                                                                                                                                         
good = let f (k, m) = decode k (encode k m) == m
           rs = map f codeDomain
       in foldl (==) True rs