Split low-level HMAC bindings into their own module

4 files changed, 73 insertions, 62 deletions

diff --git a/btls.cabal b/btls.cabal
index 4f46ec3..a7fe7ec 100644
--- a/btls.cabal
+++ b/btls.cabal
@@ -58,6 +58,7 @@ library
                      , Foreign.Ptr.ConstantTimeEquals
                      , Internal.Base
                      , Internal.Digest
+                     , Internal.Hmac
                      , Result
   c-sources:           cbits/btls.c
   -- Use special names for the BoringSSL libraries to avoid accidentally pulling
diff --git a/src/Data/Hmac.chs b/src/Data/Hmac.hs
index 8cbdda7..d1124b6 100644
--- a/src/Data/Hmac.chs
+++ b/src/Data/Hmac.hs
@@ -12,8 +12,6 @@
 -- License for the specific language governing permissions and limitations under
 -- the License.
 
-{-# OPTIONS_GHC -Wno-missing-methods #-}
-
 module Data.Hmac
   ( SecretKey(SecretKey)
   , Hmac
@@ -24,73 +22,18 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Lazy as ByteString.Lazy
 import qualified Data.ByteString.Unsafe as ByteString
-import Foreign
-       (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, peek, sizeOf),
-        addForeignPtrFinalizer, alloca, allocaArray, mallocForeignPtr,
-        withForeignPtr)
-import Foreign.C.Types
+import Foreign (Storable(peek), alloca, allocaArray, withForeignPtr)
 import Foreign.Marshal.Unsafe (unsafeLocalState)
 import Unsafe.Coerce (unsafeCoerce)
 
 import Data.Digest.Internal (Algorithm(Algorithm), Digest(Digest))
-import Foreign.Ptr.Cast (asVoidPtr)
-{#import Foreign.Ptr.ConstantTimeEquals#} (constantTimeEquals)
-{#import Internal.Base#}
-{#import Internal.Digest#}
-import Result
+import Foreign.Ptr.ConstantTimeEquals (constantTimeEquals)
+import Internal.Base
+import Internal.Digest
+import Internal.Hmac
 
 type LazyByteString = ByteString.Lazy.ByteString
 
-#include <openssl/hmac.h>
-
--- First, we build basic bindings to the BoringSSL HMAC interface.
-
--- | The BoringSSL @HMAC_CTX@ type, representing the state of a pending HMAC
--- operation.
-data HmacCtx
-{#pointer *HMAC_CTX as 'Ptr HmacCtx' -> HmacCtx nocode#}
-
-instance Storable HmacCtx where
-  sizeOf _ = {#sizeof HMAC_CTX#}
-  alignment _ = {#alignof HMAC_CTX#}
-
--- Imported functions from BoringSSL. See
--- https://commondatastorage.googleapis.com/chromium-boringssl-docs/hmac.h.html
--- for documentation.
---
--- Some of these functions return 'CInt' even though they can never fail. Wrap
--- them to prevent warnings.
-
-hmacUpdate :: Ptr HmacCtx -> Ptr CUChar -> CULong -> IO ()
-hmacUpdate ctx bytes size =
-  alwaysSucceeds $ {#call HMAC_Update as ^#} ctx bytes size
-
--- Convert functions that can in fact fail to throw exceptions instead.
-
-hmacInitEx :: Ptr HmacCtx -> Ptr a -> CULong -> Ptr EvpMd -> Ptr Engine -> IO ()
-hmacInitEx ctx bytes size md engine =
-  requireSuccess $
-    {#call HMAC_Init_ex as ^#} ctx (asVoidPtr bytes) size md engine
-
-hmacFinal :: Ptr HmacCtx -> Ptr CUChar -> Ptr CUInt -> IO ()
-hmacFinal ctx out outSize =
-  requireSuccess $ {#call HMAC_Final as ^#} ctx out outSize
-
--- Now we can build a memory-safe allocator.
-
--- | Memory-safe allocator for 'HmacCtx'.
-mallocHmacCtx :: IO (ForeignPtr HmacCtx)
-mallocHmacCtx = do
-  fp <- mallocForeignPtr
-  withForeignPtr fp {#call HMAC_CTX_init as ^#}
-  addForeignPtrFinalizer hmacCtxCleanup fp
-  return fp
-
-foreign import ccall "&HMAC_CTX_cleanup"
-  hmacCtxCleanup :: FinalizerPtr HmacCtx
-
--- Finally, we're ready to actually implement the HMAC interface.
-
 -- | A secret key used as input to a cipher or HMAC. Equality comparisons on
 -- this type are variable-time.
 newtype SecretKey = SecretKey ByteString
diff --git a/src/Internal/Base.chs b/src/Internal/Base.chs
index 552e76b..427cf6b 100644
--- a/src/Internal/Base.chs
+++ b/src/Internal/Base.chs
@@ -36,3 +36,8 @@ data EvpMdCtx
 -- | The BoringSSL @EVP_MD@ type, representing a hash algorithm.
 data EvpMd
 {#pointer *EVP_MD as 'Ptr EvpMd' -> EvpMd nocode#}
+
+-- | The BoringSSL @HMAC_CTX@ type, representing the state of a pending HMAC
+-- operation.
+data HmacCtx
+{#pointer *HMAC_CTX as 'Ptr HmacCtx' -> HmacCtx nocode#}
diff --git a/src/Internal/Hmac.chs b/src/Internal/Hmac.chs
new file mode 100644
index 0000000..69c474e
--- /dev/null
+++ b/src/Internal/Hmac.chs
@@ -0,0 +1,62 @@
+-- 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.
+
+{-# OPTIONS_GHC -Wno-missing-methods #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Internal.Hmac
+  ( mallocHmacCtx
+  , hmacInitEx
+  , hmacUpdate
+  , hmacFinal
+  ) where
+
+import Foreign
+  (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf),
+   addForeignPtrFinalizer, mallocForeignPtr, withForeignPtr)
+import Foreign.C.Types
+
+import Foreign.Ptr.Cast (asVoidPtr)
+{#import Internal.Base#}
+import Result
+
+#include <openssl/hmac.h>
+
+-- | Memory-safe allocator for 'HmacCtx'.
+mallocHmacCtx :: IO (ForeignPtr HmacCtx)
+mallocHmacCtx = do
+  fp <- mallocForeignPtr
+  withForeignPtr fp {#call HMAC_CTX_init as ^#}
+  addForeignPtrFinalizer hmacCtxCleanup fp
+  return fp
+
+foreign import ccall "&HMAC_CTX_cleanup"
+  hmacCtxCleanup :: FinalizerPtr HmacCtx
+
+hmacInitEx :: Ptr HmacCtx -> Ptr a -> CULong -> Ptr EvpMd -> Ptr Engine -> IO ()
+hmacInitEx ctx bytes size md engine =
+  requireSuccess $
+    {#call HMAC_Init_ex as ^#} ctx (asVoidPtr bytes) size md engine
+
+hmacUpdate :: Ptr HmacCtx -> Ptr CUChar -> CULong -> IO ()
+hmacUpdate ctx bytes size =
+  alwaysSucceeds $ {#call HMAC_Update as ^#} ctx bytes size
+
+hmacFinal :: Ptr HmacCtx -> Ptr CUChar -> Ptr CUInt -> IO ()
+hmacFinal ctx out outSize =
+  requireSuccess $ {#call HMAC_Final as ^#} ctx out outSize
+
+instance Storable HmacCtx where
+  sizeOf _ = {#sizeof HMAC_CTX#}
+  alignment _ = {#alignof HMAC_CTX#}