packages feed

crypto-multihash 0.3.0.0 → 0.4.0.0

raw patch · 7 files changed

+591/−198 lines, 7 filesdep +string-conversions

Dependencies added: string-conversions

Files

README.md view
@@ -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)
crypto-multihash.cabal view
@@ -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                      <https://github.com/jbenet/multihash/ multihash github>.                      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
src/Crypto/Multihash.hs view
@@ -18,15 +18,21 @@ -- <https://github.com/mseri/crypto-multihash gihub repository>. -- {-# 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 <https://github.com/jbenet/multihash/issues/31 this issue to resolve>-          | 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
+ src/Crypto/Multihash/Internal.hs view
@@ -0,0 +1,70 @@+-- |+-- Module      : Crypto.Multihash.Internal+-- License     : BSD3+-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>+-- 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
+ src/Crypto/Multihash/Internal/Types.hs view
@@ -0,0 +1,79 @@+-- |+-- Module      : Crypto.Multihash.Internal.Types+-- License     : BSD3+-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>+-- 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 <https://github.com/jbenet/multihash/issues/31 this issue to resolve>+          | 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
+ src/Crypto/Multihash/Weak.hs view
@@ -0,0 +1,253 @@+-- |+-- Module      : Crypto.Multihash.Weak+-- License     : BSD3+-- Maintainer  : Marcello Seri <marcello.seri@gmail.com>+-- 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 +-- <https://github.com/jbenet/multihash/ multihash poroposal github repo>.+--+-- 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+-- <https://github.com/mseri/crypto-multihash gihub repository>.+--+{-# 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)
test/Spec.hs view
@@ -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"