{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Hashing capabilities.
module Cardano.Crypto.Hashing (
  -- * 'AbstractHash' type supporting different hash algorithms
  AbstractHash,
  HashAlgorithm,

  -- ** Hashing
  abstractHash,
  unsafeAbstractHash,

  -- ** Conversion
  abstractHashFromDigest,
  abstractHashFromBytes,
  unsafeAbstractHashFromBytes,
  abstractHashToBytes,
  unsafeAbstractHashFromShort,
  abstractHashToShort,

  -- ** Parsing and printing
  decodeAbstractHash,

  -- * Standard 'Hash' type using Blake2b 256
  Hash,

  -- ** Hashing
  hash,
  hashDecoded,
  hashRaw,
  serializeCborHash,

  -- ** Conversion
  hashFromBytes,
  unsafeHashFromBytes,
  hashToBytes,

  -- ** Parsing and printing
  decodeHash,
  hashHexF,
  mediumHashF,
  shortHashF,
) where

import Cardano.Crypto.Raw (Raw (..))
import Cardano.HeapWords
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoded (..),
  DecoderError (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  byronProtVer,
  cborError,
  fromByronCBOR,
  serialize,
  toByronCBOR,
  withWordSize,
 )
import Cardano.Prelude hiding (cborError)
import Crypto.Hash (Blake2b_256, Digest, HashAlgorithm, hashDigestSize)
import qualified Crypto.Hash as Hash
import Data.Aeson (
  FromJSON (..),
  FromJSONKey (..),
  FromJSONKeyFunction (..),
  ToJSON (..),
  ToJSONKey (..),
 )
import Data.Aeson.Types (toJSONKeyText)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteArray.Encoding as ByteArray
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Short as SBS
import Data.String (String)
import qualified Data.Text.Encoding as T
import Formatting (Format, bprint, build, fitLeft, later, sformat, (%.))
import qualified Formatting.Buildable as B (Buildable (..))
import NoThunks.Class (NoThunks (..))
import qualified Prelude

--------------------------------------------------------------------------------
-- AbstractHash
--------------------------------------------------------------------------------

-- | Hash wrapper with phantom type for more type-safety
--
--   Made abstract in order to support different algorithms
type AbstractHash :: Type -> Type -> Type
newtype AbstractHash algo a = AbstractHash SBS.ShortByteString
  deriving (AbstractHash algo a -> AbstractHash algo a -> Bool
(AbstractHash algo a -> AbstractHash algo a -> Bool)
-> (AbstractHash algo a -> AbstractHash algo a -> Bool)
-> Eq (AbstractHash algo a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall algo a. AbstractHash algo a -> AbstractHash algo a -> Bool
$c== :: forall algo a. AbstractHash algo a -> AbstractHash algo a -> Bool
== :: AbstractHash algo a -> AbstractHash algo a -> Bool
$c/= :: forall algo a. AbstractHash algo a -> AbstractHash algo a -> Bool
/= :: AbstractHash algo a -> AbstractHash algo a -> Bool
Eq, Eq (AbstractHash algo a)
Eq (AbstractHash algo a) =>
(AbstractHash algo a -> AbstractHash algo a -> Ordering)
-> (AbstractHash algo a -> AbstractHash algo a -> Bool)
-> (AbstractHash algo a -> AbstractHash algo a -> Bool)
-> (AbstractHash algo a -> AbstractHash algo a -> Bool)
-> (AbstractHash algo a -> AbstractHash algo a -> Bool)
-> (AbstractHash algo a
    -> AbstractHash algo a -> AbstractHash algo a)
-> (AbstractHash algo a
    -> AbstractHash algo a -> AbstractHash algo a)
-> Ord (AbstractHash algo a)
AbstractHash algo a -> AbstractHash algo a -> Bool
AbstractHash algo a -> AbstractHash algo a -> Ordering
AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo 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 algo a. Eq (AbstractHash algo a)
forall algo a. AbstractHash algo a -> AbstractHash algo a -> Bool
forall algo a.
AbstractHash algo a -> AbstractHash algo a -> Ordering
forall algo a.
AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo a
$ccompare :: forall algo a.
AbstractHash algo a -> AbstractHash algo a -> Ordering
compare :: AbstractHash algo a -> AbstractHash algo a -> Ordering
$c< :: forall algo a. AbstractHash algo a -> AbstractHash algo a -> Bool
< :: AbstractHash algo a -> AbstractHash algo a -> Bool
$c<= :: forall algo a. AbstractHash algo a -> AbstractHash algo a -> Bool
<= :: AbstractHash algo a -> AbstractHash algo a -> Bool
$c> :: forall algo a. AbstractHash algo a -> AbstractHash algo a -> Bool
> :: AbstractHash algo a -> AbstractHash algo a -> Bool
$c>= :: forall algo a. AbstractHash algo a -> AbstractHash algo a -> Bool
>= :: AbstractHash algo a -> AbstractHash algo a -> Bool
$cmax :: forall algo a.
AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo a
max :: AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo a
$cmin :: forall algo a.
AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo a
min :: AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo a
Ord, (forall x. AbstractHash algo a -> Rep (AbstractHash algo a) x)
-> (forall x. Rep (AbstractHash algo a) x -> AbstractHash algo a)
-> Generic (AbstractHash algo a)
forall x. Rep (AbstractHash algo a) x -> AbstractHash algo a
forall x. AbstractHash algo a -> Rep (AbstractHash algo a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall algo a x. Rep (AbstractHash algo a) x -> AbstractHash algo a
forall algo a x. AbstractHash algo a -> Rep (AbstractHash algo a) x
$cfrom :: forall algo a x. AbstractHash algo a -> Rep (AbstractHash algo a) x
from :: forall x. AbstractHash algo a -> Rep (AbstractHash algo a) x
$cto :: forall algo a x. Rep (AbstractHash algo a) x -> AbstractHash algo a
to :: forall x. Rep (AbstractHash algo a) x -> AbstractHash algo a
Generic, AbstractHash algo a -> ()
(AbstractHash algo a -> ()) -> NFData (AbstractHash algo a)
forall a. (a -> ()) -> NFData a
forall algo a. AbstractHash algo a -> ()
$crnf :: forall algo a. AbstractHash algo a -> ()
rnf :: AbstractHash algo a -> ()
NFData, Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
Proxy (AbstractHash algo a) -> String
(Context -> AbstractHash algo a -> IO (Maybe ThunkInfo))
-> (Context -> AbstractHash algo a -> IO (Maybe ThunkInfo))
-> (Proxy (AbstractHash algo a) -> String)
-> NoThunks (AbstractHash algo a)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall algo a.
Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
forall algo a. Proxy (AbstractHash algo a) -> String
$cnoThunks :: forall algo a.
Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
noThunks :: Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall algo a.
Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall algo a. Proxy (AbstractHash algo a) -> String
showTypeOf :: Proxy (AbstractHash algo a) -> String
NoThunks)

instance Show (AbstractHash algo a) where
  show :: AbstractHash algo a -> String
show (AbstractHash ShortByteString
h) =
    ByteString -> String
BSC.unpack
      (ByteString -> String)
-> (ShortByteString -> ByteString) -> ShortByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
ByteArray.convertToBase Base
ByteArray.Base16
      (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShortByteString -> ByteString
SBS.fromShort
      (ShortByteString -> String) -> ShortByteString -> String
forall a b. (a -> b) -> a -> b
$ ShortByteString
h

instance HashAlgorithm algo => Read (AbstractHash algo a) where
  readsPrec :: Int -> ReadS (AbstractHash algo a)
readsPrec Int
_ String
s = case ByteString -> Either String ByteString
B16.decode (Text -> ByteString
T.encodeUtf8 (String -> Text
forall a b. ConvertText a b => a -> b
toS String
s)) of
    Left String
_ -> []
    Right ByteString
bs -> case ByteString -> Maybe (AbstractHash algo a)
forall algo a.
HashAlgorithm algo =>
ByteString -> Maybe (AbstractHash algo a)
abstractHashFromBytes ByteString
bs of
      Maybe (AbstractHash algo a)
Nothing -> []
      Just AbstractHash algo a
h -> [(AbstractHash algo a
h, String
"")]

instance B.Buildable (AbstractHash algo a) where
  build :: AbstractHash algo a -> Builder
build = Format Builder (AbstractHash algo a -> Builder)
-> AbstractHash algo a -> Builder
forall a. Format Builder a -> a
bprint Format Builder (AbstractHash algo a -> Builder)
forall r algo a. Format r (AbstractHash algo a -> r)
mediumHashF

instance ToJSON (AbstractHash algo a) where
  toJSON :: AbstractHash algo a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (AbstractHash algo a -> Text) -> AbstractHash algo a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Text (AbstractHash algo a -> Text)
-> AbstractHash algo a -> Text
forall a. Format Text a -> a
sformat Format Text (AbstractHash algo a -> Text)
forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF

instance HashAlgorithm algo => FromJSON (AbstractHash algo a) where
  parseJSON :: Value -> Parser (AbstractHash algo a)
parseJSON = Either String (AbstractHash algo a) -> Parser (AbstractHash algo a)
forall e a. Buildable e => Either e a -> Parser a
toAesonError (Either String (AbstractHash algo a)
 -> Parser (AbstractHash algo a))
-> (String -> Either String (AbstractHash algo a))
-> String
-> Parser (AbstractHash algo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a e.
(Read a, ConvertText String e, ConvertText e String) =>
e -> Either e a
readEither @_ @String (String -> Parser (AbstractHash algo a))
-> (Value -> Parser String)
-> Value
-> Parser (AbstractHash algo a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON

instance
  (HashAlgorithm algo, FromJSON (AbstractHash algo a)) =>
  FromJSONKey (AbstractHash algo a)
  where
  fromJSONKey :: FromJSONKeyFunction (AbstractHash algo a)
fromJSONKey = (Text -> Parser (AbstractHash algo a))
-> FromJSONKeyFunction (AbstractHash algo a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Either Text (AbstractHash algo a) -> Parser (AbstractHash algo a)
forall e a. Buildable e => Either e a -> Parser a
toAesonError (Either Text (AbstractHash algo a) -> Parser (AbstractHash algo a))
-> (Text -> Either Text (AbstractHash algo a))
-> Text
-> Parser (AbstractHash algo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either Text (AbstractHash algo a)
forall algo a.
HashAlgorithm algo =>
Text -> Either Text (AbstractHash algo a)
decodeAbstractHash)

instance ToJSONKey (AbstractHash algo a) where
  toJSONKey :: ToJSONKeyFunction (AbstractHash algo a)
toJSONKey = (AbstractHash algo a -> Text)
-> ToJSONKeyFunction (AbstractHash algo a)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (Format Text (AbstractHash algo a -> Text)
-> AbstractHash algo a -> Text
forall a. Format Text a -> a
sformat Format Text (AbstractHash algo a -> Text)
forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF)

instance (Typeable algo, Typeable a, HashAlgorithm algo) => ToCBOR (AbstractHash algo a) where
  toCBOR :: AbstractHash algo a -> Encoding
toCBOR = AbstractHash algo a -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance (Typeable algo, Typeable a, HashAlgorithm algo) => EncCBOR (AbstractHash algo a) where
  encCBOR :: AbstractHash algo a -> Encoding
encCBOR (AbstractHash ShortByteString
h) = ShortByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ShortByteString
h

  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AbstractHash algo a) -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
_ Proxy (AbstractHash algo a)
_ =
    let realSz :: Int
realSz = algo -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (Text -> algo
forall a. HasCallStack => Text -> a
panic Text
"unused, I hope!" :: algo)
     in Integer -> Size
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Int
forall s a. (Integral s, Integral a) => s -> a
withWordSize Int
realSz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
realSz))

instance (Typeable algo, Typeable a, HashAlgorithm algo) => FromCBOR (AbstractHash algo a) where
  fromCBOR :: forall s. Decoder s (AbstractHash algo a)
fromCBOR = Decoder s (AbstractHash algo a)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance
  (Typeable algo, Typeable a, HashAlgorithm algo) =>
  DecCBOR (AbstractHash algo a)
  where
  decCBOR :: forall s. Decoder s (AbstractHash algo a)
decCBOR = do
    -- FIXME bad decode: it reads an arbitrary-length byte string.
    -- Better instance: know the hash algorithm up front, read exactly that
    -- many bytes, fail otherwise. Then convert to a digest.
    ShortByteString
bs <- forall a s. DecCBOR a => Decoder s a
decCBOR @SBS.ShortByteString
    Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ShortByteString -> Int
SBS.length ShortByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expectedSize)
      (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ DecoderError -> Decoder s ()
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError
      (DecoderError -> Decoder s ()) -> DecoderError -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"AbstractHash" Text
"Bytes not expected length"
    AbstractHash algo a -> Decoder s (AbstractHash algo a)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString -> AbstractHash algo a
forall algo a. ShortByteString -> AbstractHash algo a
AbstractHash ShortByteString
bs)
    where
      expectedSize :: Int
expectedSize = algo -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (algo
forall a. HasCallStack => a
Prelude.undefined :: algo)

instance HeapWords (AbstractHash algo a) where
  heapWords :: AbstractHash algo a -> Int
heapWords AbstractHash algo a
_ =
    -- We have
    --
    -- > newtype AbstractHash algo a = AbstractHash ShortByteString
    -- > data ShortByteString = SBS ByteArray#
    --
    -- so @AbstractHash algo a@ requires:
    --
    -- - 1 word for the 'ShortByteString' object header
    -- - 1 word for the pointer to the byte array object
    -- - 1 word for the byte array object header
    -- - 1 word for the size of the byte array payload in bytes
    -- - 4 words (on a 64-bit arch) for the byte array payload containing the digest
    --
    -- +---------+
    -- │ SBS │ * │
    -- +-------+-+
    --         |
    --         v
    --         +--------------+
    --         │BA#│sz│payload│
    --         +--------------+
    --
    Int
8

-- | Parses given hash in base16 form.
decodeAbstractHash ::
  HashAlgorithm algo => Text -> Either Text (AbstractHash algo a)
decodeAbstractHash :: forall algo a.
HashAlgorithm algo =>
Text -> Either Text (AbstractHash algo a)
decodeAbstractHash Text
prettyHash = do
  ByteString
bytes <- (String -> Text)
-> Either String ByteString -> Either Text ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Format Text (String -> Text) -> String -> Text
forall a. Format Text a -> a
sformat Format Text (String -> Text)
forall a r. Buildable a => Format r (a -> r)
build) (Either String ByteString -> Either Text ByteString)
-> Either String ByteString -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
B16.decode (Text -> ByteString
T.encodeUtf8 Text
prettyHash)
  case ByteString -> Maybe (AbstractHash algo a)
forall algo a.
HashAlgorithm algo =>
ByteString -> Maybe (AbstractHash algo a)
abstractHashFromBytes ByteString
bytes of
    Maybe (AbstractHash algo a)
Nothing ->
      Text -> Either Text (AbstractHash algo a)
forall a b. a -> Either a b
Left
        ( Text
"decodeAbstractHash: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"can't convert bytes to hash,"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" the value was "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. ConvertText a b => a -> b
toS Text
prettyHash
        )
    Just AbstractHash algo a
h -> AbstractHash algo a -> Either Text (AbstractHash algo a)
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return AbstractHash algo a
h

-- | Hash the 'EncCBOR'-serialised version of a value
-- Once this is no longer used outside this module it should be made private.
abstractHash :: (HashAlgorithm algo, EncCBOR a) => a -> AbstractHash algo a
abstractHash :: forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash = LByteString -> AbstractHash algo a
forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash (LByteString -> AbstractHash algo a)
-> (a -> LByteString) -> a -> AbstractHash algo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Version -> a -> LByteString
forall a. EncCBOR a => Version -> a -> LByteString
serialize Version
byronProtVer

-- | Hash a lazy 'LByteString'
--
-- You can choose the phantom type, hence the \"unsafe\".
unsafeAbstractHash :: HashAlgorithm algo => LByteString -> AbstractHash algo a
unsafeAbstractHash :: forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash = Digest algo -> AbstractHash algo a
forall algo a. Digest algo -> AbstractHash algo a
abstractHashFromDigest (Digest algo -> AbstractHash algo a)
-> (LByteString -> Digest algo)
-> LByteString
-> AbstractHash algo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LByteString -> Digest algo
forall a. HashAlgorithm a => LByteString -> Digest a
Hash.hashlazy

-- | Make an 'AbstractHash' from a 'Digest' for the same 'HashAlgorithm'.
abstractHashFromDigest :: Digest algo -> AbstractHash algo a
abstractHashFromDigest :: forall algo a. Digest algo -> AbstractHash algo a
abstractHashFromDigest = ShortByteString -> AbstractHash algo a
forall algo a. ShortByteString -> AbstractHash algo a
AbstractHash (ShortByteString -> AbstractHash algo a)
-> (Digest algo -> ShortByteString)
-> Digest algo
-> AbstractHash algo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Digest algo -> ByteString) -> Digest algo -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Digest algo -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert

-- | Make an 'AbstractHash' from the bytes representation of the hash. It will
-- fail if given the wrong number of bytes for the choice of 'HashAlgorithm'.
abstractHashFromBytes ::
  forall algo a.
  HashAlgorithm algo =>
  ByteString ->
  Maybe (AbstractHash algo a)
abstractHashFromBytes :: forall algo a.
HashAlgorithm algo =>
ByteString -> Maybe (AbstractHash algo a)
abstractHashFromBytes ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedSize = AbstractHash algo a -> Maybe (AbstractHash algo a)
forall a. a -> Maybe a
Just (ByteString -> AbstractHash algo a
forall algo a. ByteString -> AbstractHash algo a
unsafeAbstractHashFromBytes ByteString
bs)
  | Bool
otherwise = Maybe (AbstractHash algo a)
forall a. Maybe a
Nothing
  where
    expectedSize :: Int
expectedSize = algo -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (algo
forall a. HasCallStack => a
Prelude.undefined :: algo)

-- | Like 'abstractHashFromDigestBytes' but the number of bytes provided
-- /must/ be correct for the choice of 'HashAlgorithm'.
unsafeAbstractHashFromBytes :: ByteString -> AbstractHash algo a
unsafeAbstractHashFromBytes :: forall algo a. ByteString -> AbstractHash algo a
unsafeAbstractHashFromBytes = ShortByteString -> AbstractHash algo a
forall algo a. ShortByteString -> AbstractHash algo a
AbstractHash (ShortByteString -> AbstractHash algo a)
-> (ByteString -> ShortByteString)
-> ByteString
-> AbstractHash algo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ShortByteString
SBS.toShort

-- | The bytes representation of the hash value.
abstractHashToBytes :: AbstractHash algo a -> ByteString
abstractHashToBytes :: forall algo a. AbstractHash algo a -> ByteString
abstractHashToBytes (AbstractHash ShortByteString
h) = ShortByteString -> ByteString
SBS.fromShort ShortByteString
h

-- | The 'SBS.ShortByteString' representation of the hash value.
unsafeAbstractHashFromShort :: SBS.ShortByteString -> AbstractHash algo a
unsafeAbstractHashFromShort :: forall algo a. ShortByteString -> AbstractHash algo a
unsafeAbstractHashFromShort = ShortByteString -> AbstractHash algo a
forall algo a. ShortByteString -> AbstractHash algo a
AbstractHash

-- | The 'SBS.ShortByteString' representation of the hash value.
abstractHashToShort :: AbstractHash algo a -> SBS.ShortByteString
abstractHashToShort :: forall algo a. AbstractHash algo a -> ShortByteString
abstractHashToShort (AbstractHash ShortByteString
h) = ShortByteString
h

--------------------------------------------------------------------------------
-- Hash
--------------------------------------------------------------------------------

-- | The type of our commonly used hash, Blake2b 256
type Hash :: Type -> Type
type Hash = AbstractHash Blake2b_256

{-# DEPRECATED hash "Use serializeCborHash or hash the annotation instead." #-}

-- | The hash of a value, serialised via 'EncCBOR'.
hash :: EncCBOR a => a -> Hash a
hash :: forall a. EncCBOR a => a -> Hash a
hash = a -> AbstractHash Blake2b_256 a
forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash

-- | The hash of a value, serialised via 'EncCBOR'.
serializeCborHash :: EncCBOR a => a -> Hash a
serializeCborHash :: forall a. EncCBOR a => a -> Hash a
serializeCborHash = a -> AbstractHash Blake2b_256 a
forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash

-- | The hash of a value's annotation
hashDecoded :: Decoded t => t -> Hash (BaseType t)
hashDecoded :: forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded = LByteString -> AbstractHash Blake2b_256 (BaseType t)
forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash (LByteString -> AbstractHash Blake2b_256 (BaseType t))
-> (t -> LByteString) -> t -> AbstractHash Blake2b_256 (BaseType t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> LByteString
LBS.fromStrict (ByteString -> LByteString)
-> (t -> ByteString) -> t -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> ByteString
forall t. Decoded t => t -> ByteString
recoverBytes

-- | Hash a bytestring
hashRaw :: LBS.ByteString -> Hash Raw
hashRaw :: LByteString -> Hash Raw
hashRaw = LByteString -> Hash Raw
forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash

-- | Make a hash from it bytes representation. It must be a 32-byte bytestring.
-- The size is checked.
hashFromBytes :: ByteString -> Maybe (Hash a)
hashFromBytes :: forall a. ByteString -> Maybe (Hash a)
hashFromBytes = ByteString -> Maybe (AbstractHash Blake2b_256 a)
forall algo a.
HashAlgorithm algo =>
ByteString -> Maybe (AbstractHash algo a)
abstractHashFromBytes

-- | Make a hash from a 32-byte bytestring. It must be exactly 32 bytes.
unsafeHashFromBytes :: ByteString -> Hash a
unsafeHashFromBytes :: forall a. ByteString -> Hash a
unsafeHashFromBytes = ByteString -> AbstractHash Blake2b_256 a
forall algo a. ByteString -> AbstractHash algo a
unsafeAbstractHashFromBytes

-- | The bytes representation of the hash value.
hashToBytes :: AbstractHash algo a -> ByteString
hashToBytes :: forall algo a. AbstractHash algo a -> ByteString
hashToBytes = AbstractHash algo a -> ByteString
forall algo a. AbstractHash algo a -> ByteString
abstractHashToBytes

-- | Parses given hash in base16 form.
decodeHash :: Text -> Either Text (Hash a)
decodeHash :: forall a. Text -> Either Text (Hash a)
decodeHash = forall algo a.
HashAlgorithm algo =>
Text -> Either Text (AbstractHash algo a)
decodeAbstractHash @Blake2b_256

-- | Specialized formatter for 'Hash'.
hashHexF :: Format r (AbstractHash algo a -> r)
hashHexF :: forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF = (AbstractHash algo a -> Builder)
-> Format r (AbstractHash algo a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((AbstractHash algo a -> Builder)
 -> Format r (AbstractHash algo a -> r))
-> (AbstractHash algo a -> Builder)
-> Format r (AbstractHash algo a -> r)
forall a b. (a -> b) -> a -> b
$ \AbstractHash algo a
h -> Text -> Builder
forall p. Buildable p => p -> Builder
B.build (AbstractHash algo a -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show AbstractHash algo a
h :: Text)

-- | Smart formatter for 'Hash' to show only first @16@ characters of 'Hash'.
mediumHashF :: Format r (AbstractHash algo a -> r)
mediumHashF :: forall r algo a. Format r (AbstractHash algo a -> r)
mediumHashF = Int -> Format r (Builder -> r)
forall a r. Buildable a => Int -> Format r (a -> r)
fitLeft Int
16 Format r (Builder -> r)
-> Format r (AbstractHash algo a -> r)
-> Format r (AbstractHash algo a -> r)
forall r r' a.
Format r (Builder -> r') -> Format r' a -> Format r a
%. Format r (AbstractHash algo a -> r)
forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF

-- | Smart formatter for 'Hash' to show only first @8@ characters of 'Hash'.
shortHashF :: Format r (AbstractHash algo a -> r)
shortHashF :: forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF = Int -> Format r (Builder -> r)
forall a r. Buildable a => Int -> Format r (a -> r)
fitLeft Int
8 Format r (Builder -> r)
-> Format r (AbstractHash algo a -> r)
-> Format r (AbstractHash algo a -> r)
forall r r' a.
Format r (Builder -> r') -> Format r' a -> Format r a
%. Format r (AbstractHash algo a -> r)
forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF