rhi/haskell-gnutls
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement hash for sha1

Browse source
This commit is contained in:
Stephen Paul Weber 2024-01-22 11:27:00 -05:00
parent 06a662e63a
commit 858bf6fe98
No known key found for this signature in database
GPG key ID: D11C2911CE519CDE
2 changed files with 25 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/Network/Protocol/TLS/GNU.hs
View file

@ -38,6 +38,8 @@ module Network.Protocol.TLS.GNU
, Credentials
, setCredentials
, certificateCredentials
, F.DigestAlgorithm(..)
, hash
) where
import qualified Control.Concurrent.MVar as M
@ -234,8 +236,17 @@ unsafeWithSession io = do
s <- getSession
UIO.unsafeFromIO $ F.withForeignPtr (sessionPtr s) $ io . F.Session
checkRC :: (Monad m) => F.ReturnCode -> TLST m ()
checkRC :: (Monad m) => F.ReturnCode -> E.ExceptT Error m ()
checkRC (F.ReturnCode x) = when (x < 0) $ E.throwE $ mapError x
mapError :: F.CInt -> Error
mapError = Error . toInteger
hash :: (Unexceptional m) => F.DigestAlgorithm -> B.ByteString -> E.ExceptT Error m B.ByteString
hash algo input = E.ExceptT $ UIO.unsafeFromIO $ F.alloca $ \hashp -> F.alloca $ \output -> E.runExceptT $ do
checkRC =<< UIO.unsafeFromIO (F.gnutls_hash_init hashp (fromIntegral $ fromEnum algo))
hsh <- UIO.unsafeFromIO $ F.peek hashp
(checkRC =<<) $ UIO.unsafeFromIO $ B.unsafeUseAsCStringLen input $ \(cstr, len) ->
F.gnutls_hash hsh cstr (fromIntegral len)
UIO.unsafeFromIO $ F.gnutls_hash_deinit hsh output
UIO.unsafeFromIO $ B.unsafePackCString output

16
lib/Network/Protocol/TLS/GNU/Foreign.hs → lib/Network/Protocol/TLS/GNU/Foreign.chs
View file

@ -1,5 +1,7 @@
{-# LANGUAGE ForeignFunctionInterface #-}
#include <gnutls/crypto.h>
-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>
--
-- This program is free software: you can redistribute it and/or modify
@ -40,9 +42,6 @@ newtype CredentialsType = CredentialsType CInt
newtype MACAlgorithm = MACAlgorithm CInt
deriving (Show, Eq)
newtype DigestAlgorithm = DigestAlgorithm CInt
deriving (Show, Eq)
newtype CompressionMethod = CompressionMethod CInt
deriving (Show, Eq)
@ -88,12 +87,15 @@ newtype PKAlgorithm = PKAlgorithm CInt
newtype SignAlgorithm = SignAlgorithm CInt
deriving (Show, Eq)
{#enum define DigestAlgorithm {GNUTLS_DIG_SHA1 as SHA1} deriving (Eq, Ord) #}
newtype Credentials = Credentials (Ptr Credentials)
newtype Transport = Transport (Ptr Transport)
newtype Session = Session (Ptr Session)
newtype DHParams = DHParams (Ptr DHParams)
newtype RSAParams = RSAParams (Ptr RSAParams)
newtype Priority = Priority (Ptr Priority)
newtype Hash = Hash (Ptr Hash)
newtype Datum = Datum (Ptr Word8, CUInt)
@ -247,6 +249,14 @@ foreign import ccall "wrapper"
-- }}}
-- Crypto {{{
foreign import ccall safe "gnutls_hash_init" gnutls_hash_init :: Ptr (Ptr Hash) -> CInt -> IO ReturnCode
foreign import ccall safe "gnutls_hash" gnutls_hash :: Ptr Hash -> CString -> CSize -> IO ReturnCode
foreign import ccall safe "gnutls_hash_deinit" gnutls_hash_deinit :: Ptr Hash -> CString -> IO ()
-- }}}
-- Utility {{{
foreign import ccall safe "gnutls_global_set_mem_functions"