{-# LANGUAGE PackageImports, OverloadedStrings #-}

module Ssb.Types.Hash where

import Data.ByteString
import qualified Data.ByteString.Lazy as L
import Data.ByteArray (convert)
import qualified Data.ByteString.Base64 as B64
import qualified Data.Text as T
import "cryptonite" Crypto.Hash as Crypto

newtype Hash = Sha256 { sha256 :: Crypto.Digest Crypto.SHA256 }
	deriving (Eq, Ord)

instance Show Hash where
	show = show . formatHash 

-- | Decodes a SHA256 hash, which is base64 encoded.
parseSha256 :: ByteString -> Maybe Hash
parseSha256 b = Sha256 <$> either
	(const Nothing)
	Crypto.digestFromByteString
	(B64.decode b)

-- | Formats a hash as a base64 encoded string.
formatHash :: Hash -> ByteString
formatHash (Sha256 { sha256 = s }) = B64.encode (convert s)

type HashType = T.Text

-- | A value accompanied with the hash of the ByteString that it was
-- deserialized from.
data Hashed v = Hashed
	{ hashedValue :: v
	, hashOf :: Hash
	}
	deriving (Show, Eq, Ord)

instance Functor Hashed where
	fmap f h = h { hashedValue = f (hashedValue h) }

calcHashed :: L.ByteString -> (v -> HashType) -> (L.ByteString -> Maybe v) -> Maybe (Hashed v)
calcHashed b gettype f = do
	v <- f b
	case gettype v of
		"sha256" -> Just $ Hashed v $ Sha256 (hashlazy b)
		_ -> Nothing