1 files changed, 0 insertions, 135 deletions
diff --git a/src/Data/Digest/Evp.hsc b/src/Data/Digest/Evp.hsc
deleted file mode 100644
index 3bba247..0000000
--- a/src/Data/Digest/Evp.hsc
+++ /dev/null
@@ -1,135 +0,0 @@
-{-# 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 <openssl/digest.h>
-
--- 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