diff options
Diffstat (limited to 'src/BTLS')
-rw-r--r-- | src/BTLS/BoringSSL/Base.chs | 9 | ||||
-rw-r--r-- | src/BTLS/BoringSSL/Cipher.chs | 92 | ||||
-rw-r--r-- | src/BTLS/Buffer.hs | 3 | ||||
-rw-r--r-- | src/BTLS/Result.hs | 9 |
4 files changed, 109 insertions, 4 deletions
diff --git a/src/BTLS/BoringSSL/Base.chs b/src/BTLS/BoringSSL/Base.chs index 347e3f4..28c287b 100644 --- a/src/BTLS/BoringSSL/Base.chs +++ b/src/BTLS/BoringSSL/Base.chs @@ -36,6 +36,15 @@ data EVPMDCtx data EVPMD {#pointer *EVP_MD as 'Ptr EVPMD' -> EVPMD nocode#} +-- | The BoringSSL @EVP_CIPHER_CTX@ type, representing the state of a pending +-- encryption or decryption operation. +data EVPCipherCtx +{#pointer *EVP_CIPHER_CTX as 'Ptr EVPCipherCtx' -> EVPCipherCtx nocode#} + +-- | The BoringSSL @EVP_CIPHER@ type, representing a cipher algorithm. +data EVPCipher +{#pointer *EVP_CIPHER as 'Ptr EVPCipher' -> EVPCipher nocode#} + -- | The BoringSSL @HMAC_CTX@ type, representing the state of a pending HMAC -- operation. data HMACCtx diff --git a/src/BTLS/BoringSSL/Cipher.chs b/src/BTLS/BoringSSL/Cipher.chs new file mode 100644 index 0000000..ac966d9 --- /dev/null +++ b/src/BTLS/BoringSSL/Cipher.chs @@ -0,0 +1,92 @@ +-- 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. + +{-# OPTIONS_GHC -Wno-missing-methods #-} + +module BTLS.BoringSSL.Cipher + ( evpRC4 + , mallocEVPCipherCtx + , evpCipherInitEx, evpCipherUpdate, evpCipherFinalEx + , evpCipherCtxSetKeyLength + , evpCipherNID, evpCipherBlockSize, evpCipherKeyLength, evpCipherIVLength + , CipherDirection(ReuseDirection, Decrypt, Encrypt) + ) where + +import Data.ByteString (ByteString) +import Foreign (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf), withForeignPtr) +import Foreign.C.Types + +{#import BTLS.BoringSSL.Base#} +import BTLS.Buffer (unsafeUseAsCBuffer) +import BTLS.CreateWithFinalizer (createWithFinalizer) + +#include <openssl/cipher.h> + +data CipherDirection = ReuseDirection | Decrypt | Encrypt + deriving (Eq, Show) + +instance Enum CipherDirection where + fromEnum ReuseDirection = -1 + fromEnum Decrypt = 0 + fromEnum Encrypt = 1 + +{#fun pure EVP_rc4 as evpRC4 {} -> `Ptr EVPCipher'#} + +-- | Memory-safe allocator for 'EVPCipherCtx'. +mallocEVPCipherCtx :: IO (ForeignPtr EVPCipherCtx) +mallocEVPCipherCtx = + createWithFinalizer {#call EVP_CIPHER_CTX_init as ^#} btlsFinalizeEVPCipherCtxPtr + +foreign import ccall "&btlsFinalizeEVPCipherCtx" + btlsFinalizeEVPCipherCtxPtr :: FinalizerPtr EVPCipherCtx + +{#fun EVP_CipherInit_ex as evpCipherInitEx + { withForeignPtr* `ForeignPtr EVPCipherCtx' + , `Ptr EVPCipher' + , `Ptr Engine' + , id `Ptr CUChar' + , id `Ptr CUChar' + , 'fromIntegral . fromEnum' `CipherDirection' + } -> `Int'#} + +{#fun EVP_CipherUpdate as evpCipherUpdate + { withForeignPtr* `ForeignPtr EVPCipherCtx' + , id `Ptr CUChar' + , id `Ptr CInt' + , unsafeUseAsCBuffer* `ByteString'& + } -> `Int'#} + +{#fun EVP_CipherFinal_ex as evpCipherFinalEx + { withForeignPtr* `ForeignPtr EVPCipherCtx' + , id `Ptr CUChar' + , id `Ptr CInt' + } -> `Int'#} + +{#fun EVP_CIPHER_CTX_set_key_length as evpCipherCtxSetKeyLength + {withForeignPtr* `ForeignPtr EVPCipherCtx', `Int'} -> `Int'#} + +{#fun pure EVP_CIPHER_nid as evpCipherNID {`Ptr EVPCipher'} -> `Int'#} + +{#fun pure EVP_CIPHER_block_size as evpCipherBlockSize + {`Ptr EVPCipher'} -> `Int'#} + +{#fun pure EVP_CIPHER_key_length as evpCipherKeyLength + {`Ptr EVPCipher'} -> `Int'#} + +{#fun pure EVP_CIPHER_iv_length as evpCipherIVLength + {`Ptr EVPCipher'} -> `Int'#} + +instance Storable EVPCipherCtx where + sizeOf _ = {#sizeof EVP_CIPHER_CTX#} + alignment _ = {#alignof EVP_CIPHER_CTX#} diff --git a/src/BTLS/Buffer.hs b/src/BTLS/Buffer.hs index 354c787..a74acf5 100644 --- a/src/BTLS/Buffer.hs +++ b/src/BTLS/Buffer.hs @@ -26,7 +26,8 @@ import qualified Data.ByteString.Unsafe as ByteString import Foreign (Storable(peek), Ptr, alloca, allocaArray, castPtr) import Foreign.C.Types -unsafeUseAsCBuffer :: ByteString -> ((Ptr a, CULong) -> IO b) -> IO b +unsafeUseAsCBuffer :: + Integral size => ByteString -> ((Ptr a, size) -> IO b) -> IO b unsafeUseAsCBuffer bs f = ByteString.unsafeUseAsCStringLen bs $ \(pStr, len) -> f (castPtr pStr, fromIntegral len) diff --git a/src/BTLS/Result.hs b/src/BTLS/Result.hs index a3c153c..f75d89e 100644 --- a/src/BTLS/Result.hs +++ b/src/BTLS/Result.hs @@ -15,7 +15,7 @@ module BTLS.Result ( alwaysSucceeds, requireSuccess , Result, Error, file, line, errorData, errorDataIsHumanReadable - , check + , check, check' ) where import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread) @@ -70,10 +70,13 @@ dequeueError = do return (Just (errorFromTuple e)) check :: IO Int -> ExceptT [Error] IO () -check f = do +check = ExceptT . check' + +check' :: IO Int -> IO (Either [Error] ()) +check' f = do unless rtsSupportsBoundThreads $ error "btls requires the threaded runtime. Please recompile with -threaded." - ExceptT $ runInBoundThread $ do + runInBoundThread $ do -- TODO(bbaren): Assert that the error queue is clear r <- f if r == 1 |