{-# LANGUAGE DeriveDataTypeable #-}
module Storage.Hashed.Hash( Hash(..), encodeBase64u, decodeBase64u
                          , encodeBase16, decodeBase16, sha256, rawHash
                          , match ) where

import qualified Bundled.SHA256 as SHA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Lazy as BL

import qualified Codec.Binary.Base64Url as B64U
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
base64u :: BS.ByteString -> BS.ByteString
debase64u :: BS.ByteString -> Maybe BS.ByteString

base16 = BS.pack . map (BSI.c2w . toLower) . B16.encode . BS.unpack
base64u = BS.pack . map BSI.c2w . B64U.encode . BS.unpack
debase64u bs = case B64U.decode $ map BSI.w2c $ BS.unpack bs of
                 Just s -> Just $ BS.pack s
                 Nothing -> Nothing
debase16 bs = case B16.decode $ map (toUpper . BSI.w2c) $ BS.unpack bs of
                Just s -> Just $ BS.pack s
                Nothing -> Nothing

encodeBase64u :: Hash -> BS.ByteString
encodeBase64u (SHA256 bs) = base64u bs
encodeBase64u (SHA1 bs) = base64u bs
encodeBase64u NoHash = BS.empty

-- | 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 base64/url-encoded string and decode it as a "Hash". If the string
-- is malformed, yields NoHash.
decodeBase64u :: BS.ByteString -> Hash
decodeBase64u bs
    | BS.length bs == 44 && isJust (debase64u bs) = SHA256 (fromJust $ debase64u bs)
    | BS.length bs == 28 && isJust (debase64u bs) = SHA1 (fromJust $ debase64u bs)
    | otherwise = NoHash

-- | 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 (SHA.sha256 $ 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