Loose inversion proof of D2 CD key decoding: note each function has a 1:1 inverse

key.hs

module Key ( decode
           ) where
import Control.Monad
import Data.Char
import Data.List
import Data.Word
import Data.Bits
import Data.Array

decode key = fmap (pack . cipher . shuffle) (initialize . normalize $ key)

-- TODO:
--  check byte order of pub/priv
--  pack them into Word32s
--  write inverses

-- test case from Pro_Tech's post, should return:
--   Just (D2Classic,[167,29,173],[156,242,3,201])
test = decode "bxhjbt989wbhfcfr"

{- Strips formatting characters and makes case consistent. -}
normalize :: String -> [Char]
normalize = map toUpper . filter (`notElem` " \t-_")

{- Initializes key for further processing and tests it for basic validity:
     1: correct length
     2: two hashes match
-}
initialize :: [Char] -> Maybe [Char]
initialize key = let
    -- keys are 16 characters in length, 8 numbers are built from them
    nums = reduce . map lookup $ key where
        -- convert characters to numbers via a 24-value lookup table
        --
        -- range is mapped from [A..Z,0..9] to [0..23,255]
        -- information is lost for characters not in table (mapped to 255)
        -- assuming uniform distribution in key, 255 should be more frequent
        lookup = maybe 255 id . (`elemIndex` "246789BCDEFGHJKMNPRTVWXZ")
        -- reduce list from 16 chars to 8 ints by adding up pairs
        --
        -- range is mapped to [0..23,24*[0..23],255,6120]
        -- this is a 1:1 mapping, no information lost
        reduce []       = []
        reduce (a:b:xs) = (a*3*8+b) : reduce xs
    -- the initial check computes two 8 bit hashes which must match:
    -- the first is drawn from the 8 numbers by checking if 9th bit is set
    --
    -- only every 2nd char of CD key has effect on non-0 hash bit
    -- even then, still less possibile 1-bits than 0-bits
    hash1 = foldr (\n h->h `shiftL` 1 .|. (n `shiftR` 8 .&. 1)) 0 nums
    -- make a 16-character key again, no longer ASCII
    --
    -- map from 9 bits of data (less, range is sparse) to 8
    -- 16 4-bit values, 16x16
    --key' = map (0xF .&.) . concatMap (\n->[n `shiftR` 4, n]) $ nums
    key' = [b.&.0xF | n<-nums, b<-[n `shiftR` 4, n]]
    -- second hash is a xor-fold of key'
    --
    -- the fact that they match reduces the space of valid CD keys, but
    --   how was this relationship chosen? is there some underlying principle?
    --   or was it just a random decision, backed up by some tests?
    hash2 = 0xFF .&. foldl (\h n->h+(n `xor` (h*2))) 3 key'
    -- the key is further modified for use in future steps:
    --
    -- this is an ASCII-like representation, this step adds the size-7 gap
    --   between '0-9' and 'A-F' (though 0x30 needs to be added to convert to
    --   actual ASCII, since the range of key' is 0x0-0xF)
    -- new range: <0-9, 17-22> == <0-9, 0x11-0x16>
    key'' = map (chr . ascii) $ key' where
        ascii n | n > 9     = n+7
                | otherwise = n
    -- all of this is done to check for failure, and pass a processed key to
    --   further steps if the hash check passes
              in do
    guard $ length key == 16
    guard $ hash1 == hash2
    return key''

{- Constant, content-independant, character position shuffle. -}
shuffle :: [a] -> [a]
shuffle key = let
    from = [0..15]
    to   = map f from where f n | n>8       = n-9
                                | otherwise = n+7
              in
    -- note the fold order: [(from,to)] is traversed back-to-front!
    elems $ foldr swap (listArray (0,15) key) (zip from to) where
        swap (f,t) arr = arr // [(f,arr!t),(t,arr!f)]

{- One-pass xor-cipher starting with a seed. -}
cipher :: [Char] -> [Word8]
cipher key = let
    (_,_,result) = foldr change (15,0x13AC9741,[]) (map ord key) where
        change k (d,seed,acc)
            -- if I got the input range right, it's [0..9, 17..22]
            -- so the 0x0A bit should only catch 9,8 (b1001, b1000)
            -- which means the first option checks for 8-bit not being set
            | k<0x08 = (d-1, seed `shiftR` 3, (seed .&. 7) `xor` k  : acc)
            -- second option checks for 8-bit being set
            | k<0x0A = (d-1, seed           , (d    .&. 1) `xor` k  : acc)
            -- third option, due to the range, checks for 9-bit being set
            | otherwise = (d-1,seed         ,                    k  : acc)
            -- all three operations do not mutate the bit that triggers them!
            -- the function is trivially invertible once this is understood!
            --
            -- more importantly, it explains the extraneous "ascii" +7 move
            --  earlier, and perhaps even gives it a sinister purpose
            -- it almost looks like whoever designed this tried to hide the
            --  purpose of the code, by using a red-herring operation and
            --  comparison operators, instead of the trivial bitmask
            --  operation ;)
             in
    -- huh, so A-F get +7 to 'ASCII-ize' them,
    --   then XOR-cipher
    --   then -7?
    -- this seems like a bug - shouldn't it happen before?
    -- seems like an extraneous step if so (TODO, test /w real data)
    map (fromIntegral . (\n->if n>9 then n-7 else n)) $ result
    -- (the fromIntegral coerces Int->Word8)

data Product = D2Classic | D2Expansion | Unknown deriving (Eq,Show)
{- Pack 4-bit values to 8-bit, split different values. -}
pack :: [Word8]
     -> ( Product
        , [Word8] -- public  (3 bytes, sent to server in logon request)
        , [Word8] -- private (4 bytes, used to respond to servers challenge)
        )
pack key = let
    (pid:xs) = pck key where
        pck []       = []
        pck (a:b:xs) = ((a `shiftL` 4) .|. b) : pck xs
           in
    (prod pid,take 3 xs,drop 3 xs) where
        prod 6  = D2Classic
        prod 10 = D2Expansion
        prod _  = Unknown