{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Abstract hashing functionality.
module Cardano.Crypto.Hash.Class
  ( HashAlgorithm (..)
  , sizeHash
  , ByteString
  , Hash(..)

    -- * Core operations
  , hashWith
  , hashWithSerialiser

    -- * Conversions
  , castHash
  , hashToBytes
  , hashFromBytes
  , hashToBytesShort
  , hashFromBytesShort

    -- * Rendering and parsing
  , hashToBytesAsHex
  , hashFromBytesAsHex
  , hashToTextAsHex
  , hashFromTextAsHex
  , hashToStringAsHex
  , hashFromStringAsHex

    -- * Other operations
  , xor

    -- * Deprecated
  , hash
  , fromHash
  , hashRaw
  , getHash
  , getHashBytesAsHex
  )
where

import Control.Monad (join)
import Data.List (foldl')
import Data.Maybe (maybeToList)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.TypeLits (Nat, KnownNat, natVal)

import           Data.Word (Word8)
import qualified Data.Bits as Bits
import           Numeric.Natural (Natural)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Short as SBS
import           Data.ByteString.Short (ShortByteString)

import           Data.String (IsString (..))
import qualified Data.Text.Encoding as Text
import qualified Data.Text as Text
import           Data.Text (Text)

import qualified Data.Aeson as Aeson
import           Data.Aeson
                   (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))
import qualified Data.Aeson.Types as Aeson
import qualified Data.Aeson.Encoding as Aeson

import           Control.DeepSeq (NFData)

import           NoThunks.Class (NoThunks)

import           Cardano.Binary
                   (Encoding, FromCBOR (..), ToCBOR (..), Size, decodeBytes,
                    serializeEncoding')

class (KnownNat (SizeHash h), Typeable h) => HashAlgorithm h where
      --TODO: eliminate this Typeable constraint needed only for the ToCBOR
      -- the ToCBOR should not need it either
  -- size of hash digest
  type SizeHash h :: Nat

  hashAlgorithmName :: proxy h -> String

  digest :: proxy h -> ByteString -> ByteString

-- | The size in bytes of the output of 'digest'
sizeHash :: forall h proxy. HashAlgorithm h => proxy h -> Word
sizeHash :: proxy h -> Word
sizeHash proxy h
_ = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Proxy (SizeHash h) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (SizeHash h)
forall k (t :: k). Proxy t
Proxy @(SizeHash h)))

newtype Hash h a = UnsafeHash ShortByteString
  deriving (Hash h a -> Hash h a -> Bool
(Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Bool) -> Eq (Hash h a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall h a. Hash h a -> Hash h a -> Bool
/= :: Hash h a -> Hash h a -> Bool
$c/= :: forall h a. Hash h a -> Hash h a -> Bool
== :: Hash h a -> Hash h a -> Bool
$c== :: forall h a. Hash h a -> Hash h a -> Bool
Eq, Eq (Hash h a)
Eq (Hash h a)
-> (Hash h a -> Hash h a -> Ordering)
-> (Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Hash h a)
-> (Hash h a -> Hash h a -> Hash h a)
-> Ord (Hash h a)
Hash h a -> Hash h a -> Bool
Hash h a -> Hash h a -> Ordering
Hash h a -> Hash h a -> Hash h a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall h a. Eq (Hash h a)
forall h a. Hash h a -> Hash h a -> Bool
forall h a. Hash h a -> Hash h a -> Ordering
forall h a. Hash h a -> Hash h a -> Hash h a
min :: Hash h a -> Hash h a -> Hash h a
$cmin :: forall h a. Hash h a -> Hash h a -> Hash h a
max :: Hash h a -> Hash h a -> Hash h a
$cmax :: forall h a. Hash h a -> Hash h a -> Hash h a
>= :: Hash h a -> Hash h a -> Bool
$c>= :: forall h a. Hash h a -> Hash h a -> Bool
> :: Hash h a -> Hash h a -> Bool
$c> :: forall h a. Hash h a -> Hash h a -> Bool
<= :: Hash h a -> Hash h a -> Bool
$c<= :: forall h a. Hash h a -> Hash h a -> Bool
< :: Hash h a -> Hash h a -> Bool
$c< :: forall h a. Hash h a -> Hash h a -> Bool
compare :: Hash h a -> Hash h a -> Ordering
$ccompare :: forall h a. Hash h a -> Hash h a -> Ordering
$cp1Ord :: forall h a. Eq (Hash h a)
Ord, (forall x. Hash h a -> Rep (Hash h a) x)
-> (forall x. Rep (Hash h a) x -> Hash h a) -> Generic (Hash h a)
forall x. Rep (Hash h a) x -> Hash h a
forall x. Hash h a -> Rep (Hash h a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h a x. Rep (Hash h a) x -> Hash h a
forall h a x. Hash h a -> Rep (Hash h a) x
$cto :: forall h a x. Rep (Hash h a) x -> Hash h a
$cfrom :: forall h a x. Hash h a -> Rep (Hash h a) x
Generic, Hash h a -> ()
(Hash h a -> ()) -> NFData (Hash h a)
forall a. (a -> ()) -> NFData a
forall h a. Hash h a -> ()
rnf :: Hash h a -> ()
$crnf :: forall h a. Hash h a -> ()
NFData, Context -> Hash h a -> IO (Maybe ThunkInfo)
Proxy (Hash h a) -> String
(Context -> Hash h a -> IO (Maybe ThunkInfo))
-> (Context -> Hash h a -> IO (Maybe ThunkInfo))
-> (Proxy (Hash h a) -> String)
-> NoThunks (Hash h a)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall h a. Context -> Hash h a -> IO (Maybe ThunkInfo)
forall h a. Proxy (Hash h a) -> String
showTypeOf :: Proxy (Hash h a) -> String
$cshowTypeOf :: forall h a. Proxy (Hash h a) -> String
wNoThunks :: Context -> Hash h a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall h a. Context -> Hash h a -> IO (Maybe ThunkInfo)
noThunks :: Context -> Hash h a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall h a. Context -> Hash h a -> IO (Maybe ThunkInfo)
NoThunks)


--
-- Core operations
--

-- | Hash the given value, using a serialisation function to turn it into bytes.
--
hashWith :: forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith :: (a -> ByteString) -> a -> Hash h a
hashWith a -> ByteString
serialise =
    ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
UnsafeHash
  (ShortByteString -> Hash h a)
-> (a -> ShortByteString) -> a -> Hash h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort
  (ByteString -> ShortByteString)
-> (a -> ByteString) -> a -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy h -> ByteString -> ByteString
forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
digest (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h)
  (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
serialise


-- | A variation on 'hashWith', but specially for CBOR encodings.
--
hashWithSerialiser :: forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
hashWithSerialiser :: (a -> Encoding) -> a -> Hash h a
hashWithSerialiser a -> Encoding
toEnc = (a -> ByteString) -> a -> Hash h a
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith (Encoding -> ByteString
serializeEncoding' (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
toEnc)


--
-- Conversions
--

-- | Cast the type of the hashed data.
--
-- The 'Hash' type has a phantom type parameter to indicate what type the
-- hash is of. It is sometimes necessary to fake this and hash a value of one
-- type and use it where as hash of a different type is expected.
--
castHash :: Hash h a -> Hash h b
castHash :: Hash h a -> Hash h b
castHash (UnsafeHash ShortByteString
h) = ShortByteString -> Hash h b
forall h a. ShortByteString -> Hash h a
UnsafeHash ShortByteString
h


-- | The representation of the hash as bytes.
--
hashToBytes :: Hash h a -> ByteString
hashToBytes :: Hash h a -> ByteString
hashToBytes (UnsafeHash ShortByteString
h) = ShortByteString -> ByteString
SBS.fromShort ShortByteString
h


-- | Make a hash from it bytes representation.
--
-- It must be a a bytestring of the correct length, as given by 'sizeHash'.
--
hashFromBytes :: forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes :: ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bytes
  | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h))
  = Hash h a -> Maybe (Hash h a)
forall a. a -> Maybe a
Just (ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
UnsafeHash (ByteString -> ShortByteString
SBS.toShort ByteString
bytes))

  | Bool
otherwise
  = Maybe (Hash h a)
forall a. Maybe a
Nothing

-- | Make a hash from it bytes representation, as a 'ShortByteString'.
--
-- It must be a a bytestring of the correct length, as given by 'sizeHash'.
--
hashFromBytesShort :: forall h a. HashAlgorithm h
                   => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort :: ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
bytes
  | ShortByteString -> Int
SBS.length ShortByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h))
  = Hash h a -> Maybe (Hash h a)
forall a. a -> Maybe a
Just (ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
UnsafeHash ShortByteString
bytes)

  | Bool
otherwise
  = Maybe (Hash h a)
forall a. Maybe a
Nothing


-- | The representation of the hash as bytes, as a 'ShortByteString'.
--
hashToBytesShort :: Hash h a -> ShortByteString
hashToBytesShort :: Hash h a -> ShortByteString
hashToBytesShort (UnsafeHash ShortByteString
h) = ShortByteString
h


--
-- Rendering and parsing
--

-- | Convert the hash to hex encoding, as 'String'.
hashToStringAsHex :: Hash h a -> String
hashToStringAsHex :: Hash h a -> String
hashToStringAsHex = Text -> String
Text.unpack (Text -> String) -> (Hash h a -> Text) -> Hash h a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> Text
forall h a. Hash h a -> Text
hashToTextAsHex

-- | Make a hash from hex-encoded 'String' representation.
--
-- This can fail for the same reason as 'hashFromBytes', or because the input
-- is invalid hex. The whole byte string must be valid hex, not just a prefix.
--
hashFromStringAsHex :: HashAlgorithm h => String -> Maybe (Hash h a)
hashFromStringAsHex :: String -> Maybe (Hash h a)
hashFromStringAsHex = Text -> Maybe (Hash h a)
forall h a. HashAlgorithm h => Text -> Maybe (Hash h a)
hashFromTextAsHex (Text -> Maybe (Hash h a))
-> (String -> Text) -> String -> Maybe (Hash h a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Convert the hash to hex encoding, as 'Text'.
--
hashToTextAsHex :: Hash h a -> Text
hashToTextAsHex :: Hash h a -> Text
hashToTextAsHex = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (Hash h a -> ByteString) -> Hash h a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex

-- | Make a hash from hex-encoded 'Text' representation.
--
-- This can fail for the same reason as 'hashFromBytes', or because the input
-- is invalid hex. The whole byte string must be valid hex, not just a prefix.
--
hashFromTextAsHex :: HashAlgorithm h => Text -> Maybe (Hash h a)
hashFromTextAsHex :: Text -> Maybe (Hash h a)
hashFromTextAsHex = ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytesAsHex (ByteString -> Maybe (Hash h a))
-> (Text -> ByteString) -> Text -> Maybe (Hash h a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

-- | Convert the hash to hex encoding, as 'ByteString'.
--
hashToBytesAsHex :: Hash h a -> ByteString
hashToBytesAsHex :: Hash h a -> ByteString
hashToBytesAsHex = ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (Hash h a -> ByteString) -> Hash h a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes

-- | Make a hash from hex-encoded 'ByteString' representation.
--
-- This can fail for the same reason as 'hashFromBytes', or because the input
-- is invalid hex. The whole byte string must be valid hex, not just a prefix.
--
hashFromBytesAsHex :: HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytesAsHex :: ByteString -> Maybe (Hash h a)
hashFromBytesAsHex = Maybe (Maybe (Hash h a)) -> Maybe (Hash h a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Hash h a)) -> Maybe (Hash h a))
-> (ByteString -> Maybe (Maybe (Hash h a)))
-> ByteString
-> Maybe (Hash h a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe (Maybe (Hash h a)))
-> (ByteString -> Maybe (Maybe (Hash h a)))
-> Either String ByteString
-> Maybe (Maybe (Hash h a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Maybe (Hash h a)) -> String -> Maybe (Maybe (Hash h a))
forall a b. a -> b -> a
const Maybe (Maybe (Hash h a))
forall a. Maybe a
Nothing) (Maybe (Hash h a) -> Maybe (Maybe (Hash h a))
forall a. a -> Maybe a
Just (Maybe (Hash h a) -> Maybe (Maybe (Hash h a)))
-> (ByteString -> Maybe (Hash h a))
-> ByteString
-> Maybe (Maybe (Hash h a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes) (Either String ByteString -> Maybe (Maybe (Hash h a)))
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe (Maybe (Hash h a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base16.decode

instance Show (Hash h a) where
  show :: Hash h a -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (Hash h a -> String) -> Hash h a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> String
forall h a. Hash h a -> String
hashToStringAsHex

instance HashAlgorithm h => Read (Hash h a) where
  readsPrec :: Int -> ReadS (Hash h a)
readsPrec Int
p String
str = [ (Hash h a
h, String
y) | (String
x, String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str, Hash h a
h <- Maybe (Hash h a) -> [Hash h a]
forall a. Maybe a -> [a]
maybeToList (String -> Maybe (Hash h a)
forall h a. HashAlgorithm h => String -> Maybe (Hash h a)
hashFromStringAsHex String
x) ]

instance HashAlgorithm h => IsString (Hash h a) where
  fromString :: String -> Hash h a
fromString String
str =
    case ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytesAsHex (String -> ByteString
BSC.pack String
str) of
      Just Hash h a
x  -> Hash h a
x
      Maybe (Hash h a)
Nothing -> String -> Hash h a
forall a. HasCallStack => String -> a
error (String
"fromString: cannot decode hash " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str)

instance ToJSONKey (Hash crypto a) where
  toJSONKey :: ToJSONKeyFunction (Hash crypto a)
toJSONKey = (Hash crypto a -> Text)
-> (Hash crypto a -> Encoding' Text)
-> ToJSONKeyFunction (Hash crypto a)
forall a.
(a -> Text) -> (a -> Encoding' Text) -> ToJSONKeyFunction a
Aeson.ToJSONKeyText Hash crypto a -> Text
forall h a. Hash h a -> Text
hashToText (Text -> Encoding' Text
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding' Text)
-> (Hash crypto a -> Text) -> Hash crypto a -> Encoding' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash crypto a -> Text
forall h a. Hash h a -> Text
hashToText)

instance HashAlgorithm crypto => FromJSONKey (Hash crypto a) where
  fromJSONKey :: FromJSONKeyFunction (Hash crypto a)
fromJSONKey = (Text -> Parser (Hash crypto a))
-> FromJSONKeyFunction (Hash crypto a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser Text -> Parser (Hash crypto a)
forall crypto a.
HashAlgorithm crypto =>
Text -> Parser (Hash crypto a)
parseHash

instance ToJSON (Hash crypto a) where
  toJSON :: Hash crypto a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (Hash crypto a -> Text) -> Hash crypto a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash crypto a -> Text
forall h a. Hash h a -> Text
hashToText

instance HashAlgorithm crypto => FromJSON (Hash crypto a) where
  parseJSON :: Value -> Parser (Hash crypto a)
parseJSON = String
-> (Text -> Parser (Hash crypto a))
-> Value
-> Parser (Hash crypto a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"hash" Text -> Parser (Hash crypto a)
forall crypto a.
HashAlgorithm crypto =>
Text -> Parser (Hash crypto a)
parseHash

-- utils used in the instances above
hashToText :: Hash crypto a -> Text
hashToText :: Hash crypto a -> Text
hashToText = ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (Hash crypto a -> ByteString) -> Hash crypto a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash crypto a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex

parseHash :: HashAlgorithm crypto => Text -> Aeson.Parser (Hash crypto a)
parseHash :: Text -> Parser (Hash crypto a)
parseHash Text
t =
    case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
Text.encodeUtf8 Text
t) of
      Right ByteString
bytes -> Parser (Hash crypto a)
-> (Hash crypto a -> Parser (Hash crypto a))
-> Maybe (Hash crypto a)
-> Parser (Hash crypto a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser (Hash crypto a)
forall crypto a. Parser (Hash crypto a)
badSize Hash crypto a -> Parser (Hash crypto a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe (Hash crypto a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bytes)
      Left String
_ -> Parser (Hash crypto a)
forall b. Parser b
badHex
  where
    badHex :: Aeson.Parser b
    badHex :: Parser b
badHex = String -> Parser b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Hashes are expected in hex encoding"

    badSize :: Aeson.Parser (Hash crypto a)
    badSize :: Parser (Hash crypto a)
badSize = String -> Parser (Hash crypto a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Hash is the wrong length"

--
-- CBOR serialisation
--

instance (HashAlgorithm h, Typeable a) => ToCBOR (Hash h a) where
  toCBOR :: Hash h a -> Encoding
toCBOR (UnsafeHash ShortByteString
h) = ShortByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ShortByteString
h

  -- | 'Size' expression for @Hash h a@, which is expressed using the 'ToCBOR'
  -- instance for 'ByteString' (as is the above 'toCBOR' method).  'Size'
  -- computation of length of the bytestring is passed as the first argument to
  -- 'encodedSizeExpr'.  The 'ByteString' instance will use it to calculate
  -- @'size' ('Proxy' @('LengthOf' 'ByteString'))@.
  --
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Hash h a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size Proxy (Hash h a)
proxy =
      (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ByteString -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr (\Proxy t
_ -> Size
hashSize) (Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash h a -> ByteString) -> Proxy (Hash h a) -> Proxy ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Hash h a)
proxy)
    where
      hashSize :: Size
      hashSize :: Size
hashSize = Word -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h))

instance (HashAlgorithm h, Typeable a) => FromCBOR (Hash h a) where
  fromCBOR :: Decoder s (Hash h a)
fromCBOR = do
    ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
    case ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs of
      Just Hash h a
x  -> Hash h a -> Decoder s (Hash h a)
forall (m :: * -> *) a. Monad m => a -> m a
return Hash h a
x
      Maybe (Hash h a)
Nothing -> String -> Decoder s (Hash h a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Hash h a)) -> String -> Decoder s (Hash h a)
forall a b. (a -> b) -> a -> b
$ String
"hash bytes wrong size, expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
expected
                     String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actual
        where
          expected :: Word
expected = Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h)
          actual :: Int
actual   = ByteString -> Int
BS.length ByteString
bs


--
-- Deprecated
--

{-# DEPRECATED hash "Use hashWith or hashWithSerialiser" #-}
hash :: forall h a. (HashAlgorithm h, ToCBOR a) => a -> Hash h a
hash :: a -> Hash h a
hash = (a -> Encoding) -> a -> Hash h a
forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
hashWithSerialiser a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

{-# DEPRECATED fromHash "Use bytesToNatural . hashToBytes" #-}
fromHash :: Hash h a -> Natural
fromHash :: Hash h a -> Natural
fromHash = (Natural -> Word8 -> Natural) -> Natural -> [Word8] -> Natural
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Natural -> Word8 -> Natural
f Natural
0 ([Word8] -> Natural)
-> (Hash h a -> [Word8]) -> Hash h a -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack (ByteString -> [Word8])
-> (Hash h a -> ByteString) -> Hash h a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes
  where
    f :: Natural -> Word8 -> Natural
    f :: Natural -> Word8 -> Natural
f Natural
n Word8
b = Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
256 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b

{-# DEPRECATED hashRaw "Use hashWith" #-}
hashRaw :: forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashRaw :: (a -> ByteString) -> a -> Hash h a
hashRaw = (a -> ByteString) -> a -> Hash h a
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith

{-# DEPRECATED getHash "Use hashToBytes" #-}
getHash :: Hash h a -> ByteString
getHash :: Hash h a -> ByteString
getHash = Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes

{-# DEPRECATED getHashBytesAsHex "Use hashToBytesAsHex" #-}
getHashBytesAsHex :: Hash h a -> ByteString
getHashBytesAsHex :: Hash h a -> ByteString
getHashBytesAsHex = Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex

-- | XOR two hashes together
--TODO: fully deprecate this, or rename it and make it efficient.
xor :: Hash h a -> Hash h a -> Hash h a
xor :: Hash h a -> Hash h a -> Hash h a
xor (UnsafeHash ShortByteString
x) (UnsafeHash ShortByteString
y) =
    ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
UnsafeHash
  (ShortByteString -> Hash h a)
-> ([Word8] -> ShortByteString) -> [Word8] -> Hash h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort
  (ByteString -> ShortByteString)
-> ([Word8] -> ByteString) -> [Word8] -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack
  ([Word8] -> Hash h a) -> [Word8] -> Hash h a
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
BS.zipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits.xor (ShortByteString -> ByteString
SBS.fromShort ShortByteString
x) (ShortByteString -> ByteString
SBS.fromShort ShortByteString
y)