    -- | The plugin-level IRC interface.

    module Lambdabot.Plugin.IRC.IRC (ircPlugin) where

    import Lambdabot.IRC
    import Lambdabot.Logging
    import Lambdabot.Monad
    import Lambdabot.Plugin
    import Lambdabot.Util
    import Lambdabot.Config.IRC

    import Control.Concurrent.Lifted
    import qualified Control.Concurrent.SSem as SSem
    import Control.Exception.Lifted as E (SomeException(..), throwIO, catch)
    import Control.Monad
    import Control.Monad.Trans
    import Control.Monad.State
    import qualified Data.ByteString.Char8 as P
    import Data.List
    import Data.List.Split
    import qualified Data.Map as M
    import Lambdabot.Util.Network (connectTo')
    import Network.Socket (PortNumber)
    import System.IO
    import System.Timeout.Lifted
    import Data.IORef

    data IRCState =
        IRCState {
            IRCState -> Maybe String
    password :: Maybe String
        }

    type IRC = ModuleT IRCState LB

    ircPlugin :: Module IRCState
    ircPlugin :: Module IRCState
    ircPlugin = Module IRCState
    forall st. Module st
    newModule
        { moduleCmds = return
            [ (command "irc-connect")
                { privileged = True
                , help = say "irc-connect tag host portnum nickname userinfo.  connect to an irc server"
                , process = \String
    rest ->
                    case String -> String -> [String]
    forall a. Eq a => [a] -> [a] -> [[a]]
    splitOn String
    " " String
    rest of
                        String
    tag:String
    hostn:String
    portn:String
    nickn:[String]
    uix -> do
                            pn <- Integer -> PortNumber
    forall a. Num a => Integer -> a
    fromInteger (Integer -> PortNumber)
    -> Cmd (ModuleT IRCState LB) Integer
    -> Cmd (ModuleT IRCState LB) PortNumber
    forall a b.
    (a -> b)
    -> Cmd (ModuleT IRCState LB) a -> Cmd (ModuleT IRCState LB) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` String -> Cmd (ModuleT IRCState LB) Integer
    forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
    readM String
    portn
                            lift (online tag hostn pn nickn (intercalate " " uix))
                        [String]
    _ -> String -> Cmd (ModuleT IRCState LB) ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Not enough parameters!"
                }
            , (command "irc-persist-connect")
                { privileged = True
                , help = say "irc-persist-connect tag host portnum nickname userinfo.  connect to an irc server and reconnect on network failures"
                , process = \String
    rest ->
                    case String -> String -> [String]
    forall a. Eq a => [a] -> [a] -> [[a]]
    splitOn String
    " " String
    rest of
                        String
    tag:String
    hostn:String
    portn:String
    nickn:[String]
    uix -> do
                            pn <- Integer -> PortNumber
    forall a. Num a => Integer -> a
    fromInteger (Integer -> PortNumber)
    -> Cmd (ModuleT IRCState LB) Integer
    -> Cmd (ModuleT IRCState LB) PortNumber
    forall a b.
    (a -> b)
    -> Cmd (ModuleT IRCState LB) a -> Cmd (ModuleT IRCState LB) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` String -> Cmd (ModuleT IRCState LB) Integer
    forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
    readM String
    portn
                            lift (online tag hostn pn nickn (intercalate " " uix))
                            lift $ lift $ modify $ \IRCRWState
    state' -> IRCRWState
    state' { ircPersists = M.insert tag True $ ircPersists state' }
                        [String]
    _ -> String -> Cmd (ModuleT IRCState LB) ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Not enough parameters!"
                }
            , (command "irc-password")
                { privileged = True
                , help = say "irc-password pwd.  set password for next irc-connect command"
                , process = \String
    rest ->
                    case String -> String -> [String]
    forall a. Eq a => [a] -> [a] -> [[a]]
    splitOn String
    " " String
    rest of
                        String
    pwd:[String]
    _ -> do
                            (LBState (Cmd (ModuleT IRCState LB))
     -> LBState (Cmd (ModuleT IRCState LB)))
    -> Cmd (ModuleT IRCState LB) ()
    forall (m :: * -> *).
    MonadLBState m =>
    (LBState m -> LBState m) -> m ()
    modifyMS (\LBState (Cmd (ModuleT IRCState LB))
    ms -> LBState (Cmd (ModuleT IRCState LB))
    ms{ password = Just pwd })
                        [String]
    _ -> String -> Cmd (ModuleT IRCState LB) ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Not enough parameters!"
                }
            ]
        , moduleDefState = return $ IRCState{ password = Nothing }
        }

    ----------------------------------------------------------------------
    -- Encoding and decoding of messages

    -- | 'encodeMessage' takes a message and converts it to a function.
    --   giving this function a string will attach the string to the message
    --   and output a string containing IRC protocol commands ready for writing
    --   on the outgoing stream socket.
    encodeMessage :: IrcMessage -> String -> String
    encodeMessage :: IrcMessage -> String -> String
    encodeMessage IrcMessage
    msg
      = String -> String -> String
    encodePrefix (IrcMessage -> String
    ircMsgPrefix IrcMessage
    msg) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    encodeCommand (IrcMessage -> String
    ircMsgCommand IrcMessage
    msg)
              (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String -> String
    encodeParams (IrcMessage -> [String]
    ircMsgParams IrcMessage
    msg)
      where
        encodePrefix :: String -> String -> String
    encodePrefix [] = String -> String
    forall a. a -> a
    id
        encodePrefix String
    prefix = Char -> String -> String
    showChar Char
    ':' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString' String
    prefix (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> String
    showChar Char
    ' '

        encodeCommand :: String -> String -> String
    encodeCommand String
    cmd = String -> String -> String
    showString String
    cmd

        encodeParams :: [String] -> String -> String
    encodeParams [] = String -> String
    forall a. a -> a
    id
        encodeParams (String
    p:[String]
    ps) = Char -> String -> String
    showChar Char
    ' ' (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString' String
    p (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String -> String
    encodeParams [String]
    ps

        -- IrcMessage is supposed to contain strings that are lists of bytes, but
        -- if a plugin messes up the encoding then we may end up with arbitrary
        -- Unicode codepoints. This is dangerous (\x10a would produce a newline!),
        -- so we sanitize the message here.
        showString' :: String -> String -> String
    showString' = String -> String -> String
    showString (String -> String -> String)
    -> (String -> String) -> String -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (\Char
    c -> if Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    > Char
    '\xFF' then Char
    '?' else Char
    c)

    -- | 'decodeMessage' Takes an input line from the IRC protocol stream
    --   and decodes it into a message.  TODO: this has too many parameters.
    decodeMessage :: String -> String -> String -> IrcMessage
    decodeMessage :: String -> String -> String -> IrcMessage
    decodeMessage String
    svr String
    lbn String
    line =
        let (String
    prefix, String
    rest1) = (String -> String -> (String, String))
    -> String -> (String, String)
    forall {t}. (String -> String -> t) -> String -> t
    decodePrefix (,) String
    line
            (String
    cmd, String
    rest2)    = (String -> String -> (String, String))
    -> String -> (String, String)
    forall {t}. (String -> String -> t) -> String -> t
    decodeCmd (,) String
    rest1
            params :: [String]
    params          = String -> [String]
    decodeParams String
    rest2
        in IrcMessage { ircMsgServer :: String
    ircMsgServer = String
    svr, ircMsgLBName :: String
    ircMsgLBName = String
    lbn, ircMsgPrefix :: String
    ircMsgPrefix = String
    prefix,
                        ircMsgCommand :: String
    ircMsgCommand = String
    cmd, ircMsgParams :: [String]
    ircMsgParams = [String]
    params }
      where
        decodePrefix :: (String -> String -> t) -> String -> t
    decodePrefix String -> String -> t
    k (Char
    ':':String
    cs) = (String -> String -> t) -> String -> t
    forall {t}. (String -> String -> t) -> String -> t
    decodePrefix' String -> String -> t
    k String
    cs
          where decodePrefix' :: (String -> String -> t) -> String -> t
    decodePrefix' String -> String -> t
    j String
    ""       = String -> String -> t
    j String
    "" String
    ""
                decodePrefix' String -> String -> t
    j (Char
    ' ':String
    ds) = String -> String -> t
    j String
    "" String
    ds
                decodePrefix' String -> String -> t
    j (Char
    c:String
    ds)   = (String -> String -> t) -> String -> t
    decodePrefix' (String -> String -> t
    j (String -> String -> t)
    -> (String -> String) -> String -> String -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :)) String
    ds

        decodePrefix String -> String -> t
    k String
    cs = String -> String -> t
    k String
    "" String
    cs

        decodeCmd :: (String -> String -> t) -> String -> t
    decodeCmd String -> String -> t
    k []       = String -> String -> t
    k String
    "" String
    ""
        decodeCmd String -> String -> t
    k (Char
    ' ':String
    cs) = String -> String -> t
    k String
    "" String
    cs
        decodeCmd String -> String -> t
    k (Char
    c:String
    cs)   = (String -> String -> t) -> String -> t
    decodeCmd (String -> String -> t
    k (String -> String -> t)
    -> (String -> String) -> String -> String -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :)) String
    cs

        decodeParams :: String -> [String]
        decodeParams :: String -> [String]
    decodeParams String
    xs = String -> [String] -> String -> [String]
    decodeParams' [] [] String
    xs
          where
            decodeParams' :: String -> [String] -> String -> [String]
    decodeParams' String
    param [String]
    params []
              | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    param = [String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    params
              | Bool
    otherwise  = [String] -> [String]
    forall a. [a] -> [a]
    reverse (String -> String
    forall a. [a] -> [a]
    reverse String
    param String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    params)
            decodeParams' String
    param [String]
    params (Char
    ' ' : String
    cs)
              | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    param = String -> [String] -> String -> [String]
    decodeParams' [] [String]
    params String
    cs
              | Bool
    otherwise  = String -> [String] -> String -> [String]
    decodeParams' [] (String -> String
    forall a. [a] -> [a]
    reverse String
    param String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    params) String
    cs
            decodeParams' String
    param [String]
    params rest :: String
    rest@(c :: Char
    c@Char
    ':' : String
    cs)
              | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    param = [String] -> [String]
    forall a. [a] -> [a]
    reverse (String
    rest String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    params)
              | Bool
    otherwise  = String -> [String] -> String -> [String]
    decodeParams' (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    param) [String]
    params String
    cs
            decodeParams' String
    param [String]
    params (Char
    c:String
    cs) = String -> [String] -> String -> [String]
    decodeParams' (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    param) [String]
    params String
    cs

    ircSignOn :: String -> Nick -> Maybe String -> String -> LB ()
    ircSignOn :: String -> Nick -> Maybe String -> String -> LB ()
    ircSignOn String
    svr Nick
    nickn Maybe String
    pwd String
    ircname = do
        LB () -> (String -> LB ()) -> Maybe String -> LB ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> LB ()
    forall a. a -> LB a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) (\String
    pwd' -> IrcMessage -> LB ()
    send (IrcMessage -> LB ()) -> IrcMessage -> LB ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> IrcMessage
    pass (Nick -> String
    nTag Nick
    nickn) String
    pwd') Maybe String
    pwd
        IrcMessage -> LB ()
    send (IrcMessage -> LB ()) -> IrcMessage -> LB ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String -> IrcMessage
    user (Nick -> String
    nTag Nick
    nickn) (Nick -> String
    nName Nick
    nickn) String
    svr String
    ircname
        IrcMessage -> LB ()
    send (IrcMessage -> LB ()) -> IrcMessage -> LB ()
    forall a b. (a -> b) -> a -> b
    $ Nick -> IrcMessage
    setNick Nick
    nickn

    ------------------------------------------------------------------------
    --
    -- Lambdabot is mostly synchronous.  We have a main loop, which reads
    -- messages and forks threads to execute commands (which write responses).
    -- OR
    -- We have a main loop which reads offline commands, and synchronously
    -- interprets them.

    online :: String -> String -> PortNumber -> String -> String -> IRC ()
    online :: String
    -> String
    -> PortNumber
    -> String
    -> String
    -> ModuleT IRCState LB ()
    online String
    tag String
    hostn PortNumber
    portnum String
    nickn String
    ui = do
        pwd <- IRCState -> Maybe String
    password (IRCState -> Maybe String)
    -> ModuleT IRCState LB IRCState
    -> ModuleT IRCState LB (Maybe String)
    forall a b.
    (a -> b) -> ModuleT IRCState LB a -> ModuleT IRCState LB b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ModuleT IRCState LB (LBState (ModuleT IRCState LB))
    ModuleT IRCState LB IRCState
    forall (m :: * -> *). MonadLBState m => m (LBState m)
    readMS
        modifyMS $ \LBState (ModuleT IRCState LB)
    ms -> LBState (ModuleT IRCState LB)
    ms{ password = Nothing }

        let online' = do
            sock    <- IO Handle -> ModuleT IRCState LB Handle
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Handle -> ModuleT IRCState LB Handle)
    -> IO Handle -> ModuleT IRCState LB Handle
    forall a b. (a -> b) -> a -> b
    $ String -> PortNumber -> IO Handle
    connectTo' String
    hostn PortNumber
    portnum
            io $ hSetBuffering sock NoBuffering
            -- Implements flood control: RFC 2813, section 5.8
            sem1    <- io $ SSem.new 0
            sem2    <- io $ SSem.new 4 -- one extra token stays in the MVar
            sendmv  <- io newEmptyMVar
            pongref <- io $ newIORef False
            io . void . fork . forever $ do
                SSem.wait sem1
                threadDelay 2000000
                SSem.signal sem2
            io . void . fork . forever $ do
                SSem.wait sem2
                putMVar sendmv ()
                SSem.signal sem1
            fin <- io $ SSem.new 0
            E.catch
                (registerServer tag (io . sendMsg sock sendmv fin))
                (\err :: SomeException
    err@SomeException{} -> IO () -> ModuleT IRCState LB ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Handle -> IO ()
    hClose Handle
    sock) ModuleT IRCState LB ()
    -> ModuleT IRCState LB () -> ModuleT IRCState LB ()
    forall a b.
    ModuleT IRCState LB a
    -> ModuleT IRCState LB b -> ModuleT IRCState LB b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> SomeException -> ModuleT IRCState LB ()
    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
    E.throwIO SomeException
    err)
            lb $ ircSignOn hostn (Nick tag nickn) pwd ui
            ready <- io $ SSem.new 0
            lb $ void $ forkFinally
                (E.catch
                    (readerLoop tag nickn pongref sock ready)
                    (\e :: SomeException
    e@SomeException{} -> String -> LB ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    errorM (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)))
                (const $ io $ SSem.signal fin)
            void $ forkFinally
                (E.catch
                    (pingPongDelay >> pingPongLoop tag hostn pongref sock)
                    (\e :: SomeException
    e@SomeException{} -> String -> ModuleT IRCState LB ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    errorM (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)))
                (const $ io $ SSem.signal fin)
            void $ fork $ do
                io $ SSem.wait fin
                unregisterServer tag
                io $ hClose sock
                io $ SSem.signal ready
                delay <- getConfig reconnectDelay
                let retry = do
                    continue <- LB Bool -> ModuleT IRCState LB Bool
    forall (m :: * -> *) a. Monad m => m a -> ModuleT IRCState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (LB Bool -> ModuleT IRCState LB Bool)
    -> LB Bool -> ModuleT IRCState LB Bool
    forall a b. (a -> b) -> a -> b
    $ (IRCRWState -> Bool) -> LB Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((IRCRWState -> Bool) -> LB Bool)
    -> (IRCRWState -> Bool) -> LB Bool
    forall a b. (a -> b) -> a -> b
    $ \IRCRWState
    st -> (String -> Map String Bool -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    M.member String
    tag (Map String Bool -> Bool) -> Map String Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ IRCRWState -> Map String Bool
    ircPersists IRCRWState
    st) Bool -> Bool -> Bool
    && Bool -> Bool
    not (String -> Map String (DSum ModuleID ServerRef) -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    M.member String
    tag (Map String (DSum ModuleID ServerRef) -> Bool)
    -> Map String (DSum ModuleID ServerRef) -> Bool
    forall a b. (a -> b) -> a -> b
    $ IRCRWState -> Map String (DSum ModuleID ServerRef)
    ircServerMap IRCRWState
    st)
                    if continue
                        then do
                            E.catch online'
                                (\e :: SomeException
    e@SomeException{} -> do
                                    String -> ModuleT IRCState LB ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    errorM (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)
                                    IO () -> ModuleT IRCState LB ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> ModuleT IRCState LB ())
    -> IO () -> ModuleT IRCState LB ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    forall (m :: * -> *). MonadBase IO m => Int -> m ()
    threadDelay Int
    delay
                                    ModuleT IRCState LB ()
    retry
                                )
                        else do
                            chans <- lift $ gets ircChannels
                            forM_ (M.keys chans) $ \ChanName
    chan ->
                                Bool -> ModuleT IRCState LB () -> ModuleT IRCState LB ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Nick -> String
    nTag (ChanName -> Nick
    getCN ChanName
    chan) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    tag) (ModuleT IRCState LB () -> ModuleT IRCState LB ())
    -> ModuleT IRCState LB () -> ModuleT IRCState LB ()
    forall a b. (a -> b) -> a -> b
    $
                                LB () -> ModuleT IRCState LB ()
    forall (m :: * -> *) a. Monad m => m a -> ModuleT IRCState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (LB () -> ModuleT IRCState LB ())
    -> LB () -> ModuleT IRCState LB ()
    forall a b. (a -> b) -> a -> b
    $ (IRCRWState -> IRCRWState) -> LB ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((IRCRWState -> IRCRWState) -> LB ())
    -> (IRCRWState -> IRCRWState) -> LB ()
    forall a b. (a -> b) -> a -> b
    $ \IRCRWState
    state' -> IRCRWState
    state' { ircChannels = M.delete chan $ ircChannels state' }

                retry
            watch <- io $ fork $ do
                threadDelay 10000000
                errorM "Welcome timeout!"
                SSem.signal fin
            io $ SSem.wait ready
            killThread watch

        online'

    pingPongDelay :: IRC ()
    pingPongDelay :: ModuleT IRCState LB ()
    pingPongDelay = IO () -> ModuleT IRCState LB ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> ModuleT IRCState LB ())
    -> IO () -> ModuleT IRCState LB ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    forall (m :: * -> *). MonadBase IO m => Int -> m ()
    threadDelay Int
    120000000

    pingPongLoop :: String -> String -> IORef Bool -> Handle -> IRC ()
    pingPongLoop :: String -> String -> IORef Bool -> Handle -> ModuleT IRCState LB ()
    pingPongLoop String
    tag String
    hostn IORef Bool
    pongref Handle
    sock = do
        IO () -> ModuleT IRCState LB ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> ModuleT IRCState LB ())
    -> IO () -> ModuleT IRCState LB ()
    forall a b. (a -> b) -> a -> b
    $ IORef Bool -> Bool -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Bool
    pongref Bool
    False
        IO () -> ModuleT IRCState LB ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> ModuleT IRCState LB ())
    -> IO () -> ModuleT IRCState LB ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> ByteString -> IO ()
    P.hPut Handle
    sock (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    P.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "PING " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    hostn String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\r\n"
        ModuleT IRCState LB ()
    pingPongDelay
        pong <- IO Bool -> ModuleT IRCState LB Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Bool -> ModuleT IRCState LB Bool)
    -> IO Bool -> ModuleT IRCState LB Bool
    forall a b. (a -> b) -> a -> b
    $ IORef Bool -> IO Bool
    forall a. IORef a -> IO a
    readIORef IORef Bool
    pongref
        if pong
            then pingPongLoop tag hostn pongref sock
            else errorM "Ping timeout."

    readerLoop :: String -> String -> IORef Bool -> Handle -> SSem.SSem -> LB ()
    readerLoop :: String -> String -> IORef Bool -> Handle -> SSem -> LB ()
    readerLoop String
    tag String
    nickn IORef Bool
    pongref Handle
    sock SSem
    ready = LB () -> LB ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (LB () -> LB ()) -> LB () -> LB ()
    forall a b. (a -> b) -> a -> b
    $ do
        line <- IO String -> LB String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO String -> LB String) -> IO String -> LB String
    forall a b. (a -> b) -> a -> b
    $ Handle -> IO String
    hGetLine Handle
    sock
        let line' = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` String
    "\r\n") String
    line
        if "PING " `isPrefixOf` line'
            then io $ P.hPut sock $ P.pack $ "PONG " ++ drop 5 line' ++ "\r\n"
            else void . fork . void . timeout 15000000 $ do
                let msg = String -> String -> String -> IrcMessage
    decodeMessage String
    tag String
    nickn String
    line'
                if ircMsgCommand msg == "PONG"
                    then io $ writeIORef pongref True
                    else do
                        when (ircMsgCommand msg == "001") $ io $ SSem.signal ready
                        received msg

    sendMsg :: Handle -> MVar () -> SSem.SSem -> IrcMessage -> IO ()
    sendMsg :: Handle -> MVar () -> SSem -> IrcMessage -> IO ()
    sendMsg Handle
    sock MVar ()
    mv SSem
    fin IrcMessage
    msg =
        IO () -> (IOError -> IO ()) -> IO ()
    forall (m :: * -> *) e a.
    (MonadBaseControl IO m, Exception e) =>
    m a -> (e -> m a) -> m a
    E.catch (do MVar () -> IO ()
    forall (m :: * -> *) a. MonadBase IO m => MVar a -> m a
    takeMVar MVar ()
    mv
                    Handle -> ByteString -> IO ()
    P.hPut Handle
    sock (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    P.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ IrcMessage -> String -> String
    encodeMessage IrcMessage
    msg String
    "\r\n")
                (\IOError
    err -> do String -> IO ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    errorM (IOError -> String
    forall a. Show a => a -> String
    show (IOError
    err :: IOError))
                            SSem -> IO ()
    SSem.signal SSem
    fin)