--  Copyright (C) 2009-2011 Petr Rockai
--
--  BSD3
{-# LANGUAGE DeriveDataTypeable #-}
module Darcs.Util.Hash( Hash(..)
                      , encodeBase16, decodeBase16, sha256, rawHash
                      , match ) where

import qualified Crypto.Hash.SHA256 as SHA256 ( hash )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BS8

import qualified Codec.Binary.Base16 as B16

import Data.Maybe( isJust, fromJust )
import Data.Char( toLower, toUpper )

import Data.Data( Data )
import Data.Typeable( Typeable )

data Hash = SHA256 !BS.ByteString
          | SHA1 !BS.ByteString
          | NoHash
            deriving (Show, Eq, Ord, Read, Typeable, Data)

base16 :: BS.ByteString -> BS.ByteString
debase16 :: BS.ByteString -> Maybe BS.ByteString

base16 = BS8.map toLower . B16.b16Enc
debase16 bs = case B16.b16Dec $ BS8.map toUpper bs of
                Right (s, _) -> Just s
                Left _ -> Nothing

-- | Produce a base16 (ascii-hex) encoded string from a hash. This can be
-- turned back into a Hash (see "decodeBase16". This is a loss-less process.
encodeBase16 :: Hash -> BS.ByteString
encodeBase16 (SHA256 bs) = base16 bs
encodeBase16 (SHA1 bs) = base16 bs
encodeBase16 NoHash = BS.empty

-- | Take a base16-encoded string and decode it as a "Hash". If the string is
-- malformed, yields NoHash.
decodeBase16 :: BS.ByteString -> Hash
decodeBase16 bs | BS.length bs == 64 && isJust (debase16 bs) = SHA256 (fromJust $ debase16 bs)
                | BS.length bs == 40 && isJust (debase16 bs) = SHA1 (fromJust $ debase16 bs)
                | otherwise = NoHash

-- | Compute a sha256 of a (lazy) ByteString. However, although this works
-- correctly for any bytestring, it is only efficient if the bytestring only
-- has a sigle chunk.
sha256 :: BL.ByteString -> Hash
sha256 bits = SHA256 $ SHA256.hash $ BS.concat $ BL.toChunks bits

rawHash :: Hash -> BS.ByteString
rawHash NoHash = error "Cannot obtain raw hash from NoHash."
rawHash (SHA1 s) = s
rawHash (SHA256 s) = s

match :: Hash -> Hash -> Bool
NoHash `match` _ = False
_ `match` NoHash = False
x `match` y = x == y