module Crypto.Multihash
(
MultihashDigest
, Base (..)
, Codable (..)
, Encodable (..)
, multihash
, multihashlazy
, truncatedMultihash
, truncatedMultihash'
, checkMultihash
, checkMultihash'
, getBase
, HashAlgorithm
, SHA1(..)
, SHA256(..)
, SHA512(..)
, SHA3_512(..)
, SHA3_384(..)
, SHA3_256(..)
, SHA3_224(..)
, Blake2b_512(..)
, Blake2s_256(..)
) where
import Crypto.Hash (Digest, hash, hashlazy)
import Crypto.Hash.Algorithms
import Data.ByteArray (ByteArrayAccess, Bytes)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.List (elemIndex)
import Data.String (IsString(..))
import Data.String.Conversions
import Data.Word (Word8)
import Crypto.Multihash.Internal.Types
import Crypto.Multihash.Internal
data MultihashDigest a = MultihashDigest
{ _getAlgorithm :: a
, _getLength :: Int
, _getDigest :: Digest a
} deriving (Eq)
instance (HashAlgorithm a, Codable a) => Show (MultihashDigest a) where
show = encode' Base58
instance (HashAlgorithm a, Codable a) => Encodable (MultihashDigest a) where
encode base (MultihashDigest alg len md) =
if len <=0 || len > BA.length md
then
Left "Corrupted MultihashDigest: invalid length"
else do
d <- fullDigestUnpacked
return $ fromString $ map (toEnum . fromIntegral) d
where
fullDigestUnpacked :: Either String [Word8]
fullDigestUnpacked = do
d <- encoder base fullDigest
return $ BA.unpack d
fullDigest :: Bytes
fullDigest = BA.pack [dHead, dSize] `BA.append` dTail
where
dHead :: Word8
dHead = fromIntegral $ toCode alg
dSize :: Word8
dSize = fromIntegral len
dTail :: Bytes
dTail = BA.take len (BA.convert md)
check hash_ multihash_ = let hash_' = convertString hash_ in do
base <- getBase hash_'
m <- encode base multihash_
return (m == hash_')
newtype Payload bs = Payload bs
instance ByteArrayAccess bs => Checkable (Payload bs) where
checkPayload hash_ (Payload p) = let hash' = convertString hash_ in do
base <- getBase hash'
mhd <- convertFromBase base hash'
if badLength mhd
then
Left "Corrupted MultihasDigest: invalid length"
else do
m <- getBinaryEncodedMultihash mhd p
return (m == mhd)
multihashlazy :: (HashAlgorithm a, Codable a) => a -> BL.ByteString -> MultihashDigest a
multihashlazy alg bs = let digest = hashlazy bs
in MultihashDigest alg (BA.length digest) digest
multihash :: (HashAlgorithm a, Codable a, ByteArrayAccess bs) => a -> bs -> MultihashDigest a
multihash alg bs = let digest = hash bs
in MultihashDigest alg (BA.length digest) digest
truncatedMultihash :: (HashAlgorithm a, Codable a, ByteArrayAccess bs)
=> Int -> a -> bs -> Either String (MultihashDigest a)
truncatedMultihash len alg bs = let digest = hash bs in
if len <= 0 || len > BA.length digest
then Left "invalid truncated multihash lenght"
else Right $ MultihashDigest alg len digest
truncatedMultihash' :: (HashAlgorithm a, Codable a, ByteArrayAccess bs)
=> Int -> a -> bs -> MultihashDigest a
truncatedMultihash' len alg bs = eitherToErr $ truncatedMultihash len alg bs
checkMultihash :: (IsString s, ConvertibleStrings s BS.ByteString, ByteArrayAccess bs)
=> s -> bs -> Either String Bool
checkMultihash h p = checkPayload h (Payload p)
checkMultihash' :: (IsString s, ConvertibleStrings s BS.ByteString, ByteArrayAccess bs)
=> s -> bs -> Bool
checkMultihash' h p = checkPayload' h (Payload p)
getBinaryEncodedMultihash :: (ByteArrayAccess bs, IsString s)
=> BS.ByteString -> bs -> Either String s
getBinaryEncodedMultihash mhd uh =
case elemIndex bitOne hashCodes of
Just 0 -> rs SHA1 uh
Just 1 -> rs SHA256 uh
Just 2 -> rs SHA512 uh
Just 3 -> rs SHA3_512 uh
Just 4 -> rs SHA3_384 uh
Just 5 -> rs SHA3_256 uh
Just 6 -> rs SHA3_224 uh
Just 7 -> rs Blake2b_512 uh
Just 8 -> rs Blake2s_256 uh
Just _ -> Left "This should be impossible"
Nothing -> Left "Impossible to infer the appropriate hash from the header"
where
[bitOne, bitTwo] = take 2 $ BA.unpack mhd
rs alg s = truncatedMultihash (fromIntegral bitTwo) alg s >>= encode Base2
hashCodes :: [Word8]
hashCodes = map fromIntegral
([0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x40, 0x41]::[Int])