{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- Module      : Haskoin.Crypto.Hash
-- Copyright   : No rights reserved
-- License     : MIT
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : POSIX
--
-- Hashing functions and corresponding data types. Uses functions from the
-- cryptonite library.
module Haskoin.Crypto.Hash
  ( -- * Hashes
    Hash512 (get),
    Hash256 (get),
    Hash160 (get),
    CheckSum32 (get),
    sha512,
    sha256,
    ripemd160,
    sha1,
    doubleSHA256,
    addressHash,
    checkSum32,
    hmac512,
    hmac256,
    split512,
    join512,
    initTaggedHash,
  )
where

import Control.DeepSeq
import Crypto.Hash
import Crypto.MAC.HMAC (HMAC, hmac)
import Data.Binary (Binary (..))
import Data.ByteArray (ByteArrayAccess, convert)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Short (ShortByteString, fromShort, toShort)
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial (Serial (..))
import Data.Either (fromRight)
import Data.Function (on)
import Data.Hashable (Hashable)
import Data.Serialize (Serialize (..))
import Data.String (IsString, fromString)
import Data.String.Conversions (cs)
import Data.Void (Void)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Haskoin.Util.Helpers
import Haskoin.Util.Marshal
import Text.Read as R

-- | 'Word32' wrapped for type-safe 32-bit checksums.
newtype CheckSum32 = CheckSum32
  { CheckSum32 -> Word32
get :: Word32
  }
  deriving (CheckSum32 -> CheckSum32 -> Bool
(CheckSum32 -> CheckSum32 -> Bool)
-> (CheckSum32 -> CheckSum32 -> Bool) -> Eq CheckSum32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CheckSum32 -> CheckSum32 -> Bool
== :: CheckSum32 -> CheckSum32 -> Bool
$c/= :: CheckSum32 -> CheckSum32 -> Bool
/= :: CheckSum32 -> CheckSum32 -> Bool
Eq, Eq CheckSum32
Eq CheckSum32 =>
(CheckSum32 -> CheckSum32 -> Ordering)
-> (CheckSum32 -> CheckSum32 -> Bool)
-> (CheckSum32 -> CheckSum32 -> Bool)
-> (CheckSum32 -> CheckSum32 -> Bool)
-> (CheckSum32 -> CheckSum32 -> Bool)
-> (CheckSum32 -> CheckSum32 -> CheckSum32)
-> (CheckSum32 -> CheckSum32 -> CheckSum32)
-> Ord CheckSum32
CheckSum32 -> CheckSum32 -> Bool
CheckSum32 -> CheckSum32 -> Ordering
CheckSum32 -> CheckSum32 -> CheckSum32
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
$ccompare :: CheckSum32 -> CheckSum32 -> Ordering
compare :: CheckSum32 -> CheckSum32 -> Ordering
$c< :: CheckSum32 -> CheckSum32 -> Bool
< :: CheckSum32 -> CheckSum32 -> Bool
$c<= :: CheckSum32 -> CheckSum32 -> Bool
<= :: CheckSum32 -> CheckSum32 -> Bool
$c> :: CheckSum32 -> CheckSum32 -> Bool
> :: CheckSum32 -> CheckSum32 -> Bool
$c>= :: CheckSum32 -> CheckSum32 -> Bool
>= :: CheckSum32 -> CheckSum32 -> Bool
$cmax :: CheckSum32 -> CheckSum32 -> CheckSum32
max :: CheckSum32 -> CheckSum32 -> CheckSum32
$cmin :: CheckSum32 -> CheckSum32 -> CheckSum32
min :: CheckSum32 -> CheckSum32 -> CheckSum32
Ord, Int -> CheckSum32 -> ShowS
[CheckSum32] -> ShowS
CheckSum32 -> String
(Int -> CheckSum32 -> ShowS)
-> (CheckSum32 -> String)
-> ([CheckSum32] -> ShowS)
-> Show CheckSum32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CheckSum32 -> ShowS
showsPrec :: Int -> CheckSum32 -> ShowS
$cshow :: CheckSum32 -> String
show :: CheckSum32 -> String
$cshowList :: [CheckSum32] -> ShowS
showList :: [CheckSum32] -> ShowS
Show, ReadPrec [CheckSum32]
ReadPrec CheckSum32
Int -> ReadS CheckSum32
ReadS [CheckSum32]
(Int -> ReadS CheckSum32)
-> ReadS [CheckSum32]
-> ReadPrec CheckSum32
-> ReadPrec [CheckSum32]
-> Read CheckSum32
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CheckSum32
readsPrec :: Int -> ReadS CheckSum32
$creadList :: ReadS [CheckSum32]
readList :: ReadS [CheckSum32]
$creadPrec :: ReadPrec CheckSum32
readPrec :: ReadPrec CheckSum32
$creadListPrec :: ReadPrec [CheckSum32]
readListPrec :: ReadPrec [CheckSum32]
Read, (forall x. CheckSum32 -> Rep CheckSum32 x)
-> (forall x. Rep CheckSum32 x -> CheckSum32) -> Generic CheckSum32
forall x. Rep CheckSum32 x -> CheckSum32
forall x. CheckSum32 -> Rep CheckSum32 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CheckSum32 -> Rep CheckSum32 x
from :: forall x. CheckSum32 -> Rep CheckSum32 x
$cto :: forall x. Rep CheckSum32 x -> CheckSum32
to :: forall x. Rep CheckSum32 x -> CheckSum32
Generic)
  deriving newtype (Eq CheckSum32
Eq CheckSum32 =>
(Int -> CheckSum32 -> Int)
-> (CheckSum32 -> Int) -> Hashable CheckSum32
Int -> CheckSum32 -> Int
CheckSum32 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> CheckSum32 -> Int
hashWithSalt :: Int -> CheckSum32 -> Int
$chash :: CheckSum32 -> Int
hash :: CheckSum32 -> Int
Hashable, CheckSum32 -> ()
(CheckSum32 -> ()) -> NFData CheckSum32
forall a. (a -> ()) -> NFData a
$crnf :: CheckSum32 -> ()
rnf :: CheckSum32 -> ()
NFData)

instance Serial CheckSum32 where
  serialize :: forall (m :: * -> *). MonadPut m => CheckSum32 -> m ()
serialize (CheckSum32 Word32
c) = Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
c
  deserialize :: forall (m :: * -> *). MonadGet m => m CheckSum32
deserialize = Word32 -> CheckSum32
CheckSum32 (Word32 -> CheckSum32) -> m Word32 -> m CheckSum32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be

instance Serialize CheckSum32 where
  put :: Putter CheckSum32
put = Putter CheckSum32
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => CheckSum32 -> m ()
serialize
  get :: Get CheckSum32
get = Get CheckSum32
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m CheckSum32
deserialize

instance Binary CheckSum32 where
  put :: CheckSum32 -> Put
put = CheckSum32 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => CheckSum32 -> m ()
serialize
  get :: Get CheckSum32
get = Get CheckSum32
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m CheckSum32
deserialize

-- | Type for 512-bit hashes.
newtype Hash512 = Hash512 {Hash512 -> ShortByteString
get :: ShortByteString}
  deriving (Hash512 -> Hash512 -> Bool
(Hash512 -> Hash512 -> Bool)
-> (Hash512 -> Hash512 -> Bool) -> Eq Hash512
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash512 -> Hash512 -> Bool
== :: Hash512 -> Hash512 -> Bool
$c/= :: Hash512 -> Hash512 -> Bool
/= :: Hash512 -> Hash512 -> Bool
Eq, Eq Hash512
Eq Hash512 =>
(Hash512 -> Hash512 -> Ordering)
-> (Hash512 -> Hash512 -> Bool)
-> (Hash512 -> Hash512 -> Bool)
-> (Hash512 -> Hash512 -> Bool)
-> (Hash512 -> Hash512 -> Bool)
-> (Hash512 -> Hash512 -> Hash512)
-> (Hash512 -> Hash512 -> Hash512)
-> Ord Hash512
Hash512 -> Hash512 -> Bool
Hash512 -> Hash512 -> Ordering
Hash512 -> Hash512 -> Hash512
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
$ccompare :: Hash512 -> Hash512 -> Ordering
compare :: Hash512 -> Hash512 -> Ordering
$c< :: Hash512 -> Hash512 -> Bool
< :: Hash512 -> Hash512 -> Bool
$c<= :: Hash512 -> Hash512 -> Bool
<= :: Hash512 -> Hash512 -> Bool
$c> :: Hash512 -> Hash512 -> Bool
> :: Hash512 -> Hash512 -> Bool
$c>= :: Hash512 -> Hash512 -> Bool
>= :: Hash512 -> Hash512 -> Bool
$cmax :: Hash512 -> Hash512 -> Hash512
max :: Hash512 -> Hash512 -> Hash512
$cmin :: Hash512 -> Hash512 -> Hash512
min :: Hash512 -> Hash512 -> Hash512
Ord, (forall x. Hash512 -> Rep Hash512 x)
-> (forall x. Rep Hash512 x -> Hash512) -> Generic Hash512
forall x. Rep Hash512 x -> Hash512
forall x. Hash512 -> Rep Hash512 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Hash512 -> Rep Hash512 x
from :: forall x. Hash512 -> Rep Hash512 x
$cto :: forall x. Rep Hash512 x -> Hash512
to :: forall x. Rep Hash512 x -> Hash512
Generic)
  deriving newtype (Eq Hash512
Eq Hash512 =>
(Int -> Hash512 -> Int) -> (Hash512 -> Int) -> Hashable Hash512
Int -> Hash512 -> Int
Hash512 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Hash512 -> Int
hashWithSalt :: Int -> Hash512 -> Int
$chash :: Hash512 -> Int
hash :: Hash512 -> Int
Hashable, Hash512 -> ()
(Hash512 -> ()) -> NFData Hash512
forall a. (a -> ()) -> NFData a
$crnf :: Hash512 -> ()
rnf :: Hash512 -> ()
NFData)

-- | Type for 256-bit hashes.
newtype Hash256 = Hash256 {Hash256 -> ShortByteString
get :: ShortByteString}
  deriving (Hash256 -> Hash256 -> Bool
(Hash256 -> Hash256 -> Bool)
-> (Hash256 -> Hash256 -> Bool) -> Eq Hash256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash256 -> Hash256 -> Bool
== :: Hash256 -> Hash256 -> Bool
$c/= :: Hash256 -> Hash256 -> Bool
/= :: Hash256 -> Hash256 -> Bool
Eq, Eq Hash256
Eq Hash256 =>
(Hash256 -> Hash256 -> Ordering)
-> (Hash256 -> Hash256 -> Bool)
-> (Hash256 -> Hash256 -> Bool)
-> (Hash256 -> Hash256 -> Bool)
-> (Hash256 -> Hash256 -> Bool)
-> (Hash256 -> Hash256 -> Hash256)
-> (Hash256 -> Hash256 -> Hash256)
-> Ord Hash256
Hash256 -> Hash256 -> Bool
Hash256 -> Hash256 -> Ordering
Hash256 -> Hash256 -> Hash256
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
$ccompare :: Hash256 -> Hash256 -> Ordering
compare :: Hash256 -> Hash256 -> Ordering
$c< :: Hash256 -> Hash256 -> Bool
< :: Hash256 -> Hash256 -> Bool
$c<= :: Hash256 -> Hash256 -> Bool
<= :: Hash256 -> Hash256 -> Bool
$c> :: Hash256 -> Hash256 -> Bool
> :: Hash256 -> Hash256 -> Bool
$c>= :: Hash256 -> Hash256 -> Bool
>= :: Hash256 -> Hash256 -> Bool
$cmax :: Hash256 -> Hash256 -> Hash256
max :: Hash256 -> Hash256 -> Hash256
$cmin :: Hash256 -> Hash256 -> Hash256
min :: Hash256 -> Hash256 -> Hash256
Ord, (forall x. Hash256 -> Rep Hash256 x)
-> (forall x. Rep Hash256 x -> Hash256) -> Generic Hash256
forall x. Rep Hash256 x -> Hash256
forall x. Hash256 -> Rep Hash256 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Hash256 -> Rep Hash256 x
from :: forall x. Hash256 -> Rep Hash256 x
$cto :: forall x. Rep Hash256 x -> Hash256
to :: forall x. Rep Hash256 x -> Hash256
Generic)
  deriving newtype (Eq Hash256
Eq Hash256 =>
(Int -> Hash256 -> Int) -> (Hash256 -> Int) -> Hashable Hash256
Int -> Hash256 -> Int
Hash256 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Hash256 -> Int
hashWithSalt :: Int -> Hash256 -> Int
$chash :: Hash256 -> Int
hash :: Hash256 -> Int
Hashable, Hash256 -> ()
(Hash256 -> ()) -> NFData Hash256
forall a. (a -> ()) -> NFData a
$crnf :: Hash256 -> ()
rnf :: Hash256 -> ()
NFData)

-- | Type for 160-bit hashes.
newtype Hash160 = Hash160 {Hash160 -> ShortByteString
get :: ShortByteString}
  deriving (Hash160 -> Hash160 -> Bool
(Hash160 -> Hash160 -> Bool)
-> (Hash160 -> Hash160 -> Bool) -> Eq Hash160
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash160 -> Hash160 -> Bool
== :: Hash160 -> Hash160 -> Bool
$c/= :: Hash160 -> Hash160 -> Bool
/= :: Hash160 -> Hash160 -> Bool
Eq, Eq Hash160
Eq Hash160 =>
(Hash160 -> Hash160 -> Ordering)
-> (Hash160 -> Hash160 -> Bool)
-> (Hash160 -> Hash160 -> Bool)
-> (Hash160 -> Hash160 -> Bool)
-> (Hash160 -> Hash160 -> Bool)
-> (Hash160 -> Hash160 -> Hash160)
-> (Hash160 -> Hash160 -> Hash160)
-> Ord Hash160
Hash160 -> Hash160 -> Bool
Hash160 -> Hash160 -> Ordering
Hash160 -> Hash160 -> Hash160
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
$ccompare :: Hash160 -> Hash160 -> Ordering
compare :: Hash160 -> Hash160 -> Ordering
$c< :: Hash160 -> Hash160 -> Bool
< :: Hash160 -> Hash160 -> Bool
$c<= :: Hash160 -> Hash160 -> Bool
<= :: Hash160 -> Hash160 -> Bool
$c> :: Hash160 -> Hash160 -> Bool
> :: Hash160 -> Hash160 -> Bool
$c>= :: Hash160 -> Hash160 -> Bool
>= :: Hash160 -> Hash160 -> Bool
$cmax :: Hash160 -> Hash160 -> Hash160
max :: Hash160 -> Hash160 -> Hash160
$cmin :: Hash160 -> Hash160 -> Hash160
min :: Hash160 -> Hash160 -> Hash160
Ord, (forall x. Hash160 -> Rep Hash160 x)
-> (forall x. Rep Hash160 x -> Hash160) -> Generic Hash160
forall x. Rep Hash160 x -> Hash160
forall x. Hash160 -> Rep Hash160 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Hash160 -> Rep Hash160 x
from :: forall x. Hash160 -> Rep Hash160 x
$cto :: forall x. Rep Hash160 x -> Hash160
to :: forall x. Rep Hash160 x -> Hash160
Generic)
  deriving newtype (Eq Hash160
Eq Hash160 =>
(Int -> Hash160 -> Int) -> (Hash160 -> Int) -> Hashable Hash160
Int -> Hash160 -> Int
Hash160 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Hash160 -> Int
hashWithSalt :: Int -> Hash160 -> Int
$chash :: Hash160 -> Int
hash :: Hash160 -> Int
Hashable, Hash160 -> ()
(Hash160 -> ()) -> NFData Hash160
forall a. (a -> ()) -> NFData a
$crnf :: Hash160 -> ()
rnf :: Hash160 -> ()
NFData)

instance Show Hash512 where
  showsPrec :: Int -> Hash512 -> ShowS
showsPrec Int
_ = Text -> ShowS
forall a. Show a => a -> ShowS
shows (Text -> ShowS) -> (Hash512 -> Text) -> Hash512 -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text) -> (Hash512 -> ByteString) -> Hash512 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (Hash512 -> ShortByteString) -> Hash512 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)

instance Read Hash512 where
  readPrec :: ReadPrec Hash512
readPrec = do
    R.String String
str <- ReadPrec Lexeme
lexP
    ReadPrec Hash512
-> (ByteString -> ReadPrec Hash512)
-> Maybe ByteString
-> ReadPrec Hash512
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec Hash512
forall a. ReadPrec a
pfail (Hash512 -> ReadPrec Hash512
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash512 -> ReadPrec Hash512)
-> (ByteString -> Hash512) -> ByteString -> ReadPrec Hash512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Hash512
Hash512 (ShortByteString -> Hash512)
-> (ByteString -> ShortByteString) -> ByteString -> Hash512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort) (Text -> Maybe ByteString
decodeHex (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
str))

instance Show Hash256 where
  showsPrec :: Int -> Hash256 -> ShowS
showsPrec Int
_ = Text -> ShowS
forall a. Show a => a -> ShowS
shows (Text -> ShowS) -> (Hash256 -> Text) -> Hash256 -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text) -> (Hash256 -> ByteString) -> Hash256 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (Hash256 -> ShortByteString) -> Hash256 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)

instance Read Hash256 where
  readPrec :: ReadPrec Hash256
readPrec = do
    R.String String
str <- ReadPrec Lexeme
lexP
    ReadPrec Hash256
-> (ByteString -> ReadPrec Hash256)
-> Maybe ByteString
-> ReadPrec Hash256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec Hash256
forall a. ReadPrec a
pfail (Hash256 -> ReadPrec Hash256
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash256 -> ReadPrec Hash256)
-> (ByteString -> Hash256) -> ByteString -> ReadPrec Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Hash256
Hash256 (ShortByteString -> Hash256)
-> (ByteString -> ShortByteString) -> ByteString -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort) (Text -> Maybe ByteString
decodeHex (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
str))

instance Show Hash160 where
  showsPrec :: Int -> Hash160 -> ShowS
showsPrec Int
_ = Text -> ShowS
forall a. Show a => a -> ShowS
shows (Text -> ShowS) -> (Hash160 -> Text) -> Hash160 -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text) -> (Hash160 -> ByteString) -> Hash160 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (Hash160 -> ShortByteString) -> Hash160 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)

instance Read Hash160 where
  readPrec :: ReadPrec Hash160
readPrec = do
    R.String String
str <- ReadPrec Lexeme
lexP
    ReadPrec Hash160
-> (ByteString -> ReadPrec Hash160)
-> Maybe ByteString
-> ReadPrec Hash160
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec Hash160
forall a. ReadPrec a
pfail (Hash160 -> ReadPrec Hash160
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash160 -> ReadPrec Hash160)
-> (ByteString -> Hash160) -> ByteString -> ReadPrec Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Hash160
Hash160 (ShortByteString -> Hash160)
-> (ByteString -> ShortByteString) -> ByteString -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort) (Text -> Maybe ByteString
decodeHex (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
str))

instance IsString Hash512 where
  fromString :: String -> Hash512
fromString String
str =
    case Text -> Maybe ByteString
decodeHex (Text -> Maybe ByteString) -> Text -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
str of
      Maybe ByteString
Nothing -> Hash512
forall {a}. a
e
      Just ByteString
bs ->
        case ByteString -> Int
B.length ByteString
bs of
          Int
64 -> ShortByteString -> Hash512
Hash512 (ByteString -> ShortByteString
toShort ByteString
bs)
          Int
_ -> Hash512
forall {a}. a
e
    where
      e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not decode hash from hex string"

instance Serial Hash512 where
  deserialize :: forall (m :: * -> *). MonadGet m => m Hash512
deserialize = ShortByteString -> Hash512
Hash512 (ShortByteString -> Hash512)
-> (ByteString -> ShortByteString) -> ByteString -> Hash512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> Hash512) -> m ByteString -> m Hash512
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
64
  serialize :: forall (m :: * -> *). MonadPut m => Hash512 -> m ()
serialize = ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString (ByteString -> m ()) -> (Hash512 -> ByteString) -> Hash512 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (Hash512 -> ShortByteString) -> Hash512 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)

instance Serialize Hash512 where
  put :: Putter Hash512
put = Putter Hash512
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash512 -> m ()
serialize
  get :: Get Hash512
get = Get Hash512
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash512
deserialize

instance Binary Hash512 where
  put :: Hash512 -> Put
put = Hash512 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash512 -> m ()
serialize
  get :: Get Hash512
get = Get Hash512
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash512
deserialize

instance IsString Hash256 where
  fromString :: String -> Hash256
fromString String
str =
    case Text -> Maybe ByteString
decodeHex (Text -> Maybe ByteString) -> Text -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
str of
      Maybe ByteString
Nothing -> Hash256
forall {a}. a
e
      Just ByteString
bs ->
        case ByteString -> Int
B.length ByteString
bs of
          Int
32 -> ShortByteString -> Hash256
Hash256 (ByteString -> ShortByteString
toShort ByteString
bs)
          Int
_ -> Hash256
forall {a}. a
e
    where
      e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not decode hash from hex string"

instance Serial Hash256 where
  deserialize :: forall (m :: * -> *). MonadGet m => m Hash256
deserialize = ShortByteString -> Hash256
Hash256 (ShortByteString -> Hash256)
-> (ByteString -> ShortByteString) -> ByteString -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> Hash256) -> m ByteString -> m Hash256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
32
  serialize :: forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize = ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString (ByteString -> m ()) -> (Hash256 -> ByteString) -> Hash256 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (Hash256 -> ShortByteString) -> Hash256 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)

instance Serialize Hash256 where
  put :: Putter Hash256
put = Putter Hash256
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize
  get :: Get Hash256
get = Get Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize

instance Binary Hash256 where
  put :: Hash256 -> Put
put = Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize
  get :: Get Hash256
get = Get Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize

instance IsString Hash160 where
  fromString :: String -> Hash160
fromString String
str =
    case Text -> Maybe ByteString
decodeHex (Text -> Maybe ByteString) -> Text -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
str of
      Maybe ByteString
Nothing -> Hash160
forall {a}. a
e
      Just ByteString
bs ->
        case ByteString -> Int
B.length ByteString
bs of
          Int
20 -> ShortByteString -> Hash160
Hash160 (ByteString -> ShortByteString
toShort ByteString
bs)
          Int
_ -> Hash160
forall {a}. a
e
    where
      e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not decode hash from hex string"

instance Serial Hash160 where
  deserialize :: forall (m :: * -> *). MonadGet m => m Hash160
deserialize = ShortByteString -> Hash160
Hash160 (ShortByteString -> Hash160)
-> (ByteString -> ShortByteString) -> ByteString -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> Hash160) -> m ByteString -> m Hash160
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
20
  serialize :: forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize = ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString (ByteString -> m ()) -> (Hash160 -> ByteString) -> Hash160 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (Hash160 -> ShortByteString) -> Hash160 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)

instance Serialize Hash160 where
  put :: Putter Hash160
put = Putter Hash160
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize
  get :: Get Hash160
get = Get Hash160
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash160
deserialize

instance Binary Hash160 where
  put :: Hash160 -> Put
put = Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize
  get :: Get Hash160
get = Get Hash160
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash160
deserialize

-- | Calculate SHA512 hash.
sha512 :: (ByteArrayAccess b) => b -> Hash512
sha512 :: forall b. ByteArrayAccess b => b -> Hash512
sha512 = ShortByteString -> Hash512
Hash512 (ShortByteString -> Hash512)
-> (b -> ShortByteString) -> b -> Hash512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> ShortByteString)
-> (b -> ByteString) -> b -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA512 -> ByteString)
-> (b -> Digest SHA512) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA512 -> b -> Digest SHA512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA512
SHA512

-- | Calculate SHA256 hash.
sha256 :: (ByteArrayAccess b) => b -> Hash256
sha256 :: forall b. ByteArrayAccess b => b -> Hash256
sha256 = ShortByteString -> Hash256
Hash256 (ShortByteString -> Hash256)
-> (b -> ShortByteString) -> b -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> ShortByteString)
-> (b -> ByteString) -> b -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA256 -> ByteString)
-> (b -> Digest SHA256) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> b -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256

-- | Calculate RIPEMD160 hash.
ripemd160 :: (ByteArrayAccess b) => b -> Hash160
ripemd160 :: forall b. ByteArrayAccess b => b -> Hash160
ripemd160 = ShortByteString -> Hash160
Hash160 (ShortByteString -> Hash160)
-> (b -> ShortByteString) -> b -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> ShortByteString)
-> (b -> ByteString) -> b -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest RIPEMD160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest RIPEMD160 -> ByteString)
-> (b -> Digest RIPEMD160) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RIPEMD160 -> b -> Digest RIPEMD160
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith RIPEMD160
RIPEMD160

-- | Claculate SHA1 hash.
sha1 :: (ByteArrayAccess b) => b -> Hash160
sha1 :: forall b. ByteArrayAccess b => b -> Hash160
sha1 = ShortByteString -> Hash160
Hash160 (ShortByteString -> Hash160)
-> (b -> ShortByteString) -> b -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> ShortByteString)
-> (b -> ByteString) -> b -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA1 -> ByteString)
-> (b -> Digest SHA1) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA1 -> b -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1

-- | Compute two rounds of SHA-256.
doubleSHA256 :: (ByteArrayAccess b) => b -> Hash256
doubleSHA256 :: forall b. ByteArrayAccess b => b -> Hash256
doubleSHA256 =
  ShortByteString -> Hash256
Hash256 (ShortByteString -> Hash256)
-> (b -> ShortByteString) -> b -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> ShortByteString)
-> (b -> ByteString) -> b -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA256 -> ByteString)
-> (b -> Digest SHA256) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> Digest SHA256 -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 (Digest SHA256 -> Digest SHA256)
-> (b -> Digest SHA256) -> b -> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> b -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256

-- | Compute SHA-256 followed by RIPMED-160.
addressHash :: (ByteArrayAccess b) => b -> Hash160
addressHash :: forall b. ByteArrayAccess b => b -> Hash160
addressHash =
  ShortByteString -> Hash160
Hash160 (ShortByteString -> Hash160)
-> (b -> ShortByteString) -> b -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
toShort (ByteString -> ShortByteString)
-> (b -> ByteString) -> b -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest RIPEMD160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest RIPEMD160 -> ByteString)
-> (b -> Digest RIPEMD160) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RIPEMD160 -> Digest SHA256 -> Digest RIPEMD160
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith RIPEMD160
RIPEMD160 (Digest SHA256 -> Digest RIPEMD160)
-> (b -> Digest SHA256) -> b -> Digest RIPEMD160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> b -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256

{- CheckSum -}

-- | Computes a 32 bit checksum.
checkSum32 :: (ByteArrayAccess b) => b -> CheckSum32
checkSum32 :: forall b. ByteArrayAccess b => b -> CheckSum32
checkSum32 =
  CheckSum32 -> Either String CheckSum32 -> CheckSum32
forall b a. b -> Either a b -> b
fromRight (String -> CheckSum32
forall a. HasCallStack => String -> a
error String
"Could not decode bytes as CheckSum32")
    (Either String CheckSum32 -> CheckSum32)
-> (b -> Either String CheckSum32) -> b -> CheckSum32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get CheckSum32 -> ByteString -> Either String CheckSum32
forall a. Get a -> ByteString -> Either String a
runGetS Get CheckSum32
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m CheckSum32
deserialize
    (ByteString -> Either String CheckSum32)
-> (b -> ByteString) -> b -> Either String CheckSum32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
4
    (ByteString -> ByteString) -> (b -> ByteString) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert
    (Digest SHA256 -> ByteString)
-> (b -> Digest SHA256) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> Digest SHA256 -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256
    (Digest SHA256 -> Digest SHA256)
-> (b -> Digest SHA256) -> b -> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> b -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256

{- HMAC -}

-- | Computes HMAC over SHA-512.
hmac512 :: ByteString -> ByteString -> Hash512
hmac512 :: ByteString -> ByteString -> Hash512
hmac512 ByteString
key ByteString
msg =
  ShortByteString -> Hash512
Hash512 (ShortByteString -> Hash512) -> ShortByteString -> Hash512
forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ HMAC SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> ByteString -> HMAC SHA512
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
key ByteString
msg :: HMAC SHA512)

-- | Computes HMAC over SHA-256.
hmac256 :: (ByteArrayAccess k, ByteArrayAccess m) => k -> m -> Hash256
hmac256 :: forall k m.
(ByteArrayAccess k, ByteArrayAccess m) =>
k -> m -> Hash256
hmac256 k
key m
msg =
  ShortByteString -> Hash256
Hash256 (ShortByteString -> Hash256) -> ShortByteString -> Hash256
forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ HMAC SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (k -> m -> HMAC SHA256
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac k
key m
msg :: HMAC SHA256)

-- | Split a 'Hash512' into a pair of 'Hash256'.
split512 :: Hash512 -> (Hash256, Hash256)
split512 :: Hash512 -> (Hash256, Hash256)
split512 Hash512
h =
  (ShortByteString -> Hash256
Hash256 (ByteString -> ShortByteString
toShort ByteString
a), ShortByteString -> Hash256
Hash256 (ByteString -> ShortByteString
toShort ByteString
b))
  where
    (ByteString
a, ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
32 (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
fromShort Hash512
h.get

-- | Join a pair of 'Hash256' into a 'Hash512'.
join512 :: (Hash256, Hash256) -> Hash512
join512 :: (Hash256, Hash256) -> Hash512
join512 (Hash256
a, Hash256
b) = ShortByteString -> Hash512
Hash512 (ByteString -> ShortByteString
toShort (Hash256
a.get ShortByteString -> ShortByteString -> ByteString
`app` Hash256
b.get))
  where
    app :: ShortByteString -> ShortByteString -> ByteString
app = ByteString -> ByteString -> ByteString
B.append (ByteString -> ByteString -> ByteString)
-> (ShortByteString -> ByteString)
-> ShortByteString
-> ShortByteString
-> ByteString
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ShortByteString -> ByteString
fromShort

-- | Initialize tagged hash specified in BIP340
--
-- @since 0.21.0
initTaggedHash ::
  -- | Hash tag
  ByteString ->
  Context SHA256
initTaggedHash :: ByteString -> Context SHA256
initTaggedHash ByteString
tag =
  (Context SHA256 -> [Digest SHA256] -> Context SHA256
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
`hashUpdates` [Digest SHA256
hashedTag, Digest SHA256
hashedTag]) (Context SHA256 -> Context SHA256)
-> Context SHA256 -> Context SHA256
forall a b. (a -> b) -> a -> b
$
    forall a. HashAlgorithm a => Context a
hashInit @SHA256
  where
    hashedTag :: Digest SHA256
hashedTag = SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 ByteString
tag