From 226c84a6e5464ca74468e690250227f70e8fa1c8 Mon Sep 17 00:00:00 2001
From: Benjamin Barenblat <bbaren@google.com>
Date: Sat, 28 Apr 2018 17:03:04 -0700
Subject: Factor out common resource create/initialize/set-finalizer cycle

---
 btls.cabal                             |  1 +
 src/Foreign/Ptr/CreateWithFinalizer.hs | 27 +++++++++++++++++++++++++++
 src/Internal/Digest.chs                |  8 +++-----
 src/Internal/HMAC.chs                  |  7 ++-----
 4 files changed, 33 insertions(+), 10 deletions(-)
 create mode 100644 src/Foreign/Ptr/CreateWithFinalizer.hs

diff --git a/btls.cabal b/btls.cabal
index d63a67a..d554a89 100644
--- a/btls.cabal
+++ b/btls.cabal
@@ -52,6 +52,7 @@ library
   other-modules:       Data.Digest.Internal
                      , Foreign.Ptr.Cast
                      , Foreign.Ptr.ConstantTimeEquals
+                     , Foreign.Ptr.CreateWithFinalizer
                      , Internal.Base
                      , Internal.Digest
                      , Internal.HMAC
diff --git a/src/Foreign/Ptr/CreateWithFinalizer.hs b/src/Foreign/Ptr/CreateWithFinalizer.hs
new file mode 100644
index 0000000..b1dd583
--- /dev/null
+++ b/src/Foreign/Ptr/CreateWithFinalizer.hs
@@ -0,0 +1,27 @@
+-- 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.
+
+module Foreign.Ptr.CreateWithFinalizer (createWithFinalizer) where
+
+import Foreign
+  (FinalizerPtr, ForeignPtr, Ptr, Storable, addForeignPtrFinalizer,
+   mallocForeignPtr, withForeignPtr)
+
+createWithFinalizer ::
+  Storable a => (Ptr a -> IO ()) -> FinalizerPtr a -> IO (ForeignPtr a)
+createWithFinalizer initialize finalize = do
+  fp <- mallocForeignPtr
+  withForeignPtr fp initialize
+  addForeignPtrFinalizer finalize fp
+  return fp
diff --git a/src/Internal/Digest.chs b/src/Internal/Digest.chs
index d451f1c..4708c47 100644
--- a/src/Internal/Digest.chs
+++ b/src/Internal/Digest.chs
@@ -28,6 +28,7 @@ import Foreign
 import Foreign.C.Types
 import Foreign.Ptr.Cast (asVoidPtr)
 
+import Foreign.Ptr.CreateWithFinalizer (createWithFinalizer)
 {#import Internal.Base#}
 import Result
 
@@ -43,11 +44,8 @@ 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
+mallocEVPMDCtx =
+  createWithFinalizer {#call EVP_MD_CTX_init as ^#} btlsFinalizeEVPMDCtxPtr
 
 foreign import ccall "&btlsFinalizeEVPMDCtx"
   btlsFinalizeEVPMDCtxPtr :: FinalizerPtr EVPMDCtx
diff --git a/src/Internal/HMAC.chs b/src/Internal/HMAC.chs
index 7e64edf..88ac1fb 100644
--- a/src/Internal/HMAC.chs
+++ b/src/Internal/HMAC.chs
@@ -26,6 +26,7 @@ import Foreign
 import Foreign.C.Types
 
 import Foreign.Ptr.Cast (asVoidPtr)
+import Foreign.Ptr.CreateWithFinalizer (createWithFinalizer)
 {#import Internal.Base#}
 import Result
 
@@ -33,11 +34,7 @@ import Result
 
 -- | 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
+mallocHMACCtx = createWithFinalizer {#call HMAC_CTX_init as ^#} hmacCtxCleanup
 
 foreign import ccall "&HMAC_CTX_cleanup"
   hmacCtxCleanup :: FinalizerPtr HMACCtx
-- 
cgit v1.2.3