diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # Crypto Multihash [![Build Status](https://travis-ci.org/mseri/crypto-multihash.svg?branch=master)](https://travis-ci.org/mseri/crypto-multihash) -![Hackage](https://img.shields.io/hackage/v/crypto-multihash.svg) +[![Hackage](https://img.shields.io/hackage/v/crypto-multihash.svg)](http://hackage.haskell.org/package/crypto-multihash) ![Hackage Dependencies](https://img.shields.io/hackage-deps/v/crypto-multihash.svg) ![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg) ![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg) @@ -23,12 +23,16 @@ -- in ghci `:set -XOverloadedStrings` {-# LANGUAGE OverloadedStrings #-} +-- `:m +Crypto.Multihash` import Crypto.Multihash import Data.ByteString (ByteString) main = do let v = "test"::ByteString let m = multihash SHA256 v + + -- If using the Weak module + -- let m' = weakMultihash "sha256" v putStrLn $ "Base16: " ++ (encode' Base16 m) -- You might need to specify the encoded string type @@ -38,20 +42,32 @@ putStrLn $ "Base64: " ++ show (encode Base64 m :: Either String String) let h = encode' Base58 m :: ByteString - checkMultihash h v + -- You can check that a multihash corresponds to some data `v` + -- but you need to wrap the data in the newtype `Payload` + checkPayload h (Payload v) -- Right True + -- Or if you have a Multihash to compare you can use it + check h m + -- Right True + -- There is also an unsafe version, as for encode - checkMultihash' "whatever" v + -- note that sometimes you will need to specify the string types + checkPayload' ("whatever"::String) (Payload v) -- *** Exception: Unable to infer an encoding - checkMultihash' "Eiwhatever" v + checkPayload' ("Eiwhatever"::ByteString) (Payload v) -- *** Exception: base64: input: invalid length - checkMultihash' "EiCfhtCBiEx9ZZov6qDFWtAVo79PGysLgizRXWwVsPA1CA==" v + check' ("EiCfhtCBiEx9ZZov6qDFWtAVo79PGysLgizRXWwVsPA1CA=="::ByteString) m -- False - checkMultihash' h v + + checkPayload' h (Payload v) -- True + check' h m + -- True ``` +The of `import Crypto.Multihash.Weak` is almost identical, but it additionally introduces the function `toWeakMultihash` that tries to import a string as a `WeakMultihashDigest`. + # Test Some preliminary tests can be performed with `stack test`. @@ -82,10 +98,8 @@ # TODO -- ~~Improve documentation~~ -- ~~Implement hash checker that takes some data and an encoded multihash and check that the multihash corresponds to the data (inferring automatically the appropriate hash function)~~ -- ~~Evaluate if throwing an error in the encode function is the wanted behaviour and anyway implement a safe version returning an Either type~~ -- Add testing for ~~the newly introduced checker and~~ for raised exceptions -- Add multihash checker into the cli example +- Use the hash length in `checkPayload` to treat correctly truncated hashes (see https://github.com/jbenet/multihash/issues/1#issuecomment-91783612) +- Improve documentation +- Improve testing for for raised exceptions - Implement `shake-128` and `shake-256` multihashes - Implement `Base32` encoding waiting for https://github.com/jbenet/multihash/issues/31 to be resolved) diff --git a/crypto-multihash.cabal b/crypto-multihash.cabal --- a/crypto-multihash.cabal +++ b/crypto-multihash.cabal @@ -1,11 +1,11 @@ name: crypto-multihash -version: 0.3.0.0 +version: 0.4.0.0 synopsis: Multihash library on top of cryptonite crypto library description: Multihash is a protocol for encoding the hash algorithm and digest length at the start of the digest, see the official . Usage and additional informations are on README.md -homepage: https://github.com/mseri/crypto-multihash#readme +homepage: https://github.com/mseri/crypto-multihash#crypto-multihash license: BSD3 license-file: LICENSE author: Marcello Seri @@ -20,13 +20,17 @@ library hs-source-dirs: src exposed-modules: Crypto.Multihash - ghc-options: -Wall -fwarn-tabs -fno-warn-name-shadowing -fwarn-pointless-pragmas + , Crypto.Multihash.Weak + other-modules: Crypto.Multihash.Internal + , Crypto.Multihash.Internal.Types + ghc-options: -Wall -fwarn-tabs -fno-warn-name-shadowing build-depends: base >= 4.7 && < 5 , base58-bytestring , bytestring , containers , cryptonite , memory + , string-conversions default-language: Haskell2010 executable mh diff --git a/src/Crypto/Multihash.hs b/src/Crypto/Multihash.hs --- a/src/Crypto/Multihash.hs +++ b/src/Crypto/Multihash.hs @@ -18,15 +18,21 @@ -- . -- {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +-- TODO: use length in check* to treat correctly truncated hashes +-- see https://github.com/jbenet/multihash/issues/1#issuecomment-91783612 + module Crypto.Multihash ( -- * Multihash Types MultihashDigest , Base (..) , Codable (..) + , Encodable (..) + , Checkable (..) + , Payload (..) -- * Multihash helpers - , encode - , encode' , multihash , multihashlazy , checkMultihash @@ -46,65 +52,79 @@ import Crypto.Hash (Digest, hash, hashlazy) import Crypto.Hash.Algorithms ---import Crypto.Hash.IO import Data.ByteArray (ByteArrayAccess, Bytes) import qualified Data.ByteArray as BA -import qualified Data.ByteArray.Encoding as BE import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Base58 as B58 import Data.List (elemIndex) import Data.String (IsString(..)) +import Data.String.Conversions import Data.Word (Word8) -import Text.Printf (printf) --- | 'Base' usable to encode the digest -data Base = Base2 -- ^ Binary form - | Base16 -- ^ Hex encoding - | Base32 -- ^ Not yet implemented. Waiting for - | Base58 -- ^ Bitcoin base58 encoding - | Base64 -- ^ Base64 encoding - deriving (Show, Eq) +------------------------------------------------------------------------------- +import Crypto.Multihash.Internal.Types +import Crypto.Multihash.Internal +------------------------------------------------------------------------------- -- | Multihash Digest container data MultihashDigest a = MultihashDigest - { getAlgorithm :: a -- ^ hash algorithm - , getLength :: Int -- ^ hash lenght - , getDigest :: Digest a -- ^ binary digest data + { _getAlgorithm :: a -- ^ hash algorithm + , _getLength :: Int -- ^ hash lenght + , _getDigest :: Digest a -- ^ binary digest data } deriving (Eq) --- | 'Codable' hash algorithms are the algorithms supported for multihashing -class Codable a where - -- | Returns the first byte for the head of the multihash digest - toCode :: a -> Int +instance (HashAlgorithm a, Codable a) => Show (MultihashDigest a) where + show = encode' Base58 -instance Codable SHA1 where - toCode SHA1 = 0x11 -instance Codable SHA256 where - toCode SHA256 = 0x12 -instance Codable SHA512 where - toCode SHA512 = 0x13 -instance Codable SHA3_512 where - toCode SHA3_512 = 0x14 -instance Codable SHA3_384 where - toCode SHA3_384 = 0x15 -instance Codable SHA3_256 where - toCode SHA3_256 = 0x16 -instance Codable SHA3_224 where - toCode SHA3_224 = 0x17 -instance Codable Blake2b_512 where - toCode Blake2b_512 = 0x40 -instance Codable Blake2s_256 where - toCode Blake2s_256 = 0x41 +instance (HashAlgorithm a, Codable a) => Encodable (MultihashDigest a) where + encode base (MultihashDigest alg len md) = + if len == BA.length md + then do + d <- fullDigestUnpacked + return $ fromString $ map (toEnum . fromIntegral) d + else + Left "Corrupted MultihashDigest: invalid length" --- TODO: add shake-128/256 to Codable. Probably --- fromCode 0x18 = Keccak_256 --- fromCode 0x19 = Keccak_512 + where + fullDigestUnpacked :: Either String [Word8] + fullDigestUnpacked = do + d <- encoder base fullDigest + return $ BA.unpack d -instance Show (MultihashDigest a) where - show (MultihashDigest _ _ d) = show 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.convert md + check hash_ multihash_ = let hash_' = convertString hash_ in do + base <- getBase hash_' + m <- encode base multihash_ + return (m == hash_') + +-- | Newtype to allow the creation of a 'Checkable' typeclass for +-- all 'ByteArrayAccess' without recurring to UndecidableInstances +newtype Payload bs = Payload bs + +instance ByteArrayAccess bs => Checkable (Payload bs) where + -- checkPayload :: (IsString s, ByteArrayAccess bs) => s -> bs -> Either String Bool + checkPayload hash_ (Payload p) = let hash' = convertString hash_ in do + base <- getBase hash' + mhd <- convertFromBase base hash' + -- Hacky... think to a different approach + if badLength mhd + then + Left "Corrupted MultihasDigest: invalid length" + else do + m <- getBinaryEncodedMultihash mhd p + return (m == mhd) + +------------------------------------------------------------------------------- + -- | Helper to multihash a lazy 'BL.ByteString' using a supported hash algorithm. -- Uses 'Crypto.Hash.hashlazy' for hashing. multihashlazy :: (HashAlgorithm a, Codable a) => a -> BL.ByteString -> MultihashDigest a @@ -117,116 +137,25 @@ multihash alg bs = let digest = hash bs in MultihashDigest alg (BA.length digest) digest - --- | Safe encoder for 'MultihashDigest'. -encode :: (HashAlgorithm a, Codable a, Show a, IsString s) => - Base -> MultihashDigest a -> Either String s -encode base (MultihashDigest alg len md) = - if len == BA.length md - then do - d <- fullDigestUnpacked - return $ fromString $ map (toEnum . fromIntegral) d - else - Left $ printf "Corrupted %s MultihashDigest: invalid length" (show alg) - - where - fullDigestUnpacked :: Either String [Word8] - fullDigestUnpacked = do - d <- encoder fullDigest - return $ BA.unpack d - where - encoder :: ByteArrayAccess a => a -> Either String Bytes - encoder bs = case base of - Base2 -> return $ BA.convert bs - Base16 -> return $ BE.convertToBase BE.Base16 bs - Base32 -> Left "Base32 encoder not implemented" - Base58 -> return $ BA.convert $ B58.encodeBase58 B58.bitcoinAlphabet - (BA.convert bs :: BS.ByteString) - Base64 -> return $ BE.convertToBase BE.Base64 bs - - 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.convert md - --- | Unsafe encoder for 'MultihashDigest'. --- Throws an error if there are encoding issues or the 'MultihashDigest' --- length field does not match the 'Digest' length. -encode' :: (HashAlgorithm a, Codable a, Show a, IsString s) - => Base -> MultihashDigest a -> s -encode' base md = - case encode base md of - Right enc -> enc - Left err -> error err - --- | Safely check the correctness of an encoded 'MultihashDigest' against the --- corresponding data. Tha data is passed as a 'ByteArrayAccess' --- (e.g. a 'BS.BinaryString'). -checkMultihash :: ByteArrayAccess bs => BS.ByteString -> bs -> Either String Bool -checkMultihash hash unahshedData = do - base <- getBase hash - mhd <- convertFromBase base hash - -- Hacky... think to a different approach - if badLength mhd - then - Left "Corrupted MultihasDigest: invalid length" - else do - m <- getBinaryEncodedMultihash mhd unahshedData - return (C.pack m == mhd) - --- | Unsafe version of 'checkMultihash'. Throws on encoding/decoding errors --- instead of returning an 'Either' type. -checkMultihash' :: ByteArrayAccess bs => BS.ByteString -> bs -> Bool -checkMultihash' hash unahshedData = - case checkMultihash hash unahshedData of - Right ans -> ans - Left err -> error err - --- Helpers - These are not exported currently, and probably will never be. - -maybeToEither :: l -> Maybe r -> Either l r -maybeToEither _ (Just res) = Right res -maybeToEither err _ = Left err +------------------------------------------------------------------------------- --- | Convert a 'BS.ByteString' from a 'Base' into a 'BS.BinaryString' in 'Base2'. -convertFromBase :: Base -> BS.ByteString -> Either String BS.ByteString -convertFromBase b bs = case b of - Base2 -> Left "This is not supposed to happen" - Base16 -> BE.convertFromBase BE.Base16 bs - Base32 -> Left "Base32 decoder not implemented" - Base58 -> do - dec <- maybeToEither "Base58 decoding error" (B58.decodeBase58 B58.bitcoinAlphabet bs) - return (BA.convert dec) - Base64 -> BE.convertFromBase BE.Base64 bs +-- | 'checkPayload' wrapper for API retro-compatibility +checkMultihash :: (IsString s, ConvertibleStrings s BS.ByteString, ByteArrayAccess bs) + => s -> bs -> Either String Bool +checkMultihash h p = checkPayload h (Payload p) --- | Infer the 'Base' encoding function from an encoded 'BS.BinaryString' representing --- a 'MultihashDigest'. -getBase :: BS.ByteString -> Either String Base -getBase h - | startWiths h ["1114", "1220", "1340", "1440", "1530", "1620", "171c", "4040", "4120"] = Right Base16 - | startWiths h ["5d", "Qm", "8V", "8t", "G9", "W1", "5d", "S2", "2U"] = Right Base58 - | startWiths h ["ER", "Ei", "E0", "FE", "FT", "Fi", "Fx", "QE", "QS"] = Right Base64 - | otherwise = Left "Unable to infer an encoding" - where startWiths h = any (`BS.isPrefixOf` h) +-- | Unsafe 'checkPayload' wrapper for API retro-compatibility +checkMultihash' :: (IsString s, ConvertibleStrings s BS.ByteString, ByteArrayAccess bs) + => s -> bs -> Bool +checkMultihash' h p = checkPayload' h (Payload p) --- | Compares the lenght of the encoded 'MultihashDigest' with the encoded hash length. --- Returns 'True' if the lengths are matching. -badLength :: ByteArrayAccess bs => bs -> Bool -badLength mh = - case BA.length mh of - n | n <= 2 -> True - n | BA.index mh 1 /= (fromIntegral n-2) -> True - _ -> False +------------------------------------------------------------------------------- -- | Infer the hash function from an unencoded 'BS.BinaryString' representing -- a 'MultihashDigest' and uses it to binary encode the data in a 'MultihashDigest'. -getBinaryEncodedMultihash :: (ByteArrayAccess bs, IsString s) => BS.ByteString -> bs -> Either String s -getBinaryEncodedMultihash mhd uh = let bitOne = head $ BS.unpack mhd in +getBinaryEncodedMultihash :: (ByteArrayAccess bs, IsString s) + => BS.ByteString -> bs -> Either String s +getBinaryEncodedMultihash mhd uh = let bitOne = head $ BA.unpack mhd in case elemIndex bitOne hashCodes of Just 0 -> rs SHA1 uh Just 1 -> rs SHA256 uh diff --git a/src/Crypto/Multihash/Internal.hs b/src/Crypto/Multihash/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Multihash/Internal.hs @@ -0,0 +1,70 @@ +-- | +-- Module : Crypto.Multihash.Internal +-- License : BSD3 +-- Maintainer : Marcello Seri +-- Stability : experimental +-- Portability : unknown +-- +{-# LANGUAGE OverloadedStrings #-} +module Crypto.Multihash.Internal where + +import Data.ByteArray (ByteArrayAccess(..)) +import qualified Data.ByteArray as BA +import qualified Data.ByteArray.Encoding as BE +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base58 as B58 +import Data.Word (Word8) + +------------------------------------------------------------------------------- +import Crypto.Multihash.Internal.Types +------------------------------------------------------------------------------- + +-- | Convert a maybe type to an either type +maybeToEither :: l -> Maybe r -> Either l r +maybeToEither _ (Just res) = Right res +maybeToEither err _ = Left err + +-- | Codes corresponding to the various hash algorithms +hashCodes :: [Word8] +hashCodes = map fromIntegral + ([0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x40, 0x41]::[Int]) + +-- | Convert a 'BS.ByteString' from a 'Base' into a 'BS.ByteString' in 'Base2'. +convertFromBase :: Base -> BS.ByteString -> Either String BS.ByteString +convertFromBase b bs = case b of + Base2 -> Left "This is not supposed to happen" + Base16 -> BE.convertFromBase BE.Base16 bs + Base32 -> Left "Base32 decoder not implemented" + Base58 -> do + dec <- maybeToEither "Base58 decoding error" (B58.decodeBase58 B58.bitcoinAlphabet bs) + return (BA.convert dec) + Base64 -> BE.convertFromBase BE.Base64 bs + +-- | Infer the 'Base' encoding function from an encoded 'BS.BinaryString' representing +-- a 'MultihashDigest'. +getBase :: BS.ByteString -> Either String Base +getBase h + | startWiths h ["1114", "1220", "1340", "1440", "1530", "1620", "171c", "4040", "4120"] = Right Base16 + | startWiths h ["5d", "Qm", "8V", "8t", "G9", "W1", "5d", "S2", "2U"] = Right Base58 + | startWiths h ["ER", "Ei", "E0", "FE", "FT", "Fi", "Fx", "QE", "QS"] = Right Base64 + | otherwise = Left "Unable to infer an encoding" + where startWiths h = any (`BS.isPrefixOf` h) + +-- | Encode the binary data using a given 'Base'. +encoder :: ByteArrayAccess a => Base -> a -> Either String BA.Bytes +encoder base bs = case base of + Base2 -> return $ BA.convert bs + Base16 -> return $ BE.convertToBase BE.Base16 bs + Base32 -> Left "Base32 encoder not implemented" + Base58 -> return $ BA.convert $ B58.encodeBase58 B58.bitcoinAlphabet + (BA.convert bs :: BS.ByteString) + Base64 -> return $ BE.convertToBase BE.Base64 bs + +-- | Compare the lenght of the encoded multihash digest with the encoded hash length. +-- Return 'True' if the lengths are matching. +badLength :: ByteArrayAccess bs => bs -> Bool +badLength mh = + case BA.length mh of + n | n <= 2 -> True + n | BA.index mh 1 /= (fromIntegral n-2) -> True + _ -> False diff --git a/src/Crypto/Multihash/Internal/Types.hs b/src/Crypto/Multihash/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Multihash/Internal/Types.hs @@ -0,0 +1,79 @@ +-- | +-- Module : Crypto.Multihash.Internal.Types +-- License : BSD3 +-- Maintainer : Marcello Seri +-- Stability : experimental +-- Portability : unknown +-- +{-# LANGUAGE FlexibleContexts #-} +module Crypto.Multihash.Internal.Types where + +import Crypto.Hash.Algorithms +import Data.ByteString (ByteString) +import Data.String (IsString(..)) +import Data.String.Conversions + +-- | 'Base' usable to encode the digest +data Base = Base2 -- ^ Binary form + | Base16 -- ^ Hex encoding + | Base32 -- ^ Not yet implemented. Waiting for + | Base58 -- ^ Bitcoin base58 encoding + | Base64 -- ^ Base64 encoding + deriving (Eq, Show) + +-- | 'Codable' hash algorithms are the algorithms supported for multihashing +class Codable a where + -- | Return the first byte for the head of the multihash digest + toCode :: a -> Int + +instance Codable SHA1 where + toCode SHA1 = 0x11 +instance Codable SHA256 where + toCode SHA256 = 0x12 +instance Codable SHA512 where + toCode SHA512 = 0x13 +instance Codable SHA3_512 where + toCode SHA3_512 = 0x14 +instance Codable SHA3_384 where + toCode SHA3_384 = 0x15 +instance Codable SHA3_256 where + toCode SHA3_256 = 0x16 +instance Codable SHA3_224 where + toCode SHA3_224 = 0x17 +instance Codable Blake2b_512 where + toCode Blake2b_512 = 0x40 +instance Codable Blake2s_256 where + toCode Blake2s_256 = 0x41 + +-- TODO: add shake-128/256 to Codable. Probably +-- fromCode 0x18 = Keccak_256 +-- fromCode 0x19 = Keccak_512 + +class Encodable a where + -- | Safe encoder for 'Encodable'. + encode :: IsString s => Base -> a -> Either String s + -- | Unsafe encoder for 'Encodable'. + -- Throws an error if there are encoding issues. + encode' :: IsString s => Base -> a -> s + encode' base digest = fromString <$> eitherToErr $ encode base digest + + -- | Safely check the correctness of an encoded 'Encodable' against a plain + -- 'Encodable'. + check :: (IsString s, ConvertibleStrings s ByteString) => s -> a -> Either String Bool + -- | Unsafe version of 'check'. Throws on encoding/decoding errors instead of returning an Either type. + check' :: (IsString s, ConvertibleStrings s ByteString) => s -> a -> Bool + check' encoded digest = eitherToErr $ check encoded digest + +class Checkable b where + -- | Safely check the correctness of an encoded 'Encodable' against the + -- corresponding data. + checkPayload :: (IsString s, ConvertibleStrings s ByteString) => s -> b -> Either String Bool + -- | Unsafe version of 'checkPayload'. + -- Throws on encoding/decoding errors instead of returning an 'Either' type. + checkPayload' :: (IsString s, ConvertibleStrings s ByteString) => s -> b -> Bool + checkPayload' encoded payload = eitherToErr $ checkPayload encoded payload + +eitherToErr :: Either String b -> b +eitherToErr v = case v of + Right val -> val + Left err -> error err diff --git a/src/Crypto/Multihash/Weak.hs b/src/Crypto/Multihash/Weak.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Multihash/Weak.hs @@ -0,0 +1,253 @@ +-- | +-- Module : Crypto.Multihash.Weak +-- License : BSD3 +-- Maintainer : Marcello Seri +-- Stability : experimental +-- Portability : unknown +-- +-- Multihash library built on top of haskell 'cryptonite' crypto package +-- Multihash is a protocol for encoding the hash algorithm and digest length +-- at the start of the digest, see the official +-- . +-- +-- The 'Crypto.Multihash.Weak' module contains a weaker implementation of the +-- MultihashDigest type that allows to deserialize multihashes and to work with +-- different algorithms at the same type. The API interface is almost identical +-- to the one exposed by 'Crypto.Multihash'. The notable differences are: +-- +-- - the hash algorithms is no longer a type +-- - the type returned by the multihash constructors is an 'Either' +-- (see 'weakMultihash' and 'weakMultihashlazy') +-- - there is a function 'toWeakMultihash' to deserialise multihashes +-- +-- For additional informations refer to the README.md or the +-- . +-- +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} + +-- TODO: use length in check* to treat correctly truncated hashes +-- see https://github.com/jbenet/multihash/issues/1#issuecomment-91783612 + +module Crypto.Multihash.Weak + ( -- * Weak Multihash Types + WeakMultihashDigest + , Base (..) + , Encodable (..) + , Checkable (..) + , Payload (..) + -- * Weak Multihash Helpers + , weakMultihash + , weakMultihash' + , weakMultihashlazy + , weakMultihashlazy' + , toWeakMultihash + , checkWeakMultihash + , checkWeakMultihash' + ) where + +import Crypto.Hash (Digest, hashWith, hashlazy) +import qualified Crypto.Hash.Algorithms as A +import Data.ByteArray (ByteArrayAccess, Bytes) +import qualified Data.ByteArray as BA +import Data.ByteString (ByteString) +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 HashAlgo = S1 A.SHA1 | S256 A.SHA256 | S512 A.SHA512 + | S3_512 A.SHA3_512 | S3_384 A.SHA3_384 + | S3_256 A.SHA3_256 | S3_224 A.SHA3_224 + | B2s A.Blake2s_256 | B2b A.Blake2b_512 + +instance Eq HashAlgo where + (S1 _) == (S1 _) = True + (S256 _) == (S256 _) = True + (S512 _) == (S512 _) = True + (S3_512 _) == (S3_512 _) = True + (S3_384 _) == (S3_384 _) = True + (S3_256 _) == (S3_256 _) = True + (S3_224 _) == (S3_224 _) = True + (B2s _) == (B2s _) = True + (B2b _) == (B2b _) = True + _ == _ = False + +instance Show HashAlgo where + show (S1 A.SHA1) = "sha1" + show (S256 A.SHA256) = "sha256" + show (S512 A.SHA512) = "sha512" + show (S3_512 A.SHA3_512) = "sha3-512" + show (S3_384 A.SHA3_384) = "sha3-384" + show (S3_256 A.SHA3_256) = "sha3-256" + show (S3_224 A.SHA3_224) = "sha3-224" + show (B2s A.Blake2s_256) = "blake2s-256" + show (B2b A.Blake2b_512) = "blake2b-512" + +instance Codable HashAlgo where + toCode (S1 A.SHA1) = 0x11 + toCode (S256 A.SHA256) = 0x12 + toCode (S512 A.SHA512) = 0x13 + toCode (S3_512 A.SHA3_512) = 0x14 + toCode (S3_384 A.SHA3_384) = 0x15 + toCode (S3_256 A.SHA3_256) = 0x16 + toCode (S3_224 A.SHA3_224) = 0x17 + toCode (B2b A.Blake2b_512) = 0x40 + toCode (B2s A.Blake2s_256) = 0x41 + +------------------------------------------------------------------------------- + +-- | Weak Multihash Digest container +data WeakMultihashDigest = WeakMultihashDigest + { _getAlgorithm :: HashAlgo -- ^ hash algorithm encoded as int + , _getLength :: Int -- ^ hash lenght + , _getDigest :: Bytes -- ^ binary digest data + } deriving (Eq) + +instance Show WeakMultihashDigest where + -- an error here should never happen + show = encode' Base58 + +instance Encodable WeakMultihashDigest where + encode base (WeakMultihashDigest alg len md) = + if len == BA.length md + then do + d <- fullDigestUnpacked + return $ fromString $ map (toEnum . fromIntegral) d + else + Left "Corrupted MultihashDigest: invalid length" + where + fullDigestUnpacked :: Either String [Word8] + fullDigestUnpacked = do + d <- encoder base fullDigest + return $ BA.unpack d + + fullDigest :: Bytes + fullDigest = BA.pack hd `BA.append` md + where + hd :: [Word8] + hd = fromIntegral <$> [toCode alg, len] + + + check hash_ multihash_ = let hash_' = convertString hash_ in do + base <- getBase hash_' + m <- encode base multihash_ + return (m == hash_') + +-- | Newtype to allow the creation of a 'Checkable' typeclass for +-- all 'ByteArrayAccess' without recurring to UndecidableInstances. +newtype Payload bs = Payload bs + +instance ByteArrayAccess bs => Checkable (Payload bs) where + checkPayload hash_ (Payload p) = let hash' = convertString hash_ in do + m <- toWeakMultihash hash' + wmh <- weakMultihash (convertString $ show $ _getAlgorithm m) p + check hash' wmh + +------------------------------------------------------------------------------- + +allowedAlgos :: [(ByteString, HashAlgo)] +allowedAlgos = [ ("sha1", S1 A.SHA1) + , ("sha256", S256 A.SHA256) + , ("sha512", S512 A.SHA512) + , ("sha3-512", S3_512 A.SHA3_512) + , ("sha3-384", S3_384 A.SHA3_384) + , ("sha3-256", S3_256 A.SHA3_256) + , ("sha3-224", S3_224 A.SHA3_224) + , ("blake2b-512", B2b A.Blake2b_512) + , ("blake2s-256", B2s A.Blake2s_256) ] + +-- | Helper to multihash a 'ByteArrayAccess' (e.g. a 'BS.ByteString') using a +-- supported hash algorithm. Uses 'Crypto.Hash.hash' for hashing. +weakMultihash :: ByteArrayAccess bs + => ByteString -> bs -> Either String WeakMultihashDigest +weakMultihash alg p = do + alg' <- maybeToEither "Unknown algorithm" $ + lookup (convertString alg) allowedAlgos + let h = case alg' of + S1 a -> BA.convert $ hashWith a p + S256 a -> BA.convert $ hashWith a p + S512 a -> BA.convert $ hashWith a p + S3_512 a -> BA.convert $ hashWith a p + S3_384 a -> BA.convert $ hashWith a p + S3_256 a -> BA.convert $ hashWith a p + S3_224 a -> BA.convert $ hashWith a p + B2b a -> BA.convert $ hashWith a p + B2s a -> BA.convert $ hashWith a p + return $ WeakMultihashDigest alg' (BA.length h) h + +-- | Unsafe equivalent of 'weakMultihash'. Throws on creation errors. +weakMultihash' :: ByteArrayAccess bs => ByteString -> bs -> WeakMultihashDigest +weakMultihash' alg p = eitherToErr $ weakMultihash alg p + +-- | Run the 'hashlazy' function but takes an explicit hash algorithm parameter +hashlazyWith :: A.HashAlgorithm alg => alg -> BL.ByteString -> Digest alg +hashlazyWith _ = hashlazy + +-- | Helper to multihash a lazy 'BL.ByteString' using a supported hash algorithm. +-- Uses 'Crypto.Hash.hashlazy' for hashing. +weakMultihashlazy :: ByteString -> BL.ByteString -> Either String WeakMultihashDigest +weakMultihashlazy alg p = do + alg' <- maybeToEither "Unknown algorithm" $ lookup alg allowedAlgos + let h = case alg' of + S1 a -> BA.convert $ hashlazyWith a p + S256 a -> BA.convert $ hashlazyWith a p + S512 a -> BA.convert $ hashlazyWith a p + S3_512 a -> BA.convert $ hashlazyWith a p + S3_384 a -> BA.convert $ hashlazyWith a p + S3_256 a -> BA.convert $ hashlazyWith a p + S3_224 a -> BA.convert $ hashlazyWith a p + B2b a -> BA.convert $ hashlazyWith a p + B2s a -> BA.convert $ hashlazyWith a p + return $ WeakMultihashDigest alg' (BA.length h) h + +-- | Unsafe equivalent of 'weakMultihashlazy'. Throws on creation errors. +weakMultihashlazy' :: ByteString -> BL.ByteString -> WeakMultihashDigest +weakMultihashlazy' alg p = eitherToErr $ weakMultihashlazy alg p + +------------------------------------------------------------------------------- + +-- | Imports a multihash into a 'WeahMultihashDigest' if possible. +toWeakMultihash :: BS.ByteString -> Either String WeakMultihashDigest +toWeakMultihash bs = do + base <- getBase bs + h <- convertFromBase base bs + if badLength h + then + Left "Corrupted MultihasDigest: invalid length" + else do + [b, b'] <- return $ take 2 $ BA.unpack h + case elemIndex b hashCodes of + Just 0 -> d h b' $ S1 A.SHA1 + Just 1 -> d h b' $ S256 A.SHA256 + Just 2 -> d h b' $ S512 A.SHA512 + Just 3 -> d h b' $ S3_512 A.SHA3_512 + Just 4 -> d h b' $ S3_384 A.SHA3_384 + Just 5 -> d h b' $ S3_256 A.SHA3_256 + Just 6 -> d h b' $ S3_224 A.SHA3_224 + Just 7 -> d h b' $ B2b A.Blake2b_512 + Just 8 -> d h b' $ B2s A.Blake2s_256 + Just _ -> Left "This should be impossible" + Nothing -> Left "Impossible to infer the appropriate hash from the header" + where + d h b' alg = Right $ WeakMultihashDigest alg (fromIntegral b') + (BA.convert $ BA.drop 2 h) + +------------------------------------------------------------------------------- + +-- | 'checkPayload' wrapper for API retro-compatibility. +checkWeakMultihash :: (IsString s, ConvertibleStrings s BS.ByteString, ByteArrayAccess bs) + => s -> bs -> Either String Bool +checkWeakMultihash h p = checkPayload h (Payload p) + +-- | Unsafe 'checkPayload' wrapper for API retro-compatibility. +checkWeakMultihash' :: (IsString s, ConvertibleStrings s BS.ByteString, ByteArrayAccess bs) + => s -> bs -> Bool +checkWeakMultihash' h p = checkPayload' h (Payload p) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -2,6 +2,7 @@ import Control.Monad (zipWithM) import Crypto.Multihash +import Crypto.Multihash.Weak (weakMultihash, checkWeakMultihash, toWeakMultihash) import Data.ByteString (ByteString, pack) import Test.Hspec import Text.Printf (printf) @@ -14,64 +15,107 @@ main :: IO () main = hspec $ do - testMHEncoding SHA1 h1 - hashChecker SHA1 h1 - testMHEncoding SHA256 h2 - hashChecker SHA256 h2 - testMHEncoding SHA512 h3 - hashChecker SHA512 h3 - testMHEncoding SHA3_512 h4 - hashChecker SHA3_512 h4 - testMHEncoding SHA3_384 h5 - hashChecker SHA3_384 h5 - testMHEncoding SHA3_256 h6 - hashChecker SHA3_256 h6 - testMHEncoding SHA3_224 h7 - hashChecker SHA3_224 h7 - testMHEncoding Blake2b_512 h8 - hashChecker Blake2b_512 h8 - testMHEncoding Blake2s_256 h9 - hashChecker Blake2s_256 h9 + mhEncoding SHA1 h1 + mhCheck mh checkMultihash SHA1 h1 + mhEncoding SHA256 h2 + mhCheck mh checkMultihash SHA256 h2 + mhEncoding SHA512 h3 + mhCheck mh checkMultihash SHA512 h3 + mhEncoding SHA3_512 h4 + mhCheck mh checkMultihash SHA3_512 h4 + mhEncoding SHA3_384 h5 + mhCheck mh checkMultihash SHA3_384 h5 + mhEncoding SHA3_256 h6 + mhCheck mh checkMultihash SHA3_256 h6 + mhEncoding SHA3_224 h7 + mhCheck mh checkMultihash SHA3_224 h7 + mhEncoding Blake2b_512 h8 + mhCheck mh checkMultihash Blake2b_512 h8 + mhEncoding Blake2s_256 h9 + mhCheck mh checkMultihash Blake2s_256 h9 - describe ("Fails correctly when") $ do + traverse (uncurry wmhEncoding) + (zip weakAlgos h) + traverse (uncurry (mhCheck wmh checkWeakMultihash)) + (zip weakAlgos h) + + describe "Multihash: fails correctly when" $ do it "checking a truncated multihash" $ - checkMultihash "1340ee26b0dd4af7e749aa1a8e" testString + checkMultihash ("1340ee26b0dd4af7e749aa1a8e"::ByteString) testString `shouldBe` Left "Corrupted MultihasDigest: invalid length" it "checking an invalid multihash" $ - checkMultihash "dd4af7e749aa1a8e1340ee26b0" testString + checkMultihash ("dd4af7e749aa1a8e1340ee26b0"::ByteString) testString `shouldBe` Left "Unable to infer an encoding" + + describe "Weak Multihash: fails correctly when" $ do + it "checking a truncated multihash" $ + checkWeakMultihash ("1340ee26b0dd4af7e749aa1a8e"::ByteString) testString + `shouldBe` Left "Corrupted MultihasDigest: invalid length" + it "checking an invalid multihash" $ + checkWeakMultihash ("dd4af7e749aa1a8e1340ee26b0"::ByteString) testString + `shouldBe` Left "Unable to infer an encoding" where - testMHEncoding :: (HashAlgorithm a, Codable a, Show a) => a + mh = "Multihash"::String + wmh = "Weak Multihash"::String + + mhEncoding :: (HashAlgorithm a, Codable a, Show a) => a -> (ByteString, ByteString, ByteString) -> SpecWith () - testMHEncoding alg (sm16, sm58, sm64) = - let m = multihash alg testString in do - describe (printf "Encoding %s multihash" (show alg)) $ do + mhEncoding alg (sm16, sm58, sm64) = + let m = multihash alg testString in + describe (printf "Multihash: encoding %s multihash" (show alg)) $ do it "returns the correct Base16 hash" $ encode' Base16 m `shouldBe` sm16 it "returns the correct Base58 hash" $ encode' Base58 m `shouldBe` sm58 it "returns the correct Base64 hash" $ encode' Base64 m `shouldBe` sm64 + + wmhEncoding :: ByteString + -> (ByteString, ByteString, ByteString) -> SpecWith () + wmhEncoding alg (sm16, sm58, sm64) = + let m = case weakMultihash alg testString of + Right val -> val + Left err -> error err + in do + describe (printf "Weak Multihash: encoding %s multihash" (show alg)) $ do + it "returns the correct Base16 hash" $ + encode' Base16 m `shouldBe` sm16 + it "returns the correct Base58 hash" $ + encode' Base58 m `shouldBe` sm58 + it "returns the correct Base64 hash" $ + encode' Base64 m `shouldBe` sm64 + + describe (printf "Weak Multihash: decoding %s multihash" (show alg)) $ do + it "imports the correct hash from Base16" $ + toWeakMultihash sm16 `shouldBe` Right m + it "imports the correct hash from Base58" $ + toWeakMultihash sm58 `shouldBe` Right m + it "imports the correct hash from Base64" $ + toWeakMultihash sm64 `shouldBe` Right m - hashChecker :: (HashAlgorithm a, Codable a, Show a) => a - -> (ByteString, ByteString, ByteString) -> SpecWith () - hashChecker alg (e16, e58, e64) = do - describe (printf "Using checkMultihash on %s hashes" (show alg)) $ do + -- hashChecker :: (HashAlgorithm a, Codable a, Show a) => a + -- -> (ByteString, ByteString, ByteString) -> SpecWith () + mhCheck t checker alg (e16, e58, e64) = + describe (printf "%s: using checkPayload on %s hashes" t (show alg)) $ do it "checks correctly Base16 hashes" $ - checkMultihash e16 testString `shouldBe` Right True + checker e16 testString `shouldBe` Right True it "fails correctly on Base16 hashes" $ - checkMultihash e16 failTestString `shouldBe` Right False + checker e16 failTestString `shouldBe` Right False it "checks correctly Base58 hashes" $ - checkMultihash e58 testString `shouldBe` Right True + checker e58 testString `shouldBe` Right True it "fails correctly on Base58 hashes" $ - checkMultihash e58 failTestString `shouldBe` Right False + checker e58 failTestString `shouldBe` Right False it "checks correctly Base64 hashes" $ - checkMultihash e64 testString `shouldBe` Right True + checker e64 testString `shouldBe` Right True it "fails correctly on Base64 hashes" $ - checkMultihash e64 failTestString `shouldBe` Right False + checker e64 failTestString `shouldBe` Right False + weakAlgos = [ "sha1", "sha256", "sha512", "sha3-512" + , "sha3-384", "sha3-256", "sha3-224" + , "blake2b-512", "blake2s-256" ] + -- array of triples of hashes of the string "test" - (h1:h2:h3:h4:h5:h6:h7:h8:h9:[]) = + h@[h1, h2, h3, h4, h5, h6, h7, h8, h9] = [ ( "1114a94a8fe5ccb19ba61c4c0873d391e987982fbbd3" , "5dt9CqvXK9qs7vazf7k7ZRqe28VPTg"