import System.Environment
import Data.Time.Clock
import Crypto.Hash.SHA1
import Data.ByteString.Char8 (pack)
import qualified Data.ByteString as BS (head, ByteString, null, tail)
import Data.Bits
import Data.Time.Format
import System.Locale   
import Text.Printf
import System.Random
import Data.List
import Safe

{- 1:20:20130405150650:dom.crossley@pebblecode.com::qxpdahop:94591 -}

checkHash :: String -> Int -> Bool
checkHash stamp size = let bitString = (toBitString . hash . pack) stamp
                        in case length bitString > size of
                            False -> False
                            True -> all (== False) (take size bitString) 
              
toBitString :: BS.ByteString -> [Bool]
toBitString b | BS.null b = []
              | otherwise = convertByte (BS.head b) ++ toBitString (BS.tail b)
                    where convertByte byte = map (\pos -> testBit byte pos) (reverse [0..7])

getDateString :: UTCTime -> String       
getDateString t = formatTime defaultTimeLocale "%Y%m%d%H%M%S" t

createHashString :: Int -> UTCTime -> String -> String -> Int -> String
createHashString s d r se c = printf "1:%s:%s:%s::%s:%s" (show s) (getDateString d) r se (show c)
       
generateStamp :: Int -> UTCTime -> String -> String -> Maybe String
generateStamp size date resource seed   
    | size <= 0 = Nothing
    | resource == "" = Nothing
    | otherwise = 
        generateStamp' size date resource seed 0
            where generateStamp' s d r se c = let hashString = createHashString s d r se c
                                             in case checkHash hashString size of
                                                True ->  Just hashString
                                                False -> generateStamp' s d r se (c+1)

extractSize :: String -> Maybe Int
extractSize ('1':':':xs) = let idx = elemIndex ':' xs
                        in case idx of
                            Just index -> readMay (take index xs) 
                            _ -> Nothing
extractSize _ = Nothing                            
                                                
generate :: IO()
generate = do 
                putStrLn "Enter resource name:"
                resName <-getLine
                putStrLn "Enter number of bits of preimage:"
                bitsOfPreimage <- getLine
                currentTime <- getCurrentTime
                randomGenerator <- getStdGen
                let seed = take 8 (randomRs ('a', 'z') randomGenerator :: [Char])
                putStrLn $ show $ generateStamp (read bitsOfPreimage :: Int) currentTime resName seed

validate :: IO()
validate = do
                putStrLn "Enter HashCash string:"
                hashCashString <- getLine
                case extractSize hashCashString of
                    Just s -> case checkHash hashCashString s of
                                True -> putStrLn "HashCash string valid"
                                False -> putStrLn "HashCash string not valid"
                    _ -> putStrLn "Could not extract size parameter from input"
                                                
main::IO()
main =  do
            putStrLn "Enter 'v' for Validate or 'g' for Generate:"
            mode <- getLine
            case mode of
                "v" -> validate 
                "g" -> generate
                _ -> putStrLn "Unknown parameter"
            _ <- getLine            
            return ()
        
        
        