1 files changed, 62 insertions, 0 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)