diff options
Diffstat (limited to 'src/BTLS')
-rw-r--r-- | src/BTLS/BoringSSLPatterns.hs | 18 | ||||
-rw-r--r-- | src/BTLS/Buffer.hs | 41 | ||||
-rw-r--r-- | src/BTLS/Cast.hs | 4 |
3 files changed, 49 insertions, 14 deletions
diff --git a/src/BTLS/BoringSSLPatterns.hs b/src/BTLS/BoringSSLPatterns.hs index e77abcb..44f4b0c 100644 --- a/src/BTLS/BoringSSLPatterns.hs +++ b/src/BTLS/BoringSSLPatterns.hs @@ -18,13 +18,12 @@ module BTLS.BoringSSLPatterns ) 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) +import BTLS.Buffer (packCUStringLen, unsafeUseAsCUStringLen) type LazyByteString = ByteString.Lazy.ByteString @@ -41,8 +40,8 @@ type LazyByteString = ByteString.Lazy.ByteString initUpdateFinalize :: IO (ForeignPtr ctx) -> (Ptr ctx -> IO ()) - -> (Ptr ctx -> Ptr CChar -> CULong -> IO ()) - -> (Ptr ctx -> Ptr CChar -> Ptr CUInt -> IO ()) + -> (Ptr ctx -> Ptr CUChar -> CULong -> IO ()) + -> (Ptr ctx -> Ptr CUChar -> Ptr CUInt -> IO ()) -> LazyByteString -> IO ByteString initUpdateFinalize mallocCtx initialize update finalize bytes = do @@ -54,9 +53,8 @@ initUpdateFinalize mallocCtx initialize update finalize bytes = do 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) + -- 'unsafeUseAsCUStringLen' is fine. + unsafeUseAsCUStringLen chunk $ \(buf, len) -> update ctx buf len -- | Allocates a buffer, runs a function 'f' to partially fill it, and packs the -- filled data into a 'ByteString'. 'f' must write the size of the filled data, @@ -67,11 +65,11 @@ initUpdateFinalize mallocCtx initialize update finalize bytes = do onBufferOfMaxSize :: (Integral size, Storable size) => Int - -> (Ptr CChar -> Ptr size -> IO ()) + -> (Ptr CUChar -> Ptr size -> IO ()) -> IO ByteString onBufferOfMaxSize maxSize f = allocaArray maxSize $ \pOut -> alloca $ \pOutLen -> do f pOut pOutLen - outLen <- fromIntegral <$> peek pOutLen - ByteString.packCStringLen (pOut, outLen) + outLen <- peek pOutLen + packCUStringLen (pOut, outLen) diff --git a/src/BTLS/Buffer.hs b/src/BTLS/Buffer.hs new file mode 100644 index 0000000..d7b3f14 --- /dev/null +++ b/src/BTLS/Buffer.hs @@ -0,0 +1,41 @@ +-- 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 BTLS.Buffer + ( unsafeUseAsCUStringLen + , packCUStringLen + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Unsafe as ByteString +import Foreign (Ptr) +import Foreign.C.Types +import Unsafe.Coerce (unsafeCoerce) + +unsafeUseAsCUStringLen :: + Integral n => ByteString -> ((Ptr CUChar, n) -> IO a) -> IO a +unsafeUseAsCUStringLen bs f = + ByteString.unsafeUseAsCStringLen bs $ \(pStr, len) -> + f (asCUCharBuf pStr, fromIntegral len) + +packCUStringLen :: Integral n => (Ptr CUChar, n) -> IO ByteString +packCUStringLen (pStr, len) = + ByteString.packCStringLen (asCCharBuf pStr, fromIntegral len) + +asCUCharBuf :: Ptr CChar -> Ptr CUChar +asCUCharBuf = unsafeCoerce + +asCCharBuf :: Ptr CUChar -> Ptr CChar +asCCharBuf = unsafeCoerce diff --git a/src/BTLS/Cast.hs b/src/BTLS/Cast.hs index a467c90..6f29469 100644 --- a/src/BTLS/Cast.hs +++ b/src/BTLS/Cast.hs @@ -15,11 +15,7 @@ module BTLS.Cast where import Foreign (Ptr) -import Foreign.C.Types import Unsafe.Coerce (unsafeCoerce) -asCUCharBuf :: Ptr CChar -> Ptr CUChar -asCUCharBuf = unsafeCoerce - asVoidPtr :: Ptr a -> Ptr () asVoidPtr = unsafeCoerce |