Z-Botan-0.3.0.0: Crypto for Haskell
CopyrightDong Han 2021
LicenseBSD
Maintainerwinterland1989@gmail.com
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Z.Crypto.Hash

Description

Hash functions are one-way functions, which map data of arbitrary size to a fixed output length. Most of the hash functions in Botan are designed to be cryptographically secure, which means that it is computationally infeasible to create a collision (finding two inputs with the same hash) or preimages (given a hash output, generating an arbitrary input with the same hash). But note that not all such hash functions meet their goals, in particular MD4 and MD5 are trivially broken. However they are still included due to their wide adoption in various protocols.

Using a hash function is typically split into three stages: initialization, update, and finalization (often referred to as a IUF interface). The initialization stage is implicit: after creating a Hash function object, it is ready to process data. Then update is called one or more times. Calling update several times is equivalent to calling it once with all of the arguments concatenated. After completing a hash computation (eg using final), the internal state is reset to begin hashing a new message.

Synopsis

Hash type

data HashType Source #

Available Hashs

Constructors

BLAKE2b Int

A recently designed hash function. Very fast on 64-bit processors. Can output a hash of any length between 1 and 64 bytes, this is specified by passing desired byte length.

BLAKE2b256

Alias for Blake2b 32

BLAKE2b512

Alias for Blake2b 64

Keccak1600_224

An older (and incompatible) variant of SHA-3, but sometimes used. Prefer SHA-3 in new code.

Keccak1600_256 
Keccak1600_384 
Keccak1600_512 
MD4

An old hash function that is now known to be trivially breakable. It is very fast, and may still be suitable as a (non-cryptographic) checksum.

MD5

Widely used, now known to be broken.

RIPEMD160

A 160 bit hash function, quite old but still thought to be secure (up to the limit of 2**80 computation required for a collision which is possible with any 160 bit hash function). Somewhat deprecated these days.

SHA160

Widely adopted NSA designed hash function. Starting to show significant signs of weakness, and collisions can now be generated. Avoid in new designs.

SHA256

Relatively fast 256 bit hash function, thought to be secure. Also includes the variant SHA-224. There is no real reason to use SHA-224.

SHA224 
SHA512

SHA-512 is faster than SHA-256 on 64-bit processors. Also includes the truncated variants SHA-384 and SHA-512/256, which have the advantage of avoiding message extension attacks.

SHA384 
SHA512_256 
SHA3_224

The new NIST standard hash. Fairly slow. Supports 224, 256, 384 or 512 bit outputs. SHA-3 is faster with smaller outputs. Use as “SHA3_256” or “SHA3_512”. Plain “SHA-3” selects default 512 bit output.

SHA3_256 
SHA3_384 
SHA3_512 
SHAKE128 Int

These are actually XOFs (extensible output functions) based on SHA-3, which can output a value of any byte length. For example “SHAKE128 @128” will produce 1024 bits of output.

SHAKE256 Int 
SM3

Chinese national hash function, 256 bit output. Widely used in industry there. Fast and seemingly secure, but no reason to prefer it over SHA-2 or SHA-3 unless required.

Skein512 Int CBytes

A contender for the NIST SHA-3 competition. Very fast on 64-bit systems. Can output a hash of any length between 1 and 64 bytes. It also accepts an optional “personalization string” which can create variants of the hash. This is useful for domain separation.

Streebog256

Newly designed Russian national hash function. Due to use of input-dependent table lookups, it is vulnerable to side channels. There is no reason to use it unless compatibility is needed. Warning: The Streebog Sbox has recently been revealed to have a hidden structure which interacts with its linear layer in a way which may provide a backdoor when used in certain ways. Avoid Streebog if at all possible.

Streebog512 
Whirlpool

A 512-bit hash function standardized by ISO and NESSIE. Relatively slow, and due to the table based implementation it is potentially vulnerable to cache based side channels.

Parallel HashType HashType

Parallel simply concatenates multiple hash functions. For example “Parallel SHA256 SHA512 outputs a 256+512 bit hash created by hashing the input with both SHA256 and SHA512 and concatenating the outputs.

Comb4P HashType HashType

This combines two cryptographic hashes in such a way that preimage and collision attacks are provably at least as hard as a preimage or collision attack on the strongest hash.

Adler32

Checksums, not suitable for cryptographic use, but can be used for error checking purposes.

CRC24 
CRC32 

Instances

Instances details
Eq HashType Source # 
Instance details

Defined in Z.Crypto.Hash

Ord HashType Source # 
Instance details

Defined in Z.Crypto.Hash

Read HashType Source # 
Instance details

Defined in Z.Crypto.Hash

Show HashType Source # 
Instance details

Defined in Z.Crypto.Hash

Generic HashType Source # 
Instance details

Defined in Z.Crypto.Hash

Associated Types

type Rep HashType :: Type -> Type #

Methods

from :: HashType -> Rep HashType x #

to :: Rep HashType x -> HashType #

JSON HashType Source # 
Instance details

Defined in Z.Crypto.Hash

Print HashType Source # 
Instance details

Defined in Z.Crypto.Hash

Methods

toUTF8BuilderP :: Int -> HashType -> Builder () #

type Rep HashType Source # 
Instance details

Defined in Z.Crypto.Hash

type Rep HashType = D1 ('MetaData "HashType" "Z.Crypto.Hash" "Z-Botan-0.3.0.0-A7CYDOzUZjP9PeT4WTwYc" 'False) (((((C1 ('MetaCons "BLAKE2b" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :+: C1 ('MetaCons "BLAKE2b256" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "BLAKE2b512" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Keccak1600_224" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Keccak1600_256" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Keccak1600_384" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Keccak1600_512" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MD4" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "MD5" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "RIPEMD160" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "SHA160" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SHA256" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "SHA224" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SHA512" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "SHA384" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SHA512_256" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: ((((C1 ('MetaCons "SHA3_224" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SHA3_256" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "SHA3_384" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SHA3_512" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "SHAKE128" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int)) :+: C1 ('MetaCons "SHAKE256" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int))) :+: (C1 ('MetaCons "SM3" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Skein512" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CBytes))))) :+: (((C1 ('MetaCons "Streebog256" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Streebog512" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Whirlpool" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Parallel" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HashType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HashType)))) :+: ((C1 ('MetaCons "Comb4P" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HashType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HashType)) :+: C1 ('MetaCons "Adler32" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "CRC24" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CRC32" 'PrefixI 'False) (U1 :: Type -> Type))))))

data Hash Source #

A Botan Hash Object.

Instances

Instances details
Show Hash Source # 
Instance details

Defined in Z.Crypto.Hash

Methods

showsPrec :: Int -> Hash -> ShowS #

show :: Hash -> String #

showList :: [Hash] -> ShowS #

Generic Hash Source # 
Instance details

Defined in Z.Crypto.Hash

Associated Types

type Rep Hash :: Type -> Type #

Methods

from :: Hash -> Rep Hash x #

to :: Rep Hash x -> Hash #

Print Hash Source # 
Instance details

Defined in Z.Crypto.Hash

Methods

toUTF8BuilderP :: Int -> Hash -> Builder () #

type Rep Hash Source # 
Instance details

Defined in Z.Crypto.Hash

type Rep Hash = D1 ('MetaData "Hash" "Z.Crypto.Hash" "Z-Botan-0.3.0.0-A7CYDOzUZjP9PeT4WTwYc" 'False) (C1 ('MetaCons "Hash" 'PrefixI 'True) (S1 ('MetaSel ('Just "hashStruct") 'SourceUnpack 'SourceStrict 'DecidedStrict) (Rec0 BotanStruct) :*: (S1 ('MetaSel ('Just "hashName") 'SourceUnpack 'SourceStrict 'DecidedStrict) (Rec0 CBytes) :*: S1 ('MetaSel ('Just "hashSize") 'SourceUnpack 'SourceStrict 'DecidedStrict) (Rec0 Int))))

hashName :: Hash -> CBytes Source #

hash algo name

hashSize :: Hash -> Int Source #

hash output size in bytes

IUF interface

newHash :: HasCallStack => HashType -> IO Hash Source #

Create a new Hash object.

updateHash :: HasCallStack => Hash -> Bytes -> IO () Source #

Feed a chunk of input into a hash object.

finalHash :: HasCallStack => Hash -> IO Bytes Source #

Compute hash value.

copyHash :: HasCallStack => Hash -> IO Hash Source #

Copies the state of the hash object to a new hash object.

clearHash :: HasCallStack => Hash -> IO () Source #

Reset the state of Hash object back to clean, as if no input has been supplied.

function interface

hash :: HasCallStack => HashType -> Bytes -> Bytes Source #

Directly compute a message's hash.

hashChunks :: HasCallStack => HashType -> [Bytes] -> Bytes Source #

Directly compute a chunked message's hash.

BIO interface

sinkToHash :: HasCallStack => Hash -> Sink Bytes Source #

Trun Hash to a Bytes sink, update Hash by write bytes to the sink.

import Z.Data.CBytes
import Z.Data.Vector.Hex
import Z.Botan.Hash
import Z.IO

-- | Calculate SHA256 and MD5 checksum for a file in one streaming pass.
sha256AndMd5File :: CBytes -> IO (HexBytes, HexBytes)
sha256AndMd5File f =
    withResource (sourceFromFile f) $  src -> do
        md5 <- newHash MD5
        sha256 <- newHash SHA256
        runBIO $ src . (joinSink (sinkToHash md5) (sinkToHash sha256))
        h1 <- finalHash md5
        h2 <- finalHash sha256
        return (HexBytes h1, HexBytes h2)

Internal helper

withHash :: Hash -> (BotanStructT -> IO r) -> IO r Source #

Pass Hash to FFI as botan_hash_t