Enable error checking for HKDF computations

3 files changed, 36 insertions, 14 deletions

diff --git a/tests/BTLS/Assertions.hs b/tests/BTLS/Assertions.hs
new file mode 100644
index 0000000..23ceb8d
--- /dev/null
+++ b/tests/BTLS/Assertions.hs
@@ -0,0 +1,27 @@
+-- Copyright 2018 Google LLC
+--
+-- Licensed under the Apache License, Version 2.0 (the "License"); you may not
+-- use this file except in compliance with the License. You may obtain a copy of
+-- the License at
+--
+--     https://www.apache.org/licenses/LICENSE-2.0
+--
+-- Unless required by applicable law or agreed to in writing, software
+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+-- License for the specific language governing permissions and limitations under
+-- the License.
+
+module BTLS.Assertions
+  ( isRightAndHolds
+  ) where
+
+import Control.Monad (unless)
+import Test.Tasty.HUnit (Assertion, assertFailure)
+
+isRightAndHolds :: (Eq a, Show a, Show e) => Either e a -> a -> Assertion
+actual@(Left _) `isRightAndHolds` _ =
+  assertFailure ("expected: Right _\n but got: " ++ show actual)
+Right actual `isRightAndHolds` expected =
+  unless (expected == actual) $
+    assertFailure ("expected: Right " ++ show expected ++ "\n but got: Right " ++ show actual)
diff --git a/tests/Codec/Crypto/HKDFTests.hs b/tests/Codec/Crypto/HKDFTests.hs
index 44a41cd..d4cfe30 100644
--- a/tests/Codec/Crypto/HKDFTests.hs
+++ b/tests/Codec/Crypto/HKDFTests.hs
@@ -21,8 +21,9 @@ import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Base16 as ByteString.Base16
 import qualified Data.ByteString.Char8 as ByteString.Char8
 import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit ((@?=), testCase)
+import Test.Tasty.HUnit (testCase)
 
+import BTLS.Assertions (isRightAndHolds)
 import Codec.Crypto.HKDF (AssociatedData(AssociatedData), Salt(Salt), SecretKey(SecretKey), noSalt)
 import qualified Codec.Crypto.HKDF as HKDF
 import Data.Digest (sha1, sha256)
@@ -91,10 +92,11 @@ testRFC5869 = testGroup "RFC 5869 examples"
   ]
   where
     t name hash ikm salt info len prk okm =
-      testGroup name [ testCase "hkdf" $ HKDF.hkdf hash salt info len ikm @?= okm
-                     , testCase "extract" $ HKDF.extract hash salt ikm @?= prk
-                     , testCase "expand" $ HKDF.expand hash info len prk @?= okm
-                     ]
+      testGroup name
+        [ testCase "hkdf" $ HKDF.hkdf hash salt info len ikm `isRightAndHolds` okm
+        , testCase "extract" $ HKDF.extract hash salt ikm `isRightAndHolds` prk
+        , testCase "expand" $ HKDF.expand hash info len prk `isRightAndHolds` okm
+        ]
 
 hex :: ByteString -> ByteString
 hex s =
diff --git a/tests/Data/HMACTests.hs b/tests/Data/HMACTests.hs
index 10500e4..55e795e 100644
--- a/tests/Data/HMACTests.hs
+++ b/tests/Data/HMACTests.hs
@@ -16,13 +16,13 @@
 
 module Data.HMACTests (tests) where
 
-import Control.Monad (unless)
 import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Lazy as ByteString.Lazy
 import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8
 import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit (Assertion, assertFailure, testCase)
+import Test.Tasty.HUnit (testCase)
 
+import BTLS.Assertions (isRightAndHolds)
 import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512)
 import Data.HMAC (Error, SecretKey(SecretKey), hmac)
 
@@ -191,10 +191,3 @@ hmacSha224 key bytes = show <$> hmac sha224 key bytes
 hmacSha256 key bytes = show <$> hmac sha256 key bytes
 hmacSha384 key bytes = show <$> hmac sha384 key bytes
 hmacSha512 key bytes = show <$> hmac sha512 key bytes
-
-isRightAndHolds :: (Eq a, Show a, Show e) => Either e a -> a -> Assertion
-actual@(Left _) `isRightAndHolds` _ =
-  assertFailure ("expected: Right _\n but got: " ++ show actual)
-Right actual `isRightAndHolds` expected =
-  unless (expected == actual) $
-    assertFailure ("expected: Right " ++ show expected ++ "\n but got: Right " ++ show actual)