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

-- | 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 qualified Data.Foldable as F (foldl')
import Data.Maybe (maybeToList)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import GHC.TypeLits (KnownNat, Nat, natVal)

import Control.Monad.Trans.Fail.String (errorFail)
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.MemPack (FailT (FailT), MemPack, StateT (StateT), Unpack (Unpack))
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 Language.Haskell.TH.Syntax (Q, TExp (..))
import Language.Haskell.TH.Syntax.Compat (Code (Code), examineSplice)

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 (..), ToCBOR (..), serialize')
import Cardano.Crypto.PackedBytes
import Cardano.Crypto.Util (decodeHexString)
import Cardano.HeapWords (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 :: forall h (proxy :: * -> *). HashAlgorithm h => 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 (forall (t :: Nat). Proxy t
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
$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
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
$ccompare :: forall h a. Hash h a -> Hash h a -> Ordering
compare :: Hash h a -> Hash h a -> Ordering
$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
>= :: Hash h a -> Hash h a -> Bool
$cmax :: forall h a. Hash h a -> Hash h a -> Hash h a
max :: Hash h a -> Hash h a -> Hash h a
$cmin :: forall h a. Hash h a -> Hash h a -> Hash h a
min :: Hash h a -> Hash h a -> 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
$cfrom :: forall h a x. Hash h a -> Rep (Hash h a) x
from :: forall x. Hash h a -> Rep (Hash h a) x
$cto :: forall h a x. Rep (Hash h a) x -> Hash h a
to :: forall x. Rep (Hash h a) x -> Hash h a
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
$cnoThunks :: forall h a. Context -> Hash h a -> IO (Maybe ThunkInfo)
noThunks :: Context -> Hash h a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall h a. Context -> Hash h a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Hash h a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall h a. Proxy (Hash h a) -> String
showTypeOf :: Proxy (Hash h a) -> String
NoThunks, Hash h a -> ()
(Hash h a -> ()) -> NFData (Hash h a)
forall a. (a -> ()) -> NFData a
forall h a. Hash h a -> ()
$crnf :: forall h a. Hash h a -> ()
rnf :: Hash h a -> ()
NFData)

deriving instance HashAlgorithm h => MemPack (Hash h a)

-- | This instance is meant to be used with @TemplateHaskell@
--
-- >>> import Cardano.Crypto.Hash.Class (Hash)
-- >>> import Cardano.Crypto.Hash.Short (ShortHash)
-- >>> :set -XTemplateHaskell
-- >>> :set -XOverloadedStrings
-- >>>  let hash = $$("0xBADC0FFEE0DDF00D") :: Hash ShortHash ()
-- >>> print hash
-- "badc0ffee0ddf00d"
-- >>> let hash = $$("0123456789abcdef") :: Hash ShortHash ()
-- >>> print hash
-- "0123456789abcdef"
-- >>> let hash = $$("deadbeef") :: Hash ShortHash ()
-- ...
--     • <Hash blake2b_prefix_8>: Expected in decoded form to be: 8 bytes, but got: 4
--     • In the Template Haskell splice $$("deadbeef")
--       In the expression: $$("deadbeef") :: Hash ShortHash ()
--       In an equation for ‘hash’:
--           hash = $$("deadbeef") :: Hash ShortHash ()
-- ...
-- >>> let hash = $$("123") :: Hash ShortHash ()
-- ...
--     • <Hash blake2b_prefix_8>: Malformed hex: invalid bytestring size
--     • In the Template Haskell splice $$("123")
--       In the expression: $$("123") :: Hash ShortHash ()
--       In an equation for ‘hash’: hash = $$("123") :: Hash ShortHash ()
-- ...
instance HashAlgorithm h => IsString (Q (TExp (Hash h a))) where
  fromString :: String -> Q (TExp (Hash h a))
fromString String
hexStr = do
    let n :: Int
n = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (SizeHash h) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SizeHash h))
    case String -> Int -> Either String ByteString
decodeHexString String
hexStr Int
n of
      Left String
err -> String -> Q (TExp (Hash h a))
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q (TExp (Hash h a))) -> String -> Q (TExp (Hash h a))
forall a b. (a -> b) -> a -> b
$ String
"<Hash " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proxy h -> String
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> String
forall (proxy :: * -> *). proxy h -> String
hashAlgorithmName (Proxy h
forall {k} (t :: k). Proxy t
Proxy :: Proxy h) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
      Right ByteString
_ -> Splice Q (Hash h a) -> Q (TExp (Hash h a))
forall (m :: * -> *) a. Splice m a -> m (TExp a)
examineSplice [||(a -> c) -> (b -> c) -> Either a b -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> a
forall a. HasCallStack => String -> a
error (b -> Hash h a
PackedBytes (SizeHash h) -> Hash h a
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PackedBytes n
forall (n :: Nat). KnownNat n => ByteString -> PackedBytes n
packPinnedBytes) (String -> Int -> Either String ByteString
decodeHexString String
hexStr a
n)||]

instance HashAlgorithm h => IsString (Code Q (Hash h a)) where
  fromString :: String -> Code Q (Hash h a)
fromString = Q (TExp (Hash h a)) -> Code Q (Hash h a)
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code (Q (TExp (Hash h a)) -> Code Q (Hash h a))
-> (String -> Q (TExp (Hash h a))) -> String -> Code Q (Hash h a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Q (TExp (Hash h a))
forall a. IsString a => String -> a
fromString

pattern UnsafeHash :: forall h a. (HashAlgorithm h, HasCallStack) => ShortByteString -> Hash h a
pattern $mUnsafeHash :: forall {r} {h} {a}.
(HashAlgorithm h, HasCallStack) =>
Hash h a -> (ShortByteString -> r) -> ((# #) -> r) -> r
$bUnsafeHash :: forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
UnsafeHash bytes <- UnsafeHashRep (unpackBytes -> bytes)
  where
    UnsafeHash = PackedBytes (SizeHash h) -> Hash h a
forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep (PackedBytes (SizeHash h) -> Hash h a)
-> (ShortByteString -> PackedBytes (SizeHash h))
-> ShortByteString
-> Hash h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fail (PackedBytes (SizeHash h)) -> PackedBytes (SizeHash h)
forall a. HasCallStack => Fail a -> a
errorFail (Fail (PackedBytes (SizeHash h)) -> PackedBytes (SizeHash h))
-> (ShortByteString -> Fail (PackedBytes (SizeHash h)))
-> ShortByteString
-> PackedBytes (SizeHash h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Fail (PackedBytes (SizeHash h))
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
ShortByteString -> m (PackedBytes n)
packShortByteString
{-# 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 :: forall h a. HashAlgorithm h => (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
forall (proxy :: * -> *). 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 :: forall h a. HashAlgorithm h => (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
forall a. ToCBOR a => a -> ByteString
serialize' (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 :: forall h a b. 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 :: forall h a. 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 =>
  -- | It must have an exact length, as given by 'sizeHash'.
  ByteString ->
  Maybe (Hash h a)
hashFromBytes :: forall h a. HashAlgorithm h => 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 =>
  -- | It must be a buffer of exact length, as given by 'sizeHash'.
  ShortByteString ->
  Maybe (Hash h a)
hashFromBytesShort :: forall h a. HashAlgorithm h => 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 -> Maybe (PackedBytes (SizeHash h))
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadFail m) =>
ShortByteString -> m (PackedBytes n)
packShortByteString ShortByteString
bytes

-- | Just like `hashFromBytesShort`, but allows using a region in a middle of a
-- 'ShortByteString'. Will return `Nothing` if there is not enough data or offset is negative.
hashFromOffsetBytesShort ::
  forall h a.
  HashAlgorithm h =>
  -- | It must be a buffer that contains at least 'sizeHash' many bytes staring at an offset.
  ShortByteString ->
  -- | Offset in number of bytes
  Int ->
  Maybe (Hash h a)
hashFromOffsetBytesShort :: forall h a.
HashAlgorithm h =>
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) (m :: * -> *).
(KnownNat n, MonadFail m) =>
ShortByteString -> Int -> m (PackedBytes n)
packShortByteStringWithOffset ShortByteString
bytes Int
offset

-- | The representation of the hash as bytes, as a 'ShortByteString'.
hashToBytesShort :: Hash h a -> ShortByteString
hashToBytesShort :: forall h a. 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 :: forall h a. 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 :: forall h a. 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 :: forall h a. 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 :: forall h a. HashAlgorithm h => 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 :: forall h a. 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 :: forall h a. HashAlgorithm h => 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 :: forall h a. 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 :: forall h a. HashAlgorithm h => 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 = String -> String
forall a. Show a => a -> String
show (String -> String) -> (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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
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 :: forall crypto a.
HashAlgorithm crypto =>
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 a. a -> Parser 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 :: forall b. Parser b
badHex = String -> Parser b
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Hashes are expected in hex encoding"

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

--
-- CBOR serialisation
--

deriving instance (HashAlgorithm h, Typeable a) => ToCBOR (Hash h a)

deriving instance (HashAlgorithm h, Typeable a) => FromCBOR (Hash h a)

--
-- Deprecated
--

{-# DEPRECATED hash "Use hashWith or hashWithSerialiser" #-}
hash :: forall h a. (HashAlgorithm h, ToCBOR a) => a -> Hash h a
hash :: forall h a. (HashAlgorithm h, ToCBOR a) => 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 :: forall h a. Hash h a -> Nat
fromHash = (Nat -> Word8 -> Nat) -> Nat -> [Word8] -> Nat
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Nat -> Word8 -> Nat
f Nat
0 ([Word8] -> Nat) -> (Hash h a -> [Word8]) -> Hash h a -> Nat
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 :: Nat -> Word8 -> Nat
f Nat
n Word8
b = Nat
n Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* Nat
256 Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Word8 -> Nat
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 :: forall h a. HashAlgorithm h => (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 :: forall h a. 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 :: forall h a. 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 :: forall h a. 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 #-}