1 {-# LANGUAGE DeriveDataTypeable #-}
    2 module Storage.Hashed.Hash( Hash(..), encodeBase64u, decodeBase64u
    3                           , encodeBase16, decodeBase16, sha256, rawHash
    4                           , match ) where
    5 
    6 import qualified Bundled.SHA256 as SHA
    7 import qualified Data.ByteString as BS
    8 import qualified Data.ByteString.Internal as BSI
    9 import qualified Data.ByteString.Lazy as BL
   10 
   11 import qualified Codec.Binary.Base64Url as B64U
   12 import qualified Codec.Binary.Base16 as B16
   13 
   14 import Data.Maybe( isJust, fromJust )
   15 import Data.Char( toLower, toUpper )
   16 
   17 import Data.Data( Data )
   18 import Data.Typeable( Typeable )
   19 
   20 data Hash = SHA256 !BS.ByteString
   21           | SHA1 !BS.ByteString
   22           | NoHash
   23             deriving (Show, Eq, Ord, Read, Typeable, Data)
   24 
   25 base16 :: BS.ByteString -> BS.ByteString
   26 debase16 :: BS.ByteString -> Maybe BS.ByteString
   27 base64u :: BS.ByteString -> BS.ByteString
   28 debase64u :: BS.ByteString -> Maybe BS.ByteString
   29 
   30 base16 = BS.pack . map (BSI.c2w . toLower) . B16.encode . BS.unpack
   31 base64u = BS.pack . map BSI.c2w . B64U.encode . BS.unpack
   32 debase64u bs = case B64U.decode $ map BSI.w2c $ BS.unpack bs of
   33                  Just s -> Just $ BS.pack s
   34                  Nothing -> Nothing
   35 debase16 bs = case B16.decode $ map (toUpper . BSI.w2c) $ BS.unpack bs of
   36                 Just s -> Just $ BS.pack s
   37                 Nothing -> Nothing
   38 
   39 encodeBase64u :: Hash -> BS.ByteString
   40 encodeBase64u (SHA256 bs) = base64u bs
   41 encodeBase64u (SHA1 bs) = base64u bs
   42 encodeBase64u NoHash = BS.empty
   43 
   44 -- | Produce a base16 (ascii-hex) encoded string from a hash. This can be
   45 -- turned back into a Hash (see "decodeBase16". This is a loss-less process.
   46 encodeBase16 :: Hash -> BS.ByteString
   47 encodeBase16 (SHA256 bs) = base16 bs
   48 encodeBase16 (SHA1 bs) = base16 bs
   49 encodeBase16 NoHash = BS.empty
   50 
   51 -- | Take a base64/url-encoded string and decode it as a "Hash". If the string
   52 -- is malformed, yields NoHash.
   53 decodeBase64u :: BS.ByteString -> Hash
   54 decodeBase64u bs
   55     | BS.length bs == 44 && isJust (debase64u bs) = SHA256 (fromJust $ debase64u bs)
   56     | BS.length bs == 28 && isJust (debase64u bs) = SHA1 (fromJust $ debase64u bs)
   57     | otherwise = NoHash
   58 
   59 -- | Take a base16-encoded string and decode it as a "Hash". If the string is
   60 -- malformed, yields NoHash.
   61 decodeBase16 :: BS.ByteString -> Hash
   62 decodeBase16 bs | BS.length bs == 64 && isJust (debase16 bs) = SHA256 (fromJust $ debase16 bs)
   63                 | BS.length bs == 40 && isJust (debase16 bs) = SHA1 (fromJust $ debase16 bs)
   64                 | otherwise = NoHash
   65 
   66 -- | Compute a sha256 of a (lazy) ByteString. However, although this works
   67 -- correctly for any bytestring, it is only efficient if the bytestring only
   68 -- has a sigle chunk.
   69 sha256 :: BL.ByteString -> Hash
   70 sha256 bits = SHA256 (SHA.sha256 $ BS.concat $ BL.toChunks bits)
   71 
   72 rawHash :: Hash -> BS.ByteString
   73 rawHash NoHash = error "Cannot obtain raw hash from NoHash."
   74 rawHash (SHA1 s) = s
   75 rawHash (SHA256 s) = s
   76 
   77 match :: Hash -> Hash -> Bool
   78 NoHash `match` _ = False
   79 _ `match` NoHash = False
   80 x `match` y = x == y