Hash.hs

{-# 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
  { get :: Word32
  }
  deriving (Eq, Ord, Show, Read, Generic)
  deriving newtype (Hashable, NFData)

instance Serial CheckSum32 where
  serialize (CheckSum32 c) = putWord32be c
  deserialize = CheckSum32 <$> getWord32be

instance Serialize CheckSum32 where
  put = serialize
  get = deserialize

instance Binary CheckSum32 where
  put = serialize
  get = deserialize

-- | Type for 512-bit hashes.
newtype Hash512 = Hash512 {get :: ShortByteString}
  deriving (Eq, Ord, Generic)
  deriving newtype (Hashable, NFData)

-- | Type for 256-bit hashes.
newtype Hash256 = Hash256 {get :: ShortByteString}
  deriving (Eq, Ord, Generic)
  deriving newtype (Hashable, NFData)

-- | Type for 160-bit hashes.
newtype Hash160 = Hash160 {get :: ShortByteString}
  deriving (Eq, Ord, Generic)
  deriving newtype (Hashable, NFData)

instance Show Hash512 where
  showsPrec _ = shows . encodeHex . fromShort . (.get)

instance Read Hash512 where
  readPrec = do
    R.String str <- lexP
    maybe pfail (return . Hash512 . toShort) (decodeHex (cs str))

instance Show Hash256 where
  showsPrec _ = shows . encodeHex . fromShort . (.get)

instance Read Hash256 where
  readPrec = do
    R.String str <- lexP
    maybe pfail (return . Hash256 . toShort) (decodeHex (cs str))

instance Show Hash160 where
  showsPrec _ = shows . encodeHex . fromShort . (.get)

instance Read Hash160 where
  readPrec = do
    R.String str <- lexP
    maybe pfail (return . Hash160 . toShort) (decodeHex (cs str))

instance IsString Hash512 where
  fromString str =
    case decodeHex $ cs str of
      Nothing -> e
      Just bs ->
        case B.length bs of
          64 -> Hash512 (toShort bs)
          _ -> e
    where
      e = error "Could not decode hash from hex string"

instance Serial Hash512 where
  deserialize = Hash512 . toShort <$> getByteString 64
  serialize = putByteString . fromShort . (.get)

instance Serialize Hash512 where
  put = serialize
  get = deserialize

instance Binary Hash512 where
  put = serialize
  get = deserialize

instance IsString Hash256 where
  fromString str =
    case decodeHex $ cs str of
      Nothing -> e
      Just bs ->
        case B.length bs of
          32 -> Hash256 (toShort bs)
          _ -> e
    where
      e = error "Could not decode hash from hex string"

instance Serial Hash256 where
  deserialize = Hash256 . toShort <$> getByteString 32
  serialize = putByteString . fromShort . (.get)

instance Serialize Hash256 where
  put = serialize
  get = deserialize

instance Binary Hash256 where
  put = serialize
  get = deserialize

instance IsString Hash160 where
  fromString str =
    case decodeHex $ cs str of
      Nothing -> e
      Just bs ->
        case B.length bs of
          20 -> Hash160 (toShort bs)
          _ -> e
    where
      e = error "Could not decode hash from hex string"

instance Serial Hash160 where
  deserialize = Hash160 . toShort <$> getByteString 20
  serialize = putByteString . fromShort . (.get)

instance Serialize Hash160 where
  put = serialize
  get = deserialize

instance Binary Hash160 where
  put = serialize
  get = deserialize

-- | Calculate SHA512 hash.
sha512 :: (ByteArrayAccess b) => b -> Hash512
sha512 = Hash512 . toShort . convert . hashWith SHA512

-- | Calculate SHA256 hash.
sha256 :: (ByteArrayAccess b) => b -> Hash256
sha256 = Hash256 . toShort . convert . hashWith SHA256

-- | Calculate RIPEMD160 hash.
ripemd160 :: (ByteArrayAccess b) => b -> Hash160
ripemd160 = Hash160 . toShort . convert . hashWith RIPEMD160

-- | Claculate SHA1 hash.
sha1 :: (ByteArrayAccess b) => b -> Hash160
sha1 = Hash160 . toShort . convert . hashWith SHA1

-- | Compute two rounds of SHA-256.
doubleSHA256 :: (ByteArrayAccess b) => b -> Hash256
doubleSHA256 =
  Hash256 . toShort . convert . hashWith SHA256 . hashWith SHA256

-- | Compute SHA-256 followed by RIPMED-160.
addressHash :: (ByteArrayAccess b) => b -> Hash160
addressHash =
  Hash160 . toShort . convert . hashWith RIPEMD160 . hashWith SHA256

{- CheckSum -}

-- | Computes a 32 bit checksum.
checkSum32 :: (ByteArrayAccess b) => b -> CheckSum32
checkSum32 =
  fromRight (error "Could not decode bytes as CheckSum32")
    . runGetS deserialize
    . B.take 4
    . convert
    . hashWith SHA256
    . hashWith SHA256

{- HMAC -}

-- | Computes HMAC over SHA-512.
hmac512 :: ByteString -> ByteString -> Hash512
hmac512 key msg =
  Hash512 $ toShort $ convert (hmac key msg :: HMAC SHA512)

-- | Computes HMAC over SHA-256.
hmac256 :: (ByteArrayAccess k, ByteArrayAccess m) => k -> m -> Hash256
hmac256 key msg =
  Hash256 $ toShort $ convert (hmac key msg :: HMAC SHA256)

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

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

-- | Initialize tagged hash specified in BIP340
--
-- @since 0.21.0
initTaggedHash ::
  -- | Hash tag
  ByteString ->
  Context SHA256
initTaggedHash tag =
  (`hashUpdates` [hashedTag, hashedTag]) $
    hashInit @SHA256
  where
    hashedTag = hashWith SHA256 tag