Warning clean

src/Network/XMPP/Concurrent/Monad.hs

@@ -4,7 +4,6 @@ import           Network.XMPP.Types
 
 import           Control.Concurrent
 import           Control.Concurrent.STM
-import qualified Control.Exception.Lifted as Ex
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Control.Monad.State.Strict
@@ -156,7 +155,7 @@ withConnection a = do
   liftIO . throwTo readerId $ Interrupt wait
   s <- liftIO . atomically $ do
     putTMVar wait ()
-    takeTMVar write
+    _ <- takeTMVar write
     takeTMVar stateRef
   (res, s') <- liftIO $ runStateT a s
   liftIO . atomically $ do

src/Network/XMPP/Concurrent/Threads.hs

@@ -10,18 +10,13 @@ import Control.Concurrent.STM
 import qualified Control.Exception.Lifted as Ex
 import Control.Monad
 import Control.Monad.IO.Class
-import Control.Monad.Trans
 import Control.Monad.Reader
 import Control.Monad.State.Strict
 
 import qualified Data.ByteString as BS
-import Data.Conduit
-import qualified Data.Conduit.List as CL
-import Data.Default (def)
 import Data.IORef
 import qualified Data.Map as Map
 import Data.Maybe
-import qualified Data.Text as Text
 
 import Data.XML.Types
 
@@ -31,7 +26,6 @@ import Network.XMPP.Pickle
 import Network.XMPP.Concurrent.Types
 
 import Text.XML.Stream.Elements
-import qualified Text.XML.Stream.Render as XR
 
 import GHC.IO (unsafeUnmask)
 
@@ -64,7 +58,8 @@ readWorker messageC presenceC handlers stateRef =
                                       _ <- readTChan messageC -- Sic!
                                       return ()
                                    -- this may seem ridiculous, but to prevent
-                                   -- the channel from filling up we immedtiately remove the
+                                   -- the channel from filling up we
+                                   -- immedtiately remove the
                                    -- Stanza we just put in. It will still be
                                    -- available in duplicates.
                     MessageErrorS m -> do writeTChan messageC $ Left m
@@ -88,6 +83,7 @@ readWorker messageC presenceC handlers stateRef =
     allowInterrupt :: IO ()
     allowInterrupt = unsafeUnmask $ return ()
 
+handleIQRequest :: TVar IQHandlers -> IQRequest -> STM ()
 handleIQRequest handlers iq = do
   (byNS, _) <- readTVar handlers
   let iqNS = fromMaybe "" (nameNamespace . elementName $ iqRequestPayload iq)
@@ -97,6 +93,7 @@ handleIQRequest handlers iq = do
         sent <- newTVar False
         writeTChan ch (iq, sent)
 
+handleIQResponse :: TVar IQHandlers -> Either IQError IQResult -> STM ()
 handleIQResponse handlers iq = do
   (byNS, byID) <- readTVar handlers
   case Map.updateLookupWithKey (\_ _ -> Nothing) (iqID iq) byID of
@@ -107,7 +104,7 @@ handleIQResponse handlers iq = do
                            writeTVar handlers (byNS, byID')
     where
       iqID (Left err) = iqErrorID err
-      iqID (Right iq) = iqResultID iq
+      iqID (Right iq') = iqResultID iq'
 
 writeWorker :: TChan Stanza -> TMVar (BS.ByteString -> IO ()) -> IO ()
 writeWorker stCh writeR = forever $ do
@@ -137,14 +134,12 @@ startThreads = do
   writeLock <- liftIO . newTMVarIO =<< gets sConPushBS
   messageC <- liftIO newTChanIO
   presenceC <- liftIO newTChanIO
-  iqC  <- liftIO newTChanIO
   outC <- liftIO  newTChanIO
   handlers <- liftIO $ newTVarIO ( Map.empty, Map.empty)
   eh <- liftIO $ newTVarIO  zeroEventHandlers
   conS <- liftIO . newTMVarIO =<< get
   lw <- liftIO . forkIO $ writeWorker outC writeLock
   cp <- liftIO . forkIO $ connPersist writeLock
-  s <- get
   rd <- liftIO . forkIO $ readWorker messageC presenceC handlers conS
   return (messageC, presenceC, handlers, outC
          , killConnection writeLock [lw, rd, cp]
@@ -170,7 +165,6 @@ runThreaded a = do
             curId <- readTVar idRef
             writeTVar idRef (curId + 1 :: Integer)
             return . read. show $ curId
-    s <- get
     liftIO . putStrLn $ "starting application"
     liftIO $ runReaderT a (Thread workermCh workerpCh mC pC outC hand writeR rdr getId conS eh stopThreads')
 
@@ -181,5 +175,4 @@ connPersist lock = forever $ do
   pushBS <- atomically $ takeTMVar lock
   pushBS " "
   atomically $ putTMVar lock pushBS
---  putStrLn "<space added>"
   threadDelay 30000000

src/Network/XMPP/Concurrent/Types.hs

@@ -26,6 +26,7 @@ data EventHandlers = EventHandlers
                          , connectionClosedHandler :: XMPPThread ()
                          }
 
+zeroEventHandlers :: EventHandlers
 zeroEventHandlers = EventHandlers
                          { sessionEndHandler       = return ()
                          , connectionClosedHandler = return ()

src/Network/XMPP/Monad.hs

@@ -13,7 +13,6 @@ import Control.Monad.State.Strict
 import Data.ByteString as BS
 import Data.Conduit
 import Data.Conduit.Binary as CB
-import Data.Conduit.List as CL
 import Data.Text(Text)
 import Data.XML.Pickle
 import Data.XML.Types
@@ -27,8 +26,6 @@ import System.IO
 
 import Text.XML.Stream.Elements
 import Text.XML.Stream.Parse as XP
-import Text.XML.Stream.Render as XR
-
 
 pushN :: Element -> XMPPConMonad ()
 pushN x = do

src/Network/XMPP/SASL.hs

@@ -78,7 +78,7 @@ xmppStartSASL realm username passwd = do
     Right _ -> return ()
   pushN saslResponse2E
   Element "{urn:ietf:params:xml:ns:xmpp-sasl}success" [] [] <- pullE
-  xmppRestartStream
+  _ <- xmppRestartStream
   return ()
 
 createResponse :: Random.RandomGen g

src/Network/XMPP/Stream.hs

@@ -3,9 +3,6 @@
 
 module Network.XMPP.Stream where
 
-import Control.Applicative((<$>))
-import Control.Exception(throwIO)
-import Control.Monad(unless)
 import Control.Monad.Error
 import Control.Monad.State.Strict
 

src/Network/XMPP/TLS.hs

@@ -9,24 +9,15 @@ import qualified Control.Exception.Lifted as Ex
 import           Control.Monad
 import           Control.Monad.Error
 import           Control.Monad.State.Strict
-import           Control.Monad.Trans
 
-import           Data.Conduit
-import           Data.Conduit.List as CL
 import           Data.Conduit.TLS as TLS
-import           Data.Default
 import           Data.Typeable
 import           Data.XML.Types
 
-import qualified Network.TLS as TLS
-import qualified Network.TLS.Extra as TLS
 import           Network.XMPP.Monad
 import           Network.XMPP.Stream
 import           Network.XMPP.Types
 
-import qualified Text.XML.Stream.Render as XR
-
-
 starttlsE :: Element
 starttlsE =
   Element "{urn:ietf:params:xml:ns:xmpp-tls}starttls" [] []
@@ -41,7 +32,7 @@ exampleParams = TLS.defaultParams
                       , pUseSecureRenegotiation = False -- No renegotiation
                       , pCertificates      = [] -- TODO
                       , pLogging           = TLS.defaultLogging -- TODO
-                      , onCertificatesRecv = \ certificate ->
+                      , onCertificatesRecv = \ _certificate ->
                                              return TLS.CertificateUsageAccept
                       }
 
@@ -68,7 +59,7 @@ xmppStartTLS params = Ex.handle (return . Left . TLSError)
       case answer of
         Element "{urn:ietf:params:xml:ns:xmpp-tls}proceed" [] [] -> return ()
         _ -> throwError $ TLSStreamError StreamXMLError
-      (raw, snk, psh, ctx) <- lift $ TLS.tlsinit params handle
+      (raw, _snk, psh, ctx) <- lift $ TLS.tlsinit params handle
       lift $ modify (\x -> x
                     { sRawSrc = raw
 --                  , sConSrc =  -- Note: this momentarily leaves us in an

src/Network/XMPP/Types.hs

@@ -15,7 +15,7 @@ module Network.XMPP.Types
     ( IQError(..)
     , IQRequest(..)
     , IQRequestType(..)
-    , IQResponse(..)
+    , IQResponse
     , IQResult(..)
     , IdGenerator(..)
     , LangTag (..)
@@ -37,7 +37,7 @@ module Network.XMPP.Types
     , StanzaId(..)
     , StreamError(..)
     , Version(..)
-    , XMPPConMonad(..)
+    , XMPPConMonad
     , XMPPConState(..)
     , XMPPT(..)
     , parseLangTag
@@ -56,7 +56,6 @@ import           Control.Monad.Error
 
 import qualified Data.ByteString as BS
 import           Data.Conduit
-import           Data.List.Split as L
 import           Data.String(IsString(..))
 import           Data.Text (Text)
 import qualified Data.Text as Text
@@ -69,15 +68,6 @@ import           Network.XMPP.JID
 
 import           System.IO
 
-
--- | The string prefix MUST be
-
-data SessionSettings =
-  SessionSettings { ssIdPrefix :: String
-                  , ssIdGenerator :: IdGenerator
-                  , ssStreamLang :: LangTag }
-
-
 -- =============================================================================
 --  STANZA TYPES
 -- =============================================================================
@@ -535,39 +525,14 @@ instance Read SASLError where
     readsPrec _ "mechanism-too-weak"     = [(SASLMechanismTooWeak     , "")]
     readsPrec _ "not-authorized"         = [(SASLNotAuthorized        , "")]
     readsPrec _ "temporary-auth-failure" = [(SASLTemporaryAuthFailure , "")]
+    readsPrec _ _                        = []
 
 -- | Readability type for host name Texts.
 
 -- type HostName = Text -- This is defined in Network as well
 
-
--- | Readability type for port number Integers.
-
-type PortNumber = Integer -- We use N(etwork).PortID (PortNumber) internally
-
-
--- | Readability type for user name Texts.
-
-type UserName = Text
-
-
--- | Readability type for password Texts.
-
-type Password = Text
-
-
--- | Readability type for (Address) resource identifier Texts.
-
-type Resource = Text
-
-
-type StreamID = Text
-
-
 data ServerAddress = ServerAddress N.HostName N.PortNumber deriving (Eq)
 
-type Timeout = Int
-
 data StreamError = StreamError String
                  | StreamWrongVersion Text
                  | StreamXMLError
@@ -640,8 +605,6 @@ instance Read LangTag where
 --           all (\ (a, b) -> map toLower a == map toLower b) $ zip as bs
 --         | otherwise = False
 
-
-
 data ServerFeatures = SF
   { stls  :: Maybe Bool
   , saslMechanisms :: [Text.Text]
@@ -659,6 +622,7 @@ data XMPPConState = XMPPConState
                , sUsername  :: Maybe Text
                , sResource  :: Maybe Text
                , sCloseConnection :: IO ()
+                 -- TODO: add default Language
                }
 
 -- |

src/Tests.hs

@@ -100,7 +100,7 @@ runMain debug number = do
           Right _ -> return ()
           Left e -> error e
       xmppThreadedBind (resourcepart we)
---      startSession
+      startSession
       debug' "session standing"
       sendPresence presenceOnline
       forkXMPP autoAccept