----------------------------------------------------------------------
-- Hashing operators
-- Copyright 2007, David Brown
--
-- This program is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by the
-- Free Software Foundation; either version 2, or (at your option) any later
-- version.
--
-- This program is distributed in the hope that it will be useful, but
-- WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
-- Public License for more details.
--
-- You should have received a copy of the GNU General Public License along
-- with this program; if not, write to the Free Software Foundation, Inc.,
-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
--
----------------------------------------------------------------------
--
-- Please ask <hackage@davidb.org> if you are interested in another
-- license.  If pieces of this program are useful in other systems I
-- will be willing to release them under a freer license, but I want
-- the program as a whole to be covered under the GPL.
--
----------------------------------------------------------------------

module Hash (
   hashOf, hashOfL, hashOfList
)where

import Control.Monad (forM_)
import Foreign
import Foreign.C
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L

-- Binding to OpenSSL SHA1 library, which is significantly faster than
-- most other implementations.
#include <openssl/sha.h>

{-
main = do
   let message = B.pack $ map (toEnum . fromEnum) $ replicate 1 'a'
   putStrLn $ "size is " ++ show (#size SHA_CTX)
   hashOf message
-}

-- Compute the hash of an array of ByteStrings.
hashOfList :: [B.ByteString] -> IO B.ByteString
hashOfList bstrs = do
   let hash = B.pack $ replicate (#const SHA_DIGEST_LENGTH) 0
   allocaBytes (#size SHA_CTX) $ \ctx -> do
   c_sha1Init ctx
   forM_ bstrs $ \bstr -> do
      B.useAsCStringLen bstr $ \(bdata, blen) -> do
      c_sha1Update ctx bdata blen
   -- Not sure if it is safe to modify like this, but we are in the IO
   -- Monad, so I think so.
   B.useAsCStringLen hash $ \(hdata, _) -> do
   c_sha1Final hdata ctx
   return hash

hashOf :: B.ByteString -> IO B.ByteString
hashOf str = hashOfList [str]

hashOfL :: L.ByteString -> IO B.ByteString
hashOfL str = hashOfList $ L.toChunks str

{-
hashOf bstr = do
   let hash = B.pack $ replicate (#const SHA_DIGEST_LENGTH) 0
   putStrLn $ "hash size = " ++ show (B.length hash)
   putStrLn $ "hash size = " ++ show (#const SHA_DIGEST_LENGTH)
   allocaBytes (#size SHA_CTX) $ \ctx -> do
   c_sha1Init ctx
   let ctxString = B.packCStringLen (ctx, (#size SHA_CTX))
   B.useAsCStringLen bstr $ \(bdata, blen) -> do
   c_sha1Update ctx bdata blen
   B.useAsCStringLen hash $ \(hdata, _) -> do
   c_sha1Final hdata ctx
   putStrLn $ show hash
-}

type Ctx = CString
foreign import ccall unsafe "openssl/sha.h SHA1_Init"
   c_sha1Init :: Ctx -> IO ()
foreign import ccall unsafe "openssl/sha.h SHA1_Update"
   c_sha1Update :: Ctx -> CString -> Int -> IO ()
foreign import ccall unsafe "openssl/sha.h SHA1_Final"
   c_sha1Final :: CString -> Ctx -> IO ()