--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- |
--Module       : Checksum
--Author       : Joe Fredette 
--License      : BSD3
--Copyright    : Joe Fredette
--
--Maintainer   : Joe Fredette <jfredett.at.gmail.dot.com>
--Stability    : Unstable
--Portability  : Portable
--
--------------------------------------------------------------------------------
--Description  : Provides a checksum function for strings. The checksum is (mostly)
--      unique to a given string.
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------

module HackMail.Control.Checksum (checksum) where

import Data.Digest.SHA2
import Data.Char
import Data.Word
import Data.List


checksum :: String -> String
checksum = map toChr . map makeReadable . toOctets . sha256Ascii

makeReadable :: Word8 -> Word8
makeReadable c = (toEnum . ord) $ readables !! ((fromEnum c) `mod` (length readables))

toChr :: Word8 -> Char
toChr = (chr . fromEnum) 

readables = "+-_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"


testChecksum :: IO ()
testChecksum = do
        values <- readFile "testchksum.tx"
        let truevals = nub . lines $ values
        let numvals = length $ truevals
        let chksums = map checksum $ truevals
        putStrLn $ checkeach chksums
        putStrLn $ "Tested: " ++ show numvals ++ " diferent hashes."

checkeach []     = "Passed"
checkeach (x:xs) | all (/=x) xs = checkeach xs
                 | otherwise    = "Failed with:\n" ++ (show x)