{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.Crypto.Hash.Class
( HashAlgorithm (..)
, sizeHash
, ByteString
, Hash(..)
, hashWith
, hashWithSerialiser
, castHash
, hashToBytes
, hashFromBytes
, hashToBytesShort
, hashFromBytesShort
, hashToBytesAsHex
, hashFromBytesAsHex
, hashToTextAsHex
, hashFromTextAsHex
, hashToStringAsHex
, hashFromStringAsHex
, xor
, hash
, fromHash
, hashRaw
, getHash
, getHashBytesAsHex
)
where
import Control.Monad (join)
import Data.List (foldl')
import Data.Maybe (maybeToList)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import GHC.TypeLits (Nat, KnownNat, natVal)
import Data.Word (Word8)
import qualified Data.Bits as Bits
import Numeric.Natural (Natural)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Short as SBS
import Data.ByteString.Short (ShortByteString)
import Data.String (IsString (..))
import qualified Data.Text.Encoding as Text
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.Aeson as Aeson
import Data.Aeson
(FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))
import qualified Data.Aeson.Types as Aeson
import qualified Data.Aeson.Encoding as Aeson
import Control.DeepSeq (NFData)
import NoThunks.Class (NoThunks)
import Cardano.Binary
(Encoding, FromCBOR (..), ToCBOR (..), Size, decodeBytes,
serializeEncoding')
class (KnownNat (SizeHash h), Typeable h) => HashAlgorithm h where
type SizeHash h :: Nat
hashAlgorithmName :: proxy h -> String
digest :: proxy h -> ByteString -> ByteString
sizeHash :: forall h proxy. HashAlgorithm h => proxy h -> Word
sizeHash :: proxy h -> Word
sizeHash proxy h
_ = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Proxy (SizeHash h) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (SizeHash h)
forall k (t :: k). Proxy t
Proxy @(SizeHash h)))
newtype Hash h a = UnsafeHash ShortByteString
deriving (Hash h a -> Hash h a -> Bool
(Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Bool) -> Eq (Hash h a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall h a. Hash h a -> Hash h a -> Bool
/= :: Hash h a -> Hash h a -> Bool
$c/= :: forall h a. Hash h a -> Hash h a -> Bool
== :: Hash h a -> Hash h a -> Bool
$c== :: forall h a. Hash h a -> Hash h a -> Bool
Eq, Eq (Hash h a)
Eq (Hash h a)
-> (Hash h a -> Hash h a -> Ordering)
-> (Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Bool)
-> (Hash h a -> Hash h a -> Hash h a)
-> (Hash h a -> Hash h a -> Hash h a)
-> Ord (Hash h a)
Hash h a -> Hash h a -> Bool
Hash h a -> Hash h a -> Ordering
Hash h a -> Hash h a -> Hash h a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall h a. Eq (Hash h a)
forall h a. Hash h a -> Hash h a -> Bool
forall h a. Hash h a -> Hash h a -> Ordering
forall h a. Hash h a -> Hash h a -> Hash h a
min :: Hash h a -> Hash h a -> Hash h a
$cmin :: forall h a. Hash h a -> Hash h a -> Hash h a
max :: Hash h a -> Hash h a -> Hash h a
$cmax :: forall h a. Hash h a -> Hash h a -> Hash h a
>= :: Hash h a -> Hash h a -> Bool
$c>= :: forall h a. Hash h a -> Hash h a -> Bool
> :: Hash h a -> Hash h a -> Bool
$c> :: forall h a. Hash h a -> Hash h a -> Bool
<= :: Hash h a -> Hash h a -> Bool
$c<= :: forall h a. Hash h a -> Hash h a -> Bool
< :: Hash h a -> Hash h a -> Bool
$c< :: forall h a. Hash h a -> Hash h a -> Bool
compare :: Hash h a -> Hash h a -> Ordering
$ccompare :: forall h a. Hash h a -> Hash h a -> Ordering
$cp1Ord :: forall h a. Eq (Hash h a)
Ord, (forall x. Hash h a -> Rep (Hash h a) x)
-> (forall x. Rep (Hash h a) x -> Hash h a) -> Generic (Hash h a)
forall x. Rep (Hash h a) x -> Hash h a
forall x. Hash h a -> Rep (Hash h a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h a x. Rep (Hash h a) x -> Hash h a
forall h a x. Hash h a -> Rep (Hash h a) x
$cto :: forall h a x. Rep (Hash h a) x -> Hash h a
$cfrom :: forall h a x. Hash h a -> Rep (Hash h a) x
Generic, Hash h a -> ()
(Hash h a -> ()) -> NFData (Hash h a)
forall a. (a -> ()) -> NFData a
forall h a. Hash h a -> ()
rnf :: Hash h a -> ()
$crnf :: forall h a. Hash h a -> ()
NFData, Context -> Hash h a -> IO (Maybe ThunkInfo)
Proxy (Hash h a) -> String
(Context -> Hash h a -> IO (Maybe ThunkInfo))
-> (Context -> Hash h a -> IO (Maybe ThunkInfo))
-> (Proxy (Hash h a) -> String)
-> NoThunks (Hash h a)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall h a. Context -> Hash h a -> IO (Maybe ThunkInfo)
forall h a. Proxy (Hash h a) -> String
showTypeOf :: Proxy (Hash h a) -> String
$cshowTypeOf :: forall h a. Proxy (Hash h a) -> String
wNoThunks :: Context -> Hash h a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall h a. Context -> Hash h a -> IO (Maybe ThunkInfo)
noThunks :: Context -> Hash h a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall h a. Context -> Hash h a -> IO (Maybe ThunkInfo)
NoThunks)
hashWith :: forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith :: (a -> ByteString) -> a -> Hash h a
hashWith a -> ByteString
serialise =
ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
UnsafeHash
(ShortByteString -> Hash h a)
-> (a -> ShortByteString) -> a -> Hash h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort
(ByteString -> ShortByteString)
-> (a -> ByteString) -> a -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy h -> ByteString -> ByteString
forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
digest (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h)
(ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
serialise
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)
castHash :: Hash h a -> Hash h b
castHash :: Hash h a -> Hash h b
castHash (UnsafeHash ShortByteString
h) = ShortByteString -> Hash h b
forall h a. ShortByteString -> Hash h a
UnsafeHash ShortByteString
h
hashToBytes :: Hash h a -> ByteString
hashToBytes :: Hash h a -> ByteString
hashToBytes (UnsafeHash ShortByteString
h) = ShortByteString -> ByteString
SBS.fromShort ShortByteString
h
hashFromBytes :: forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes :: ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bytes
| ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h))
= Hash h a -> Maybe (Hash h a)
forall a. a -> Maybe a
Just (ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
UnsafeHash (ByteString -> ShortByteString
SBS.toShort ByteString
bytes))
| Bool
otherwise
= Maybe (Hash h a)
forall a. Maybe a
Nothing
hashFromBytesShort :: forall h a. HashAlgorithm h
=> ShortByteString -> Maybe (Hash h a)
hashFromBytesShort :: ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
bytes
| ShortByteString -> Int
SBS.length ShortByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h))
= Hash h a -> Maybe (Hash h a)
forall a. a -> Maybe a
Just (ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
UnsafeHash ShortByteString
bytes)
| Bool
otherwise
= Maybe (Hash h a)
forall a. Maybe a
Nothing
hashToBytesShort :: Hash h a -> ShortByteString
hashToBytesShort :: Hash h a -> ShortByteString
hashToBytesShort (UnsafeHash ShortByteString
h) = ShortByteString
h
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
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
hashToTextAsHex :: Hash h a -> Text
hashToTextAsHex :: Hash h a -> Text
hashToTextAsHex = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (Hash h a -> ByteString) -> Hash h a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex
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
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
hashFromBytesAsHex :: HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytesAsHex :: ByteString -> Maybe (Hash h a)
hashFromBytesAsHex = Maybe (Maybe (Hash h a)) -> Maybe (Hash h a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Hash h a)) -> Maybe (Hash h a))
-> (ByteString -> Maybe (Maybe (Hash h a)))
-> ByteString
-> Maybe (Hash h a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe (Maybe (Hash h a)))
-> (ByteString -> Maybe (Maybe (Hash h a)))
-> Either String ByteString
-> Maybe (Maybe (Hash h a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Maybe (Hash h a)) -> String -> Maybe (Maybe (Hash h a))
forall a b. a -> b -> a
const Maybe (Maybe (Hash h a))
forall a. Maybe a
Nothing) (Maybe (Hash h a) -> Maybe (Maybe (Hash h a))
forall a. a -> Maybe a
Just (Maybe (Hash h a) -> Maybe (Maybe (Hash h a)))
-> (ByteString -> Maybe (Hash h a))
-> ByteString
-> Maybe (Maybe (Hash h a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes) (Either String ByteString -> Maybe (Maybe (Hash h a)))
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe (Maybe (Hash h a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base16.decode
instance Show (Hash h a) where
show :: Hash h a -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (Hash h a -> String) -> Hash h a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> String
forall h a. Hash h a -> String
hashToStringAsHex
instance HashAlgorithm h => Read (Hash h a) where
readsPrec :: Int -> ReadS (Hash h a)
readsPrec Int
p String
str = [ (Hash h a
h, String
y) | (String
x, String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str, Hash h a
h <- Maybe (Hash h a) -> [Hash h a]
forall a. Maybe a -> [a]
maybeToList (String -> Maybe (Hash h a)
forall h a. HashAlgorithm h => String -> Maybe (Hash h a)
hashFromStringAsHex String
x) ]
instance HashAlgorithm h => IsString (Hash h a) where
fromString :: String -> Hash h a
fromString String
str =
case ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytesAsHex (String -> ByteString
BSC.pack String
str) of
Just Hash h a
x -> Hash h a
x
Maybe (Hash h a)
Nothing -> String -> Hash h a
forall a. HasCallStack => String -> a
error (String
"fromString: cannot decode hash " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
str)
instance ToJSONKey (Hash crypto a) where
toJSONKey :: ToJSONKeyFunction (Hash crypto a)
toJSONKey = (Hash crypto a -> Text)
-> (Hash crypto a -> Encoding' Text)
-> ToJSONKeyFunction (Hash crypto a)
forall a.
(a -> Text) -> (a -> Encoding' Text) -> ToJSONKeyFunction a
Aeson.ToJSONKeyText Hash crypto a -> Text
forall h a. Hash h a -> Text
hashToText (Text -> Encoding' Text
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding' Text)
-> (Hash crypto a -> Text) -> Hash crypto a -> Encoding' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash crypto a -> Text
forall h a. Hash h a -> Text
hashToText)
instance HashAlgorithm crypto => FromJSONKey (Hash crypto a) where
fromJSONKey :: FromJSONKeyFunction (Hash crypto a)
fromJSONKey = (Text -> Parser (Hash crypto a))
-> FromJSONKeyFunction (Hash crypto a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser Text -> Parser (Hash crypto a)
forall crypto a.
HashAlgorithm crypto =>
Text -> Parser (Hash crypto a)
parseHash
instance ToJSON (Hash crypto a) where
toJSON :: Hash crypto a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (Hash crypto a -> Text) -> Hash crypto a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash crypto a -> Text
forall h a. Hash h a -> Text
hashToText
instance HashAlgorithm crypto => FromJSON (Hash crypto a) where
parseJSON :: Value -> Parser (Hash crypto a)
parseJSON = String
-> (Text -> Parser (Hash crypto a))
-> Value
-> Parser (Hash crypto a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"hash" Text -> Parser (Hash crypto a)
forall crypto a.
HashAlgorithm crypto =>
Text -> Parser (Hash crypto a)
parseHash
hashToText :: Hash crypto a -> Text
hashToText :: Hash crypto a -> Text
hashToText = ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (Hash crypto a -> ByteString) -> Hash crypto a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash crypto a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytesAsHex
parseHash :: HashAlgorithm crypto => Text -> Aeson.Parser (Hash crypto a)
parseHash :: Text -> Parser (Hash crypto a)
parseHash Text
t =
case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
Text.encodeUtf8 Text
t) of
Right ByteString
bytes -> Parser (Hash crypto a)
-> (Hash crypto a -> Parser (Hash crypto a))
-> Maybe (Hash crypto a)
-> Parser (Hash crypto a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser (Hash crypto a)
forall crypto a. Parser (Hash crypto a)
badSize Hash crypto a -> Parser (Hash crypto a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe (Hash crypto a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bytes)
Left String
_ -> Parser (Hash crypto a)
forall b. Parser b
badHex
where
badHex :: Aeson.Parser b
badHex :: Parser b
badHex = String -> Parser b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Hashes are expected in hex encoding"
badSize :: Aeson.Parser (Hash crypto a)
badSize :: Parser (Hash crypto a)
badSize = String -> Parser (Hash crypto a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Hash is the wrong length"
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
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Hash h a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size Proxy (Hash h a)
proxy =
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy ByteString -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr (\Proxy t
_ -> Size
hashSize) (Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash h a -> ByteString) -> Proxy (Hash h a) -> Proxy ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Hash h a)
proxy)
where
hashSize :: Size
hashSize :: Size
hashSize = Word -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h))
instance (HashAlgorithm h, Typeable a) => FromCBOR (Hash h a) where
fromCBOR :: Decoder s (Hash h a)
fromCBOR = do
ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
case ByteString -> Maybe (Hash h a)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs of
Just Hash h a
x -> Hash h a -> Decoder s (Hash h a)
forall (m :: * -> *) a. Monad m => a -> m a
return Hash h a
x
Maybe (Hash h a)
Nothing -> String -> Decoder s (Hash h a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Hash h a)) -> String -> Decoder s (Hash h a)
forall a b. (a -> b) -> a -> b
$ String
"hash bytes wrong size, expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
expected
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actual
where
expected :: Word
expected = Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h)
actual :: Int
actual = ByteString -> Int
BS.length ByteString
bs
{-# DEPRECATED 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 :: Hash h a -> Hash h a -> Hash h a
xor :: Hash h a -> Hash h a -> Hash h a
xor (UnsafeHash ShortByteString
x) (UnsafeHash ShortByteString
y) =
ShortByteString -> Hash h a
forall h a. ShortByteString -> Hash h a
UnsafeHash
(ShortByteString -> Hash h a)
-> ([Word8] -> ShortByteString) -> [Word8] -> Hash h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort
(ByteString -> ShortByteString)
-> ([Word8] -> ByteString) -> [Word8] -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack
([Word8] -> Hash h a) -> [Word8] -> Hash h a
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
BS.zipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits.xor (ShortByteString -> ByteString
SBS.fromShort ShortByteString
x) (ShortByteString -> ByteString
SBS.fromShort ShortByteString
y)