{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Types and functions relating to hash values.
--
module Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..)
    , hashFromText
    , mockHash
    ) where

import Prelude

import Cardano.Wallet.Util
    ( mapFirst )
import Control.DeepSeq
    ( NFData (..) )
import Crypto.Hash
    ( Blake2b_256, hash )
import Data.ByteArray
    ( ByteArrayAccess )
import Data.ByteArray.Encoding
    ( Base (Base16), convertFromBase, convertToBase )
import Data.ByteString
    ( ByteString )
import Data.Hashable
    ( Hashable )
import Data.Proxy
    ( Proxy (..) )
import Data.Text
    ( Text )
import Data.Text.Class
    ( FromText (..), TextDecodingError (..), ToText (..) )
import Fmt
    ( Buildable (..), prefixF )
import GHC.Generics
    ( Generic )
import GHC.TypeLits
    ( KnownSymbol, Symbol, symbolVal )
import NoThunks.Class
    ( NoThunks (..) )
import Quiet
    ( Quiet (..) )

import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.Char as C
import qualified Data.Text.Encoding as T

newtype Hash (tag :: Symbol) = Hash { Hash tag -> ByteString
getHash :: ByteString }
    deriving stock ((forall x. Hash tag -> Rep (Hash tag) x)
-> (forall x. Rep (Hash tag) x -> Hash tag) -> Generic (Hash tag)
forall x. Rep (Hash tag) x -> Hash tag
forall x. Hash tag -> Rep (Hash tag) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (tag :: Symbol) x. Rep (Hash tag) x -> Hash tag
forall (tag :: Symbol) x. Hash tag -> Rep (Hash tag) x
$cto :: forall (tag :: Symbol) x. Rep (Hash tag) x -> Hash tag
$cfrom :: forall (tag :: Symbol) x. Hash tag -> Rep (Hash tag) x
Generic, Hash tag -> Hash tag -> Bool
(Hash tag -> Hash tag -> Bool)
-> (Hash tag -> Hash tag -> Bool) -> Eq (Hash tag)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (tag :: Symbol). Hash tag -> Hash tag -> Bool
/= :: Hash tag -> Hash tag -> Bool
$c/= :: forall (tag :: Symbol). Hash tag -> Hash tag -> Bool
== :: Hash tag -> Hash tag -> Bool
$c== :: forall (tag :: Symbol). Hash tag -> Hash tag -> Bool
Eq, Eq (Hash tag)
Eq (Hash tag)
-> (Hash tag -> Hash tag -> Ordering)
-> (Hash tag -> Hash tag -> Bool)
-> (Hash tag -> Hash tag -> Bool)
-> (Hash tag -> Hash tag -> Bool)
-> (Hash tag -> Hash tag -> Bool)
-> (Hash tag -> Hash tag -> Hash tag)
-> (Hash tag -> Hash tag -> Hash tag)
-> Ord (Hash tag)
Hash tag -> Hash tag -> Bool
Hash tag -> Hash tag -> Ordering
Hash tag -> Hash tag -> Hash tag
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 (tag :: Symbol). Eq (Hash tag)
forall (tag :: Symbol). Hash tag -> Hash tag -> Bool
forall (tag :: Symbol). Hash tag -> Hash tag -> Ordering
forall (tag :: Symbol). Hash tag -> Hash tag -> Hash tag
min :: Hash tag -> Hash tag -> Hash tag
$cmin :: forall (tag :: Symbol). Hash tag -> Hash tag -> Hash tag
max :: Hash tag -> Hash tag -> Hash tag
$cmax :: forall (tag :: Symbol). Hash tag -> Hash tag -> Hash tag
>= :: Hash tag -> Hash tag -> Bool
$c>= :: forall (tag :: Symbol). Hash tag -> Hash tag -> Bool
> :: Hash tag -> Hash tag -> Bool
$c> :: forall (tag :: Symbol). Hash tag -> Hash tag -> Bool
<= :: Hash tag -> Hash tag -> Bool
$c<= :: forall (tag :: Symbol). Hash tag -> Hash tag -> Bool
< :: Hash tag -> Hash tag -> Bool
$c< :: forall (tag :: Symbol). Hash tag -> Hash tag -> Bool
compare :: Hash tag -> Hash tag -> Ordering
$ccompare :: forall (tag :: Symbol). Hash tag -> Hash tag -> Ordering
$cp1Ord :: forall (tag :: Symbol). Eq (Hash tag)
Ord)
    deriving newtype (Hash tag -> Int
Hash tag -> Ptr p -> IO ()
Hash tag -> (Ptr p -> IO a) -> IO a
(Hash tag -> Int)
-> (forall p a. Hash tag -> (Ptr p -> IO a) -> IO a)
-> (forall p. Hash tag -> Ptr p -> IO ())
-> ByteArrayAccess (Hash tag)
forall p. Hash tag -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. Hash tag -> (Ptr p -> IO a) -> IO a
forall (tag :: Symbol). Hash tag -> Int
forall (tag :: Symbol) p. Hash tag -> Ptr p -> IO ()
forall (tag :: Symbol) p a. Hash tag -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: Hash tag -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall (tag :: Symbol) p. Hash tag -> Ptr p -> IO ()
withByteArray :: Hash tag -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall (tag :: Symbol) p a. Hash tag -> (Ptr p -> IO a) -> IO a
length :: Hash tag -> Int
$clength :: forall (tag :: Symbol). Hash tag -> Int
ByteArrayAccess)
    deriving (ReadPrec [Hash tag]
ReadPrec (Hash tag)
Int -> ReadS (Hash tag)
ReadS [Hash tag]
(Int -> ReadS (Hash tag))
-> ReadS [Hash tag]
-> ReadPrec (Hash tag)
-> ReadPrec [Hash tag]
-> Read (Hash tag)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (tag :: Symbol). ReadPrec [Hash tag]
forall (tag :: Symbol). ReadPrec (Hash tag)
forall (tag :: Symbol). Int -> ReadS (Hash tag)
forall (tag :: Symbol). ReadS [Hash tag]
readListPrec :: ReadPrec [Hash tag]
$creadListPrec :: forall (tag :: Symbol). ReadPrec [Hash tag]
readPrec :: ReadPrec (Hash tag)
$creadPrec :: forall (tag :: Symbol). ReadPrec (Hash tag)
readList :: ReadS [Hash tag]
$creadList :: forall (tag :: Symbol). ReadS [Hash tag]
readsPrec :: Int -> ReadS (Hash tag)
$creadsPrec :: forall (tag :: Symbol). Int -> ReadS (Hash tag)
Read, Int -> Hash tag -> ShowS
[Hash tag] -> ShowS
Hash tag -> String
(Int -> Hash tag -> ShowS)
-> (Hash tag -> String) -> ([Hash tag] -> ShowS) -> Show (Hash tag)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (tag :: Symbol). Int -> Hash tag -> ShowS
forall (tag :: Symbol). [Hash tag] -> ShowS
forall (tag :: Symbol). Hash tag -> String
showList :: [Hash tag] -> ShowS
$cshowList :: forall (tag :: Symbol). [Hash tag] -> ShowS
show :: Hash tag -> String
$cshow :: forall (tag :: Symbol). Hash tag -> String
showsPrec :: Int -> Hash tag -> ShowS
$cshowsPrec :: forall (tag :: Symbol). Int -> Hash tag -> ShowS
Show) via (Quiet (Hash tag))
    deriving anyclass (Hash tag -> ()
(Hash tag -> ()) -> NFData (Hash tag)
forall a. (a -> ()) -> NFData a
forall (tag :: Symbol). Hash tag -> ()
rnf :: Hash tag -> ()
$crnf :: forall (tag :: Symbol). Hash tag -> ()
NFData, Int -> Hash tag -> Int
Hash tag -> Int
(Int -> Hash tag -> Int)
-> (Hash tag -> Int) -> Hashable (Hash tag)
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (tag :: Symbol). Int -> Hash tag -> Int
forall (tag :: Symbol). Hash tag -> Int
hash :: Hash tag -> Int
$chash :: forall (tag :: Symbol). Hash tag -> Int
hashWithSalt :: Int -> Hash tag -> Int
$chashWithSalt :: forall (tag :: Symbol). Int -> Hash tag -> Int
Hashable)

instance NoThunks (Hash tag)

instance Buildable (Hash tag) where
    build :: Hash tag -> Builder
build Hash tag
h = Builder
forall a. Monoid a => a
mempty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
prefixF Int
8 Builder
builder
      where
        builder :: Builder
builder = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (Hash tag -> Text) -> Hash tag -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash tag -> Text
forall a. ToText a => a -> Text
toText (Hash tag -> Builder) -> Hash tag -> Builder
forall a b. (a -> b) -> a -> b
$ Hash tag
h

instance ToText (Hash tag) where
    toText :: Hash tag -> Text
toText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (Hash tag -> ByteString) -> Hash tag -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 (ByteString -> ByteString)
-> (Hash tag -> ByteString) -> Hash tag -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash tag -> ByteString
forall (tag :: Symbol). Hash tag -> ByteString
getHash

instance FromText (Hash "Tx")              where fromText :: Text -> Either TextDecodingError (Hash "Tx")
fromText = Int -> Text -> Either TextDecodingError (Hash "Tx")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
32
instance FromText (Hash "Account")         where fromText :: Text -> Either TextDecodingError (Hash "Account")
fromText = Int -> Text -> Either TextDecodingError (Hash "Account")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
32
instance FromText (Hash "Genesis")         where fromText :: Text -> Either TextDecodingError (Hash "Genesis")
fromText = Int -> Text -> Either TextDecodingError (Hash "Genesis")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
32
instance FromText (Hash "Block")           where fromText :: Text -> Either TextDecodingError (Hash "Block")
fromText = Int -> Text -> Either TextDecodingError (Hash "Block")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
32
instance FromText (Hash "BlockHeader")     where fromText :: Text -> Either TextDecodingError (Hash "BlockHeader")
fromText = Int -> Text -> Either TextDecodingError (Hash "BlockHeader")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
32
instance FromText (Hash "RewardAccount")   where fromText :: Text -> Either TextDecodingError (Hash "RewardAccount")
fromText = Int -> Text -> Either TextDecodingError (Hash "RewardAccount")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
28
instance FromText (Hash "TokenPolicy")     where fromText :: Text -> Either TextDecodingError (Hash "TokenPolicy")
fromText = Int -> Text -> Either TextDecodingError (Hash "TokenPolicy")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
28 -- Script Hash
instance FromText (Hash "Datum")           where fromText :: Text -> Either TextDecodingError (Hash "Datum")
fromText = Int -> Text -> Either TextDecodingError (Hash "Datum")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
32
instance FromText (Hash "VerificationKey") where fromText :: Text -> Either TextDecodingError (Hash "VerificationKey")
fromText = Int -> Text -> Either TextDecodingError (Hash "VerificationKey")
forall (t :: Symbol).
KnownSymbol t =>
Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
28

hashFromText
    :: forall t. (KnownSymbol t)
    => Int
        -- ^ Expected decoded hash length
    -> Text
    -> Either TextDecodingError (Hash t)
hashFromText :: Int -> Text -> Either TextDecodingError (Hash t)
hashFromText Int
len Text
text = case Either String ByteString
decoded of
    Right ByteString
bytes | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len ->
        Hash t -> Either TextDecodingError (Hash t)
forall a b. b -> Either a b
Right (Hash t -> Either TextDecodingError (Hash t))
-> Hash t -> Either TextDecodingError (Hash t)
forall a b. (a -> b) -> a -> b
$ ByteString -> Hash t
forall (tag :: Symbol). ByteString -> Hash tag
Hash ByteString
bytes
    Either String ByteString
_ ->
        TextDecodingError -> Either TextDecodingError (Hash t)
forall a b. a -> Either a b
Left (TextDecodingError -> Either TextDecodingError (Hash t))
-> TextDecodingError -> Either TextDecodingError (Hash t)
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ Context -> String
unwords
            [ String
"Invalid"
            , (Char -> Char) -> ShowS
forall a. (a -> a) -> [a] -> [a]
mapFirst Char -> Char
C.toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Proxy t -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy t -> String) -> Proxy t -> String
forall a b. (a -> b) -> a -> b
$ Proxy t
forall k (t :: k). Proxy t
Proxy @t
            , String
"hash: expecting a hex-encoded value that is"
            , Int -> String
forall a. Show a => a -> String
show Int
len
            , String
"bytes in length."
            ]
  where
    decoded :: Either String ByteString
decoded = Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
text

-- | Constructs a hash that is good enough for testing.
--
mockHash :: Show a => a -> Hash whatever
mockHash :: a -> Hash whatever
mockHash = ByteString -> Hash whatever
forall (tag :: Symbol). ByteString -> Hash tag
Hash (ByteString -> Hash whatever)
-> (a -> ByteString) -> a -> Hash whatever
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
blake2b256 (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B8.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
  where
     blake2b256 :: ByteString -> ByteString
     blake2b256 :: ByteString -> ByteString
blake2b256 =
         Digest Blake2b_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest Blake2b_256 -> ByteString)
-> (ByteString -> Digest Blake2b_256) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArrayAccess ByteString, HashAlgorithm Blake2b_256) =>
ByteString -> Digest Blake2b_256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @_ @Blake2b_256