{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MagicHash #-}

-- | Abstract hashing functionality.
module Cardano.Crypto.Hash.Class
  ( HashAlgorithm (..)
  , sizeHash
  , ByteString
  , Hash(UnsafeHash)
  , PackedBytes(PackedBytes8, PackedBytes28, PackedBytes32)

    -- * Core operations
  , hashWith
  , hashWithSerialiser

    -- * Conversions
  , castHash
  , hashToBytes
  , hashFromBytes
  , hashToBytesShort
  , hashFromBytesShort
  , hashFromOffsetBytesShort
  , hashToPackedBytes
  , hashFromPackedBytes

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

    -- * Other operations
  , xor

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

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

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 Data.ByteString.Short (ShortByteString)
import Data.Word (Word8)
import Numeric.Natural (Natural)

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

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

import Control.DeepSeq (NFData)

import NoThunks.Class (NoThunks)

import Cardano.Binary (Encoding, FromCBOR(..), Size, ToCBOR(..), decodeBytes,
                       serializeEncoding')
import Cardano.Crypto.PackedBytes
import Cardano.Prelude (HeapWords (..))

import qualified Data.ByteString.Short.Internal as SBSI

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 = UnsafeHashRep (PackedBytes (SizeHash h))
  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, 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, 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)

pattern UnsafeHash :: forall h a. HashAlgorithm h => ShortByteString -> Hash h a
pattern $bUnsafeHash :: ShortByteString -> Hash h a
$mUnsafeHash :: forall r h a.
HashAlgorithm h =>
Hash h a -> (ShortByteString -> r) -> (Void# -> r) -> r
UnsafeHash bytes <- UnsafeHashRep (unpackBytes -> bytes)
  where
  UnsafeHash ShortByteString
bytes =
    case ShortByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
bytes of
      Maybe (Hash h a)
Nothing ->
        String -> Hash h a
forall a. HasCallStack => String -> a
error String
"UnsafeHash: mismatched size of the supplied ShortByteString and the expected digest"
      Just Hash h a
h -> Hash h a
h
{-# COMPLETE UnsafeHash #-}

--
-- 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 =
    PackedBytes (SizeHash h) -> Hash h a
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep
  (PackedBytes (SizeHash h) -> Hash h a)
-> (a -> PackedBytes (SizeHash h)) -> a -> Hash h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PackedBytes (SizeHash h)
forall (n :: Nat). KnownNat n => ByteString -> PackedBytes n
packPinnedBytes
  (ByteString -> PackedBytes (SizeHash h))
-> (a -> ByteString) -> a -> PackedBytes (SizeHash h)
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 (UnsafeHashRep PackedBytes (SizeHash h)
h) = PackedBytes (SizeHash h) -> Hash h b
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep PackedBytes (SizeHash h)
h


-- | The representation of the hash as bytes.
--
hashToBytes :: Hash h a -> ByteString
hashToBytes :: Hash h a -> ByteString
hashToBytes (UnsafeHashRep PackedBytes (SizeHash h)
h) = PackedBytes (SizeHash h) -> ByteString
forall (n :: Nat). PackedBytes n -> ByteString
unpackPinnedBytes PackedBytes (SizeHash h)
h


-- | Make a hash from it bytes representation.
--
hashFromBytes ::
     forall h a. HashAlgorithm h
  => ByteString
  -- ^ It must have an exact length, as given by 'sizeHash'.
  -> 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 (Hash h a -> Maybe (Hash h a)) -> Hash h a -> Maybe (Hash h a)
forall a b. (a -> b) -> a -> b
$ PackedBytes (SizeHash h) -> Hash h a
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep (ByteString -> PackedBytes (SizeHash h)
forall (n :: Nat). KnownNat n => ByteString -> PackedBytes n
packPinnedBytes ByteString
bytes)

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

-- | Make a hash from it bytes representation, as a 'ShortByteString'.
--
hashFromBytesShort ::
     forall h a. HashAlgorithm h
  => ShortByteString
  -- ^ It must be a buffer of exact length, as given by 'sizeHash'.
  -> Maybe (Hash h a)
hashFromBytesShort :: ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
bytes = PackedBytes (SizeHash h) -> Hash h a
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep (PackedBytes (SizeHash h) -> Hash h a)
-> Maybe (PackedBytes (SizeHash h)) -> Maybe (Hash h a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShortByteString -> Int -> Maybe (PackedBytes (SizeHash h))
forall (n :: Nat).
KnownNat n =>
ShortByteString -> Int -> Maybe (PackedBytes n)
packBytesMaybe ShortByteString
bytes Int
0

-- | Just like `hashFromBytesShort`, but allows using a region of a 'ShortByteString'.
--
hashFromOffsetBytesShort ::
     forall h a. HashAlgorithm h
  => ShortByteString
  -- ^ It must be a buffer that contains at least 'sizeHash' many bytes staring at an offset.
  -> Int
  -- ^ Offset in number of bytes
  -> Maybe (Hash h a)
hashFromOffsetBytesShort :: ShortByteString -> Int -> Maybe (Hash h a)
hashFromOffsetBytesShort ShortByteString
bytes Int
offset = PackedBytes (SizeHash h) -> Hash h a
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep (PackedBytes (SizeHash h) -> Hash h a)
-> Maybe (PackedBytes (SizeHash h)) -> Maybe (Hash h a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShortByteString -> Int -> Maybe (PackedBytes (SizeHash h))
forall (n :: Nat).
KnownNat n =>
ShortByteString -> Int -> Maybe (PackedBytes n)
packBytesMaybe ShortByteString
bytes Int
offset


-- | The representation of the hash as bytes, as a 'ShortByteString'.
--
hashToBytesShort :: Hash h a -> ShortByteString
hashToBytesShort :: Hash h a -> ShortByteString
hashToBytesShort (UnsafeHashRep PackedBytes (SizeHash h)
h) = PackedBytes (SizeHash h) -> ShortByteString
forall (n :: Nat). PackedBytes n -> ShortByteString
unpackBytes PackedBytes (SizeHash h)
h

-- | /O(1)/ - Get the underlying hash representation
--
hashToPackedBytes :: Hash h a -> PackedBytes (SizeHash h)
hashToPackedBytes :: Hash h a -> PackedBytes (SizeHash h)
hashToPackedBytes (UnsafeHashRep PackedBytes (SizeHash h)
pb) = PackedBytes (SizeHash h)
pb

-- | /O(1)/ - Construct hash from the underlying representation
--
hashFromPackedBytes :: PackedBytes (SizeHash h) -> Hash h a
hashFromPackedBytes :: PackedBytes (SizeHash h) -> Hash h a
hashFromPackedBytes = PackedBytes (SizeHash h) -> Hash h a
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep

--
-- 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.decodeLatin1 (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 ByteString
bsHex = do
  Right ByteString
bs <- Either String ByteString -> Maybe (Either String ByteString)
forall a. a -> Maybe a
Just (Either String ByteString -> Maybe (Either String ByteString))
-> Either String ByteString -> Maybe (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Base16.decode ByteString
bsHex
  ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs

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 HashAlgorithm h => ToJSONKey (Hash h a) where
  toJSONKey :: ToJSONKeyFunction (Hash h a)
toJSONKey = (Hash h a -> Text) -> ToJSONKeyFunction (Hash h a)
forall a. (a -> Text) -> ToJSONKeyFunction a
Aeson.toJSONKeyText Hash h a -> Text
forall h a. Hash h a -> Text
hashToTextAsHex

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

instance HashAlgorithm h => ToJSON (Hash h a) where
  toJSON :: Hash h a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Hash h a -> Text) -> Hash h a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> Text
forall h a. Hash h a -> Text
hashToTextAsHex
  toEncoding :: Hash h a -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (Hash h a -> Text) -> Hash h a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> Text
forall h a. Hash h a -> Text
hashToTextAsHex

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

instance HeapWords (Hash h a) where
  heapWords :: Hash h a -> Int
heapWords (UnsafeHashRep (PackedBytes8 Word64
_)) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  heapWords (UnsafeHashRep (PackedBytes28 Word64
_ Word64
_ Word64
_ Word32
_)) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
  heapWords (UnsafeHashRep (PackedBytes32 Word64
_ Word64
_ Word64
_ Word64
_)) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
  heapWords (UnsafeHashRep (PackedBytes# ByteArray#
ba#)) = ShortByteString -> Int
forall a. HeapWords a => a -> Int
heapWords (ByteArray# -> ShortByteString
SBSI.SBS ByteArray#
ba#)

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 (Size -> Proxy t -> Size
forall a b. a -> b -> a
const 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
xor :: Hash h a -> Hash h a -> Hash h a
xor :: Hash h a -> Hash h a -> Hash h a
xor (UnsafeHashRep PackedBytes (SizeHash h)
x) (UnsafeHashRep PackedBytes (SizeHash h)
y) = PackedBytes (SizeHash h) -> Hash h a
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep (PackedBytes (SizeHash h)
-> PackedBytes (SizeHash h) -> PackedBytes (SizeHash h)
forall (n :: Nat). PackedBytes n -> PackedBytes n -> PackedBytes n
xorPackedBytes PackedBytes (SizeHash h)
x PackedBytes (SizeHash h)
y)
{-# INLINE xor #-}