Split low-level digest bindings into their own module

6 files changed, 173 insertions, 176 deletions

diff --git a/src/Data/Digest.chs b/src/Data/Digest.chs
deleted file mode 100644
index 0ed24d2..0000000
--- a/src/Data/Digest.chs
+++ /dev/null
@@ -1,50 +0,0 @@
--- Copyright 2017 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.
-
-module Data.Digest
-  ( Algorithm
-  , Digest
-  , hash
-  , md5
-  , sha1
-  , sha224
-  , sha256
-  , sha384
-  , sha512
-  ) where
-
-import Foreign (Ptr)
-
-{#import Data.Digest.Internal#}
-{#import Internal.Base#}
-
-#include <openssl/digest.h>
-
-md5 :: Algorithm
-md5 = Algorithm {#call pure EVP_md5 as ^#}
-
-sha1 :: Algorithm
-sha1 = Algorithm {#call pure EVP_sha1 as ^#}
-
-sha224 :: Algorithm
-sha224 = Algorithm {#call pure EVP_sha224 as ^#}
-
-sha256 :: Algorithm
-sha256 = Algorithm {#call pure EVP_sha256 as ^#}
-
-sha384 :: Algorithm
-sha384 = Algorithm {#call pure EVP_sha384 as ^#}
-
-sha512 :: Algorithm
-sha512 = Algorithm {#call pure EVP_sha512 as ^#}
diff --git a/src/Data/Digest.hs b/src/Data/Digest.hs
new file mode 100644
index 0000000..e0e0540
--- /dev/null
+++ b/src/Data/Digest.hs
@@ -0,0 +1,84 @@
+-- Copyright 2017 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.
+
+module Data.Digest
+  ( Algorithm
+  , Digest
+  , hash
+  , md5
+  , sha1
+  , sha224
+  , sha256
+  , sha384
+  , sha512
+  ) where
+
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Unsafe as ByteString
+import qualified Data.ByteString.Lazy as ByteString.Lazy
+import Foreign (Storable(peek), alloca, allocaArray, withForeignPtr)
+import Foreign.Marshal.Unsafe (unsafeLocalState)
+import Unsafe.Coerce (unsafeCoerce)
+
+import Data.Digest.Internal
+import Internal.Base
+import Internal.Digest
+
+type LazyByteString = ByteString.Lazy.ByteString
+
+md5 :: Algorithm
+md5 = Algorithm evpMd5
+
+sha1 :: Algorithm
+sha1 = Algorithm evpSha1
+
+sha224 :: Algorithm
+sha224 = Algorithm evpSha224
+
+sha256 :: Algorithm
+sha256 = Algorithm evpSha256
+
+sha384 :: Algorithm
+sha384 = Algorithm evpSha384
+
+sha512 :: Algorithm
+sha512 = Algorithm evpSha512
+
+-- | Hashes according to the given 'Algorithm'.
+hash :: Algorithm -> LazyByteString -> Digest
+hash (Algorithm md) bytes =
+  unsafeLocalState $ do
+    ctxFP <- mallocEvpMdCtx
+    withForeignPtr ctxFP $ \ctx -> do
+      evpDigestInitEx ctx md noEngine
+      mapM_ (updateBytes ctx) (ByteString.Lazy.toChunks bytes)
+      d <-
+        allocaArray evpMaxMdSize $ \mdOut ->
+          alloca $ \pOutSize -> do
+            evpDigestFinalEx ctx mdOut pOutSize
+            outSize <- fromIntegral <$> peek pOutSize
+            -- 'mdOut' is a 'Ptr CUChar'. However, to make life more
+            -- interesting, 'CString' is a 'Ptr CChar', and 'CChar' is signed.
+            -- This is especially unfortunate given that all we really want to
+            -- do is convert to a 'ByteString', which is unsigned. To work
+            -- around it, we're going to cheat and let Haskell reinterpret-cast
+            -- 'mdOut' to 'Ptr CChar' before it does its 'ByteString' ingestion.
+            ByteString.packCStringLen (unsafeCoerce mdOut, outSize)
+      return (Digest d)
+  where
+    updateBytes ctx chunk =
+      -- 'mdUpdate' treats its @buf@ argument as @const@, so the sharing
+      -- inherent in 'ByteString.unsafeUseAsCStringLen' is fine.
+      ByteString.unsafeUseAsCStringLen chunk $ \(buf, len) ->
+        evpDigestUpdate ctx buf (fromIntegral len)
diff --git a/src/Data/Digest/Internal.chs b/src/Data/Digest/Internal.chs
deleted file mode 100644
index 6478810..0000000
--- a/src/Data/Digest/Internal.chs
+++ /dev/null
@@ -1,122 +0,0 @@
--- Copyright 2017 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.
-
-module Data.Digest.Internal where
-
-import Data.Bits (Bits((.&.)), shiftR)
-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 Data.Char (intToDigit)
-import Data.Word (Word8)
-import Foreign
-       (FinalizerPtr, ForeignPtr, Ptr, Storable(peek), addForeignPtrFinalizer,
-        alloca, allocaArray, mallocForeignPtr, withForeignPtr)
-import Foreign.C.Types
-import Foreign.Marshal.Unsafe (unsafeLocalState)
-import Unsafe.Coerce (unsafeCoerce)
-
-{#import Internal.Base#}
-{#import Internal.Digest#} ()
-import Foreign.Ptr.Cast (asVoidPtr)
-import Result
-
-type LazyByteString = ByteString.Lazy.ByteString
-
-#include <openssl/digest.h>
-
--- First, we build basic bindings to the BoringSSL EVP interface.
-
--- Imported functions from BoringSSL. See
--- https://commondatastorage.googleapis.com/chromium-boringssl-docs/digest.h.html
--- for documentation.
-
-evpMaxMdSize :: Int
-evpMaxMdSize = {#const EVP_MAX_MD_SIZE#}
-
--- Some of these functions return 'CInt' even though they can never fail. Wrap
--- them to prevent warnings.
-
-evpDigestUpdate :: Ptr EvpMdCtx -> Ptr a -> CULong -> IO ()
-evpDigestUpdate ctx md bytes =
-  alwaysSucceeds $ {#call EVP_DigestUpdate as ^#} ctx (asVoidPtr md) bytes
-
-evpDigestFinalEx :: Ptr EvpMdCtx -> Ptr CUChar -> Ptr CUInt -> IO ()
-evpDigestFinalEx ctx mdOut outSize =
-  alwaysSucceeds $ {#call EVP_DigestFinal_ex as ^#} ctx mdOut outSize
-
--- Convert functions that can in fact fail to throw exceptions instead.
-
-evpDigestInitEx :: Ptr EvpMdCtx -> Ptr EvpMd -> Ptr Engine -> IO ()
-evpDigestInitEx ctx md engine =
-  requireSuccess $ {#call EVP_DigestInit_ex as ^#} ctx md engine
-
--- Now we can build a memory-safe allocator.
-
--- | Memory-safe allocator for 'EvpMdCtx'.
-mallocEvpMdCtx :: IO (ForeignPtr EvpMdCtx)
-mallocEvpMdCtx = do
-  fp <- mallocForeignPtr
-  withForeignPtr fp {#call EVP_MD_CTX_init as ^#}
-  addForeignPtrFinalizer btlsFinalizeEvpMdCtxPtr fp
-  return fp
-
-foreign import ccall "&btlsFinalizeEvpMdCtx"
-  btlsFinalizeEvpMdCtxPtr :: FinalizerPtr EvpMdCtx
-
--- Finally, we're ready to actually implement the hashing interface.
-
--- | A cryptographic hash function.
-newtype Algorithm = Algorithm (Ptr EvpMd)
-
--- | The result of a hash operation.
-newtype Digest =
-  Digest ByteString
-  deriving (Eq, Ord)
-
-instance Show Digest where
-  show (Digest d) = ByteString.foldr showHexPadded [] d
-    where
-      showHexPadded b xs =
-        hexit (b `shiftR` 4 .&. 0x0f) : hexit (b .&. 0x0f) : xs
-      hexit = intToDigit . fromIntegral :: Word8 -> Char
-
--- | Hashes according to the given 'Algorithm'.
-hash :: Algorithm -> LazyByteString -> Digest
-hash (Algorithm md) bytes =
-  unsafeLocalState $ do
-    ctxFP <- mallocEvpMdCtx
-    withForeignPtr ctxFP $ \ctx -> do
-      evpDigestInitEx ctx md noEngine
-      mapM_ (updateBytes ctx) (ByteString.Lazy.toChunks bytes)
-      d <-
-        allocaArray evpMaxMdSize $ \mdOut ->
-          alloca $ \pOutSize -> do
-            evpDigestFinalEx ctx mdOut pOutSize
-            outSize <- fromIntegral <$> peek pOutSize
-            -- 'mdOut' is a 'Ptr CUChar'. However, to make life more
-            -- interesting, 'CString' is a 'Ptr CChar', and 'CChar' is signed.
-            -- This is especially unfortunate given that all we really want to
-            -- do is convert to a 'ByteString', which is unsigned. To work
-            -- around it, we're going to cheat and let Haskell reinterpret-cast
-            -- 'mdOut' to 'Ptr CChar' before it does its 'ByteString' ingestion.
-            ByteString.packCStringLen (unsafeCoerce mdOut, outSize)
-      return (Digest d)
-  where
-    updateBytes ctx chunk =
-      -- 'mdUpdate' treats its @buf@ argument as @const@, so the sharing
-      -- inherent in 'ByteString.unsafeUseAsCStringLen' is fine.
-      ByteString.unsafeUseAsCStringLen chunk $ \(buf, len) ->
-        evpDigestUpdate ctx buf (fromIntegral len)
diff --git a/src/Data/Digest/Internal.hs b/src/Data/Digest/Internal.hs
new file mode 100644
index 0000000..f8db383
--- /dev/null
+++ b/src/Data/Digest/Internal.hs
@@ -0,0 +1,39 @@
+-- Copyright 2017 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.
+
+module Data.Digest.Internal where
+
+import Data.Bits (Bits((.&.)), shiftR)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import Data.Char (intToDigit)
+import Data.Word (Word8)
+import Foreign (Ptr)
+
+import Internal.Base (EvpMd)
+
+-- | A cryptographic hash function.
+newtype Algorithm = Algorithm (Ptr EvpMd)
+
+-- | The result of a hash operation.
+newtype Digest =
+  Digest ByteString
+  deriving (Eq, Ord)
+
+instance Show Digest where
+  show (Digest d) = ByteString.foldr showHexPadded [] d
+    where
+      showHexPadded b xs =
+        hexit (b `shiftR` 4 .&. 0x0f) : hexit (b .&. 0x0f) : xs
+      hexit = intToDigit . fromIntegral :: Word8 -> Char
diff --git a/src/Data/Hmac.chs b/src/Data/Hmac.chs
index e78c1af..8cbdda7 100644
--- a/src/Data/Hmac.chs
+++ b/src/Data/Hmac.chs
@@ -32,11 +32,11 @@ import Foreign.C.Types
 import Foreign.Marshal.Unsafe (unsafeLocalState)
 import Unsafe.Coerce (unsafeCoerce)
 
-{#import Data.Digest.Internal#}
-       (Algorithm(Algorithm), Digest(Digest), evpMaxMdSize)
+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
 
 type LazyByteString = ByteString.Lazy.ByteString
diff --git a/src/Internal/Digest.chs b/src/Internal/Digest.chs
index 46b497e..81d5a3b 100644
--- a/src/Internal/Digest.chs
+++ b/src/Internal/Digest.chs
@@ -15,14 +15,60 @@
 {-# OPTIONS_GHC -Wno-missing-methods #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Internal.Digest where
+module Internal.Digest
+  ( evpMd5, evpSha1, evpSha224, evpSha256, evpSha384, evpSha512
+  , mallocEvpMdCtx
+  , evpDigestInitEx
+  , evpDigestUpdate
+  , evpDigestFinalEx
+  , evpMaxMdSize
+  ) where
 
-import Foreign (Storable(alignment, sizeOf))
+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/digest.h>
 
+evpMd5, evpSha1, evpSha224, evpSha256, evpSha384, evpSha512 :: Ptr EvpMd
+evpMd5    = {#call pure EVP_md5 as ^#}
+evpSha1   = {#call pure EVP_sha1 as ^#}
+evpSha224 = {#call pure EVP_sha224 as ^#}
+evpSha256 = {#call pure EVP_sha256 as ^#}
+evpSha384 = {#call pure EVP_sha384 as ^#}
+evpSha512 = {#call pure EVP_sha512 as ^#}
+
+-- | Memory-safe allocator for 'EvpMdCtx'.
+mallocEvpMdCtx :: IO (ForeignPtr EvpMdCtx)
+mallocEvpMdCtx = do
+  fp <- mallocForeignPtr
+  withForeignPtr fp {#call EVP_MD_CTX_init as ^#}
+  addForeignPtrFinalizer btlsFinalizeEvpMdCtxPtr fp
+  return fp
+
+foreign import ccall "&btlsFinalizeEvpMdCtx"
+  btlsFinalizeEvpMdCtxPtr :: FinalizerPtr EvpMdCtx
+
+evpDigestInitEx :: Ptr EvpMdCtx -> Ptr EvpMd -> Ptr Engine -> IO ()
+evpDigestInitEx ctx md engine =
+  requireSuccess $ {#call EVP_DigestInit_ex as ^#} ctx md engine
+
+evpDigestUpdate :: Ptr EvpMdCtx -> Ptr a -> CULong -> IO ()
+evpDigestUpdate ctx md bytes =
+  alwaysSucceeds $ {#call EVP_DigestUpdate as ^#} ctx (asVoidPtr md) bytes
+
+evpDigestFinalEx :: Ptr EvpMdCtx -> Ptr CUChar -> Ptr CUInt -> IO ()
+evpDigestFinalEx ctx mdOut outSize =
+  alwaysSucceeds $ {#call EVP_DigestFinal_ex as ^#} ctx mdOut outSize
+
+evpMaxMdSize :: Int
+evpMaxMdSize = {#const EVP_MAX_MD_SIZE#}
+
 instance Storable EvpMdCtx where
   sizeOf _ = {#sizeof EVP_MD_CTX#}
   alignment _ = {#alignof EVP_MD_CTX#}