diff options
| -rw-r--r-- | src/BTLS/Result.hs | 2 | ||||
| -rw-r--r-- | tests/Data/HMACTests.hs | 30 |
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) |