module Data.Digest.OpenSSL.HMAC
(
hmac
, unsafeHMAC
, CryptoHashFunction
, md5
, sha, sha1, sha224, sha256, sha384, sha512
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import Foreign
import Foreign.C.Types
import Numeric (showHex)
type OSSL_EVP_MD = Ptr ()
data CryptoHashFunction = CHF OSSL_EVP_MD Int
md5 :: CryptoHashFunction
md5 = CHF c_md5 (16)
sha :: CryptoHashFunction
sha = CHF c_sha (20)
sha1 :: CryptoHashFunction
sha1 = CHF c_sha1 (20)
sha224 :: CryptoHashFunction
sha224 = CHF c_sha224 (28)
sha256 :: CryptoHashFunction
sha256 = CHF c_sha256 (32)
sha384 :: CryptoHashFunction
sha384 = CHF c_sha384 (48)
sha512 :: CryptoHashFunction
sha512 = CHF c_sha512 (64)
hmac
:: CryptoHashFunction
-> B.ByteString
-> B.ByteString
-> IO String
hmac hf k p = return (unsafeHMAC hf (B.copy k) (B.copy p))
unsafeHMAC
:: CryptoHashFunction
-> B.ByteString
-> B.ByteString
-> String
unsafeHMAC (CHF evp_md len) k p =
unsafePerformIO $
BU.unsafeUseAsCStringLen k $ \(ptrKey,nKey) ->
BU.unsafeUseAsCStringLen p $ \(ptr,n) -> do
digest <- c_hmac evp_md ptrKey (fromIntegral nKey)
(castPtr ptr) (fromIntegral n) nullPtr nullPtr
go digest 0 []
where
go :: (Storable a, Integral a) => Ptr a -> Int -> [String] -> IO String
go !q !n acc
| n >= len = return $ concat (reverse acc)
| otherwise = do w <- peekElemOff q n
go q (n+1) (draw w : acc)
draw :: (Integral a) => a -> String
draw w = case showHex w [] of
[x] -> ['0', x]
x -> x
foreign import ccall "openssl/hmac.h HMAC" c_hmac :: OSSL_EVP_MD -> Ptr CChar -> CInt -> Ptr Word8 -> CSize -> Ptr CUChar -> Ptr CUInt -> IO (Ptr Word8)
foreign import ccall "openssl/evp.h EVP_md5" c_md5 :: OSSL_EVP_MD
foreign import ccall "openssl/evp.h EVP_sha" c_sha :: OSSL_EVP_MD
foreign import ccall "openssl/evp.h EVP_sha1" c_sha1 :: OSSL_EVP_MD
foreign import ccall "openssl/evp.h EVP_sha224" c_sha224 :: OSSL_EVP_MD
foreign import ccall "openssl/evp.h EVP_sha256" c_sha256 :: OSSL_EVP_MD
foreign import ccall "openssl/evp.h EVP_sha384" c_sha384 :: OSSL_EVP_MD
foreign import ccall "openssl/evp.h EVP_sha512" c_sha512 :: OSSL_EVP_MD