aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Benjamin Barenblat <bbaren@google.com>2018-04-28 14:49:07 -0700
committerGravatar Benjamin Barenblat <bbaren@google.com>2018-04-28 14:49:07 -0700
commit8fc0b121543b742f56f83c9eb74885e04d104778 (patch)
treeb9bf54768acefb7153464574823edd5d59111a05 /src
parent5012ab360d06a5b3e0955c107329ac6b1d3d62e5 (diff)
Split low-level HMAC bindings into their own module
Diffstat (limited to 'src')
-rw-r--r--src/Data/Hmac.hs (renamed from src/Data/Hmac.chs)67
-rw-r--r--src/Internal/Base.chs5
-rw-r--r--src/Internal/Hmac.chs62
3 files changed, 72 insertions, 62 deletions
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#}