apache-md5 0.5.0.1 → 0.6.0.0

raw patch · 8 files changed

+358/−161 lines, 8 filesdep +deepseqdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +13/−0
• README.md +31/−6
• apache-md5.cabal +25/−7
• example.hs +14/−7
• src/Data/Digest/ApacheMD5.hs +32/−106
• src/Data/Digest/ApacheMD5/Internal.hs +191/−2
• test/benchmark-main.hs +18/−13
• test/unit-tests-main.hs +34/−20

@@ -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][]:+  <http://hackage.haskell.org/package/apache-md5-0.6.0.0>+  ## Version 0.5.0.1 

@@ -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]:

@@ -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 @@   .   * <https://github.com/trskop/apache-md5/blob/master/ChangeLog.md> +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 <peter.trsko@gmail.com> 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

@@ -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

@@ -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 <peter.trsko@gmail.com> -- 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

@@ -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 <peter.trsko@gmail.com>+-- 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 <http://hackage.haskell.org/package/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)

@@ -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)

@@ -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 "<username>:$apr1$<salt>$<hash>\n" to pair (Salt,Hash)+        -- Split "<username>:$apr1$<salt>$<hash>\n" to pair (Salt, Hash)         parse :: String -> (String, String)         parse = second (drop 1)      -- ("<salt>","<hash>")             . break (== '$')         -- ("<salt>","$<hash>")@@ -49,14 +55,21 @@             . dropWhile (/= ':')     -- ":$apr1$<salt>$<hash>"             . takeWhile (/= '\n')    -- "<username>:$apr1$<salt>$<hash>" -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)