{-# 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.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 qualified Data.ByteString.Short as SBS
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 (..), Size, 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
_ = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (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
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, 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
Ord, 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
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 -> ()
forall a. (a -> ()) -> NFData a
forall h a. Hash h a -> ()
rnf :: Hash h a -> ()
$crnf :: forall h a. 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 ()
-- <interactive>:5:15: error:
--     • <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 ()
-- <interactive>:6:15: error:
--     • <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 = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @(SizeHash h))
    case String -> Int -> Either String ByteString
decodeHexString String
hexStr Int
n of
      Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"<Hash " forall a. [a] -> [a] -> [a]
++ forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> String
hashAlgorithmName (forall {k} (t :: k). Proxy t
Proxy :: Proxy h) forall a. [a] -> [a] -> [a]
++ String
">: " forall a. [a] -> [a] -> [a]
++ String
err
      Right ByteString
_ -> forall (m :: * -> *) a. Splice m a -> m (TExp a)
examineSplice [||either error (UnsafeHashRep . packPinnedBytes) (decodeHexString hexStr n)||]

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

pattern UnsafeHash :: forall h a. HashAlgorithm h => ShortByteString -> Hash h a
pattern $bUnsafeHash :: forall h a. HashAlgorithm h => ShortByteString -> Hash h a
$mUnsafeHash :: forall {r} {h} {a}.
HashAlgorithm h =>
Hash h a -> (ShortByteString -> r) -> ((# #) -> r) -> r
UnsafeHash bytes <- UnsafeHashRep (unpackBytes -> bytes)
  where
    UnsafeHash ShortByteString
bytes =
      case forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
bytes of
        Maybe (Hash h a)
Nothing ->
          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 :: forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith a -> ByteString
serialise =
  forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). KnownNat n => ByteString -> PackedBytes n
packPinnedBytes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
digest (forall {k} (t :: k). Proxy t
Proxy :: Proxy h)
    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 = forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith (forall a. ToCBOR a => a -> ByteString
serialize' 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) = 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) = 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 forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy h)) =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep (forall (n :: Nat). KnownNat n => ByteString -> PackedBytes n
packPinnedBytes ByteString
bytes)
  | Bool
otherwise =
      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 = forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 =>
  -- | 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 = forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall h a. Hash h a -> ShortByteString
hashToBytesShort (UnsafeHashRep PackedBytes (SizeHash h)
h) = 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall h a. HashAlgorithm h => Text -> Maybe (Hash h a)
hashFromTextAsHex 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytesAsHex 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Base16.decode ByteString
bsHex
  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 = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) <- forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str, Hash h a
h <- forall a. Maybe a -> [a]
maybeToList (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 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 -> forall a. HasCallStack => String -> a
error (String
"fromString: cannot decode hash " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
str)

instance HashAlgorithm h => ToJSONKey (Hash h a) where
  toJSONKey :: ToJSONKeyFunction (Hash h a)
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
Aeson.toJSONKeyText forall h a. Hash h a -> Text
hashToTextAsHex

instance HashAlgorithm h => FromJSONKey (Hash h a) where
  fromJSONKey :: FromJSONKeyFunction (Hash h a)
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser 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 = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. Hash h a -> Text
hashToTextAsHex
  toEncoding :: Hash h a -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. Hash h a -> Text
hashToTextAsHex

instance HashAlgorithm h => FromJSON (Hash h a) where
  parseJSON :: Value -> Parser (Hash h a)
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"hash" 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 forall a. Num a => a -> a -> a
+ Int
1
  heapWords (UnsafeHashRep (PackedBytes28 Word64
_ Word64
_ Word64
_ Word32
_)) = Int
1 forall a. Num a => a -> a -> a
+ Int
4
  heapWords (UnsafeHashRep (PackedBytes32 Word64
_ Word64
_ Word64
_ Word64
_)) = Int
1 forall a. Num a => a -> a -> a
+ Int
4
  heapWords (UnsafeHashRep (PackedBytes# ByteArray#
ba#)) = 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 -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall crypto a. Parser (Hash crypto a)
badSize forall (m :: * -> *) a. Monad m => a -> m a
return (forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bytes)
    Left String
_ -> forall b. Parser b
badHex
  where
    badHex :: Aeson.Parser b
    badHex :: forall b. Parser b
badHex = 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 = 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) = 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 a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr (forall a b. a -> b -> a
const Size
hashSize) (forall h a. Hash h a -> ByteString
hashToBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Hash h a)
proxy)
    where
      hashSize :: Size
      hashSize :: Size
hashSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy h))

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

--
-- 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 = forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
hashWithSerialiser 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Nat -> Word8 -> Nat
f Nat
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. Hash h a -> ByteString
hashToBytes
  where
    f :: Natural -> Word8 -> Natural
    f :: Nat -> Word8 -> Nat
f Nat
n Word8
b = Nat
n forall a. Num a => a -> a -> a
* Nat
256 forall a. Num a => a -> a -> a
+ 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 = 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 = 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 = 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) = forall h a. PackedBytes (SizeHash h) -> Hash h a
UnsafeHashRep (forall (n :: Nat). PackedBytes n -> PackedBytes n -> PackedBytes n
xorPackedBytes PackedBytes (SizeHash h)
x PackedBytes (SizeHash h)
y)
{-# INLINE xor #-}