~singpolyma/haskell-gnutls

5c99dfb01491bc5ef2a12356e9265049680b2761 — Stephen Paul Weber 1 year, 4 months ago cdd6ecf
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.
2 files changed, 9 insertions(+), 5 deletions(-)

M gnutls.cabal
M lib/Network/Protocol/TLS/GNU.hs
M gnutls.cabal => gnutls.cabal +1 -0
@@ 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

M lib/Network/Protocol/TLS/GNU.hs => lib/Network/Protocol/TLS/GNU.hs +8 -5
@@ 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