{-# OPTIONS -fglasgow-exts #-}
module SHA1
    ( SHA1
    , sha1Init
    , sha1Close
    , update
    , toHexString
    , hash
    , hexHash
    , fileDigest
    , fileHexDigest
    , final
    , doSHA1
    )
    where

import Control.Exception (bracket)

import System.IO
import Foreign
import Foreign.C

import Array (listArray, (!))

type SHA1CTX = Ptr ()
newtype SHA1 = SHA1 SHA1CTX


sha1Init :: IO SHA1
sha1Init = fmap SHA1 _SHA1_Init

doSHA1 :: (SHA1 -> IO a) -> IO a
doSHA1 = bracket sha1Init sha1Close 

update :: SHA1 -> String -> IO ()
update (SHA1 ptr) str =
    withCStringLen str $ \(cstr, clen) -> _SHA1_Update ptr cstr clen

toHexString :: [Word8] -> String
toHexString = concatMap showHex2
    where showHex2 c = [ arr ! (c `div` 16), arr ! (c `mod` 16) ]
          arr = listArray (0, 15) "0123456789abcdef"

hash :: String -> IO [Word8]
hash str = allocaBytes 20 $ \buf ->
           withCStringLen str $ \(cstr, clen) ->
               do _SHA1 cstr clen buf
                  fmap (map (toEnum.fromEnum)) $ peekCStringLen (buf, 20)

hexHash :: String -> IO String
hexHash = fmap toHexString . hash

fileDigest :: FilePath -> IO [Word8]
fileDigest fpath = allocaBytes 20 $ \buf ->
                   withCString fpath $ \cstr ->
                   do _SHA1_File cstr buf
                      fmap (map (toEnum.fromEnum)) $ peekCStringLen (buf, 20)

fileHexDigest :: FilePath -> IO String
fileHexDigest = fmap toHexString . fileDigest



final :: SHA1 -> IO [Word8]
final (SHA1 ptr) = allocaBytes 20 $ \cs ->
                   do _SHA1_Final cs ptr
                      ret <- peekCStringLen (cs, 20)
                      return $ map (toEnum.fromEnum) ret

sha1Close :: SHA1 -> IO ()
sha1Close (SHA1 ptr) = free ptr


foreign import ccall "sha1.h SHA1_Init2" _SHA1_Init :: IO SHA1CTX
foreign import ccall "sha1.h SHA1_Update" _SHA1_Update :: SHA1CTX -> CString -> Int -> IO ()
foreign import ccall "sha1.h SHA1_Final" _SHA1_Final :: CString -> SHA1CTX -> IO ()
foreign import ccall "sha1.h SHA1_File" _SHA1_File :: CString -> CString -> IO ()
foreign import ccall "sha1.h SHA1" _SHA1 :: CString -> Int -> CString -> IO ()