aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Benjamin Barenblat <bbaren@google.com>2018-09-04 18:53:20 -0400
committerGravatar Benjamin Barenblat <bbaren@google.com>2018-09-04 18:53:20 -0400
commit015079075e1e156d5934f4e716a51eb284289b5d (patch)
tree17dd43c33e0af2696dc1a61c2a9abe6c0667e1d4
parent2e7bd84469eba730f24dd3e448cca22f5aed16f4 (diff)
Marshal `ForeignPtr` to `Ptr` within c2hs code
-rw-r--r--src/BTLS/BoringSSL/Digest.chs12
-rw-r--r--src/BTLS/BoringSSL/HMAC.chs17
-rw-r--r--src/Data/Digest.hs10
-rw-r--r--src/Data/HMAC.hs12
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)