From 015079075e1e156d5934f4e716a51eb284289b5d Mon Sep 17 00:00:00 2001
From: Benjamin Barenblat <bbaren@google.com>
Date: Tue, 4 Sep 2018 18:53:20 -0400
Subject: Marshal `ForeignPtr` to `Ptr` within c2hs code

---
 src/BTLS/BoringSSL/Digest.chs | 12 ++++++++----
 src/BTLS/BoringSSL/HMAC.chs   | 17 +++++++++++++----
 src/Data/Digest.hs            | 10 ++++------
 src/Data/HMAC.hs              | 12 +++++-------
 4 files changed, 30 insertions(+), 21 deletions(-)

diff --git a/src/BTLS/BoringSSL/Digest.chs b/src/BTLS/BoringSSL/Digest.chs
index 3b21636..c919125 100644
--- a/src/BTLS/BoringSSL/Digest.chs
+++ b/src/BTLS/BoringSSL/Digest.chs
@@ -22,7 +22,8 @@ module BTLS.BoringSSL.Digest
   ) where
 
 import Data.ByteString (ByteString)
-import Foreign (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf))
+import Foreign
+  (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf), withForeignPtr)
 import Foreign.C.Types
 
 {#import BTLS.BoringSSL.Base#}
@@ -48,13 +49,16 @@ foreign import ccall "&btlsFinalizeEVPMDCtx"
   btlsFinalizeEVPMDCtxPtr :: FinalizerPtr EVPMDCtx
 
 {#fun EVP_DigestInit_ex as evpDigestInitEx
-  {`Ptr EVPMDCtx', `Ptr EVPMD', `Ptr Engine'} -> `()' requireSuccess*-#}
+  {withForeignPtr* `ForeignPtr EVPMDCtx', `Ptr EVPMD', `Ptr Engine'}
+  -> `()' requireSuccess*-#}
 
 {#fun EVP_DigestUpdate as evpDigestUpdate
-  {`Ptr EVPMDCtx', unsafeUseAsCBuffer* `ByteString'&} -> `()' alwaysSucceeds*-#}
+  {withForeignPtr* `ForeignPtr EVPMDCtx', unsafeUseAsCBuffer* `ByteString'&}
+  -> `()' alwaysSucceeds*-#}
 
 {#fun EVP_DigestFinal_ex as evpDigestFinalEx
-  {`Ptr EVPMDCtx', id `Ptr CUChar', id `Ptr CUInt'} -> `()' alwaysSucceeds*-#}
+  {withForeignPtr* `ForeignPtr EVPMDCtx', id `Ptr CUChar', id `Ptr CUInt'}
+  -> `()' alwaysSucceeds*-#}
 
 evpMaxMDSize :: Int
 evpMaxMDSize = {#const EVP_MAX_MD_SIZE#}
diff --git a/src/BTLS/BoringSSL/HMAC.chs b/src/BTLS/BoringSSL/HMAC.chs
index ea9fd03..72cdd3c 100644
--- a/src/BTLS/BoringSSL/HMAC.chs
+++ b/src/BTLS/BoringSSL/HMAC.chs
@@ -20,7 +20,8 @@ module BTLS.BoringSSL.HMAC
   ) where
 
 import Data.ByteString (ByteString)
-import Foreign (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf))
+import Foreign
+  (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf), withForeignPtr)
 import Foreign.C.Types
 
 {#import BTLS.BoringSSL.Base#}
@@ -38,14 +39,22 @@ foreign import ccall "&HMAC_CTX_cleanup"
   hmacCtxCleanup :: FinalizerPtr HMACCtx
 
 {#fun HMAC_Init_ex as hmacInitEx
-  {`Ptr HMACCtx', unsafeUseAsCBuffer* `ByteString'&, `Ptr EVPMD', `Ptr Engine'}
+  { withForeignPtr* `ForeignPtr HMACCtx'
+  , unsafeUseAsCBuffer* `ByteString'&
+  , `Ptr EVPMD'
+  , `Ptr Engine' }
   -> `Int'#}
 
 {#fun HMAC_Update as hmacUpdate
-  {`Ptr HMACCtx', unsafeUseAsCBuffer* `ByteString'&} -> `()' alwaysSucceeds*-#}
+  { withForeignPtr* `ForeignPtr HMACCtx'
+  , unsafeUseAsCBuffer* `ByteString'& }
+  -> `()' alwaysSucceeds*-#}
 
 {#fun HMAC_Final as hmacFinal
-  {`Ptr HMACCtx', id `Ptr CUChar', id `Ptr CUInt'} -> `()' requireSuccess*-#}
+  { withForeignPtr* `ForeignPtr HMACCtx'
+  , id `Ptr CUChar'
+  , id `Ptr CUInt' }
+  -> `()' requireSuccess*-#}
 
 instance Storable HMACCtx where
   sizeOf _ = {#sizeof HMAC_CTX#}
diff --git a/src/Data/Digest.hs b/src/Data/Digest.hs
index a17c438..594fef1 100644
--- a/src/Data/Digest.hs
+++ b/src/Data/Digest.hs
@@ -40,7 +40,6 @@ module Data.Digest
 
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy as ByteString.Lazy
-import Foreign (withForeignPtr)
 import Foreign.Marshal.Unsafe (unsafeLocalState)
 
 import BTLS.BoringSSL.Base
@@ -88,8 +87,7 @@ sha512 = Algorithm evpSHA512
 hash :: Algorithm -> Lazy.ByteString -> Digest
 hash (Algorithm md) bytes =
   unsafeLocalState $ do
-    ctxFP <- mallocEVPMDCtx
-    withForeignPtr ctxFP $ \ctx -> do
-      evpDigestInitEx ctx md noEngine
-      mapM_ (evpDigestUpdate ctx) (ByteString.Lazy.toChunks bytes)
-      Digest <$> onBufferOfMaxSize evpMaxMDSize (evpDigestFinalEx ctx)
+    ctx <- mallocEVPMDCtx
+    evpDigestInitEx ctx md noEngine
+    mapM_ (evpDigestUpdate ctx) (ByteString.Lazy.toChunks bytes)
+    Digest <$> onBufferOfMaxSize evpMaxMDSize (evpDigestFinalEx ctx)
diff --git a/src/Data/HMAC.hs b/src/Data/HMAC.hs
index fb67817..c6edca3 100644
--- a/src/Data/HMAC.hs
+++ b/src/Data/HMAC.hs
@@ -51,7 +51,6 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy as ByteString.Lazy
 import qualified Data.ByteString.Unsafe as ByteString
-import Foreign (withForeignPtr)
 import Foreign.Marshal.Unsafe (unsafeLocalState)
 
 import BTLS.BoringSSL.Base
@@ -80,9 +79,8 @@ instance Show HMAC where
 -- | Creates an HMAC according to the given 'Algorithm'.
 hmac :: Algorithm -> SecretKey -> Lazy.ByteString -> Either [Error] HMAC
 hmac (Algorithm md) (SecretKey key) bytes =
-  unsafeLocalState $ do
-    ctxFP <- mallocHMACCtx
-    withForeignPtr ctxFP $ \ctx -> runExceptT $ do
-      check $ hmacInitEx ctx key md noEngine
-      lift $ mapM_ (hmacUpdate ctx) (ByteString.Lazy.toChunks bytes)
-      lift $ HMAC <$> onBufferOfMaxSize evpMaxMDSize (hmacFinal ctx)
+  unsafeLocalState $ runExceptT $ do
+    ctx <- lift mallocHMACCtx
+    check $ hmacInitEx ctx key md noEngine
+    lift $ mapM_ (hmacUpdate ctx) (ByteString.Lazy.toChunks bytes)
+    lift $ HMAC <$> onBufferOfMaxSize evpMaxMDSize (hmacFinal ctx)
-- 
cgit v1.2.3