From decd5d9cb22d6fa56963481051e52c3162f78053 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 13 Feb 2021 20:14:32 -0500
Subject: [PATCH 01/10] Switch base of the transformer stack to UIO

A lot of the utilities are still in IO for now, and we still provide a
transitional MonadIO instance, but the transformer stack itself is Unexceptional now.
---
 gnutls.cabal                    |  1 +
 lib/Network/Protocol/TLS/GNU.hs | 13 ++++++++-----
 2 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/gnutls.cabal b/gnutls.cabal
index 5b77759..529ab51 100644
--- a/gnutls.cabal
+++ b/gnutls.cabal
@@ -36,6 +36,7 @@ library
       base >= 4.0 && < 5.0
     , bytestring >= 0.9
     , transformers >= 0.4.0.0
+    , unexceptionalio-trans
 
   extra-libraries: gnutls
   pkgconfig-depends: gnutls
diff --git a/lib/Network/Protocol/TLS/GNU.hs b/lib/Network/Protocol/TLS/GNU.hs
index 59c95ac..765466b 100644
--- a/lib/Network/Protocol/TLS/GNU.hs
+++ b/lib/Network/Protocol/TLS/GNU.hs
@@ -54,10 +54,12 @@ import qualified Foreign.C as F
 import           Foreign.Concurrent as FC
 import qualified System.IO as IO
 import           System.IO.Unsafe (unsafePerformIO)
+import           UnexceptionalIO.Trans (UIO, Unexceptional)
+import qualified UnexceptionalIO.Trans as UIO
 
 import qualified Network.Protocol.TLS.GNU.Foreign as F
 
-data Error = Error Integer
+data Error = Error Integer | IOError IOError
 	deriving (Show)
 
 globalInitMVar :: M.MVar ()
@@ -86,7 +88,7 @@ data Session = Session
 	, sessionCredentials :: IORef [F.ForeignPtr F.Credentials]
 	}
 
-newtype TLS a = TLS { unTLS :: ExceptT Error (R.ReaderT Session IO) a }
+newtype TLS a = TLS { unTLS :: ExceptT Error (R.ReaderT Session UIO) a }
 
 instance Functor TLS where
 	fmap f = TLS . fmap f . unTLS
@@ -99,11 +101,12 @@ instance Monad TLS where
 	return = TLS . return
 	m >>= f = TLS $ unTLS m >>= unTLS . f
 
+-- | This is a transitional instance and may be deprecated in the future
 instance MonadIO TLS where
-	liftIO = TLS . liftIO
+	liftIO = TLS . withExceptT IOError . UIO.fromIO' (userError . show)
 
-runTLS :: Session -> TLS a -> IO (Either Error a)
-runTLS s tls = R.runReaderT (runExceptT (unTLS tls)) s
+runTLS :: (Unexceptional m) => Session -> TLS a -> m (Either Error a)
+runTLS s tls = UIO.lift $ R.runReaderT (runExceptT (unTLS tls)) s
 
 runClient :: Transport -> TLS a -> IO (Either Error a)
 runClient transport tls = do

From 17b9279287d1a0d00aa3a3182fb975644855c5d6 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 13 Feb 2021 20:31:35 -0500
Subject: [PATCH 02/10] Export local throwE/catchE/fromExceptT helpers

---
 lib/Network/Protocol/TLS/GNU.hs | 34 ++++++++++++++++++++++-----------
 1 file changed, 23 insertions(+), 11 deletions(-)

diff --git a/lib/Network/Protocol/TLS/GNU.hs b/lib/Network/Protocol/TLS/GNU.hs
index 765466b..3bf92b5 100644
--- a/lib/Network/Protocol/TLS/GNU.hs
+++ b/lib/Network/Protocol/TLS/GNU.hs
@@ -19,6 +19,9 @@ module Network.Protocol.TLS.GNU
 	( TLS
 	, Session
 	, Error (..)
+	, throwE
+	, catchE
+	, fromExceptT
 	
 	, runTLS
 	, runClient
@@ -42,7 +45,7 @@ import           Control.Applicative (Applicative, pure, (<*>))
 import qualified Control.Concurrent.MVar as M
 import           Control.Monad (ap, when, foldM, foldM_)
 import           Control.Monad.Trans.Class (lift)
-import           Control.Monad.Trans.Except
+import qualified Control.Monad.Trans.Except as E
 import qualified Control.Monad.Trans.Reader as R
 import           Control.Monad.IO.Class (MonadIO, liftIO)
 import qualified Data.ByteString as B
@@ -66,11 +69,11 @@ globalInitMVar :: M.MVar ()
 {-# NOINLINE globalInitMVar #-}
 globalInitMVar = unsafePerformIO $ M.newMVar ()
 
-globalInit :: ExceptT Error IO ()
+globalInit :: E.ExceptT Error IO ()
 globalInit = do
 	let init_ = M.withMVar globalInitMVar $ \_ -> F.gnutls_global_init
 	F.ReturnCode rc <- liftIO init_
-	when (rc < 0) $ throwE $ mapError rc
+	when (rc < 0) $ E.throwE $ mapError rc
 
 globalDeinit :: IO ()
 globalDeinit = M.withMVar globalInitMVar $ \_ -> F.gnutls_global_deinit
@@ -88,7 +91,7 @@ data Session = Session
 	, sessionCredentials :: IORef [F.ForeignPtr F.Credentials]
 	}
 
-newtype TLS a = TLS { unTLS :: ExceptT Error (R.ReaderT Session UIO) a }
+newtype TLS a = TLS { unTLS :: E.ExceptT Error (R.ReaderT Session UIO) a }
 
 instance Functor TLS where
 	fmap f = TLS . fmap f . unTLS
@@ -103,10 +106,19 @@ instance Monad TLS where
 
 -- | This is a transitional instance and may be deprecated in the future
 instance MonadIO TLS where
-	liftIO = TLS . withExceptT IOError . UIO.fromIO' (userError . show)
+	liftIO = TLS . E.withExceptT IOError . UIO.fromIO' (userError . show)
+
+throwE :: Error -> TLS a
+throwE = fromExceptT . E.throwE
+
+catchE :: TLS a -> (Error -> TLS a) -> TLS a
+catchE inner handler = TLS $ unTLS inner `E.catchE` (unTLS . handler)
+
+fromExceptT :: E.ExceptT Error UIO a -> TLS a
+fromExceptT = TLS . E.mapExceptT lift
 
 runTLS :: (Unexceptional m) => Session -> TLS a -> m (Either Error a)
-runTLS s tls = UIO.lift $ R.runReaderT (runExceptT (unTLS tls)) s
+runTLS s tls = UIO.lift $ R.runReaderT (E.runExceptT (unTLS tls)) s
 
 runClient :: Transport -> TLS a -> IO (Either Error a)
 runClient transport tls = do
@@ -116,10 +128,10 @@ runClient transport tls = do
 		Right session -> runTLS session tls
 
 newSession :: Transport -> F.ConnectionEnd -> IO (Either Error Session)
-newSession transport end = F.alloca $ \sPtr -> runExceptT $ do
+newSession transport end = F.alloca $ \sPtr -> E.runExceptT $ do
 	globalInit
 	F.ReturnCode rc <- liftIO $ F.gnutls_init sPtr end
-	when (rc < 0) $ throwE $ mapError rc
+	when (rc < 0) $ E.throwE $ mapError rc
 	liftIO $ do
 		ptr <- F.peek sPtr
 		let session = F.Session ptr
@@ -151,7 +163,7 @@ putBytes = putChunks . BL.toChunks where
 		maybeErr <- withSession $ \s -> foldM (putChunk s) Nothing chunks
 		case maybeErr of
 			Nothing -> return ()
-			Just err -> TLS $ mapExceptT lift $ throwE $ mapError $ fromIntegral err
+			Just err -> throwE $ mapError $ fromIntegral err
 	
 	putChunk s Nothing chunk = B.unsafeUseAsCStringLen chunk $ uncurry loop where
 		loop ptr len = do
@@ -179,7 +191,7 @@ getBytes count = do
 	
 	case mbytes of
 		Just bytes -> return bytes
-		Nothing   -> TLS $ mapExceptT lift $ throwE $ mapError $ fromIntegral len
+		Nothing   -> throwE $ mapError $ fromIntegral len
 
 checkPending :: TLS Integer
 checkPending = withSession $ \s -> do
@@ -242,7 +254,7 @@ withSession io = do
 	liftIO $ F.withForeignPtr (sessionPtr s) $ io . F.Session
 
 checkRC :: F.ReturnCode -> TLS ()
-checkRC (F.ReturnCode x) = when (x < 0) $ TLS $ mapExceptT lift $ throwE $ mapError x
+checkRC (F.ReturnCode x) = when (x < 0) $ throwE $ mapError x
 
 mapError :: F.CInt -> Error
 mapError = Error . toInteger

From 955b054ff43f3758c1c394b8f688bad742407c24 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 13 Feb 2021 20:59:00 -0500
Subject: [PATCH 03/10] Switch monad transformer stack to a type alias

Since we already allowed injecting any Session via runTLS or throwing any Error
via throwE, this does not reduce safety at all but improves ergonomics
considerably.

The only downside here is that we must say goodbye to our transitional MonadIO
instance.
---
 lib/Network/Protocol/TLS/GNU.hs | 59 +++++++++++----------------------
 1 file changed, 20 insertions(+), 39 deletions(-)

diff --git a/lib/Network/Protocol/TLS/GNU.hs b/lib/Network/Protocol/TLS/GNU.hs
index 3bf92b5..a9ab31a 100644
--- a/lib/Network/Protocol/TLS/GNU.hs
+++ b/lib/Network/Protocol/TLS/GNU.hs
@@ -20,7 +20,6 @@ module Network.Protocol.TLS.GNU
 	, Session
 	, Error (..)
 	, throwE
-	, catchE
 	, fromExceptT
 	
 	, runTLS
@@ -41,13 +40,12 @@ module Network.Protocol.TLS.GNU
 	, certificateCredentials
 	) where
 
-import           Control.Applicative (Applicative, pure, (<*>))
 import qualified Control.Concurrent.MVar as M
-import           Control.Monad (ap, when, foldM, foldM_)
+import           Control.Monad (when, foldM, foldM_)
 import           Control.Monad.Trans.Class (lift)
 import qualified Control.Monad.Trans.Except as E
 import qualified Control.Monad.Trans.Reader as R
-import           Control.Monad.IO.Class (MonadIO, liftIO)
+import           Control.Monad.IO.Class (liftIO)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Unsafe as B
@@ -62,7 +60,7 @@ import qualified UnexceptionalIO.Trans as UIO
 
 import qualified Network.Protocol.TLS.GNU.Foreign as F
 
-data Error = Error Integer | IOError IOError
+data Error = Error Integer
 	deriving (Show)
 
 globalInitMVar :: M.MVar ()
@@ -91,34 +89,16 @@ data Session = Session
 	, sessionCredentials :: IORef [F.ForeignPtr F.Credentials]
 	}
 
-newtype TLS a = TLS { unTLS :: E.ExceptT Error (R.ReaderT Session UIO) a }
-
-instance Functor TLS where
-	fmap f = TLS . fmap f . unTLS
-
-instance Applicative TLS where
-	pure = TLS . return
-	(<*>) = ap
-
-instance Monad TLS where
-	return = TLS . return
-	m >>= f = TLS $ unTLS m >>= unTLS . f
-
--- | This is a transitional instance and may be deprecated in the future
-instance MonadIO TLS where
-	liftIO = TLS . E.withExceptT IOError . UIO.fromIO' (userError . show)
+type TLS a = E.ExceptT Error (R.ReaderT Session UIO) a
 
 throwE :: Error -> TLS a
 throwE = fromExceptT . E.throwE
 
-catchE :: TLS a -> (Error -> TLS a) -> TLS a
-catchE inner handler = TLS $ unTLS inner `E.catchE` (unTLS . handler)
-
 fromExceptT :: E.ExceptT Error UIO a -> TLS a
-fromExceptT = TLS . E.mapExceptT lift
+fromExceptT = E.mapExceptT lift
 
 runTLS :: (Unexceptional m) => Session -> TLS a -> m (Either Error a)
-runTLS s tls = UIO.lift $ R.runReaderT (E.runExceptT (unTLS tls)) s
+runTLS s tls = UIO.lift $ R.runReaderT (E.runExceptT tls) s
 
 runClient :: Transport -> TLS a -> IO (Either Error a)
 runClient transport tls = do
@@ -149,18 +129,18 @@ newSession transport end = F.alloca $ \sPtr -> E.runExceptT $ do
 		return (Session fp creds)
 
 getSession :: TLS Session
-getSession = TLS $ lift R.ask
+getSession = lift R.ask
 
 handshake :: TLS ()
-handshake = withSession F.gnutls_handshake >>= checkRC
+handshake = unsafeWithSession F.gnutls_handshake >>= checkRC
 
 rehandshake :: TLS ()
-rehandshake = withSession F.gnutls_rehandshake >>= checkRC
+rehandshake = unsafeWithSession F.gnutls_rehandshake >>= checkRC
 
 putBytes :: BL.ByteString -> TLS ()
 putBytes = putChunks . BL.toChunks where
 	putChunks chunks = do
-		maybeErr <- withSession $ \s -> foldM (putChunk s) Nothing chunks
+		maybeErr <- unsafeWithSession $ \s -> foldM (putChunk s) Nothing chunks
 		case maybeErr of
 			Nothing -> return ()
 			Just err -> throwE $ mapError $ fromIntegral err
@@ -179,7 +159,7 @@ putBytes = putChunks . BL.toChunks where
 
 getBytes :: Integer -> TLS BL.ByteString
 getBytes count = do
-	(mbytes, len) <- withSession $ \s ->
+	(mbytes, len) <- unsafeWithSession $ \s ->
 		F.allocaBytes (fromInteger count) $ \ptr -> do
 		len <- F.gnutls_record_recv s ptr (fromInteger count)
 		bytes <- if len >= 0
@@ -194,7 +174,7 @@ getBytes count = do
 		Nothing   -> throwE $ mapError $ fromIntegral len
 
 checkPending :: TLS Integer
-checkPending = withSession $ \s -> do
+checkPending = unsafeWithSession $ \s -> do
 	pending <- F.gnutls_record_check_pending s
 	return $ toInteger pending
 
@@ -227,31 +207,32 @@ data Credentials = Credentials F.CredentialsType (F.ForeignPtr F.Credentials)
 
 setCredentials :: Credentials -> TLS ()
 setCredentials (Credentials ctype fp) = do
-	rc <- withSession $ \s ->
+	rc <- unsafeWithSession $ \s ->
 		F.withForeignPtr fp $ \ptr -> do
 		F.gnutls_credentials_set s ctype ptr
 	
 	s <- getSession
 	if F.unRC rc == 0
-		then liftIO (atomicModifyIORef (sessionCredentials s) (\creds -> (fp:creds, ())))
+		then UIO.unsafeFromIO (atomicModifyIORef (sessionCredentials s) (\creds -> (fp:creds, ())))
 		else checkRC rc
 
 certificateCredentials :: TLS Credentials
 certificateCredentials = do
-	(rc, ptr) <- liftIO $ F.alloca $ \ptr -> do
+	(rc, ptr) <- UIO.unsafeFromIO $ F.alloca $ \ptr -> do
 		rc <- F.gnutls_certificate_allocate_credentials ptr
 		ptr' <- if F.unRC rc < 0
 			then return F.nullPtr
 			else F.peek ptr
 		return (rc, ptr')
 	checkRC rc
-	fp <- liftIO $ F.newForeignPtr F.gnutls_certificate_free_credentials_funptr ptr
+	fp <- UIO.unsafeFromIO $ F.newForeignPtr F.gnutls_certificate_free_credentials_funptr ptr
 	return $ Credentials (F.CredentialsType 1) fp
 
-withSession :: (F.Session -> IO a) -> TLS a
-withSession io = do
+-- | This must only be called with IO actions that do not throw NonPseudoException
+unsafeWithSession :: (F.Session -> IO a) -> TLS a
+unsafeWithSession io = do
 	s <- getSession
-	liftIO $ F.withForeignPtr (sessionPtr s) $ io . F.Session
+	UIO.unsafeFromIO $ F.withForeignPtr (sessionPtr s) $ io . F.Session
 
 checkRC :: F.ReturnCode -> TLS ()
 checkRC (F.ReturnCode x) = when (x < 0) $ throwE $ mapError x

From ceac3318dab99fff87a062dd84759c2b43e4013d Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Sat, 13 Feb 2021 21:18:46 -0500
Subject: [PATCH 04/10] runTLS' for when the caller is also using ExceptT

---
 lib/Network/Protocol/TLS/GNU.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/lib/Network/Protocol/TLS/GNU.hs b/lib/Network/Protocol/TLS/GNU.hs
index a9ab31a..0f99536 100644
--- a/lib/Network/Protocol/TLS/GNU.hs
+++ b/lib/Network/Protocol/TLS/GNU.hs
@@ -23,6 +23,7 @@ module Network.Protocol.TLS.GNU
 	, fromExceptT
 	
 	, runTLS
+	, runTLS'
 	, runClient
 	, getSession
 	, handshake
@@ -98,7 +99,10 @@ fromExceptT :: E.ExceptT Error UIO a -> TLS a
 fromExceptT = E.mapExceptT lift
 
 runTLS :: (Unexceptional m) => Session -> TLS a -> m (Either Error a)
-runTLS s tls = UIO.lift $ R.runReaderT (E.runExceptT tls) s
+runTLS s = E.runExceptT . runTLS' s
+
+runTLS' :: (Unexceptional m) => Session -> TLS a -> E.ExceptT Error m a
+runTLS' s = E.mapExceptT (UIO.lift . flip R.runReaderT s)
 
 runClient :: Transport -> TLS a -> IO (Either Error a)
 runClient transport tls = do

From 06a662e63ab0345b044655410bb3c58f87cb0491 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 15 Feb 2021 21:51:41 -0500
Subject: [PATCH 05/10] Switch TLS to TLST to allow any Unexceptional base
 monad

---
 lib/Network/Protocol/TLS/GNU.hs | 64 ++++++++++++++++-----------------
 1 file changed, 30 insertions(+), 34 deletions(-)

diff --git a/lib/Network/Protocol/TLS/GNU.hs b/lib/Network/Protocol/TLS/GNU.hs
index 0f99536..711e263 100644
--- a/lib/Network/Protocol/TLS/GNU.hs
+++ b/lib/Network/Protocol/TLS/GNU.hs
@@ -17,10 +17,9 @@
 
 module Network.Protocol.TLS.GNU
 	( TLS
+	, TLST
 	, Session
 	, Error (..)
-	, throwE
-	, fromExceptT
 	
 	, runTLS
 	, runTLS'
@@ -46,7 +45,6 @@ import           Control.Monad (when, foldM, foldM_)
 import           Control.Monad.Trans.Class (lift)
 import qualified Control.Monad.Trans.Except as E
 import qualified Control.Monad.Trans.Reader as R
-import           Control.Monad.IO.Class (liftIO)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Unsafe as B
@@ -56,7 +54,7 @@ import qualified Foreign.C as F
 import           Foreign.Concurrent as FC
 import qualified System.IO as IO
 import           System.IO.Unsafe (unsafePerformIO)
-import           UnexceptionalIO.Trans (UIO, Unexceptional)
+import           UnexceptionalIO.Trans (Unexceptional)
 import qualified UnexceptionalIO.Trans as UIO
 
 import qualified Network.Protocol.TLS.GNU.Foreign as F
@@ -68,10 +66,10 @@ globalInitMVar :: M.MVar ()
 {-# NOINLINE globalInitMVar #-}
 globalInitMVar = unsafePerformIO $ M.newMVar ()
 
-globalInit :: E.ExceptT Error IO ()
+globalInit :: (Unexceptional m) => E.ExceptT Error m ()
 globalInit = do
 	let init_ = M.withMVar globalInitMVar $ \_ -> F.gnutls_global_init
-	F.ReturnCode rc <- liftIO init_
+	F.ReturnCode rc <- UIO.unsafeFromIO init_
 	when (rc < 0) $ E.throwE $ mapError rc
 
 globalDeinit :: IO ()
@@ -90,33 +88,31 @@ data Session = Session
 	, sessionCredentials :: IORef [F.ForeignPtr F.Credentials]
 	}
 
-type TLS a = E.ExceptT Error (R.ReaderT Session UIO) a
+type TLS a = TLST IO a
+type TLST m a = E.ExceptT Error (R.ReaderT Session m) a
 
-throwE :: Error -> TLS a
-throwE = fromExceptT . E.throwE
-
-fromExceptT :: E.ExceptT Error UIO a -> TLS a
-fromExceptT = E.mapExceptT lift
-
-runTLS :: (Unexceptional m) => Session -> TLS a -> m (Either Error a)
+runTLS :: (Unexceptional m) => Session -> TLST m a -> m (Either Error a)
 runTLS s = E.runExceptT . runTLS' s
 
-runTLS' :: (Unexceptional m) => Session -> TLS a -> E.ExceptT Error m a
-runTLS' s = E.mapExceptT (UIO.lift . flip R.runReaderT s)
+runTLS' :: Session -> TLST m a -> E.ExceptT Error m a
+runTLS' s = E.mapExceptT (flip R.runReaderT s)
 
-runClient :: Transport -> TLS a -> IO (Either Error a)
+runClient :: (Unexceptional m) => Transport -> TLST m a -> m (Either Error a)
 runClient transport tls = do
 	eitherSession <- newSession transport (F.ConnectionEnd 2)
 	case eitherSession of
 		Left err -> return (Left err)
 		Right session -> runTLS session tls
 
-newSession :: Transport -> F.ConnectionEnd -> IO (Either Error Session)
-newSession transport end = F.alloca $ \sPtr -> E.runExceptT $ do
+newSession :: (Unexceptional m) =>
+	   Transport
+	-> F.ConnectionEnd
+	-> m (Either Error Session)
+newSession transport end = UIO.unsafeFromIO . F.alloca $ \sPtr -> E.runExceptT $ do
 	globalInit
-	F.ReturnCode rc <- liftIO $ F.gnutls_init sPtr end
+	F.ReturnCode rc <- UIO.unsafeFromIO $ F.gnutls_init sPtr end
 	when (rc < 0) $ E.throwE $ mapError rc
-	liftIO $ do
+	UIO.unsafeFromIO $ do
 		ptr <- F.peek sPtr
 		let session = F.Session ptr
 		push <- F.wrapTransportFunc (pushImpl transport)
@@ -132,22 +128,22 @@ newSession transport end = F.alloca $ \sPtr -> E.runExceptT $ do
 			F.freeHaskellFunPtr pull
 		return (Session fp creds)
 
-getSession :: TLS Session
+getSession :: (Monad m) => TLST m Session
 getSession = lift R.ask
 
-handshake :: TLS ()
+handshake :: (Unexceptional m) => TLST m ()
 handshake = unsafeWithSession F.gnutls_handshake >>= checkRC
 
-rehandshake :: TLS ()
+rehandshake :: (Unexceptional m) => TLST m ()
 rehandshake = unsafeWithSession F.gnutls_rehandshake >>= checkRC
 
-putBytes :: BL.ByteString -> TLS ()
+putBytes :: (Unexceptional m) => BL.ByteString -> TLST m ()
 putBytes = putChunks . BL.toChunks where
 	putChunks chunks = do
 		maybeErr <- unsafeWithSession $ \s -> foldM (putChunk s) Nothing chunks
 		case maybeErr of
 			Nothing -> return ()
-			Just err -> throwE $ mapError $ fromIntegral err
+			Just err -> E.throwE $ mapError $ fromIntegral err
 	
 	putChunk s Nothing chunk = B.unsafeUseAsCStringLen chunk $ uncurry loop where
 		loop ptr len = do
@@ -161,7 +157,7 @@ putBytes = putChunks . BL.toChunks where
 	
 	putChunk _ err _ = return err
 
-getBytes :: Integer -> TLS BL.ByteString
+getBytes :: (Unexceptional m) => Integer -> TLST m BL.ByteString
 getBytes count = do
 	(mbytes, len) <- unsafeWithSession $ \s ->
 		F.allocaBytes (fromInteger count) $ \ptr -> do
@@ -175,9 +171,9 @@ getBytes count = do
 	
 	case mbytes of
 		Just bytes -> return bytes
-		Nothing   -> throwE $ mapError $ fromIntegral len
+		Nothing   -> E.throwE $ mapError $ fromIntegral len
 
-checkPending :: TLS Integer
+checkPending :: (Unexceptional m) => TLST m Integer
 checkPending = unsafeWithSession $ \s -> do
 	pending <- F.gnutls_record_check_pending s
 	return $ toInteger pending
@@ -209,7 +205,7 @@ handleTransport h = Transport (BL.hPut h) (BL.hGet h . fromInteger)
 
 data Credentials = Credentials F.CredentialsType (F.ForeignPtr F.Credentials)
 
-setCredentials :: Credentials -> TLS ()
+setCredentials :: (Unexceptional m) => Credentials -> TLST m ()
 setCredentials (Credentials ctype fp) = do
 	rc <- unsafeWithSession $ \s ->
 		F.withForeignPtr fp $ \ptr -> do
@@ -220,7 +216,7 @@ setCredentials (Credentials ctype fp) = do
 		then UIO.unsafeFromIO (atomicModifyIORef (sessionCredentials s) (\creds -> (fp:creds, ())))
 		else checkRC rc
 
-certificateCredentials :: TLS Credentials
+certificateCredentials :: (Unexceptional m) => TLST m Credentials
 certificateCredentials = do
 	(rc, ptr) <- UIO.unsafeFromIO $ F.alloca $ \ptr -> do
 		rc <- F.gnutls_certificate_allocate_credentials ptr
@@ -233,13 +229,13 @@ certificateCredentials = do
 	return $ Credentials (F.CredentialsType 1) fp
 
 -- | This must only be called with IO actions that do not throw NonPseudoException
-unsafeWithSession :: (F.Session -> IO a) -> TLS a
+unsafeWithSession :: (Unexceptional m) => (F.Session -> IO a) -> TLST m a
 unsafeWithSession io = do
 	s <- getSession
 	UIO.unsafeFromIO $ F.withForeignPtr (sessionPtr s) $ io . F.Session
 
-checkRC :: F.ReturnCode -> TLS ()
-checkRC (F.ReturnCode x) = when (x < 0) $ throwE $ mapError x
+checkRC :: (Monad m) => F.ReturnCode -> TLST m ()
+checkRC (F.ReturnCode x) = when (x < 0) $ E.throwE $ mapError x
 
 mapError :: F.CInt -> Error
 mapError = Error . toInteger

From 858bf6fe98401a853bb5141871888300cba779ea Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 22 Jan 2024 11:27:00 -0500
Subject: [PATCH 06/10] Implement hash for sha1

---
 lib/Network/Protocol/TLS/GNU.hs                  | 13 ++++++++++++-
 .../Protocol/TLS/GNU/{Foreign.hs => Foreign.chs} | 16 +++++++++++++---
 2 files changed, 25 insertions(+), 4 deletions(-)
 rename lib/Network/Protocol/TLS/GNU/{Foreign.hs => Foreign.chs} (94%)

diff --git a/lib/Network/Protocol/TLS/GNU.hs b/lib/Network/Protocol/TLS/GNU.hs
index 711e263..cfab870 100644
--- a/lib/Network/Protocol/TLS/GNU.hs
+++ b/lib/Network/Protocol/TLS/GNU.hs
@@ -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
diff --git a/lib/Network/Protocol/TLS/GNU/Foreign.hs b/lib/Network/Protocol/TLS/GNU/Foreign.chs
similarity index 94%
rename from lib/Network/Protocol/TLS/GNU/Foreign.hs
rename to lib/Network/Protocol/TLS/GNU/Foreign.chs
index 28d1b9c..8461659 100644
--- a/lib/Network/Protocol/TLS/GNU/Foreign.hs
+++ b/lib/Network/Protocol/TLS/GNU/Foreign.chs
@@ -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"

From f3c719ae440a76f0de582f75afbbc57290a7ff29 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 22 Jan 2024 11:29:01 -0500
Subject: [PATCH 07/10] Update metadata for 0.3

---
 gnutls.cabal | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/gnutls.cabal b/gnutls.cabal
index 529ab51..45120f7 100644
--- a/gnutls.cabal
+++ b/gnutls.cabal
@@ -1,15 +1,15 @@
 name: gnutls
-version: 0.2
+version: 0.3
 license: GPL-3
 license-file: license.txt
 author: John Millikin <jmillikin@gmail.com>
-maintainer: John Millikin <jmillikin@gmail.com>
+maintainer: Stephen Paul Weber <singpolyma@singpolyma.net>
 build-type: Simple
-cabal-version: >= 1.6
+cabal-version: >= 1.10
 category: Network
 stability: experimental
-homepage: https://john-millikin.com/software/haskell-gnutls/
-bug-reports: mailto:jmillikin@gmail.com
+homepage: https://git.singpolyma.net/haskell-gnutls
+bug-reports: mailto:dev@singpolyma.net
 
 synopsis: Bindings for GNU libgnutls
 description:
@@ -21,14 +21,15 @@ description:
 
 source-repository head
   type: git
-  location: https://john-millikin.com/code/haskell-gnutls/
+  location: https://git.singpolyma.net/haskell-gnutls
 
 source-repository this
   type: git
-  location: https://john-millikin.com/code/haskell-gnutls/
-  tag: haskell-gnutls_0.2
+  location: https://git.singpolyma.net/haskell-gnutls
+  tag: 0.3
 
 library
+  default-language: Haskell2010
   hs-source-dirs: lib
   ghc-options: -Wall -Wno-tabs -O2
 

From d1da25f3a00ed830bd59ff03c9bc5927c6aac317 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 4 Sep 2024 17:50:43 -0500
Subject: [PATCH 08/10] These are ssize_t not size_t

The return negative for error cases and with newer GHCs lying causes a problem.
---
 lib/Network/Protocol/TLS/GNU/Foreign.chs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/lib/Network/Protocol/TLS/GNU/Foreign.chs b/lib/Network/Protocol/TLS/GNU/Foreign.chs
index 8461659..b313612 100644
--- a/lib/Network/Protocol/TLS/GNU/Foreign.chs
+++ b/lib/Network/Protocol/TLS/GNU/Foreign.chs
@@ -21,6 +21,7 @@ module Network.Protocol.TLS.GNU.Foreign where
 
 import           Foreign
 import           Foreign.C
+import           System.Posix.Types
 
 -- Type aliases {{{
 
@@ -224,13 +225,13 @@ foreign import ccall safe "gnutls_record_get_max_size"
 	gnutls_record_get_max_size :: Session -> IO CSize
 
 foreign import ccall safe "gnutls_record_recv"
-	gnutls_record_recv :: Session -> Ptr a -> CSize -> IO CSize
+	gnutls_record_recv :: Session -> Ptr a -> CSize -> IO CSsize
 
 foreign import ccall safe "gnutls_record_send"
-	gnutls_record_send :: Session -> Ptr a -> CSize -> IO CSize
+	gnutls_record_send :: Session -> Ptr a -> CSize -> IO CSsize
 
 foreign import ccall safe "gnutls_record_set_max_size"
-	gnutls_record_set_max_size :: Session -> CSize -> IO CSize
+	gnutls_record_set_max_size :: Session -> CSize -> IO CSsize
 
 -- }}}
 

From 5cdfc843ac6d98190be60762f8c9fca3c00164f4 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Wed, 4 Sep 2024 17:51:42 -0500
Subject: [PATCH 09/10] Bump to 0.3.1

---
 gnutls.cabal | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gnutls.cabal b/gnutls.cabal
index 45120f7..e9b11f0 100644
--- a/gnutls.cabal
+++ b/gnutls.cabal
@@ -1,5 +1,5 @@
 name: gnutls
-version: 0.3
+version: 0.3.1
 license: GPL-3
 license-file: license.txt
 author: John Millikin <jmillikin@gmail.com>
@@ -26,7 +26,7 @@ source-repository head
 source-repository this
   type: git
   location: https://git.singpolyma.net/haskell-gnutls
-  tag: 0.3
+  tag: 0.3.1
 
 library
   default-language: Haskell2010

From 8d785689ebac870096005d07c30b737de10124a0 Mon Sep 17 00:00:00 2001
From: rhiannon morris <rhi@rhiannon.website>
Date: Wed, 23 Oct 2024 00:50:16 +0200
Subject: [PATCH 10/10] add missing c2hs dependency

---
 gnutls.cabal | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gnutls.cabal b/gnutls.cabal
index e9b11f0..8993058 100644
--- a/gnutls.cabal
+++ b/gnutls.cabal
@@ -38,6 +38,8 @@ library
     , bytestring >= 0.9
     , transformers >= 0.4.0.0
     , unexceptionalio-trans
+  build-tool-depends:
+      c2hs:c2hs
 
   extra-libraries: gnutls
   pkgconfig-depends: gnutls