~singpolyma/haskell-gnutls

858bf6fe98401a853bb5141871888300cba779ea — Stephen Paul Weber a month ago 06a662e
Implement hash for sha1
2 files changed, 25 insertions(+), 4 deletions(-)

M lib/Network/Protocol/TLS/GNU.hs
R lib/Network/Protocol/TLS/GNU/{Foreign.hs => Foreign.chs}
M lib/Network/Protocol/TLS/GNU.hs => lib/Network/Protocol/TLS/GNU.hs +12 -1
@@ 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

R lib/Network/Protocol/TLS/GNU/Foreign.hs => lib/Network/Protocol/TLS/GNU/Foreign.chs +13 -3
@@ 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"