aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/BTLS/Result.hs2
-rw-r--r--tests/Data/HMACTests.hs30
2 files changed, 20 insertions, 12 deletions
diff --git a/src/BTLS/Result.hs b/src/BTLS/Result.hs
index 4f0238a..a3c153c 100644
--- a/src/BTLS/Result.hs
+++ b/src/BTLS/Result.hs
@@ -47,7 +47,7 @@ data Error = Error
, line :: Int
, errorData :: Maybe ByteString
, flags :: CInt
- } deriving Eq
+ }
errorDataIsHumanReadable :: Error -> Bool
errorDataIsHumanReadable e = flags e .&. errFlagString == 1
diff --git a/tests/Data/HMACTests.hs b/tests/Data/HMACTests.hs
index bcdd7a6..10500e4 100644
--- a/tests/Data/HMACTests.hs
+++ b/tests/Data/HMACTests.hs
@@ -16,11 +16,12 @@
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 ((@?=), testCase)
+import Test.Tasty.HUnit (Assertion, assertFailure, testCase)
import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512)
import Data.HMAC (Error, SecretKey(SecretKey), hmac)
@@ -39,7 +40,7 @@ tableTestCase ::
-> (SecretKey, LazyByteString, String)
-> TestTree
tableTestCase f (key, input, output) =
- testCase (abbreviate input) (f key input @?= Right output)
+ testCase (abbreviate input) (f key input `isRightAndHolds` output)
abbreviate :: LazyByteString -> String
abbreviate input =
@@ -119,16 +120,16 @@ truncatedFips198Test =
output = "9ea886efe268dbecce420c75" :: String
in testCase
(show input)
- (take 24 <$> hmacSha1 key (ByteString.Lazy.Char8.pack input) @?= Right output)
+ ((take 24 <$> hmacSha1 key (ByteString.Lazy.Char8.pack input)) `isRightAndHolds` output)
rfc4231TestCase ::
(SecretKey, LazyByteString, String, String, String, String) -> TestTree
rfc4231TestCase (key, input, sha224Output, sha256Output, sha384Output, sha512Output) =
testGroup (abbreviate input)
- [ testCase "SHA-224" (hmacSha224 key input @?= Right sha224Output)
- , testCase "SHA-256" (hmacSha256 key input @?= Right sha256Output)
- , testCase "SHA-384" (hmacSha384 key input @?= Right sha384Output)
- , testCase "SHA-512" (hmacSha512 key input @?= Right sha512Output)
+ [ testCase "SHA-224" (hmacSha224 key input `isRightAndHolds` sha224Output)
+ , testCase "SHA-256" (hmacSha256 key input `isRightAndHolds` sha256Output)
+ , testCase "SHA-384" (hmacSha384 key input `isRightAndHolds` sha384Output)
+ , testCase "SHA-512" (hmacSha512 key input `isRightAndHolds` sha512Output)
]
-- | Tests from RFC 4231.
@@ -178,10 +179,10 @@ truncatedRFC4231Test =
input = "Test With Truncation" :: LazyByteString
t f = take 32 <$> f key input :: Either [Error] String
in testGroup (abbreviate input)
- [ testCase "SHA-224" (t hmacSha224 @?= Right "0e2aea68a90c8d37c988bcdb9fca6fa8")
- , testCase "SHA-256" (t hmacSha256 @?= Right "a3b6167473100ee06e0c796c2955552b")
- , testCase "SHA-384" (t hmacSha384 @?= Right "3abf34c3503b2a23a46efc619baef897")
- , testCase "SHA-512" (t hmacSha512 @?= Right "415fad6271580a531d4179bc891d87a6")
+ [ testCase "SHA-224" (t hmacSha224 `isRightAndHolds` "0e2aea68a90c8d37c988bcdb9fca6fa8")
+ , testCase "SHA-256" (t hmacSha256 `isRightAndHolds` "a3b6167473100ee06e0c796c2955552b")
+ , testCase "SHA-384" (t hmacSha384 `isRightAndHolds` "3abf34c3503b2a23a46efc619baef897")
+ , testCase "SHA-512" (t hmacSha512 `isRightAndHolds` "415fad6271580a531d4179bc891d87a6")
]
hmacMd5 key bytes = show <$> hmac md5 key bytes
@@ -190,3 +191,10 @@ 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)