diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,18 @@ # ChangeLog / ReleaseNotes +## Version 0.6.0.0 + +* Introducing Salt newtype wrapper to guarantee that it consists of only + characters that can be used in htpasswd entry. +* Algorithm implementation details and helper functions were all moved to + `Data.Digest.ApacheMD5.Internal` module to make it explicit that they aren't + part of stable API. +* Exposing `Data.Digest.ApacheMD5.Internal` module so that library authors + still have the ability to get the most out of this package. +* Updated `README.md`, `example.hs`, tests and benchmarks. +* Uploaded to [Hackage][]: + + ## Version 0.5.0.1 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -51,21 +51,28 @@ import qualified Data.ByteString as BS (index, pack) import qualified Data.ByteString.Char8 as C8 (concat, pack, putStrLn, singleton) -- bytestring package http://hackage.haskell.org/package/bytestring -import Data.Digest.ApacheMD5 (alpha64, apacheMD5) +import Data.Digest.ApacheMD5 (Salt, alpha64, apacheMD5, mkSalt, unSalt) -htpasswdEntry :: String -> String -> ByteString -> ByteString +htpasswdEntry :: String -> String -> Salt -> ByteString htpasswdEntry username password salt = C8.concat [ C8.pack username , C8.pack ":$apr1$" - , salt + , unSalt salt , C8.singleton '$' , apacheMD5 (C8.pack password) salt ] -genSalt :: IO ByteString -genSalt = evalRandIO - $ BS.pack . map (BS.index alpha64) . take 8 <$> getRandomRs (0, 63) +genSalt :: IO Salt +genSalt = do + Just s <- evalRandIO $ mkSalt . BS.pack . map (BS.index alpha64) . take 8 + <$> getRandomRs (0, 63) + -- We know that Salt is correctly generated, since we use alpha64 to do + -- it. That is the reason why we can pattern match on Just. + -- + -- Other option would be to use Salt value constructor from + -- Data.Digest.ApacheMD5.Internal module. + return s main :: IO () main = do @@ -107,6 +114,22 @@ $ cabal configure --enable-tests && cabal build && cabal test +Benchmarks +---------- + +This package provides [Criterion][] benchmarks, to run them you can use +something like: + + $ cabal configure --enable-benchmarks && cabal build && cabal bench + +To generate HTML output one needs to specify output file. Then the last +command in above chain would look like: + + $ cabal bench --benchmark-option=--output=benchmarks.html + +Where `benchmarks.html` is the name of [Criterion][] generated HTML file. + + Contributions ------------- @@ -121,6 +144,8 @@ http://packages.debian.org/lenny/libssl-dev [cabal-install]: http://haskell.org/haskellwiki/Cabal-Install +[Criterion]: + http://hackage.haskell.org/package/criterion [Hackage]: http://hackage.haskell.org/package/apache-md5 [HaskellWiki: How to install a Cabal package]: diff --git a/apache-md5.cabal b/apache-md5.cabal --- a/apache-md5.cabal +++ b/apache-md5.cabal @@ -1,5 +1,5 @@ name: apache-md5 -version: 0.5.0.1 +version: 0.6.0.0 synopsis: Apache specific MD5 digest algorighm. description: Haskell implementation of Apache HTTP server specific MD5 digest algorithm @@ -11,9 +11,11 @@ . * +homepage: https://github.com/trskop/apache-md5 +bug-reports: https://github.com/trskop/apache-md5/issues license: BSD3 license-File: LICENSE -copyright: (c) 2009, 2010, 2012, 2013 Peter Trško +copyright: (c) 2009, 2010, 2012 - 2014 Peter Trško author: Peter Trško maintainer: peter.trsko@gmail.com category: Data, Cryptography @@ -31,15 +33,28 @@ Pass additional warning flags including -Werror to GHC during compilation. default: False +flag deepseq + description: + Define instance of NFData for Salt newtype. This dependency is enforced for + benchmark. + default: False + library hs-Source-Dirs: src - exposed-Modules: Data.Digest.ApacheMD5 - other-Modules: Data.Digest.ApacheMD5.Internal - build-Depends: + exposed-modules: + Data.Digest.ApacheMD5 + , Data.Digest.ApacheMD5.Internal + build-depends: base >= 4 && < 5 , bytestring >= 0.10 && < 0.11 + + if flag(deepseq) + cpp-options: -DWITH_deepseq + build-depends: deepseq >= 1.1.0.0 + -- Same minimal bound as criterion has since version 0.4.0. + includes: openssl/md5.h - extra-Libraries: crypto + extra-libraries: crypto ghc-options: -Wall if impl(ghc >= 6.8) @@ -104,11 +119,14 @@ , bytestring >= 0.10 && < 0.11 , criterion + , deepseq >= 1.1.0.0 + -- Same minimal bound as criterion has since version 0.4.0. , MonadRandom includes: openssl/md5.h extra-libraries: crypto + cpp-options: -DWITH_deepseq ghc-options: -Wall if impl(ghc >= 6.8) ghc-options: -fwarn-tabs @@ -122,4 +140,4 @@ source-repository this type: git location: git://github.com/trskop/apache-md5.git - tag: v0.5.0.1 + tag: v0.6.0.0 diff --git a/example.hs b/example.hs --- a/example.hs +++ b/example.hs @@ -1,7 +1,7 @@ -- | -- Module: Main -- Description: Create htpasswd like entry and print it to stdout. --- Copyright: (c) 2013 Peter Trsko +-- Copyright: (c) 2013, 2014 Peter Trsko -- License: BSD3 -- -- Maintainer: peter.trsko@gmail.com @@ -23,21 +23,28 @@ import qualified Data.ByteString as BS (index, pack) import qualified Data.ByteString.Char8 as C8 (concat, pack, putStrLn, singleton) -- bytestring package http://hackage.haskell.org/package/bytestring -import Data.Digest.ApacheMD5 (alpha64, apacheMD5) +import Data.Digest.ApacheMD5 (Salt, alpha64, apacheMD5, mkSalt, unSalt) -htpasswdEntry :: String -> String -> ByteString -> ByteString +htpasswdEntry :: String -> String -> Salt -> ByteString htpasswdEntry username password salt = C8.concat [ C8.pack username , C8.pack ":$apr1$" - , salt + , unSalt salt , C8.singleton '$' , apacheMD5 (C8.pack password) salt ] -genSalt :: IO ByteString -genSalt = evalRandIO - $ BS.pack . map (BS.index alpha64) . take 8 <$> getRandomRs (0, 63) +genSalt :: IO Salt +genSalt = do + Just s <- evalRandIO $ mkSalt . BS.pack . map (BS.index alpha64) . take 8 + <$> getRandomRs (0, 63) + -- We know that Salt is correctly generated, since we use alpha64 to do + -- it. That is the reason why we can pattern match on Just. + -- + -- Other option would be to use Salt value constructor from + -- Data.Digest.ApacheMD5.Internal module. + return s main :: IO () main = do diff --git a/src/Data/Digest/ApacheMD5.hs b/src/Data/Digest/ApacheMD5.hs --- a/src/Data/Digest/ApacheMD5.hs +++ b/src/Data/Digest/ApacheMD5.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE BangPatterns #-} -- | -- Module: Data.Digest.ApacheMD5 --- Copyright: (c) 2009, 2010, 2012, 2013 Peter Trško +-- Copyright: (c) 2009, 2010, 2012 - 2014 Peter Trško -- License: BSD3 -- Maintainer: Peter Trško -- Stability: Provisional --- Portability: non-portable (BangPatterns) +-- Portability: non-portable (depends on non-portable internal module) -- -- ApacheMD5 is one of the hash algorithms used by Apache HTTP server for basic -- authentication. It is Apache specific, but e.g. nginx supports this @@ -35,128 +34,55 @@ -- -- > import Data.ByteString (ByteString) -- > import qualified Data.ByteString.Char8 as C8 (concat, pack, singleton) - -- > import Data.Digest.ApacheMD5 (apacheMD5) + -- > import Data.Digest.ApacheMD5 (Salt, apacheMD5, unSalt) -- > - -- > htpasswdEntry :: ByteString -> ByteString -> ByteString -> ByteString + -- > htpasswdEntry :: ByteString -> ByteString -> Salt -> ByteString -- > htpasswdEntry username password salt = C8.concat -- > [ username -- > , C8.pack ":$apr1$" - -- > , salt + -- > , unSalt salt -- > , C8.singleton '$' -- > , apacheMD5 password salt -- > ] -- * API Documentation apacheMD5 - , apacheMD5' - , alpha64 - , encode64 - , md5DigestLength + , Password + , Salt + , mkSalt + , unSalt ) where -import Data.Bits (Bits((.|.), (.&.), shiftL, shiftR)) -import Data.Word (Word8, Word16, Word32) - import Data.ByteString (ByteString) -import qualified Data.ByteString as BS - ( append - , concat - , cons - , empty - , head - , index - , length - , null - , pack - , take +import qualified Data.ByteString as BS (all) + +import Data.Digest.ApacheMD5.Internal (Password, Salt(Salt)) +import qualified Data.Digest.ApacheMD5.Internal as Internal + ( apacheMD5 + , encode64 + , isAlpha64 + , md5BS ) -import qualified Data.ByteString.Char8 as C8 (pack) -import Data.Digest.ApacheMD5.Internal (md5BS, md5DigestLength) +-- | Smart constructor for 'Salt'. It tests all octets to be members of +-- 'Data.Digest.ApacheMD5.Internal.alpha64' by using 'Internal.isAlpha64' +-- predicate. +mkSalt :: ByteString -> Maybe Salt +mkSalt str + | BS.all Internal.isAlpha64 str = Just $ Salt str + | otherwise = Nothing +-- | Unpack 'Salt' in to 'ByteString'. +unSalt :: Salt -> ByteString +unSalt (Salt str) = str + -- | Taking password and salt this function produces resulting ApacheMD5 hash -- which is already base 64 encoded. -apacheMD5 :: ByteString -> ByteString -> ByteString -apacheMD5 = (encode64 .) . apacheMD5' md5BS - --- | Raw Apache MD5 implementation that is parametrized by MD5 implementation --- and doesn't encode result in to base 64. -apacheMD5' - :: (ByteString -> ByteString) - -- ^ MD5 hash function. - -> ByteString - -- ^ Password - -> ByteString - -- ^ Salt +apacheMD5 + :: Password + -> Salt -> ByteString -- ^ Apache MD5 Hash -apacheMD5' md5 !password !salt = g . f . md5 $ password <> salt <> password - where - (<>) = BS.append - - f :: ByteString -> ByteString - f !digest = md5 $ password <> C8.pack "$apr1$" <> salt - <> BS.concat (replicate (passwordLength `div` md5DigestLength) digest) - <> BS.take (passwordLength `rem` md5DigestLength) digest - <> f' pwHead passwordLength - where - !passwordLength = BS.length password - pwHead = if BS.null password then 0 else BS.head password - -- Consistent with htpasswd implementation. - - f' :: Word8 -> Int -> ByteString - f' !pwhead !i - | i == 0 = BS.empty - | otherwise = (if i .&. 1 == 1 then 0 else pwhead) - `BS.cons` f' pwhead (i `shiftR` 1) - - g :: ByteString -> ByteString - g = g' 0 - where - -- Iterate this function 1000 times, starting with 0 and ending with - -- 999. - g' :: Word16 -> ByteString -> ByteString - g' !i !digest - | i < 1000 = g' (i + 1) . md5 - $ (if i .&. 1 == 1 then password else digest) - <> (if i `mod` 3 > 0 then salt else BS.empty) - <> (if i `mod` 7 > 0 then password else BS.empty) - <> (if i .&. 1 == 1 then digest else password) - | otherwise = digest - --- | Alphabet used by 'encode64'. -alpha64 :: ByteString -alpha64 = C8.pack - "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - -encode64 :: ByteString -> ByteString -encode64 str = BS.pack $ concatMap (encode64' str) - -- Index --. ,-- Shift bits left this much - -- V V - [ (4, [( 0, 16), ( 6, 8), (12, 0)]) - , (4, [( 1, 16), ( 7, 8), (13, 0)]) - , (4, [( 2, 16), ( 8, 8), (14, 0)]) - , (4, [( 3, 16), ( 9, 8), (15, 0)]) - , (4, [( 4, 16), (10, 8), ( 5, 0)]) - , (2, [(11, 0) ]) - -- ^ `-----------. ,------------' - -- | V - -- | Do bitwise OR on results - -- | - -- `-- How many characters from alpa64 - -- will be used to encode the row. - ] - where - encode64' :: ByteString -> (Int, [(Int, Int)]) -> [Word8] - encode64' !s (!n, xs) = - to64 n . foldl1 (.|.) . (`map` xs) $ \ (!i, !t) -> - conv (s `BS.index` i) `shiftL` t - - conv :: (Integral i, Num n, Integral n, Bits n) => i -> n - conv = fromInteger . toInteger - - to64 :: Int -> Word32 -> [Word8] - to64 !n !c = take n . map ((alpha64 `BS.index`) . conv . (.&. 0x3f)) - $ iterate (`shiftR` 6) c +apacheMD5 = (Internal.encode64 .) . Internal.apacheMD5 Internal.md5BS diff --git a/src/Data/Digest/ApacheMD5/Internal.hs b/src/Data/Digest/ApacheMD5/Internal.hs --- a/src/Data/Digest/ApacheMD5/Internal.hs +++ b/src/Data/Digest/ApacheMD5/Internal.hs @@ -1,21 +1,208 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} + +#ifdef __GLASGOW_HASKELL__ +#define LANGUAGE_DERIVE_DATA_TYPEABLE +{-# LANGUAGE DeriveDataTypeable #-} +#endif + +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704 +#define LANGUAGE_DERIVE_GENERIC +{-# LANGUAGE DeriveGeneric #-} +#endif + {-# LANGUAGE ForeignFunctionInterface #-} + +-- | +-- Module: Data.Digest.ApacheMD5.Internal +-- Copyright: (c) 2009, 2010, 2012 - 2014 Peter Trško +-- License: BSD3 +-- Maintainer: Peter Trško +-- Stability: Provisional +-- Portability: non-portable (BangPatterns, CPP, DeriveDataTypeable, +-- DeriveGeneric, ForeignFunctionInterface) +-- +-- Internal and unsafe functions used for implementing Apache MD5 +-- hash algorithm. +-- +-- Try to avoid using this module directly when possible, but there +-- are situations when it might come handy. module Data.Digest.ApacheMD5.Internal - ( md5BS + ( + -- * Types + Password + , Salt(Salt) + + -- * ApacheMD5 Hash + , apacheMD5 + + -- * Base64-like encoding + , alpha64 + , isAlpha64 + , encode64 + + -- * OpenSSL Bindings + , md5BS , md5DigestLength ) where +import Control.Applicative (liftA2) import Control.Monad (void) -import Data.Word (Word8) +import Data.Bits (Bits((.|.), (.&.), shiftL, shiftR)) +import Data.Word (Word8, Word16, Word32) import Foreign (Ptr) import Foreign.C.Types (CChar(..), CULong(..)) import System.IO.Unsafe (unsafePerformIO) +#ifdef WITH_deepseq +import Control.DeepSeq (NFData) +#endif + +#ifdef LANGUAGE_DERIVE_DATA_TYPEABLE +import Data.Data (Data) +import Data.Typeable (Typeable) +#endif + +#ifdef LANGUAGE_DERIVE_GENERIC +import GHC.Generics (Generic) +#endif + import Data.ByteString (ByteString) +import qualified Data.ByteString as BS + ( append + , concat + , cons + , empty + , head + , index + , length + , null + , pack + , take + ) +import qualified Data.ByteString.Char8 as C8 (pack) import qualified Data.ByteString.Internal as BS (create) import qualified Data.ByteString.Unsafe as BS (unsafeUseAsCStringLen) +-- | Type alias for more readable type signatures. +type Password = ByteString + +-- | Apache MD5 hash salt. When constructing @.htpasswd@ file it is necessary +-- for the salt to be consisting of octets from 'alpha64' \"set\". This newtype +-- along with 'mkSalt' smart constructor are here to ensure such invariant. +newtype Salt = Salt ByteString + deriving + ( Eq, Ord, Read, Show +#ifdef LANGUAGE_DERIVE_DATA_TYPEABLE + , Data, Typeable +#endif +#ifdef LANGUAGE_DERIVE_GENERIC + , Generic +#endif + ) + +#ifdef WITH_deepseq +instance NFData Salt +#endif + +-- | Raw Apache MD5 implementation that is parametrized by MD5 implementation +-- and doesn't encode result in to base 64. +apacheMD5 + :: (ByteString -> ByteString) + -- ^ MD5 hash function. + -> Password + -> Salt + -> ByteString + -- ^ Apache MD5 Hash +apacheMD5 md5 !password (Salt !salt) = + g . f . md5 $ password <> salt <> password + where + (<>) = BS.append + + f :: ByteString -> ByteString + f !digest = md5 $ password <> C8.pack "$apr1$" <> salt + <> BS.concat (replicate (passwordLength `div` md5DigestLength) digest) + <> BS.take (passwordLength `rem` md5DigestLength) digest + <> f' pwHead passwordLength + where + !passwordLength = BS.length password + pwHead = if BS.null password then 0 else BS.head password + -- Consistent with htpasswd implementation. + + f' :: Word8 -> Int -> ByteString + f' !pwhead !i + | i == 0 = BS.empty + | otherwise = (if i .&. 1 == 1 then 0 else pwhead) + `BS.cons` f' pwhead (i `shiftR` 1) + + g :: ByteString -> ByteString + g = g' 0 + where + -- Iterate this function 1000 times, starting with 0 and ending with + -- 999. + g' :: Word16 -> ByteString -> ByteString + g' !i !digest + | i < 1000 = g' (i + 1) . md5 + $ (if i .&. 1 == 1 then password else digest) + <> (if i `mod` 3 > 0 then salt else BS.empty) + <> (if i `mod` 7 > 0 then password else BS.empty) + <> (if i .&. 1 == 1 then digest else password) + | otherwise = digest + +-- | Alphabet used by 'encode64'. +alpha64 :: ByteString +alpha64 = C8.pack + "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + +-- | Check if specified 8 bit word is a valid member of 'alpha64'. +isAlpha64 :: Word8 -> Bool +isAlpha64 = ((>= dot) <&&> (<= _9)) + <||> ((>= _A) <&&> (<= _Z)) + <||> ((>= _a) <&&> (<= _z)) + where + (<&&>) = liftA2 (&&) + (<||>) = liftA2 (||) + + dot = 46 -- '.' + _9 = 57 -- '9' + _A = 65 -- 'A' + _Z = 90 -- 'Z' + _a = 97 -- 'a' + _z = 122 -- 'z' + +-- | Encode raw MD5 hash in to Base64-like encoding. +encode64 :: ByteString -> ByteString +encode64 str = BS.pack $ concatMap (encode64' str) + -- Index --. ,-- Shift bits left this much + -- V V + [ (4, [( 0, 16), ( 6, 8), (12, 0)]) + , (4, [( 1, 16), ( 7, 8), (13, 0)]) + , (4, [( 2, 16), ( 8, 8), (14, 0)]) + , (4, [( 3, 16), ( 9, 8), (15, 0)]) + , (4, [( 4, 16), (10, 8), ( 5, 0)]) + , (2, [(11, 0) ]) + -- ^ `-----------. ,------------' + -- | V + -- | Do bitwise OR on results + -- | + -- `-- How many characters from alpa64 + -- will be used to encode the row. + ] + where + encode64' :: ByteString -> (Int, [(Int, Int)]) -> [Word8] + encode64' !s (!n, xs) = + to64 n . foldl1 (.|.) . (`map` xs) $ \ (!i, !t) -> + conv (s `BS.index` i) `shiftL` t + + conv :: (Integral i, Num n, Integral n, Bits n) => i -> n + conv = fromInteger . toInteger + + to64 :: Int -> Word32 -> [Word8] + to64 !n !c = take n . map ((alpha64 `BS.index`) . conv . (.&. 0x3f)) + $ iterate (`shiftR` 6) c + -- Inspired by nano-md5 package -- by Don Stewart -- @@ -26,9 +213,11 @@ foreign import ccall "openssl/md5.h MD5" c_md5 :: Ptr CChar -> CULong -> Ptr Word8 -> IO (Ptr Word8) +-- | Length of MD5 hash in octets. md5DigestLength :: Int md5DigestLength = 16 +-- | Thin Haskell wrapper around OpenSSL's MD5 hash function. md5BS :: ByteString -> ByteString md5BS bs = unsafePerformIO . BS.unsafeUseAsCStringLen bs $ \ (ptr, len) -> BS.create md5DigestLength $ void . c_md5 ptr (fromIntegral len) diff --git a/test/benchmark-main.hs b/test/benchmark-main.hs --- a/test/benchmark-main.hs +++ b/test/benchmark-main.hs @@ -3,29 +3,34 @@ where import Control.Applicative ((<$>)) -import Control.Arrow ((***), first) import Control.Monad (replicateM) -import Data.Word (Word8) +import Data.ByteString (ByteString) + import Control.Monad.Random -import Criterion.Main +import Criterion.Config (Config(cfgPerformGC), defaultConfig, ljust) +import Criterion.Main (bench, defaultMainWith, nf) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 -import Data.Digest.ApacheMD5 (alpha64, apacheMD5) +import Data.Digest.ApacheMD5 (apacheMD5) +import Data.Digest.ApacheMD5.Internal (Salt(Salt), alpha64) -genSalt :: RandT StdGen IO [Word8] -genSalt = replicateM 8 $ BS.index alpha64 <$> getRandomR (0, 63) +genSalt :: RandT StdGen IO Salt +genSalt = Salt . BS.pack + <$> replicateM 8 (BS.index alpha64 <$> getRandomR (0, 63)) + -- We know, that salt will be correct since we generate it out of + -- alpha64, therefore we don't use mkSalt to check it for us. genPassword :: Int -> RandT StdGen IO String genPassword len = replicateM len (getRandomR ('!', '~')) -genData :: Int -> RandT StdGen IO ([Word8], String) +genData :: Int -> RandT StdGen IO (ByteString, Salt) genData len = do s <- genSalt - p <- genPassword len - return (s, p) + p <- C8.pack <$> genPassword len + return (p, s) main :: IO () main = do @@ -35,17 +40,17 @@ (!inputData64, _) <- genData' 64 (!inputData128, _) <- genData' 128 (!inputData256, _) <- genData' 256 + (!inputData512, _) <- genData' 512 - defaultMain + defaultMainWith defaultConfig{cfgPerformGC = ljust True} (return ()) [ bench "Random passwords of length 8" $ test inputData8 , bench "Random passwords of length 16" $ test inputData16 , bench "Random passwords of length 32" $ test inputData32 , bench "Random passwords of length 64" $ test inputData64 , bench "Random passwords of length 128" $ test inputData128 , bench "Random passwords of length 256" $ test inputData256 + , bench "Random passwords of length 512" $ test inputData512 ] where test = nf $ uncurry apacheMD5 - - genData' n = getStdGen - >>= (first (BS.pack *** C8.pack) <$>) . runRandT (genData n) + genData' n = getStdGen >>= runRandT (genData n) diff --git a/test/unit-tests-main.hs b/test/unit-tests-main.hs --- a/test/unit-tests-main.hs +++ b/test/unit-tests-main.hs @@ -1,21 +1,23 @@ module Main (main) where -import Control.Arrow ((***), second) +import Control.Arrow (Arrow(second)) import Control.Monad (replicateM, replicateM_, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Random import qualified Data.ByteString.Char8 as C8 +import Data.Function (on) import System.Exit (ExitCode(..)) import System.Process (readProcessWithExitCode) import Test.Framework -import Test.Framework.Providers.HUnit -import Test.HUnit +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, assertEqual) import Data.Digest.ApacheMD5 (apacheMD5) +import Data.Digest.ApacheMD5.Internal (Salt(Salt)) --- Settings ------------------------------------------------------------------- +-- {{{ Settings --------------------------------------------------------------- numberOfTests :: Int numberOfTests = 1000 @@ -23,6 +25,10 @@ maxPasswordLength :: Int maxPasswordLength = 255 +-- }}} Settings --------------------------------------------------------------- + +-- | Execute @htpasswd@ command to generate salt and Apache MD5 hash for given +-- password. runHtpasswd :: String -- ^ Password @@ -41,7 +47,7 @@ ] return $ parse out where - -- Split ":$apr1$$\n" to pair (Salt,Hash) + -- Split ":$apr1$$\n" to pair (Salt, Hash) parse :: String -> (String, String) parse = second (drop 1) -- ("","") . break (== '$') -- ("","$") @@ -49,14 +55,21 @@ . dropWhile (/= ':') -- ":$apr1$$" . takeWhile (/= '\n') -- ":$apr1$$" -testApacheMD5' :: (String -> String -> String) -> Int -> RandT StdGen IO () -testApacheMD5' toTest n = replicateM_ n $ do - password <- genPassword - (salt, hash) <- liftIO $ runHtpasswd password - - liftIO $ assertEqual (msg salt password) hash - $ toTest password salt +-- | Generate random password, run @htpasswd@ to obtain salt and reference +-- Apache MD5, then ran provided function with password and salt as arguments +-- and compare its output to what @htpasswd@ generated. +testApacheMD5 :: (String -> String -> String) -> Int -> Assertion +testApacheMD5 toTest n = + void $ getStdGen >>= runRandT (replicateM_ n testApacheMD5') where + testApacheMD5' :: RandT StdGen IO () + testApacheMD5' = do + password <- genPassword + (salt, hash) <- liftIO $ runHtpasswd password + + liftIO $ assertEqual (msg salt password) hash + $ toTest password salt + msg :: String -> String -> String msg s p = concat [ "Hash does not match for salt = " @@ -65,17 +78,18 @@ , show p ] + -- Generate password of length between 0 and maxPasswordLength. genPassword :: RandT StdGen IO String genPassword = getRandomR (0, maxPasswordLength) - >>= flip replicateM (getRandomR ('!', '~')) - -testApacheMD5 :: (String -> String -> String) -> Int -> Assertion -testApacheMD5 f n = void $ getStdGen >>= runRandT (testApacheMD5' f n) + >>= (`replicateM` getRandomR ('!', '~')) main :: IO () -main = defaultMain . hUnitTestToTests $ TestList - [ TestLabel ("apacheMD5 (" ++ show numberOfTests ++ " tests)") - . TestCase $ testApacheMD5 apacheMD5' numberOfTests +main = defaultMain + [ testCase ("apacheMD5 (" ++ show numberOfTests ++ " tests)") + $ testApacheMD5 apacheMD5' numberOfTests ] where - apacheMD5' = curry $ C8.unpack . uncurry apacheMD5 . (C8.pack *** C8.pack) + -- Wrap tested function so that it takes Strings and produces String. + apacheMD5' :: String -> String -> String + apacheMD5' = + (C8.unpack .) . ((\password -> apacheMD5 password . Salt) `on` C8.pack)