From e74149a7569afd1ea7d67c77f40c37471e7e3e58 Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Fri, 28 Sep 2018 18:33:35 -0400 Subject: Begin implementing symmetric encryption Support RC4. Future commits will add support for more modern algorithms. --- src/BTLS/Result.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'src/BTLS/Result.hs') diff --git a/src/BTLS/Result.hs b/src/BTLS/Result.hs index a3c153c..f75d89e 100644 --- a/src/BTLS/Result.hs +++ b/src/BTLS/Result.hs @@ -15,7 +15,7 @@ module BTLS.Result ( alwaysSucceeds, requireSuccess , Result, Error, file, line, errorData, errorDataIsHumanReadable - , check + , check, check' ) where import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread) @@ -70,10 +70,13 @@ dequeueError = do return (Just (errorFromTuple e)) check :: IO Int -> ExceptT [Error] IO () -check f = do +check = ExceptT . check' + +check' :: IO Int -> IO (Either [Error] ()) +check' f = do unless rtsSupportsBoundThreads $ error "btls requires the threaded runtime. Please recompile with -threaded." - ExceptT $ runInBoundThread $ do + runInBoundThread $ do -- TODO(bbaren): Assert that the error queue is clear r <- f if r == 1 -- cgit v1.2.3