aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--btls.cabal2
-rw-r--r--src/Data/Digest/Md5.hsc38
-rw-r--r--tests/Data/Digest/HashTests.hs6
-rw-r--r--tests/Data/Digest/Md5Tests.hs109
-rw-r--r--tests/Data/Digest/Sha1Tests.hs4
-rw-r--r--tests/Data/Digest/Sha2Tests.hs10
-rw-r--r--tests/Tests.hs8
7 files changed, 166 insertions, 11 deletions
diff --git a/btls.cabal b/btls.cabal
index 7008631..6b389fc 100644
--- a/btls.cabal
+++ b/btls.cabal
@@ -33,6 +33,7 @@ library
-Wno-safe -Wno-unsafe
-optl-Wl,-z,relro -optl-Wl,-z,now -optl-Wl,-s
exposed-modules: Data.Digest
+ , Data.Digest.Md5
, Data.Digest.Sha1
, Data.Digest.Sha2
other-modules: Cleanse
@@ -58,6 +59,7 @@ test-suite tests
-optl-Wl,-z,relro -optl-Wl,-z,now -optl-Wl,-s
main-is: Tests.hs
other-modules: Data.Digest.HashTests
+ , Data.Digest.Md5Tests
, Data.Digest.Sha1Tests
, Data.Digest.Sha2Tests
build-depends: base >=4.9 && <4.10
diff --git a/src/Data/Digest/Md5.hsc b/src/Data/Digest/Md5.hsc
new file mode 100644
index 0000000..2a1303d
--- /dev/null
+++ b/src/Data/Digest/Md5.hsc
@@ -0,0 +1,38 @@
+{-# LANGUAGE CApiFFI #-}
+{-# OPTIONS_GHC -Wno-missing-methods #-}
+
+module Data.Digest.Md5
+ ( md5
+ ) where
+
+import Data.ByteString.Lazy (ByteString)
+import Foreign (Ptr, Storable(alignment, sizeOf))
+import Foreign.C.Types
+
+import Data.Digest.Internal
+
+#include <openssl/md5.h>
+
+data Md5Ctx
+
+instance Storable Md5Ctx where
+ sizeOf _ = #size MD5_CTX
+ alignment _ = #alignment MD5_CTX
+
+foreign import capi "openssl/md5.h value MD5_DIGEST_LENGTH"
+ md5DigestLength :: CSize
+
+foreign import ccall "openssl/md5.h MD5_Init"
+ md5Init :: Ptr Md5Ctx -> IO CInt
+
+foreign import ccall "openssl/md5.h MD5_Update"
+ md5Update :: Ptr Md5Ctx -> Ptr a -> CSize -> IO CInt
+
+foreign import ccall "openssl/md5.h MD5_Final"
+ md5Final :: Ptr CUChar -> Ptr Md5Ctx -> IO CInt
+
+md5Algo :: Algo
+md5Algo = Algo md5DigestLength md5Init md5Update md5Final
+
+md5 :: ByteString -> Digest
+md5 = hash md5Algo
diff --git a/tests/Data/Digest/HashTests.hs b/tests/Data/Digest/HashTests.hs
index 0691bf4..d2f637d 100644
--- a/tests/Data/Digest/HashTests.hs
+++ b/tests/Data/Digest/HashTests.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Data.Digest.HashTests
- ( goTestCase
+ ( tableTestCase
, testAgainstCoreutils
, testAgainstOpenssl
) where
@@ -18,8 +18,8 @@ import Test.Tasty (TestTree)
import Test.Tasty.HUnit ((@?=), testCase)
import Test.Tasty.SmallCheck (Property, monadic, over)
-goTestCase :: (ByteString -> String) -> (String, ByteString) -> TestTree
-goTestCase f (output, input) = testCase description (f input @?= output)
+tableTestCase :: (ByteString -> String) -> (String, ByteString) -> TestTree
+tableTestCase f (output, input) = testCase description (f input @?= output)
where
description =
let (x, y) = ByteString.splitAt 11 input
diff --git a/tests/Data/Digest/Md5Tests.hs b/tests/Data/Digest/Md5Tests.hs
new file mode 100644
index 0000000..f7f62a7
--- /dev/null
+++ b/tests/Data/Digest/Md5Tests.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.Digest.Md5Tests
+ ( tests
+ ) where
+
+import qualified Data.ByteString.Lazy as ByteString.Lazy
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.SmallCheck (testProperty)
+
+import Data.Digest.HashTests
+ (tableTestCase, testAgainstCoreutils, testAgainstOpenssl)
+import Data.Digest.Md5
+
+tests :: TestTree
+tests =
+ testGroup
+ "Data.Digest.Md5"
+ [ testRfcExamples
+ , testGoExamples
+ , testCoreutilsConformance
+ , testOpensslConformance
+ ]
+
+
+-- | MD5 example vectors from RFC 1321.
+testRfcExamples =
+ testGroup "RFC 1321 examples" $
+ map
+ (tableTestCase md5sum)
+ [ ("d41d8cd98f00b204e9800998ecf8427e", "")
+ , ("0cc175b9c0f1b6a831c399e269772661", "a")
+ , ("900150983cd24fb0d6963f7d28e17f72", "abc")
+ , ("f96b697d7cb7938d525a2f31aaf161d0", "message digest")
+ , ("c3fcd3d76192e4007dfb496cca67e13b", "abcdefghijklmnopqrstuvwxyz")
+ , ( "d174ab98d277d9f5a5611c2c9f419d9f"
+ , "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
+ , ( "57edf4a22be3c955ac49da2e2107b67a"
+ , "12345678901234567890123456789012345678901234567890123456789012345678901234567890")
+ ]
+
+-- | Test vectors used to test the Go MD5 implementation.
+testGoExamples =
+ testGroup "Go tests" $
+ map
+ (tableTestCase md5sum)
+ [ ("d41d8cd98f00b204e9800998ecf8427e", "")
+ , ("0cc175b9c0f1b6a831c399e269772661", "a")
+ , ("187ef4436122d1cc2f40dc2b92f0eba0", "ab")
+ , ("900150983cd24fb0d6963f7d28e17f72", "abc")
+ , ("e2fc714c4727ee9395f324cd2e7f331f", "abcd")
+ , ("ab56b4d92b40713acc5af89985d4b786", "abcde")
+ , ("e80b5017098950fc58aad83c8c14978e", "abcdef")
+ , ("7ac66c0f148de9519b8bd264312c4d64", "abcdefg")
+ , ("e8dc4081b13434b45189a720b77b6818", "abcdefgh")
+ , ("8aa99b1f439ff71293e95357bac6fd94", "abcdefghi")
+ , ("a925576942e94b2ef57a066101b48876", "abcdefghij")
+ , ( "d747fc1719c7eacb84058196cfe56d57"
+ , "Discard medicine more than two years old.")
+ , ( "bff2dcb37ef3a44ba43ab144768ca837"
+ , "He who has a shady past knows that nice guys finish last.")
+ , ( "0441015ecb54a7342d017ed1bcfdbea5"
+ , "I wouldn't marry him with a ten foot pole.")
+ , ( "9e3cac8e9e9757a60c3ea391130d3689"
+ , "Free! Free!/A trip/to Mars/for 900/empty jars/Burma Shave")
+ , ( "a0f04459b031f916a59a35cc482dc039"
+ , "The days of the digital watch are numbered. -Tom Stoppard")
+ , ("e7a48e0fe884faf31475d2a04b1362cc", "Nepal premier won't resign.")
+ , ( "637d2fe925c07c113800509964fb0e06"
+ , "For every action there is an equal and opposite government program.")
+ , ( "834a8d18d5c6562119cf4c7f5086cb71"
+ , "His money is twice tainted: 'taint yours and 'taint mine.")
+ , ( "de3a4d2fd6c73ec2db2abad23b444281"
+ , "There is no reason for any individual to have a computer in their home. -Ken Olsen, 1977")
+ , ( "acf203f997e2cf74ea3aff86985aefaf"
+ , "It's a tiny change to the code and not completely disgusting. - Bob Manchek")
+ , ("e1c1384cb4d2221dfdd7c795a4222c9a", "size: a.out: bad magic")
+ , ( "c90f3ddecc54f34228c063d7525bf644"
+ , "The major problem is with sendmail. -Mark Horton")
+ , ( "cdf7ab6c1fd49bd9933c43f3ea5af185"
+ , "Give me a rock, paper and scissors and I will move the world. CCFestoon")
+ , ( "83bc85234942fc883c063cbd7f0ad5d0"
+ , "If the enemy is within range, then so are you.")
+ , ( "277cbe255686b48dd7e8f389394d9299"
+ , "It's well we cannot hear the screams/That we create in others' dreams.")
+ , ( "fd3fb0a7ffb8af16603f3d3af98f8e1f"
+ , "You remind me of a TV show, but that's all right: I watch it anyway.")
+ , ("469b13a78ebf297ecda64d4723655154", "C is as portable as Stonehedge!!")
+ , ( "63eb3a2f466410104731c4b037600110"
+ , "Even if I could be Shakespeare, I think I should still choose to be Faraday. - A. Huxley")
+ , ( "72c2ed7592debca1c90fc0100f931a2f"
+ , "The fugacity of a constituent in a mixture of gases at a given temperature is proportional to its mole fraction. Lewis-Randall Rule")
+ , ( "132f7619d33b523b1d9e5bd8e0928355"
+ , "How can you write a big system without C++? -Paul Glick")
+ ]
+
+-- | Tests our MD5 implementation against coreutils'.
+testCoreutilsConformance =
+ testProperty
+ "conformance with coreutils"
+ (testAgainstCoreutils md5sum "md5sum")
+
+-- | Tests our MD5 implementation against openssl(1)'s.
+testOpensslConformance =
+ testProperty "conformance with OpenSSL" (testAgainstOpenssl md5sum "md5")
+
+-- Convenience function.
+
+md5sum = show . md5 . ByteString.Lazy.fromStrict
diff --git a/tests/Data/Digest/Sha1Tests.hs b/tests/Data/Digest/Sha1Tests.hs
index 3d06e5d..cd1f1c6 100644
--- a/tests/Data/Digest/Sha1Tests.hs
+++ b/tests/Data/Digest/Sha1Tests.hs
@@ -10,7 +10,7 @@ import Test.Tasty.HUnit ((@?=), testCase)
import Test.Tasty.SmallCheck (testProperty)
import Data.Digest.HashTests
- (goTestCase, testAgainstCoreutils, testAgainstOpenssl)
+ (tableTestCase, testAgainstCoreutils, testAgainstOpenssl)
import Data.Digest.Sha1
tests :: TestTree
@@ -40,7 +40,7 @@ testNistExamples =
testGoExamples =
testGroup "Go tests" $
map
- (goTestCase sha1sum)
+ (tableTestCase sha1sum)
[ ( "76245dbf96f661bd221046197ab8b9f063f11bad"
, "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n")
, ("da39a3ee5e6b4b0d3255bfef95601890afd80709", "")
diff --git a/tests/Data/Digest/Sha2Tests.hs b/tests/Data/Digest/Sha2Tests.hs
index 9efc714..b1faf27 100644
--- a/tests/Data/Digest/Sha2Tests.hs
+++ b/tests/Data/Digest/Sha2Tests.hs
@@ -10,7 +10,7 @@ import Test.Tasty.HUnit ((@?=), testCase)
import Test.Tasty.SmallCheck (testProperty)
import Data.Digest.HashTests
- (goTestCase, testAgainstCoreutils, testAgainstOpenssl)
+ (tableTestCase, testAgainstCoreutils, testAgainstOpenssl)
import Data.Digest.Sha2
tests :: TestTree
@@ -83,7 +83,7 @@ testGoExamples =
testGoSha224 =
testGroup "SHA-224" $
map
- (goTestCase sha224sum)
+ (tableTestCase sha224sum)
[ ( "d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f"
, ""
)
@@ -182,7 +182,7 @@ testGoSha224 =
testGoSha256 =
testGroup "SHA-256" $
map
- (goTestCase sha256sum)
+ (tableTestCase sha256sum)
[ ( "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
, ""
)
@@ -281,7 +281,7 @@ testGoSha256 =
testGoSha384 =
testGroup "SHA-384" $
map
- (goTestCase sha384sum)
+ (tableTestCase sha384sum)
[ ( "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b"
, ""
)
@@ -379,7 +379,7 @@ testGoSha384 =
testGoSha512 =
testGroup "SHA-512" $
- map (goTestCase sha512sum)
+ map (tableTestCase sha512sum)
[ ( "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e"
, ""
)
diff --git a/tests/Tests.hs b/tests/Tests.hs
index 34852db..caec20a 100644
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -4,10 +4,16 @@ module Main
import Test.Tasty (defaultMain, testGroup)
+import qualified Data.Digest.Md5Tests
import qualified Data.Digest.Sha1Tests
import qualified Data.Digest.Sha2Tests
main :: IO ()
main =
defaultMain $
- testGroup "btls" [Data.Digest.Sha1Tests.tests, Data.Digest.Sha2Tests.tests]
+ testGroup
+ "btls"
+ [ Data.Digest.Md5Tests.tests
+ , Data.Digest.Sha1Tests.tests
+ , Data.Digest.Sha2Tests.tests
+ ]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-21 15:21:31 +0000