From a31daa3545c0a8cb5f95e88d66cfcee55a7ee925 Mon Sep 17 00:00:00 2001
From: Benjamin Barenblat <bbaren@google.com>
Date: Sat, 1 Sep 2018 15:12:30 -0400
Subject: Enable error checking for HMAC computations

---
 src/Data/HMAC.hs | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

(limited to 'src/Data/HMAC.hs')

diff --git a/src/Data/HMAC.hs b/src/Data/HMAC.hs
index e659749..812b638 100644
--- a/src/Data/HMAC.hs
+++ b/src/Data/HMAC.hs
@@ -14,19 +14,24 @@
 
 module Data.HMAC
   ( SecretKey(SecretKey)
-  , HMAC
+  , HMAC, Result
   , hmac
   ) where
 
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Except (runExceptT)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as ByteString.Lazy
 import qualified Data.ByteString.Unsafe as ByteString
+import Foreign (withForeignPtr)
 import Foreign.Marshal.Unsafe (unsafeLocalState)
 
 import BTLS.BoringSSL.Base
+import BTLS.BoringSSL.Digest (evpMaxMDSize)
 import BTLS.BoringSSL.HMAC
 import BTLS.BoringSSL.Mem (cryptoMemcmp)
-import BTLS.BoringSSLPatterns (initUpdateFinalize)
+import BTLS.BoringSSLPatterns (onBufferOfMaxSize)
+import BTLS.Result (Result, check)
 import BTLS.Types (Algorithm(Algorithm), Digest(Digest), SecretKey(SecretKey))
 
 type LazyByteString = ByteString.Lazy.ByteString
@@ -46,10 +51,11 @@ instance Show HMAC where
   show (HMAC m) = show (Digest m)
 
 -- | Creates an HMAC according to the given 'Algorithm'.
-hmac :: Algorithm -> SecretKey -> LazyByteString -> HMAC
-hmac (Algorithm md) (SecretKey key) =
-  HMAC
-    . unsafeLocalState
-    . initUpdateFinalize mallocHMACCtx initialize hmacUpdate hmacFinal
-  where
-    initialize ctx = hmacInitEx ctx key md noEngine
+hmac :: Algorithm -> SecretKey -> LazyByteString -> Result HMAC
+hmac (Algorithm md) (SecretKey key) bytes =
+  unsafeLocalState $ do
+    ctxFP <- mallocHMACCtx
+    withForeignPtr ctxFP $ \ctx -> runExceptT $ do
+      check $ hmacInitEx ctx key md noEngine
+      lift $ mapM_ (hmacUpdate ctx) (ByteString.Lazy.toChunks bytes)
+      lift $ HMAC <$> onBufferOfMaxSize evpMaxMDSize (hmacFinal ctx)
-- 
cgit v1.2.3