Implement SHA-1

4 files changed, 168 insertions, 40 deletions

diff --git a/tests/Data/Digest/HashTests.hs b/tests/Data/Digest/HashTests.hs
new file mode 100644
index 0000000..0691bf4
--- /dev/null
+++ b/tests/Data/Digest/HashTests.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.Digest.HashTests
+  ( goTestCase
+  , testAgainstCoreutils
+  , testAgainstOpenssl
+  ) where
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import System.IO (hClose, hGetContents, hSetBinaryMode)
+import System.Process
+       (CreateProcess(std_in, std_out), StdStream(CreatePipe),
+        createProcess_, proc)
+import qualified Test.SmallCheck.Series.ByteString
+       as ByteString.Series
+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)
+  where
+    description =
+      let (x, y) = ByteString.splitAt 11 input
+      in show (x `ByteString.append` if ByteString.null y then "" else "...")
+
+testAgainstCoreutils :: (ByteString -> String) -> FilePath -> Property IO
+testAgainstCoreutils f prog =
+  over ByteString.Series.enumW8s $ \s ->
+    monadic $ do
+      theirs <- runExternal (proc prog ["-b"]) s
+      return (f s == head (words theirs))
+
+-- | Runs an external hashing command with the specified standard input. Assumes
+-- that the process will exit when its standard input is closed.
+runExternal :: CreateProcess -> ByteString -> IO String
+runExternal p s = do
+  (Just stdin, Just stdout, _, _) <-
+    createProcess_ "runExternal" (p {std_in = CreatePipe, std_out = CreatePipe})
+  hSetBinaryMode stdin True
+  ByteString.hPut stdin s
+  hClose stdin -- causes process to exit
+  hGetContents stdout
+
+testAgainstOpenssl :: (ByteString -> String) -> String -> Property IO
+testAgainstOpenssl f flag =
+  over ByteString.Series.enumW8s $ \s ->
+    monadic $ do
+      theirs <- runExternal (proc "openssl" ["dgst", '-' : flag]) s
+      return (f s == words theirs !! 1)
diff --git a/tests/Data/Digest/Sha1Tests.hs b/tests/Data/Digest/Sha1Tests.hs
new file mode 100644
index 0000000..3d06e5d
--- /dev/null
+++ b/tests/Data/Digest/Sha1Tests.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.Digest.Sha1Tests
+  ( tests
+  ) where
+
+import qualified Data.ByteString.Lazy as ByteString.Lazy
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit ((@?=), testCase)
+import Test.Tasty.SmallCheck (testProperty)
+
+import Data.Digest.HashTests
+       (goTestCase, testAgainstCoreutils, testAgainstOpenssl)
+import Data.Digest.Sha1
+
+tests :: TestTree
+tests =
+  testGroup
+    "Data.Digest.Sha1"
+    [ testNistExamples
+    , testGoExamples
+    , testCoreutilsConformance
+    , testOpensslConformance
+    ]
+
+
+-- | SHA-1 example vectors from
+-- https://csrc.nist.gov/projects/cryptographic-standards-and-guidelines/example-values.
+testNistExamples =
+  testGroup
+    "NIST examples"
+    [ testCase "one-block" $
+      sha1sum "abc" @?= "a9993e364706816aba3e25717850c26c9cd0d89d"
+    , testCase "two-block" $
+      sha1sum "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" @?=
+      "84983e441c3bd26ebaae4aa1f95129e5e54670f1"
+    ]
+
+-- | Test vectors used to test the Go SHA-1 implementation.
+testGoExamples =
+  testGroup "Go tests" $
+  map
+    (goTestCase sha1sum)
+    [ ( "76245dbf96f661bd221046197ab8b9f063f11bad"
+      , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n")
+    , ("da39a3ee5e6b4b0d3255bfef95601890afd80709", "")
+    , ("86f7e437faa5a7fce15d1ddcb9eaeaea377667b8", "a")
+    , ("da23614e02469a0d7c7bd1bdab5c9c474b1904dc", "ab")
+    , ("a9993e364706816aba3e25717850c26c9cd0d89d", "abc")
+    , ("81fe8bfe87576c3ecb22426f8e57847382917acf", "abcd")
+    , ("03de6c570bfe24bfc328ccd7ca46b76eadaf4334", "abcde")
+    , ("1f8ac10f23c5b5bc1167bda84b833e5c057a77d2", "abcdef")
+    , ("2fb5e13419fc89246865e7a324f476ec624e8740", "abcdefg")
+    , ("425af12a0743502b322e93a015bcf868e324d56a", "abcdefgh")
+    , ("c63b19f1e4c8b5f76b25c49b8b87f57d8e4872a1", "abcdefghi")
+    , ("d68c19a0a345b7eab78d5e11e991c026ec60db63", "abcdefghij")
+    , ( "ebf81ddcbe5bf13aaabdc4d65354fdf2044f38a7"
+      , "Discard medicine more than two years old.")
+    , ( "e5dea09392dd886ca63531aaa00571dc07554bb6"
+      , "He who has a shady past knows that nice guys finish last.")
+    , ( "45988f7234467b94e3e9494434c96ee3609d8f8f"
+      , "I wouldn't marry him with a ten foot pole.")
+    , ( "55dee037eb7460d5a692d1ce11330b260e40c988"
+      , "Free! Free!/A trip/to Mars/for 900/empty jars/Burma Shave")
+    , ( "b7bc5fb91080c7de6b582ea281f8a396d7c0aee8"
+      , "The days of the digital watch are numbered.  -Tom Stoppard")
+    , ( "c3aed9358f7c77f523afe86135f06b95b3999797"
+      , "Nepal premier won't resign.")
+    , ( "6e29d302bf6e3a5e4305ff318d983197d6906bb9"
+      , "For every action there is an equal and opposite government program.")
+    , ( "597f6a540010f94c15d71806a99a2c8710e747bd"
+      , "His money is twice tainted: 'taint yours and 'taint mine.")
+    , ( "6859733b2590a8a091cecf50086febc5ceef1e80"
+      , "There is no reason for any individual to have a computer in their home. -Ken Olsen, 1977")
+    , ( "514b2630ec089b8aee18795fc0cf1f4860cdacad"
+      , "It's a tiny change to the code and not completely disgusting. - Bob Manchek")
+    , ("c5ca0d4a7b6676fc7aa72caa41cc3d5df567ed69", "size:  a.out:  bad magic")
+    , ( "74c51fa9a04eadc8c1bbeaa7fc442f834b90a00a"
+      , "The major problem is with sendmail.  -Mark Horton")
+    , ( "0b4c4ce5f52c3ad2821852a8dc00217fa18b8b66"
+      , "Give me a rock, paper and scissors and I will move the world.  CCFestoon")
+    , ( "3ae7937dd790315beb0f48330e8642237c61550a"
+      , "If the enemy is within range, then so are you.")
+    , ( "410a2b296df92b9a47412b13281df8f830a9f44b"
+      , "It's well we cannot hear the screams/That we create in others' dreams.")
+    , ( "841e7c85ca1adcddbdd0187f1289acb5c642f7f5"
+      , "You remind me of a TV show, but that's all right: I watch it anyway.")
+    , ( "163173b825d03b952601376b25212df66763e1db"
+      , "C is as portable as Stonehedge!!")
+    , ( "32b0377f2687eb88e22106f133c586ab314d5279"
+      , "Even if I could be Shakespeare, I think I should still choose to be Faraday. - A. Huxley")
+    , ( "0885aaf99b569542fd165fa44e322718f4a984e0"
+      , "The fugacity of a constituent in a mixture of gases at a given temperature is proportional to its mole fraction.  Lewis-Randall Rule")
+    , ( "6627d6904d71420b0bf3886ab629623538689f45"
+      , "How can you write a big system without C++?  -Paul Glick")
+    ]
+
+-- | Tests our SHA-1 implementation against coreutils'.
+testCoreutilsConformance =
+  testProperty
+    "conformance with coreutils"
+    (testAgainstCoreutils sha1sum "sha1sum")
+
+-- | Tests our SHA-1 implementation against openssl(1)'s.
+testOpensslConformance =
+  testProperty "conformance with OpenSSL" (testAgainstOpenssl sha1sum "sha1")
+
+-- Convenience function.
+
+sha1sum = show . sha1 . ByteString.Lazy.fromStrict
diff --git a/tests/Data/Digest/Sha2Tests.hs b/tests/Data/Digest/Sha2Tests.hs
index 248d23c..9efc714 100644
--- a/tests/Data/Digest/Sha2Tests.hs
+++ b/tests/Data/Digest/Sha2Tests.hs
@@ -4,19 +4,13 @@ module Data.Digest.Sha2Tests
   ( tests
   ) where
 
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as ByteString
 import qualified Data.ByteString.Lazy as ByteString.Lazy
-import System.IO (hClose, hGetContents, hSetBinaryMode)
-import System.Process
-       (CreateProcess(std_in, std_out), StdStream(CreatePipe),
-        createProcess_, proc)
-import qualified Test.SmallCheck.Series.ByteString
-       as ByteString.Series
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit ((@?=), testCase)
-import Test.Tasty.SmallCheck (monadic, over, testProperty)
+import Test.Tasty.SmallCheck (testProperty)
 
+import Data.Digest.HashTests
+       (goTestCase, testAgainstCoreutils, testAgainstOpenssl)
 import Data.Digest.Sha2
 
 tests :: TestTree
@@ -86,13 +80,6 @@ testNistSha512 =
 testGoExamples =
   testGroup "Go tests" [testGoSha224, testGoSha256, testGoSha384, testGoSha512]
 
-goTestCase :: (ByteString -> String) -> (String, ByteString) -> TestTree
-goTestCase f (output, input) = testCase description (f input @?= output)
-  where
-    description =
-      let (x, y) = ByteString.splitAt 11 input
-      in show (x `ByteString.append` if ByteString.null y then "" else "...")
-
 testGoSha224 =
   testGroup "SHA-224" $
   map
@@ -498,23 +485,6 @@ testCoreutilsConformance =
     , testProperty "SHA-512" (testAgainstCoreutils sha512sum "sha512sum")
     ]
 
-testAgainstCoreutils f prog =
-  over ByteString.Series.enumW8s $ \s ->
-    monadic $ do
-      theirs <- runExternal (proc prog ["-b"]) s
-      return (f s == head (words theirs))
-
--- | Runs an external hashing command with the specified standard input. Assumes
--- that the process will exit when its standard input is closed.
-runExternal :: CreateProcess -> ByteString -> IO String
-runExternal p s = do
-  (Just stdin, Just stdout, _, _) <-
-    createProcess_ "runExternal" (p {std_in = CreatePipe, std_out = CreatePipe})
-  hSetBinaryMode stdin True
-  ByteString.hPut stdin s
-  hClose stdin -- causes process to exit
-  hGetContents stdout
-
 -- | Tests our SHA-2 implementations against openssl(1)'s.
 testOpensslConformance =
   testGroup
@@ -525,12 +495,6 @@ testOpensslConformance =
     , testProperty "SHA-512" (testAgainstOpenssl sha512sum "sha512")
     ]
 
-testAgainstOpenssl f flag =
-  over ByteString.Series.enumW8s $ \s ->
-    monadic $ do
-      theirs <- runExternal (proc "openssl" ["dgst", '-' : flag]) s
-      return (f s == words theirs !! 1)
-
 -- Convenience functions.
 
 sha224sum = show . sha224 . ByteString.Lazy.fromStrict
diff --git a/tests/Tests.hs b/tests/Tests.hs
index e14f836..34852db 100644
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -4,7 +4,10 @@ module Main
 
 import Test.Tasty (defaultMain, testGroup)
 
+import qualified Data.Digest.Sha1Tests
 import qualified Data.Digest.Sha2Tests
 
 main :: IO ()
-main = defaultMain $ testGroup "btls" [Data.Digest.Sha2Tests.tests]
+main =
+  defaultMain $
+  testGroup "btls" [Data.Digest.Sha1Tests.tests, Data.Digest.Sha2Tests.tests]