From 5418461764453d2a6fa0e66b56123ef541631689 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Sat, 28 Apr 2018 14:19:31 -0700 Subject: Move result-handling functions into their own module --- btls.cabal | 1 + src/Data/Digest/Internal.chs | 12 ++---------- src/Data/Hmac.chs | 5 +++-- src/Result.hs | 27 +++++++++++++++++++++++++++ 4 files changed, 33 insertions(+), 12 deletions(-) create mode 100644 src/Result.hs diff --git a/btls.cabal b/btls.cabal index e4f7a5d..0359ab7 100644 --- a/btls.cabal +++ b/btls.cabal @@ -56,6 +56,7 @@ library other-modules: Data.Digest.Internal , Foreign.Ptr.Cast , Foreign.Ptr.ConstantTimeEquals + , Result c-sources: cbits/btls.c -- Use special names for the BoringSSL libraries to avoid accidentally pulling -- in OpenSSL. diff --git a/src/Data/Digest/Internal.chs b/src/Data/Digest/Internal.chs index ed4e09e..86cea65 100644 --- a/src/Data/Digest/Internal.chs +++ b/src/Data/Digest/Internal.chs @@ -16,7 +16,6 @@ module Data.Digest.Internal where -import Control.Exception (assert) import Data.Bits (Bits((.&.)), shiftR) import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString @@ -27,12 +26,13 @@ import Data.Word (Word8) import Foreign (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, peek, sizeOf), addForeignPtrFinalizer, alloca, allocaArray, mallocForeignPtr, - nullPtr, throwIf_, withForeignPtr) + nullPtr, withForeignPtr) import Foreign.C.Types import Foreign.Marshal.Unsafe (unsafeLocalState) import Unsafe.Coerce (unsafeCoerce) import Foreign.Ptr.Cast (asVoidPtr) +import Result type LazyByteString = ByteString.Lazy.ByteString @@ -70,11 +70,6 @@ evpMaxMdSize = {#const EVP_MAX_MD_SIZE#} -- Some of these functions return 'CInt' even though they can never fail. Wrap -- them to prevent warnings. -alwaysSucceeds :: IO CInt -> IO () -alwaysSucceeds f = do - r <- f - assert (r == 1) (return ()) - evpDigestUpdate :: Ptr EvpMdCtx -> Ptr a -> CULong -> IO () evpDigestUpdate ctx md bytes = alwaysSucceeds $ {#call EVP_DigestUpdate as ^#} ctx (asVoidPtr md) bytes @@ -85,9 +80,6 @@ evpDigestFinalEx ctx mdOut outSize = -- Convert functions that can in fact fail to throw exceptions instead. -requireSuccess :: IO CInt -> IO () -requireSuccess f = throwIf_ (/= 1) (const "BoringSSL failure") f - evpDigestInitEx :: Ptr EvpMdCtx -> Ptr EvpMd -> Ptr Engine -> IO () evpDigestInitEx ctx md engine = requireSuccess $ {#call EVP_DigestInit_ex as ^#} ctx md engine diff --git a/src/Data/Hmac.chs b/src/Data/Hmac.chs index 7ee68d2..907c352 100644 --- a/src/Data/Hmac.chs +++ b/src/Data/Hmac.chs @@ -33,10 +33,11 @@ import Foreign.Marshal.Unsafe (unsafeLocalState) import Unsafe.Coerce (unsafeCoerce) {#import Data.Digest.Internal#} - (Algorithm(Algorithm), Digest(Digest), Engine, EvpMd, - alwaysSucceeds, evpMaxMdSize, noEngine, requireSuccess) + (Algorithm(Algorithm), Digest(Digest), Engine, EvpMd, evpMaxMdSize, + noEngine) import Foreign.Ptr.Cast (asVoidPtr) {#import Foreign.Ptr.ConstantTimeEquals#} (constantTimeEquals) +import Result type LazyByteString = ByteString.Lazy.ByteString diff --git a/src/Result.hs b/src/Result.hs new file mode 100644 index 0000000..dfd3b9f --- /dev/null +++ b/src/Result.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 Result where + +import Control.Exception (assert) +import Foreign (throwIf_) +import Foreign.C.Types + +alwaysSucceeds :: IO CInt -> IO () +alwaysSucceeds f = do + r <- f + assert (r == 1) (return ()) + +requireSuccess :: IO CInt -> IO () +requireSuccess f = throwIf_ (/= 1) (const "BoringSSL failure") f -- cgit v1.2.3