From bb481a181375c32f797b15253fbe348242809294 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Sat, 30 Dec 2017 17:50:13 -0500 Subject: Begin writing btls, a Haskell crypto and TLS library using BoringSSL MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit So far, btls provides SHA-224, SHA-256, SHA-384, and SHA-512 algorithms. To do that, I - vendor BoringSSL and create a custom `Setup.hs` to build it, - wrap a number of functions and values from BoringSSL's EVP subsystem, and - implement the four SHA-2 algorithms using the wrapped routines. I provide conformance tests incorporating the official NIST example vectors and the vectors used in the Go SHA-2 test suite. The tests also use SmallCheck to compare btls’s SHA-2 implementations with those provided by the system’s Coreutils and openssl(1) installations. --- src/Data/Digest.hs | 5 ++ src/Data/Digest/Evp.hsc | 135 ++++++++++++++++++++++++++++++++++++++++++++++++ src/Data/Digest/Sha2.hs | 30 +++++++++++ 3 files changed, 170 insertions(+) create mode 100644 src/Data/Digest.hs create mode 100644 src/Data/Digest/Evp.hsc create mode 100644 src/Data/Digest/Sha2.hs (limited to 'src') diff --git a/src/Data/Digest.hs b/src/Data/Digest.hs new file mode 100644 index 0000000..717cd0d --- /dev/null +++ b/src/Data/Digest.hs @@ -0,0 +1,5 @@ +module Data.Digest + ( Digest + ) where + +import Data.Digest.Evp diff --git a/src/Data/Digest/Evp.hsc b/src/Data/Digest/Evp.hsc new file mode 100644 index 0000000..3bba247 --- /dev/null +++ b/src/Data/Digest/Evp.hsc @@ -0,0 +1,135 @@ +{-# LANGUAGE CApiFFI #-} +{-# OPTIONS_GHC -Wno-missing-methods #-} + +module Data.Digest.Evp + ( Algo + , Digest(Digest) + , hash + ) where + +import Control.Exception (bracket_) +import Control.Monad (void) +import Data.Bits (Bits((.&.)), shiftR) +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Unsafe as ByteString +import Data.Char (intToDigit) +import Data.Word (Word8) +import Foreign + (Ptr, Storable(alignment, peek, sizeOf), alloca, allocaArray, + nullPtr, throwIf_) +import Foreign.C.Types +import System.IO.Unsafe (unsafePerformIO) +import Unsafe.Coerce (unsafeCoerce) + +#include + +-- First, we build basic bindings to the BoringSSL EVP interface. + +-- | The BoringSSL @ENGINE@ type. +data Engine + +-- | The BoringSSL @EVP_MD@ type, representing a hash algorithm. +data EvpMd + +-- | A convenience alias for @Ptr EvpMd@. +type Algo = Ptr EvpMd + +-- | The BoringSSL @EVP_MD_CTX@ type, representing the state of a pending +-- hashing operation. +data EvpMdCtx + +instance Storable EvpMdCtx where + sizeOf _ = #size EVP_MD_CTX + alignment _ = #alignment EVP_MD_CTX + +-- Imported functions from BoringSSL. See +-- https://commondatastorage.googleapis.com/chromium-boringssl-docs/digest.h.html +-- for documentation. + +foreign import ccall "openssl/digest.h EVP_MD_CTX_init" + evpMdCtxInit :: Ptr EvpMdCtx -> IO () + +foreign import ccall "openssl/digest.h EVP_MD_CTX_cleanup" + evpMdCtxCleanup' :: Ptr EvpMdCtx -> IO CInt + +foreign import ccall "openssl/digest.h EVP_DigestInit_ex" + evpDigestInitEx' :: Ptr EvpMdCtx -> Ptr EvpMd -> Ptr Engine -> IO CInt + +foreign import capi "openssl/digest.h value EVP_MAX_MD_SIZE" + evpMaxMdSize :: CSize + +foreign import ccall "openssl/digest.h EVP_DigestUpdate" + evpDigestUpdate' :: Ptr EvpMdCtx -> Ptr a -> CSize -> IO CInt + +foreign import ccall "openssl/digest.h EVP_DigestFinal_ex" + evpDigestFinalEx' :: Ptr EvpMdCtx -> Ptr CUChar -> Ptr CUInt -> IO CInt + +-- Some of these functions return 'CInt' even though they can never fail. Wrap +-- them to prevent warnings. + +evpMdCtxCleanup :: Ptr EvpMdCtx -> IO () +evpMdCtxCleanup = void . evpMdCtxCleanup' + +evpDigestUpdate :: Ptr EvpMdCtx -> Ptr a -> CSize -> IO () +evpDigestUpdate ctx md bytes = void $ evpDigestUpdate' ctx md bytes + +evpDigestFinalEx :: Ptr EvpMdCtx -> Ptr CUChar -> Ptr CUInt -> IO () +evpDigestFinalEx ctx mdOut outSize = void $ evpDigestFinalEx' ctx mdOut outSize + +-- Convert functions that can in fact fail to throw exceptions instead. + +evpDigestInitEx :: Ptr EvpMdCtx -> Ptr EvpMd -> Ptr Engine -> IO () +evpDigestInitEx ctx md engine = + throwIf_ (/= 1) (const "BoringSSL failure") $ evpDigestInitEx' ctx md engine + +-- Now we can build a memory-safe abstraction layer. + +-- | Memory-safe wrapper for 'EvpMdCtx'. +withMdCtx :: (Ptr EvpMdCtx -> IO a) -> IO a +withMdCtx f = + alloca $ \ctx -> bracket_ (evpMdCtxInit ctx) (evpMdCtxCleanup ctx) (f ctx) + +-- Finally, we're ready to actually implement the hashing interface. + +-- | The result of a hash operation. +newtype Digest = + Digest ByteString + deriving (Eq, Ord) + +instance Show Digest where + show (Digest d) = ByteString.foldr showHexPadded [] d + where + showHexPadded b xs = + hexit (b `shiftR` 4 .&. 0x0f) : hexit (b .&. 0x0f) : xs + hexit = intToDigit . fromIntegral :: Word8 -> Char + +hash :: Algo -> ByteString -> Digest +hash md bytes = + -- We'd like to use 'unsafeLocalState' (i.e., 'unsafeDupablePerformIO') here, + -- but 'unsafeDupablePerformIO' runs computation in a context where it can be + -- arbitrarily terminated--i.e., where the cleanup in 'withMdCtx' is not + -- guaranteed to run. See + -- https://hackage.haskell.org/package/base/docs/System-IO-Unsafe.html#v:unsafeDupablePerformIO. + unsafePerformIO $ + withMdCtx $ \ctx -> do + evpDigestInitEx ctx md noEngine + -- evpDigestUpdate treats its @buf@ argument as @const@, so the sharing + -- inherent in 'ByteString.unsafeUseAsCStringLen' is fine. + ByteString.unsafeUseAsCStringLen bytes $ \(buf, len) -> + evpDigestUpdate ctx buf (fromIntegral len) + d <- + allocaArray (fromIntegral evpMaxMdSize) $ \mdOut -> + alloca $ \pOutSize -> do + evpDigestFinalEx ctx mdOut pOutSize + outSize <- fromIntegral <$> peek pOutSize + -- 'mdOut' is a 'Ptr CUChar'. However, to make life more interesting, + -- 'CString' is a 'Ptr CChar', and 'CChar' is signed. This is + -- especially unfortunate given that all we really want to do is + -- convert to a 'ByteString', which is unsigned. To work around it, + -- we're going to cheat and let Haskell reinterpret-cast 'mdOut' to + -- 'Ptr CChar' before it does its 'ByteString' ingestion. + ByteString.packCStringLen (unsafeCoerce mdOut, outSize) + return (Digest d) + where + noEngine = nullPtr :: Ptr Engine diff --git a/src/Data/Digest/Sha2.hs b/src/Data/Digest/Sha2.hs new file mode 100644 index 0000000..0aa814e --- /dev/null +++ b/src/Data/Digest/Sha2.hs @@ -0,0 +1,30 @@ +module Data.Digest.Sha2 + ( sha224 + , sha256 + , sha384 + , sha512 + ) where + +import Data.ByteString (ByteString) + +import qualified Data.Digest.Evp as Evp + +foreign import ccall "openssl/digest.h EVP_sha224" evpSha224 :: Evp.Algo + +foreign import ccall "openssl/digest.h EVP_sha256" evpSha256 :: Evp.Algo + +foreign import ccall "openssl/digest.h EVP_sha384" evpSha384 :: Evp.Algo + +foreign import ccall "openssl/digest.h EVP_sha512" evpSha512 :: Evp.Algo + +sha224 :: ByteString -> Evp.Digest +sha224 = Evp.hash evpSha224 + +sha256 :: ByteString -> Evp.Digest +sha256 = Evp.hash evpSha256 + +sha384 :: ByteString -> Evp.Digest +sha384 = Evp.hash evpSha384 + +sha512 :: ByteString -> Evp.Digest +sha512 = Evp.hash evpSha512 -- cgit v1.2.3