[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]

[tor-dev] PRELIMINARY: [PATCH 21/21] Remove 'TorDNSEL.Compat.Exception'.



These patches should allow you to build all modules (using GHC 7.6.3.)
if you apply them on the previous set [1].  /But please donât expect
anything to work./

Now itâs time to actually test and reorganize the patches.  Will it be
sane to resend the previous 12 patches (approximately 1500 lines) to the
list?

Then Iâm planning to review each patch since Iâm not sure about some
things (like the IncoherentInstances extension or the âhGetLineâ
function).  Iâll probably ask someone to help with that.

Any comments?

[1] https://lists.torproject.org/pipermail/tor-dev/2013-August/005246.html
[2] http://www.haskell.org/ghc/docs/7.6.3/html/users_guide/type-class-extensions.html#instance-overlap

From 1aed59fcf3612061814858eb0bf8f42f8431ca72 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Mon, 12 Aug 2013 23:48:06 +0000
Subject: [PATCH 13/21] Replace 'TorDNSEL.Compat.Exception' with
 'Control.Exception'.

---
 src/TorDNSEL/ExitTest/Initiator/Internals.hs |   35 +++++++++++++++-----------
 1 file changed, 20 insertions(+), 15 deletions(-)

diff --git a/src/TorDNSEL/ExitTest/Initiator/Internals.hs b/src/TorDNSEL/ExitTest/Initiator/Internals.hs
index 4be908a..0e9ba73 100644
--- a/src/TorDNSEL/ExitTest/Initiator/Internals.hs
+++ b/src/TorDNSEL/ExitTest/Initiator/Internals.hs
@@ -62,10 +62,10 @@ import Prelude hiding (log)
 import Control.Arrow (first, second)
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Chan (Chan, newChan, writeChan, readChan)
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import Control.Monad (replicateM_, guard, when)
 import qualified Data.ByteString.Char8 as B
-import Data.Dynamic (fromDynamic)
+import Data.Dynamic (fromDynamic, Dynamic)
 import qualified Data.Foldable as F
 import Data.List (foldl', unfoldr, mapAccumL)
 import qualified Data.Map as M
@@ -378,15 +378,19 @@ forkTestClient conf rid published port =
               B.hGet handle 1024 -- ignore response
               return ()
     case r of
-      Left e@(E.DynException d) | Just (e' :: SocksError) <- fromDynamic d -> do
-        log Info "Exit test for router " rid " port " port " failed: " e'
-        E.throwIO e
-      Left e -> do
-        log Warn "Exit test for router " rid " port " port " failed : " e
-                 ". This might indicate a problem with making application \
-                 \connections through Tor. Is Tor running? Is its SocksPort \
-                 \listening on " (eticfSocksServer conf) '?'
-        E.throwIO e
+      Left e
+        | Just (e' :: SocksError)
+          <- fromDynamic =<< (E.fromException e :: Maybe Dynamic)
+          -> do
+            log Info "Exit test for router " rid " port " port " failed: " e'
+            E.throwIO e
+        | otherwise
+          -> do
+            log Warn "Exit test for router " rid " port " port " failed : " e
+              ". This might indicate a problem with making application \
+              \connections through Tor. Is Tor running? Is its SocksPort \
+              \listening on " (eticfSocksServer conf) '?'
+            E.throwIO e
       Right Nothing ->
         log Info "Exit test for router " rid " port " port " timed out."
       _ ->
@@ -401,10 +405,11 @@ forkTestClient conf rid published port =
         connect sock (eticfSocksServer conf)
         socketToHandle sock ReadWriteMode
 
-    clientExceptions e@(E.DynException d)
-      | Just (_ :: SocksError) <- fromDynamic d = Just e
-    clientExceptions e@(E.IOException _)        = Just e
-    clientExceptions _                          = Nothing
+    clientExceptions e
+      | Just (_ :: SocksError)
+        <- fromDynamic =<< (E.fromException e :: Maybe Dynamic) = Just e
+      | Just _ <- E.fromException e :: Maybe E.IOException      = Just e
+      | otherwise                                               = Nothing
 
     connectionTimeout = 120 * 10^6
 
-- 
1.7.9.5

From 64c55b340b392847eab1882b17ab01147750db11 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Thu, 22 Aug 2013 09:49:58 +0000
Subject: [PATCH 14/21] Replace 'OverlappingInstances' with
 'IncoherentInstances'.

---
 src/TorDNSEL/Log/Internals.hsc         |    2 +-
 src/TorDNSEL/NetworkState/Internals.hs |    1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/TorDNSEL/Log/Internals.hsc b/src/TorDNSEL/Log/Internals.hsc
index 53f5cba..44b30b7 100644
--- a/src/TorDNSEL/Log/Internals.hsc
+++ b/src/TorDNSEL/Log/Internals.hsc
@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances,
-             OverlappingInstances, FlexibleInstances #-}
+             IncoherentInstances, FlexibleInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
diff --git a/src/TorDNSEL/NetworkState/Internals.hs b/src/TorDNSEL/NetworkState/Internals.hs
index 933b7eb..078aad4 100644
--- a/src/TorDNSEL/NetworkState/Internals.hs
+++ b/src/TorDNSEL/NetworkState/Internals.hs
@@ -483,6 +483,7 @@ startTorController net conf mbDelay = liftIO $ do
       log Info "Successfully initialized Tor controller connection."
       return (Right conn, tid)
   where
+    logTorControlErrors :: MonadIO m => String -> [TorControlError] -> m ()
     logTorControlErrors event = mapM_ (log Warn "Error in " event " event: ")
     logParseErrors (xs,errors) = mapM_ (log Warn) errors >> return xs
     updateDescriptors (NetworkStateManager send _) = send . NewDescriptors
-- 
1.7.9.5

From 14002eccf29d7b71f7edff49d8c2966954963f3f Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Thu, 22 Aug 2013 09:56:01 +0000
Subject: [PATCH 15/21] Replace 'TorDNSEL.Compat.Exception' with
 'Control.Exception'.

---
 src/TorDNSEL/NetworkState/Internals.hs |    7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/TorDNSEL/NetworkState/Internals.hs b/src/TorDNSEL/NetworkState/Internals.hs
index 078aad4..d8fb4fb 100644
--- a/src/TorDNSEL/NetworkState/Internals.hs
+++ b/src/TorDNSEL/NetworkState/Internals.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards, BangPatterns #-}
+{-# LANGUAGE PatternGuards, BangPatterns, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 
 -----------------------------------------------------------------------------
@@ -64,7 +64,7 @@ import Control.Monad.State
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Chan (newChan, readChan, writeChan)
 import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Char8 (ByteString)
 import Data.List (foldl')
@@ -188,7 +188,8 @@ startNetworkStateManager initConf = do
       Just testConf | Right conn <- controller ->
         execStateT (initializeExitTests net (nsmcfStateDir initConf) testConf)
                    emptyState
-          `E.catch` \e -> closeConnection conn >> E.throwIO e
+          `E.catch` \(e :: E.SomeException) ->
+            closeConnection conn >> E.throwIO e
       _ -> return emptyState
     swapMVar networkStateMV $! networkState initState
     signal
-- 
1.7.9.5

From f4e2b2144f2ccf79262b4715c2ebe41e9eab388d Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Thu, 22 Aug 2013 10:03:53 +0000
Subject: [PATCH 16/21] Replace 'TorDNSEL.Compat.Exception' with
 'Control.Exception'.

---
 src/TorDNSEL/Statistics/Internals.hs |    6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/TorDNSEL/Statistics/Internals.hs b/src/TorDNSEL/Statistics/Internals.hs
index b1b505f..10f35fc 100644
--- a/src/TorDNSEL/Statistics/Internals.hs
+++ b/src/TorDNSEL/Statistics/Internals.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fglasgow-exts -fno-warn-type-defaults #-}
 
 -----------------------------------------------------------------------------
@@ -23,7 +23,7 @@ import Prelude hiding (log)
 import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
 import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, readMVar)
 import Control.Concurrent.QSem (QSem, newQSem, waitQSem, signalQSem)
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import Control.Monad.Fix (fix)
 import qualified Data.ByteString.Char8 as B
 import Data.Maybe (isJust, isNothing)
@@ -134,7 +134,7 @@ forkListener statsChan listenSock sem =
   forkLinkIO . E.block . forever $ do
     waitQSem sem
     (client,_) <- E.unblock $ accept listenSock
-      `E.catch` \e -> signalQSem sem >> E.throwIO e
+      `E.catch` \(e :: E.SomeException) -> signalQSem sem >> E.throwIO e
     writeChan statsChan $ NewClient client
 
 -- | Terminate the stats server gracefully. The optional parameter specifies the
-- 
1.7.9.5

From 1ce11d7f13b313c06016cacdf9469d2c4cb714c4 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Thu, 22 Aug 2013 10:10:25 +0000
Subject: [PATCH 17/21] Replace 'TorDNSEL.Compat.Exception' with
 'Control.Exception'.

---
 src/TorDNSEL/Config/Internals.hs |    4 ++--
 src/TorDNSEL/Main.hsc            |   46 +++++++++++++++++++-------------------
 2 files changed, 25 insertions(+), 25 deletions(-)

diff --git a/src/TorDNSEL/Config/Internals.hs b/src/TorDNSEL/Config/Internals.hs
index 54366f3..3849997 100644
--- a/src/TorDNSEL/Config/Internals.hs
+++ b/src/TorDNSEL/Config/Internals.hs
@@ -49,7 +49,7 @@ import Prelude hiding (log)
 import Control.Arrow ((***), second)
 import Control.Concurrent.Chan
 import Control.Concurrent.MVar
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import Control.Monad (liftM, liftM2, ap)
 import Control.Monad.Error (MonadError(..))
 import Control.Monad.Fix (fix)
@@ -435,7 +435,7 @@ startReconfigServer sock sendConfig = do
 
 handleMessage :: State -> ReconfigMessage -> IO State
 handleMessage s (NewClient client signal) = do
-  E.handleJust E.ioErrors
+  E.handleJust ioErrors
     (log Warn "Reading config from reconfigure socket failed: ") $
     E.bracket (socketToHandle client ReadWriteMode) hClose $ \handle -> do
       str <- B.hGetContents handle
diff --git a/src/TorDNSEL/Main.hsc b/src/TorDNSEL/Main.hsc
index 609543f..598026e 100644
--- a/src/TorDNSEL/Main.hsc
+++ b/src/TorDNSEL/Main.hsc
@@ -64,7 +64,7 @@ module TorDNSEL.Main (
 
 import Prelude hiding (log)
 import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import Control.Monad (when, liftM, forM, forM_)
 import Control.Monad.Fix (fix)
 import Control.Monad.State (StateT, runStateT, liftIO, get, put)
@@ -200,7 +200,7 @@ main = do
         `E.catch` \e -> do
           hCat stderr "Connecting to reconfigure socket failed: " e '\n'
           exitWith $ fromSysExitCode Unavailable
-      r <- E.handleJust E.ioErrors (\e -> do
+      r <- E.handleJust ioErrors (\e -> do
              hCat stderr "An I/O error occurred while reconfiguring: " e '\n'
              exitWith $ fromSysExitCode IOError) $
         E.bracket (socketToHandle sock ReadWriteMode) hClose $ \handle -> do
@@ -221,7 +221,7 @@ main = do
     conf <- exitLeft Usage $ parseConfigArgs args
     case B.pack "configfile" `M.lookup` conf of
       Just fp -> do
-        file <- E.catchJust E.ioErrors (B.readFile $ B.unpack fp)
+        file <- E.catchJust ioErrors (B.readFile $ B.unpack fp)
           (exitPrint NoInput . cat "Opening config file failed: ")
         exitLeft DataError $ makeConfig . M.union conf =<< parseConfigFile file
       Nothing -> exitLeft Usage $ makeConfig conf
@@ -237,33 +237,33 @@ main = do
         euid /= 0) $
     exitPrint NoPermission ("You must be root to drop privileges or chroot." ++)
 
-  ids <- E.catchJust E.ioErrors
+  ids <- E.catchJust ioErrors
     (getIDs (cfUser conf) (cfGroup conf))
     (exitPrint OSFile . cat "Looking up uid/gid failed: ")
 
-  E.catchJust E.ioErrors
+  E.catchJust ioErrors
     (checkDirectory (fst ids) (cfChangeRootDirectory conf)
                     (cfStateDirectory conf))
     (exitPrint Can'tCreate . cat "Preparing state directory failed: ")
 
-  E.catchJust E.ioErrors
+  E.catchJust ioErrors
     (checkDirectory Nothing Nothing (cfRuntimeDirectory conf))
     (exitPrint Can'tCreate . cat "Preparing runtime directory failed: ")
 
-  statsSock <- E.catchJust E.ioErrors
+  statsSock <- E.catchJust ioErrors
     (bindStatsSocket $ cfRuntimeDirectory conf)
     (exitPrint Can'tCreate . cat "Opening statistics listener failed: ")
 
-  reconfigSock <- E.catchJust E.ioErrors
+  reconfigSock <- E.catchJust ioErrors
     (bindReconfigSocket (cfRuntimeDirectory conf) (fst ids))
     (exitPrint Can'tCreate . cat "Opening reconfigure listener failed: ")
 
-  pidHandle <- E.catchJust E.ioErrors
+  pidHandle <- E.catchJust ioErrors
     (flip openFile WriteMode `liftMb` cfPIDFile conf)
     (exitPrint Can'tCreate . cat "Opening PID file failed: ")
 
   log Notice "Opening DNS listener on " (cfDNSListenAddress conf) '.'
-  dnsSock <- E.catchJust E.ioErrors
+  dnsSock <- E.catchJust ioErrors
     (bindUDPSocket $ cfDNSListenAddress conf)
     (\e -> exitPrint (bindErrorCode e) $
              cat "Opening DNS listener on " (cfDNSListenAddress conf)
@@ -276,7 +276,7 @@ main = do
         let sockAddr = SockAddrInet (fromIntegral port)
                                    (htonl . fst $ tcfTestListenAddress testConf)
         log Notice "Opening exit test listener on " sockAddr '.'
-        sock <- E.catchJust E.ioErrors
+        sock <- E.catchJust ioErrors
          (bindListeningTCPSocket sockAddr)
          (\e -> exitPrint (bindErrorCode e) $
                   cat "Opening exit test listener on " sockAddr " failed: " e)
@@ -311,7 +311,7 @@ verifyConfig args =
     Right conf ->
       case B.pack "configfile" `M.lookup` conf of
         Just fp -> do
-          file <- E.catchJust E.ioErrors (B.readFile $ B.unpack fp) $ \e -> do
+          file <- E.catchJust ioErrors (B.readFile $ B.unpack fp) $ \e -> do
             hCat stderr "Opening config file failed: " e '\n'
             exitWith $ fromSysExitCode NoInput
           check DataError $ parseConfigFile file >>= makeConfig . M.union conf
@@ -374,7 +374,7 @@ handleMessage _ static conf s (Reconfigure reconf) = flip runStateT s $ do
     Nothing
       | Just configFile <- cfConfigFile conf -> do
           log Notice "Caught SIGHUP. Reloading config file."
-          r <- liftIO . E.tryJust E.ioErrors $ B.readFile configFile
+          r <- liftIO . E.tryJust ioErrors $ B.readFile configFile
           case r of
             Left e -> do
               -- If we're chrooted, it's not suprising that we can't read our
@@ -615,7 +615,7 @@ reconfigureDNSListenerAndServer
 reconfigureDNSListenerAndServer static oldConf newConf errorRespond = do
   when (cfDNSListenAddress oldConf /= cfDNSListenAddress newConf) $ do
     log Notice "Opening DNS listener on " (cfDNSListenAddress newConf) '.'
-    r <- liftIO . E.tryJust E.ioErrors $
+    r <- liftIO . E.tryJust ioErrors $
            bindUDPSocket $ cfDNSListenAddress newConf
     case r of
       Left e -> do
@@ -649,14 +649,14 @@ terminateProcess status static s mbWait = do
   forM_ (M.assocs $ exitTestListeners s) $ \(addr,mbSock) ->
     whenJust mbSock $ \sock -> do
       log Info "Closing exit test listener on " addr '.'
-      ignoreJust E.ioErrors $ sClose sock
+      ignoreJust ioErrors $ sClose sock
   log Info "Closing DNS listener."
-  ignoreJust E.ioErrors . sClose $ dnsListener s
+  ignoreJust ioErrors . sClose $ dnsListener s
   log Info "Closing statistics listener."
-  ignoreJust E.ioErrors . sClose $ statsSocket static
+  ignoreJust ioErrors . sClose $ statsSocket static
   log Info "Closing reconfigure listener."
-  ignoreJust E.ioErrors . sClose $ reconfigSocket static
-  ignoreJust E.ioErrors . hClose $ randomHandle static
+  ignoreJust ioErrors . sClose $ reconfigSocket static
+  ignoreJust ioErrors . hClose $ randomHandle static
   log Notice "All subsystems have terminated. Exiting now."
   terminateLogger mbWait
   closeSystemLogger
@@ -732,7 +732,7 @@ setMaxOpenFiles lowerLimit cap = do
       unResourceLimit (ResourceLimit n) = n
       unResourceLimit _ = error "unResourceLimit: bug"
 
-  fmap unResourceLimit $ E.catchJust E.ioErrors
+  fmap unResourceLimit $ E.catchJust ioErrors
     (setResourceLimit ResourceOpenFiles (newLimits most) >> return most) $ \e ->
     do
 #ifdef OPEN_MAX
@@ -741,9 +741,9 @@ setMaxOpenFiles lowerLimit cap = do
       if not (isPermissionError e) && openMax < most
         then do setResourceLimit ResourceOpenFiles (newLimits openMax)
                 return openMax
-        else E.throwIO (E.IOException e)
+        else E.throwIO (E.toException e)
 #else
-      E.throwIO (E.IOException e)
+      E.throwIO (E.toException e)
 #endif
 
 instance Ord ResourceLimit where
@@ -777,7 +777,7 @@ checkDirectory uid newRoot path = do
 -- return 'ToStdOut'.
 checkLogTarget :: LogTarget -> IO LogTarget
 checkLogTarget target@(ToFile logPath) =
-  E.catchJust E.ioErrors
+  E.catchJust ioErrors
     (do E.bracket (openFile logPath AppendMode) hClose (const $ return ())
         return target)
     (const $ return ToStdOut)
-- 
1.7.9.5

From 9b124d93a53a575f6d1563f0ac19e75e83de3f23 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Thu, 22 Aug 2013 10:19:25 +0000
Subject: [PATCH 18/21] Import the 'CInt' constructor properly.

---
 src/TorDNSEL/Main.hsc |    2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/TorDNSEL/Main.hsc b/src/TorDNSEL/Main.hsc
index 598026e..aa5636d 100644
--- a/src/TorDNSEL/Main.hsc
+++ b/src/TorDNSEL/Main.hsc
@@ -108,7 +108,7 @@ import System.Posix.Types (UserID, GroupID)
 import System.Posix.User
   ( getEffectiveUserID, UserEntry(userID), GroupEntry(groupID)
   , getUserEntryForName, getGroupEntryForName, setUserID, setGroupID )
-import Foreign.C (CString, CInt, withCString)
+import Foreign.C (CString, CInt(..), withCString)
 
 import TorDNSEL.Config
 import TorDNSEL.Control.Concurrent.Link
-- 
1.7.9.5

From fa5d8d418cdd9f23503337ec3bfd2617edcdfc82 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Thu, 22 Aug 2013 10:27:11 +0000
Subject: [PATCH 19/21] Use ScopedTypeVariables.

---
 src/TorDNSEL/Main.hsc |   22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/src/TorDNSEL/Main.hsc b/src/TorDNSEL/Main.hsc
index aa5636d..b95fa8d 100644
--- a/src/TorDNSEL/Main.hsc
+++ b/src/TorDNSEL/Main.hsc
@@ -1,4 +1,5 @@
-{-# LANGUAGE PatternGuards, BangPatterns, ForeignFunctionInterface, CPP #-}
+{-# LANGUAGE PatternGuards, BangPatterns, ForeignFunctionInterface, CPP,
+             ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-missing-fields
                 -fno-warn-orphans #-}
 
@@ -197,7 +198,7 @@ main = do
           verifyConfig args
     ["--reconfigure",runtimeDir] -> do
       sock <- connectToReconfigSocket runtimeDir
-        `E.catch` \e -> do
+        `E.catch` \(e :: E.SomeException) -> do
           hCat stderr "Connecting to reconfigure socket failed: " e '\n'
           exitWith $ fromSysExitCode Unavailable
       r <- E.handleJust ioErrors (\e -> do
@@ -334,10 +335,11 @@ runMainThread static initTestListeners initDNSListener initConf = do
   installHandler sigHUP (Catch hupHandler) Nothing
   installHandler sigINT (Catch $ termHandler sigINT) Nothing
 
-  initState <- E.handle (\e -> do log Error "Starting failed: " e
-                                  terminateLogger Nothing
-                                  closeSystemLogger
-                                  exitWith $ fromSysExitCode ConfigError) $ do
+  initState <- E.handle (\(e :: E.SomeException) -> do
+                            log Error "Starting failed: " e
+                            terminateLogger Nothing
+                            closeSystemLogger
+                            exitWith $ fromSysExitCode ConfigError) $ do
     initLogger <- initializeLogger initConf
     whenJust (cfChangeRootDirectory initConf) $ \dir ->
       log Notice "Chrooted in " (esc 256 $ B.pack dir) '.'
@@ -348,11 +350,11 @@ runMainThread static initTestListeners initDNSListener initConf = do
                       (((writeChan mainChan . Reconfigure) .) . curry Just)
     let cleanup = terminateReconfigServer Nothing initReconfig
     stats <- startStatsServer (statsSocket static)
-      `E.catch` \e -> cleanup >> E.throwIO e
+      `E.catch` \(e :: E.SomeException) -> cleanup >> E.throwIO e
     let cleanup' = cleanup >> terminateStatsServer Nothing stats
     netState <- initializeNetworkStateManager
                   (mkExitTestConfig static initTestListeners initConf) initConf
-      `E.catch` \e -> cleanup' >> E.throwIO e
+      `E.catch` \(e :: E.SomeException) -> cleanup' >> E.throwIO e
     dns <- startDNSServer (mkDNSServerConfig initDNSListener initConf)
     return $ State (Just initLogger) (Just initReconfig) (Just stats) netState
                    dns initTestListeners initDNSListener S.empty
@@ -412,7 +414,7 @@ handleMessage _ static conf s (Reconfigure reconf) = flip runStateT s $ do
 
       when (cfStateDirectory conf /= cfStateDirectory newConf') $
         liftIO $ checkDirectory Nothing Nothing (cfStateDirectory newConf')
-          `E.catch` \e -> do
+          `E.catch` \(e :: E.SomeException) -> do
             errorRespond $ cat "Preparing new state directory failed: " e
                                "; exiting gracefully."
             terminateProcess Can'tCreate static s Nothing
@@ -476,7 +478,7 @@ handleMessage mainChan static conf s (Exit tid reason)
                (showExitReason [] reason) "; restarting."
       newManager <- initializeNetworkStateManager
                       (mkExitTestConfig static (exitTestListeners s) conf) conf
-        `E.catch` \e -> do
+        `E.catch` \(e :: E.SomeException) -> do
           log Error "Restarting network state manager failed: " e
                     "; exiting gracefully."
           terminateProcess Internal static s Nothing
-- 
1.7.9.5

From 39dc429a34873c11090908f6f5f817637dadbeab Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Thu, 22 Aug 2013 10:54:32 +0000
Subject: [PATCH 20/21] Replace 'TorDNSEL.Compat.Exception' with
 'Control.Exception'.

---
 src/TorDNSEL/Control/Concurrent/Future.hs |    2 +-
 src/TorDNSEL/DNS/Internals.hs             |    2 +-
 src/TorDNSEL/DNS/Server/Internals.hs      |    2 +-
 src/TorDNSEL/Directory/Internals.hs       |    2 +-
 src/TorDNSEL/Log/Internals.hsc            |    2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/TorDNSEL/Control/Concurrent/Future.hs b/src/TorDNSEL/Control/Concurrent/Future.hs
index 8f3c77e..4b5c6ac 100644
--- a/src/TorDNSEL/Control/Concurrent/Future.hs
+++ b/src/TorDNSEL/Control/Concurrent/Future.hs
@@ -18,7 +18,7 @@ module TorDNSEL.Control.Concurrent.Future (
   ) where
 
 import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, withMVar)
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 
 import TorDNSEL.Control.Concurrent.Link
 
diff --git a/src/TorDNSEL/DNS/Internals.hs b/src/TorDNSEL/DNS/Internals.hs
index 23f1595..54d1c08 100644
--- a/src/TorDNSEL/DNS/Internals.hs
+++ b/src/TorDNSEL/DNS/Internals.hs
@@ -59,7 +59,7 @@ module TorDNSEL.DNS.Internals (
   , Class(..)
   ) where
 
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import Control.Monad (when, unless, replicateM, liftM2, liftM3, forM)
 import qualified Control.Monad.State as S
 import Control.Monad.Trans (lift)
diff --git a/src/TorDNSEL/DNS/Server/Internals.hs b/src/TorDNSEL/DNS/Server/Internals.hs
index 87ad170..0be6e2b 100644
--- a/src/TorDNSEL/DNS/Server/Internals.hs
+++ b/src/TorDNSEL/DNS/Server/Internals.hs
@@ -21,7 +21,7 @@
 module TorDNSEL.DNS.Server.Internals where
 
 import Prelude hiding (log)
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import Control.Monad (when, guard, liftM2, liftM3)
 import Data.Bits ((.|.), shiftL)
 import qualified Data.ByteString.Char8 as B
diff --git a/src/TorDNSEL/Directory/Internals.hs b/src/TorDNSEL/Directory/Internals.hs
index f6dacfe..00a5e89 100644
--- a/src/TorDNSEL/Directory/Internals.hs
+++ b/src/TorDNSEL/Directory/Internals.hs
@@ -52,7 +52,7 @@ module TorDNSEL.Directory.Internals (
   ) where
 
 import Control.Concurrent.MVar (newMVar, withMVar)
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import Control.Monad (when, unless, liftM)
 import Control.Monad.Error (MonadError(throwError))
 import Data.Char
diff --git a/src/TorDNSEL/Log/Internals.hsc b/src/TorDNSEL/Log/Internals.hsc
index 44b30b7..18670ae 100644
--- a/src/TorDNSEL/Log/Internals.hsc
+++ b/src/TorDNSEL/Log/Internals.hsc
@@ -25,7 +25,7 @@ module TorDNSEL.Log.Internals where
 import Prelude hiding (log)
 import Control.Concurrent.Chan (Chan, newChan, writeChan, readChan)
 import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)
-import qualified TorDNSEL.Compat.Exception as E
+import qualified Control.Exception as E
 import Control.Monad (when, liftM2)
 import Control.Monad.Fix (fix)
 import Control.Monad.Trans (MonadIO, liftIO)
-- 
1.7.9.5

From 6f65520ebcad8b4a115047fc6d15ec172b9b8598 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@xxxxxxxxxxxxxx>
Date: Thu, 22 Aug 2013 10:55:12 +0000
Subject: [PATCH 21/21] Remove 'TorDNSEL.Compat.Exception'.

---
 src/TorDNSEL/Compat/Exception.hs |   26 --------------------------
 1 file changed, 26 deletions(-)
 delete mode 100644 src/TorDNSEL/Compat/Exception.hs

diff --git a/src/TorDNSEL/Compat/Exception.hs b/src/TorDNSEL/Compat/Exception.hs
deleted file mode 100644
index b206513..0000000
--- a/src/TorDNSEL/Compat/Exception.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE CPP #-}
-
------------------------------------------------------------------------------
--- |
--- Module      : TorDNSEL.Compat.Exception
--- Copyright   : (c) tup 2007
--- License     : Public domain (see LICENSE)
---
--- Maintainer  : tup.tuple@xxxxxxxxxxxxxx
--- Stability   : alpha
--- Portability : non-portable (pattern guards, bang patterns, concurrency,
---                             STM, FFI)
---
--- Ensure compatibility between several GHC versions on exception handling.
---
------------------------------------------------------------------------------
-
-module TorDNSEL.Compat.Exception (
-    module Exception
-  ) where
-
-#if __GLASGOW_HASKELL__ == 610
-import Control.OldException as Exception
-#else
-import Control.Exception as Exception
-#endif
-- 
1.7.9.5

Attachment: pgp1wmsTuwDtw.pgp
Description: PGP signature

_______________________________________________
tor-dev mailing list
tor-dev@xxxxxxxxxxxxxxxxxxxx
https://lists.torproject.org/cgi-bin/mailman/listinfo/tor-dev