From 22b190b55afcbbd2e014339ead081a552fea4287 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Sat, 28 Apr 2018 15:26:04 -0700 Subject: Switch initialism style to follow the rest of the Haskell world --- src/Data/Digest.hs | 16 ++++----- src/Data/Digest/Internal.hs | 4 +-- src/Data/HMAC.hs | 82 +++++++++++++++++++++++++++++++++++++++++++++ src/Data/Hmac.hs | 82 --------------------------------------------- src/Internal/Base.chs | 12 +++---- src/Internal/Digest.chs | 44 ++++++++++++------------ src/Internal/HMAC.chs | 60 +++++++++++++++++++++++++++++++++ src/Internal/Hmac.chs | 60 --------------------------------- 8 files changed, 180 insertions(+), 180 deletions(-) create mode 100644 src/Data/HMAC.hs delete mode 100644 src/Data/Hmac.hs create mode 100644 src/Internal/HMAC.chs delete mode 100644 src/Internal/Hmac.chs (limited to 'src') diff --git a/src/Data/Digest.hs b/src/Data/Digest.hs index 3bd042c..34279e5 100644 --- a/src/Data/Digest.hs +++ b/src/Data/Digest.hs @@ -35,23 +35,23 @@ import Internal.Digest type LazyByteString = ByteString.Lazy.ByteString md5, sha1, sha224, sha256, sha384, sha512 :: Algorithm -md5 = Algorithm evpMd5 -sha1 = Algorithm evpSha1 -sha224 = Algorithm evpSha224 -sha256 = Algorithm evpSha256 -sha384 = Algorithm evpSha384 -sha512 = Algorithm evpSha512 +md5 = Algorithm evpMD5 +sha1 = Algorithm evpSHA1 +sha224 = Algorithm evpSHA224 +sha256 = Algorithm evpSHA256 +sha384 = Algorithm evpSHA384 +sha512 = Algorithm evpSHA512 -- | Hashes according to the given 'Algorithm'. hash :: Algorithm -> LazyByteString -> Digest hash (Algorithm md) bytes = unsafeLocalState $ do - ctxFP <- mallocEvpMdCtx + ctxFP <- mallocEVPMDCtx withForeignPtr ctxFP $ \ctx -> do evpDigestInitEx ctx md noEngine mapM_ (updateBytes ctx) (ByteString.Lazy.toChunks bytes) d <- - allocaArray evpMaxMdSize $ \mdOut -> + allocaArray evpMaxMDSize $ \mdOut -> alloca $ \pOutSize -> do evpDigestFinalEx ctx mdOut pOutSize outSize <- fromIntegral <$> peek pOutSize diff --git a/src/Data/Digest/Internal.hs b/src/Data/Digest/Internal.hs index be88e68..859f765 100644 --- a/src/Data/Digest/Internal.hs +++ b/src/Data/Digest/Internal.hs @@ -21,10 +21,10 @@ import Data.Char (intToDigit) import Data.Word (Word8) import Foreign (Ptr) -import Internal.Base (EvpMd) +import Internal.Base (EVPMD) -- | A cryptographic hash function. -newtype Algorithm = Algorithm (Ptr EvpMd) +newtype Algorithm = Algorithm (Ptr EVPMD) -- | The result of a hash operation. newtype Digest = Digest ByteString diff --git a/src/Data/HMAC.hs b/src/Data/HMAC.hs new file mode 100644 index 0000000..1ad1bfb --- /dev/null +++ b/src/Data/HMAC.hs @@ -0,0 +1,82 @@ +-- 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 Data.HMAC + ( SecretKey(SecretKey) + , HMAC + , hmac + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Lazy as ByteString.Lazy +import qualified Data.ByteString.Unsafe as ByteString +import Foreign (Storable(peek), alloca, allocaArray, withForeignPtr) +import Foreign.Marshal.Unsafe (unsafeLocalState) +import Unsafe.Coerce (unsafeCoerce) + +import Data.Digest.Internal (Algorithm(Algorithm), Digest(Digest)) +import Foreign.Ptr.ConstantTimeEquals (constantTimeEquals) +import Internal.Base +import Internal.Digest +import Internal.HMAC + +type LazyByteString = ByteString.Lazy.ByteString + +-- | A secret key used as input to a cipher or HMAC. Equality comparisons on +-- this type are variable-time. +newtype SecretKey = SecretKey ByteString + deriving (Eq, Ord, Show) + +-- | A hash-based message authentication code. Equality comparisons on this type +-- are constant-time. +newtype HMAC = HMAC ByteString + +instance Eq HMAC where + (HMAC a) == (HMAC b) = + unsafeLocalState $ + ByteString.unsafeUseAsCStringLen a $ \(a', size) -> + ByteString.unsafeUseAsCStringLen b $ \(b', _) -> + constantTimeEquals a' b' size + +instance Show HMAC where + show (HMAC m) = show (Digest m) + +-- | Creates an HMAC according to the given 'Algorithm'. +hmac :: Algorithm -> SecretKey -> LazyByteString -> HMAC +hmac (Algorithm md) (SecretKey key) bytes = + unsafeLocalState $ do + ctxFP <- mallocHMACCtx + withForeignPtr ctxFP $ \ctx -> do + ByteString.unsafeUseAsCStringLen key $ \(keyBytes, keySize) -> + hmacInitEx ctx keyBytes (fromIntegral keySize) md noEngine + mapM_ (updateBytes ctx) (ByteString.Lazy.toChunks bytes) + m <- + allocaArray evpMaxMDSize $ \hmacOut -> + alloca $ \pOutSize -> do + hmacFinal ctx hmacOut pOutSize + outSize <- fromIntegral <$> peek pOutSize + -- As in 'Data.Digest.Internal', 'hmacOut' is a 'Ptr CUChar'. Have + -- GHC reinterpret it as a 'Ptr CChar' so that it can be ingested + -- into a 'ByteString'. + ByteString.packCStringLen (unsafeCoerce hmacOut, outSize) + return (HMAC m) + where + updateBytes ctx chunk = + -- 'hmacUpdate' treats its @bytes@ argument as @const@, so the sharing + -- inherent in 'ByteString.unsafeUseAsCStringLen' is fine. + ByteString.unsafeUseAsCStringLen chunk $ \(buf, len) -> + -- 'buf' is a 'Ptr CChar', but 'hmacUpdate' takes a 'Ptr CUChar', so we + -- do the 'unsafeCoerce' dance yet again. + hmacUpdate ctx (unsafeCoerce buf) (fromIntegral len) diff --git a/src/Data/Hmac.hs b/src/Data/Hmac.hs deleted file mode 100644 index 2211248..0000000 --- a/src/Data/Hmac.hs +++ /dev/null @@ -1,82 +0,0 @@ --- 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 Data.Hmac - ( SecretKey(SecretKey) - , Hmac - , hmac - ) where - -import Data.ByteString (ByteString) -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Lazy as ByteString.Lazy -import qualified Data.ByteString.Unsafe as ByteString -import Foreign (Storable(peek), alloca, allocaArray, withForeignPtr) -import Foreign.Marshal.Unsafe (unsafeLocalState) -import Unsafe.Coerce (unsafeCoerce) - -import Data.Digest.Internal (Algorithm(Algorithm), Digest(Digest)) -import Foreign.Ptr.ConstantTimeEquals (constantTimeEquals) -import Internal.Base -import Internal.Digest -import Internal.Hmac - -type LazyByteString = ByteString.Lazy.ByteString - --- | A secret key used as input to a cipher or HMAC. Equality comparisons on --- this type are variable-time. -newtype SecretKey = SecretKey ByteString - deriving (Eq, Ord, Show) - --- | A hash-based message authentication code. Equality comparisons on this type --- are constant-time. -newtype Hmac = Hmac ByteString - -instance Eq Hmac where - (Hmac a) == (Hmac b) = - unsafeLocalState $ - ByteString.unsafeUseAsCStringLen a $ \(a', size) -> - ByteString.unsafeUseAsCStringLen b $ \(b', _) -> - constantTimeEquals a' b' size - -instance Show Hmac where - show (Hmac m) = show (Digest m) - --- | Creates an HMAC according to the given 'Algorithm'. -hmac :: Algorithm -> SecretKey -> LazyByteString -> Hmac -hmac (Algorithm md) (SecretKey key) bytes = - unsafeLocalState $ do - ctxFP <- mallocHmacCtx - withForeignPtr ctxFP $ \ctx -> do - ByteString.unsafeUseAsCStringLen key $ \(keyBytes, keySize) -> - hmacInitEx ctx keyBytes (fromIntegral keySize) md noEngine - mapM_ (updateBytes ctx) (ByteString.Lazy.toChunks bytes) - m <- - allocaArray evpMaxMdSize $ \hmacOut -> - alloca $ \pOutSize -> do - hmacFinal ctx hmacOut pOutSize - outSize <- fromIntegral <$> peek pOutSize - -- As in 'Data.Digest.Internal', 'hmacOut' is a 'Ptr CUChar'. Have - -- GHC reinterpret it as a 'Ptr CChar' so that it can be ingested - -- into a 'ByteString'. - ByteString.packCStringLen (unsafeCoerce hmacOut, outSize) - return (Hmac m) - where - updateBytes ctx chunk = - -- 'hmacUpdate' treats its @bytes@ argument as @const@, so the sharing - -- inherent in 'ByteString.unsafeUseAsCStringLen' is fine. - ByteString.unsafeUseAsCStringLen chunk $ \(buf, len) -> - -- 'buf' is a 'Ptr CChar', but 'hmacUpdate' takes a 'Ptr CUChar', so we - -- do the 'unsafeCoerce' dance yet again. - hmacUpdate ctx (unsafeCoerce buf) (fromIntegral len) diff --git a/src/Internal/Base.chs b/src/Internal/Base.chs index 427cf6b..c2e615a 100644 --- a/src/Internal/Base.chs +++ b/src/Internal/Base.chs @@ -30,14 +30,14 @@ noEngine = nullPtr -- | The BoringSSL @EVP_MD_CTX@ type, representing the state of a pending -- hashing operation. -data EvpMdCtx -{#pointer *EVP_MD_CTX as 'Ptr EvpMdCtx' -> EvpMdCtx nocode#} +data EVPMDCtx +{#pointer *EVP_MD_CTX as 'Ptr EVPMDCtx' -> EVPMDCtx nocode#} -- | The BoringSSL @EVP_MD@ type, representing a hash algorithm. -data EvpMd -{#pointer *EVP_MD as 'Ptr EvpMd' -> EvpMd nocode#} +data EVPMD +{#pointer *EVP_MD as 'Ptr EVPMD' -> EVPMD nocode#} -- | The BoringSSL @HMAC_CTX@ type, representing the state of a pending HMAC -- operation. -data HmacCtx -{#pointer *HMAC_CTX as 'Ptr HmacCtx' -> HmacCtx nocode#} +data HMACCtx +{#pointer *HMAC_CTX as 'Ptr HMACCtx' -> HMACCtx nocode#} diff --git a/src/Internal/Digest.chs b/src/Internal/Digest.chs index 021de22..d451f1c 100644 --- a/src/Internal/Digest.chs +++ b/src/Internal/Digest.chs @@ -16,10 +16,10 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Internal.Digest - ( evpMd5, evpSha1, evpSha224, evpSha256, evpSha384, evpSha512 - , mallocEvpMdCtx + ( evpMD5, evpSHA1, evpSHA224, evpSHA256, evpSHA384, evpSHA512 + , mallocEVPMDCtx , evpDigestInitEx, evpDigestUpdate, evpDigestFinalEx - , evpMaxMdSize + , evpMaxMDSize ) where import Foreign @@ -33,40 +33,40 @@ import Result #include -evpMd5, evpSha1, evpSha224, evpSha256, evpSha384, evpSha512 :: Ptr EvpMd -evpMd5 = {#call pure EVP_md5 as ^#} -evpSha1 = {#call pure EVP_sha1 as ^#} -evpSha224 = {#call pure EVP_sha224 as ^#} -evpSha256 = {#call pure EVP_sha256 as ^#} -evpSha384 = {#call pure EVP_sha384 as ^#} -evpSha512 = {#call pure EVP_sha512 as ^#} +evpMD5, evpSHA1, evpSHA224, evpSHA256, evpSHA384, evpSHA512 :: Ptr EVPMD +evpMD5 = {#call pure EVP_md5 as ^#} +evpSHA1 = {#call pure EVP_sha1 as ^#} +evpSHA224 = {#call pure EVP_sha224 as ^#} +evpSHA256 = {#call pure EVP_sha256 as ^#} +evpSHA384 = {#call pure EVP_sha384 as ^#} +evpSHA512 = {#call pure EVP_sha512 as ^#} --- | Memory-safe allocator for 'EvpMdCtx'. -mallocEvpMdCtx :: IO (ForeignPtr EvpMdCtx) -mallocEvpMdCtx = do +-- | Memory-safe allocator for 'EVPMDCtx'. +mallocEVPMDCtx :: IO (ForeignPtr EVPMDCtx) +mallocEVPMDCtx = do fp <- mallocForeignPtr withForeignPtr fp {#call EVP_MD_CTX_init as ^#} - addForeignPtrFinalizer btlsFinalizeEvpMdCtxPtr fp + addForeignPtrFinalizer btlsFinalizeEVPMDCtxPtr fp return fp -foreign import ccall "&btlsFinalizeEvpMdCtx" - btlsFinalizeEvpMdCtxPtr :: FinalizerPtr EvpMdCtx +foreign import ccall "&btlsFinalizeEVPMDCtx" + btlsFinalizeEVPMDCtxPtr :: FinalizerPtr EVPMDCtx -evpDigestInitEx :: Ptr EvpMdCtx -> Ptr EvpMd -> Ptr Engine -> IO () +evpDigestInitEx :: Ptr EVPMDCtx -> Ptr EVPMD -> Ptr Engine -> IO () evpDigestInitEx ctx md engine = requireSuccess $ {#call EVP_DigestInit_ex as ^#} ctx md engine -evpDigestUpdate :: Ptr EvpMdCtx -> Ptr a -> CULong -> IO () +evpDigestUpdate :: Ptr EVPMDCtx -> Ptr a -> CULong -> IO () evpDigestUpdate ctx md bytes = alwaysSucceeds $ {#call EVP_DigestUpdate as ^#} ctx (asVoidPtr md) bytes -evpDigestFinalEx :: Ptr EvpMdCtx -> Ptr CUChar -> Ptr CUInt -> IO () +evpDigestFinalEx :: Ptr EVPMDCtx -> Ptr CUChar -> Ptr CUInt -> IO () evpDigestFinalEx ctx mdOut outSize = alwaysSucceeds $ {#call EVP_DigestFinal_ex as ^#} ctx mdOut outSize -evpMaxMdSize :: Int -evpMaxMdSize = {#const EVP_MAX_MD_SIZE#} +evpMaxMDSize :: Int +evpMaxMDSize = {#const EVP_MAX_MD_SIZE#} -instance Storable EvpMdCtx where +instance Storable EVPMDCtx where sizeOf _ = {#sizeof EVP_MD_CTX#} alignment _ = {#alignof EVP_MD_CTX#} diff --git a/src/Internal/HMAC.chs b/src/Internal/HMAC.chs new file mode 100644 index 0000000..7e64edf --- /dev/null +++ b/src/Internal/HMAC.chs @@ -0,0 +1,60 @@ +-- 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 #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Internal.HMAC + ( mallocHMACCtx + , hmacInitEx, hmacUpdate, hmacFinal + ) where + +import Foreign + (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf), + addForeignPtrFinalizer, mallocForeignPtr, withForeignPtr) +import Foreign.C.Types + +import Foreign.Ptr.Cast (asVoidPtr) +{#import Internal.Base#} +import Result + +#include + +-- | Memory-safe allocator for 'HMACCtx'. +mallocHMACCtx :: IO (ForeignPtr HMACCtx) +mallocHMACCtx = do + fp <- mallocForeignPtr + withForeignPtr fp {#call HMAC_CTX_init as ^#} + addForeignPtrFinalizer hmacCtxCleanup fp + return fp + +foreign import ccall "&HMAC_CTX_cleanup" + hmacCtxCleanup :: FinalizerPtr HMACCtx + +hmacInitEx :: Ptr HMACCtx -> Ptr a -> CULong -> Ptr EVPMD -> Ptr Engine -> IO () +hmacInitEx ctx bytes size md engine = + requireSuccess $ + {#call HMAC_Init_ex as ^#} ctx (asVoidPtr bytes) size md engine + +hmacUpdate :: Ptr HMACCtx -> Ptr CUChar -> CULong -> IO () +hmacUpdate ctx bytes size = + alwaysSucceeds $ {#call HMAC_Update as ^#} ctx bytes size + +hmacFinal :: Ptr HMACCtx -> Ptr CUChar -> Ptr CUInt -> IO () +hmacFinal ctx out outSize = + requireSuccess $ {#call HMAC_Final as ^#} ctx out outSize + +instance Storable HMACCtx where + sizeOf _ = {#sizeof HMAC_CTX#} + alignment _ = {#alignof HMAC_CTX#} diff --git a/src/Internal/Hmac.chs b/src/Internal/Hmac.chs deleted file mode 100644 index 0ef1e2e..0000000 --- a/src/Internal/Hmac.chs +++ /dev/null @@ -1,60 +0,0 @@ --- 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 #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Internal.Hmac - ( mallocHmacCtx - , hmacInitEx, hmacUpdate, hmacFinal - ) where - -import Foreign - (FinalizerPtr, ForeignPtr, Ptr, Storable(alignment, sizeOf), - addForeignPtrFinalizer, mallocForeignPtr, withForeignPtr) -import Foreign.C.Types - -import Foreign.Ptr.Cast (asVoidPtr) -{#import Internal.Base#} -import Result - -#include - --- | Memory-safe allocator for 'HmacCtx'. -mallocHmacCtx :: IO (ForeignPtr HmacCtx) -mallocHmacCtx = do - fp <- mallocForeignPtr - withForeignPtr fp {#call HMAC_CTX_init as ^#} - addForeignPtrFinalizer hmacCtxCleanup fp - return fp - -foreign import ccall "&HMAC_CTX_cleanup" - hmacCtxCleanup :: FinalizerPtr HmacCtx - -hmacInitEx :: Ptr HmacCtx -> Ptr a -> CULong -> Ptr EvpMd -> Ptr Engine -> IO () -hmacInitEx ctx bytes size md engine = - requireSuccess $ - {#call HMAC_Init_ex as ^#} ctx (asVoidPtr bytes) size md engine - -hmacUpdate :: Ptr HmacCtx -> Ptr CUChar -> CULong -> IO () -hmacUpdate ctx bytes size = - alwaysSucceeds $ {#call HMAC_Update as ^#} ctx bytes size - -hmacFinal :: Ptr HmacCtx -> Ptr CUChar -> Ptr CUInt -> IO () -hmacFinal ctx out outSize = - requireSuccess $ {#call HMAC_Final as ^#} ctx out outSize - -instance Storable HmacCtx where - sizeOf _ = {#sizeof HMAC_CTX#} - alignment _ = {#alignof HMAC_CTX#} -- cgit v1.2.3