{-# 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 #-}
module Cardano.Crypto.Hashing (
AbstractHash,
HashAlgorithm,
abstractHash,
unsafeAbstractHash,
abstractHashFromDigest,
abstractHashFromBytes,
unsafeAbstractHashFromBytes,
abstractHashToBytes,
unsafeAbstractHashFromShort,
abstractHashToShort,
decodeAbstractHash,
Hash,
hash,
hashDecoded,
hashRaw,
serializeCborHash,
hashFromBytes,
unsafeHashFromBytes,
hashToBytes,
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
type AbstractHash :: Type -> Type -> Type
newtype AbstractHash algo a = AbstractHash SBS.ShortByteString
deriving (AbstractHash algo a -> AbstractHash algo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
Eq, 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
min :: AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo a
$cmin :: forall algo a.
AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo a
max :: AbstractHash algo a -> AbstractHash algo a -> AbstractHash algo a
$cmax :: forall algo a.
AbstractHash algo a -> AbstractHash algo a -> AbstractHash 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
$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
compare :: AbstractHash algo a -> AbstractHash algo a -> Ordering
$ccompare :: forall algo a.
AbstractHash algo a -> AbstractHash algo a -> Ordering
Ord, 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
$cto :: forall algo a x. Rep (AbstractHash algo a) x -> AbstractHash algo a
$cfrom :: forall algo a x. AbstractHash algo a -> Rep (AbstractHash algo a) x
Generic, AbstractHash algo a -> ()
forall a. (a -> ()) -> NFData a
forall algo a. AbstractHash algo a -> ()
rnf :: AbstractHash algo a -> ()
$crnf :: forall algo a. AbstractHash algo a -> ()
NFData, Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
Proxy (AbstractHash algo a) -> String
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
showTypeOf :: Proxy (AbstractHash algo a) -> String
$cshowTypeOf :: forall algo a. Proxy (AbstractHash algo a) -> String
wNoThunks :: Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall algo a.
Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
noThunks :: Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall algo a.
Context -> AbstractHash algo a -> IO (Maybe ThunkInfo)
NoThunks)
instance Show (AbstractHash algo a) where
show :: AbstractHash algo a -> String
show (AbstractHash ShortByteString
h) =
ByteString -> String
BSC.unpack
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
ByteArray.convertToBase Base
ByteArray.Base16
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
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 (forall a b. ConvertText a b => a -> b
toS String
s)) of
Left String
_ -> []
Right ByteString
bs -> case 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 = forall a. Format Builder a -> a
bprint forall r algo a. Format r (AbstractHash algo a -> r)
mediumHashF
instance ToJSON (AbstractHash algo a) where
toJSON :: AbstractHash algo a -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Format Text a -> a
sformat 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 = forall e a. Buildable e => Either e a -> Parser a
toAesonError 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 forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (forall e a. Buildable e => Either e a -> Parser a
toAesonError forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall algo a.
HashAlgorithm algo =>
Text -> Either Text (AbstractHash algo a)
decodeAbstractHash)
instance ToJSONKey (AbstractHash algo a) where
toJSONKey :: ToJSONKeyFunction (AbstractHash algo a)
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (forall a. Format Text a -> a
sformat 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 = 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) = 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 = forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => Text -> a
panic Text
"unused, I hope!" :: algo)
in forall a. Num a => Integer -> a
fromInteger (forall a. Integral a => a -> Integer
toInteger (forall s a. (Integral s, Integral a) => s -> a
withWordSize Int
realSz 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 = 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
ShortByteString
bs <- forall a s. DecCBOR a => Decoder s a
decCBOR @SBS.ShortByteString
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ShortByteString -> Int
SBS.length ShortByteString
bs forall a. Eq a => a -> a -> Bool
/= Int
expectedSize)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"AbstractHash" Text
"Bytes not expected length"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall algo a. ShortByteString -> AbstractHash algo a
AbstractHash ShortByteString
bs)
where
expectedSize :: Int
expectedSize = forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => a
Prelude.undefined :: algo)
instance HeapWords (AbstractHash algo a) where
heapWords :: AbstractHash algo a -> Int
heapWords AbstractHash algo a
_ =
Int
8
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 <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Format Text a -> a
sformat forall a r. Buildable a => Format r (a -> r)
build) forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
B16.decode (Text -> ByteString
T.encodeUtf8 Text
prettyHash)
case forall algo a.
HashAlgorithm algo =>
ByteString -> Maybe (AbstractHash algo a)
abstractHashFromBytes ByteString
bytes of
Maybe (AbstractHash algo a)
Nothing ->
forall a b. a -> Either a b
Left
( Text
"decodeAbstractHash: "
forall a. Semigroup a => a -> a -> a
<> Text
"can't convert bytes to hash,"
forall a. Semigroup a => a -> a -> a
<> Text
" the value was "
forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertText a b => a -> b
toS Text
prettyHash
)
Just AbstractHash algo a
h -> forall (m :: * -> *) a. Monad m => a -> m a
return AbstractHash algo a
h
abstractHash :: (HashAlgorithm algo, EncCBOR a) => a -> AbstractHash algo a
abstractHash :: forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash = forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. EncCBOR a => Version -> a -> LByteString
serialize Version
byronProtVer
unsafeAbstractHash :: HashAlgorithm algo => LByteString -> AbstractHash algo a
unsafeAbstractHash :: forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash = forall algo a. Digest algo -> AbstractHash algo a
abstractHashFromDigest forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. HashAlgorithm a => LByteString -> Digest a
Hash.hashlazy
abstractHashFromDigest :: Digest algo -> AbstractHash algo a
abstractHashFromDigest :: forall algo a. Digest algo -> AbstractHash algo a
abstractHashFromDigest = forall algo a. ShortByteString -> AbstractHash algo a
AbstractHash 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert
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 forall a. Eq a => a -> a -> Bool
== Int
expectedSize = forall a. a -> Maybe a
Just (forall algo a. ByteString -> AbstractHash algo a
unsafeAbstractHashFromBytes ByteString
bs)
| Bool
otherwise = forall a. Maybe a
Nothing
where
expectedSize :: Int
expectedSize = forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => a
Prelude.undefined :: algo)
unsafeAbstractHashFromBytes :: ByteString -> AbstractHash algo a
unsafeAbstractHashFromBytes :: forall algo a. ByteString -> AbstractHash algo a
unsafeAbstractHashFromBytes = forall algo a. ShortByteString -> AbstractHash algo a
AbstractHash 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
abstractHashToBytes :: AbstractHash algo a -> ByteString
abstractHashToBytes :: forall algo a. AbstractHash algo a -> ByteString
abstractHashToBytes (AbstractHash ShortByteString
h) = ShortByteString -> ByteString
SBS.fromShort ShortByteString
h
unsafeAbstractHashFromShort :: SBS.ShortByteString -> AbstractHash algo a
unsafeAbstractHashFromShort :: forall algo a. ShortByteString -> AbstractHash algo a
unsafeAbstractHashFromShort = forall algo a. ShortByteString -> AbstractHash algo a
AbstractHash
abstractHashToShort :: AbstractHash algo a -> SBS.ShortByteString
abstractHashToShort :: forall algo a. AbstractHash algo a -> ShortByteString
abstractHashToShort (AbstractHash ShortByteString
h) = ShortByteString
h
type Hash :: Type -> Type
type Hash = AbstractHash Blake2b_256
{-# DEPRECATED hash "Use serializeCborHash or hash the annotation instead." #-}
hash :: EncCBOR a => a -> Hash a
hash :: forall a. EncCBOR a => a -> Hash a
hash = forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash
serializeCborHash :: EncCBOR a => a -> Hash a
serializeCborHash :: forall a. EncCBOR a => a -> Hash a
serializeCborHash = forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash
hashDecoded :: Decoded t => t -> Hash (BaseType t)
hashDecoded :: forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded = forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. Decoded t => t -> ByteString
recoverBytes
hashRaw :: LBS.ByteString -> Hash Raw
hashRaw :: LByteString -> Hash Raw
hashRaw = forall algo a.
HashAlgorithm algo =>
LByteString -> AbstractHash algo a
unsafeAbstractHash
hashFromBytes :: ByteString -> Maybe (Hash a)
hashFromBytes :: forall a. ByteString -> Maybe (Hash a)
hashFromBytes = forall algo a.
HashAlgorithm algo =>
ByteString -> Maybe (AbstractHash algo a)
abstractHashFromBytes
unsafeHashFromBytes :: ByteString -> Hash a
unsafeHashFromBytes :: forall a. ByteString -> Hash a
unsafeHashFromBytes = forall algo a. ByteString -> AbstractHash algo a
unsafeAbstractHashFromBytes
hashToBytes :: AbstractHash algo a -> ByteString
hashToBytes :: forall algo a. AbstractHash algo a -> ByteString
hashToBytes = forall algo a. AbstractHash algo a -> ByteString
abstractHashToBytes
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
hashHexF :: Format r (AbstractHash algo a -> r)
hashHexF :: forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF = forall a r. (a -> Builder) -> Format r (a -> r)
later forall a b. (a -> b) -> a -> b
$ \AbstractHash algo a
h -> forall p. Buildable p => p -> Builder
B.build (forall a b. (Show a, ConvertText String b) => a -> b
show AbstractHash algo a
h :: Text)
mediumHashF :: Format r (AbstractHash algo a -> r)
mediumHashF :: forall r algo a. Format r (AbstractHash algo a -> r)
mediumHashF = forall a r. Buildable a => Int -> Format r (a -> r)
fitLeft Int
16 forall r r' a.
Format r (Builder -> r') -> Format r' a -> Format r a
%. forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF
shortHashF :: Format r (AbstractHash algo a -> r)
shortHashF :: forall r algo a. Format r (AbstractHash algo a -> r)
shortHashF = forall a r. Buildable a => Int -> Format r (a -> r)
fitLeft Int
8 forall r r' a.
Format r (Builder -> r') -> Format r' a -> Format r a
%. forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF