Eliminate Data.Digest.Internal

Move Data.Digest.Internal’s functions and types into more appropriate
modules. There’s now a single BTLS hierarchy that contains all internal
modules for the project.

2 files changed, 83 insertions, 5 deletions

diff --git a/src/BTLS/BoringSSLPatterns.hs b/src/BTLS/BoringSSLPatterns.hs
new file mode 100644
index 0000000..4b08663
--- /dev/null
+++ b/src/BTLS/BoringSSLPatterns.hs
@@ -0,0 +1,62 @@
+-- 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 BTLS.BoringSSLPatterns
+  ( initUpdateFinalize
+  ) where
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Unsafe as ByteString
+import qualified Data.ByteString.Lazy as ByteString.Lazy
+import Foreign (ForeignPtr, Storable(peek), Ptr, alloca, allocaArray, withForeignPtr)
+import Foreign.C.Types
+
+import BTLS.BoringSSL.Digest (evpMaxMDSize)
+
+type LazyByteString = ByteString.Lazy.ByteString
+
+-- | Encapsulates a common pattern of operation between hashing and HMAC
+-- computation. Both of these operations require an allocated context local to
+-- the operation. The context gets initialized once, updated repeatedly, and
+-- then finalized. Finally, we read the result out of a buffer produced by the
+-- finalizer.
+--
+-- The updater must not mutate any argument other than the context.
+--
+-- If all arguments are safe to use under 'unsafeLocalState', this whole
+-- function is safe to use under 'unsafeLocalState'.
+initUpdateFinalize ::
+     IO (ForeignPtr ctx)
+  -> (Ptr ctx -> IO ())
+  -> (Ptr ctx -> Ptr CChar -> CULong -> IO ())
+  -> (Ptr ctx -> Ptr CChar -> Ptr CUInt -> IO ())
+  -> LazyByteString
+  -> IO ByteString
+initUpdateFinalize mallocCtx initialize update finalize bytes = do
+  ctxFP <- mallocCtx
+  withForeignPtr ctxFP $ \ctx -> do
+    initialize ctx
+    mapM_ (updateBytes ctx) (ByteString.Lazy.toChunks bytes)
+    allocaArray evpMaxMDSize $ \rOut ->
+      alloca $ \pOutSize -> do
+        finalize ctx rOut pOutSize
+        outSize <- fromIntegral <$> peek pOutSize
+        ByteString.packCStringLen (rOut, outSize)
+  where
+    updateBytes ctx chunk =
+      -- The updater won't mutate its arguments, so the sharing inherent in
+      -- 'ByteString.unsafeUseAsCStringLen' is fine.
+      ByteString.unsafeUseAsCStringLen chunk $ \(buf, len) ->
+        update ctx buf (fromIntegral len)
diff --git a/src/BTLS/Types.hs b/src/BTLS/Types.hs
index dbd806a..06b5173 100644
--- a/src/BTLS/Types.hs
+++ b/src/BTLS/Types.hs
@@ -12,20 +12,36 @@
 -- License for the specific language governing permissions and limitations under
 -- the License.
 
-module BTLS.Types
-  ( AssociatedData(AssociatedData)
-  , Salt(Salt), noSalt
-  , SecretKey(SecretKey)
-  ) where
+module BTLS.Types 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 BTLS.BoringSSL.Base (EVPMD)
+
+-- | A cryptographic hash function.
+newtype Algorithm = Algorithm (Ptr EVPMD)
 
 -- | Context or application-specific information. Equality comparisons on this
 -- type are variable-time.
 newtype AssociatedData = AssociatedData ByteString
   deriving (Eq, Ord, Show)
 
+-- | 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
+
 -- | A salt. Equality comparisons on this type are variable-time.
 newtype Salt = Salt ByteString
   deriving (Eq, Ord, Show)