glirc 2.19 → 2.20

raw patch · 15 files changed

+188/−162 lines, 15 filesdep +HsOpenSSLdep +hookupdep −connectiondep −tlsdep −x509dep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies added: HsOpenSSL, hookup

Dependencies removed: connection, tls, x509, x509-store, x509-system

Dependency ranges changed: lens

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• glirc.cabal +3/−6
• src/Client/Authentication/Ecdsa.hs +21/−3
• src/Client/CApi/Types.hsc +1/−1
• src/Client/Commands.hs +2/−0
• src/Client/Commands/WordCompletion.hs +12/−0
• src/Client/Configuration.hs +6/−3
• src/Client/Configuration/ServerSettings.hs +6/−3
• src/Client/EventLoop.hs +3/−3
• src/Client/EventLoop/Errors.hs +22/−39
• src/Client/Image/StatusLine.hs +19/−0
• src/Client/Log.hs +13/−4
• src/Client/Network/Async.hs +12/−12
• src/Client/Network/Connect.hs +28/−73
• src/Client/State.hs +36/−15

@@ -1,5 +1,9 @@ # Revision history for glirc2 +## 2.20++* Move from `tls` to `HsOpenSSL` support via the new `hookup` package+ ## 2.19  * Smarter text box tracks "scroll" position independently from cursor

@@ -1,5 +1,5 @@ name:                glirc-version:             2.19+version:             2.20 synopsis:            Console IRC client description:         Console IRC client                      .@@ -123,13 +123,13 @@                        attoparsec           >=0.13   && <0.14,                        bytestring           >=0.10.8 && <0.11,                        config-value         >=0.5    && <0.6,-                       connection           >=0.2.6  && <0.3,                        containers           >=0.5.7  && <0.6,                        data-default-class   >=0.1.2  && <0.2,                        directory            >=1.2.6  && <1.3,                        filepath             >=1.4.1  && <1.5,                        gitrev               >=1.2    && <1.3,                        hashable             >=1.2.4  && <1.3,+                       HsOpenSSL            >=0.11   && <0.12,                        irc-core             >=2.2    && <2.3,                        lens                 >=4.14   && <4.15,                        kan-extensions       >=5.0    && <5.1,@@ -142,15 +142,12 @@                        stm                  >=2.4    && <2.5,                        text                 >=1.2.2  && <1.3,                        time                 >=1.6    && <1.7,-                       tls                  >=1.3.8  && <1.4,                        transformers         >=0.5.2  && <0.6,                        unix                 >=2.7    && <2.8,                        unordered-containers >=0.2.7  && <0.3,                        vector               >=0.11   && <0.12,                        vty                  >=5.10   && <5.12,-                       x509                 >=1.6.3  && <1.7,-                       x509-store           >=1.6.1  && <1.7,-                       x509-system          >=1.6.3  && <1.7+                       hookup               >=0.1    && <0.2    if flag(ExportCApi)     cpp-options: -DEXPORT_GLIRC_CAPI

@@ -29,16 +29,34 @@ import           System.IO.Error (IOError) import           System.Process (readProcess) ++-- | Identifier for SASL ECDSA challenge response authentication+-- using curve NIST256P.+--+-- @ECDSA-NIST256P-CHALLENGE@ authenticationMode :: Text authenticationMode = "ECDSA-NIST256P-CHALLENGE" -encodeUsername :: Text -> Text++-- | Encode a username as specified in this authentication mode.+encodeUsername ::+  Text {- ^ username                 -} ->+  Text {- ^ base-64 encoded username -} encodeUsername = Text.decodeUtf8 . convertToBase Base64 . Text.encodeUtf8 -computeResponse :: FilePath -> Text -> IO (Either String Text)++-- | Compute the response for a given challenge using the @ecdsatool@+-- executable which must be available in @PATH@.+computeResponse ::+  FilePath                {- ^ private key file                 -} ->+  Text                    {- ^ challenge string                 -} ->+  IO (Either String Text) {- ^ error message or response string -} computeResponse privateKeyFile challenge =   do path <- resolveConfigurationPath privateKeyFile-     res  <- try (readProcess "ecdsatool" ["sign", path, Text.unpack challenge] "")+     res  <- try $ readProcess+                     "ecdsatool"+                     ["sign", path, Text.unpack challenge]+                     "" -- stdin      return $! case words <$> res of                  Right [resp] -> Right $! Text.pack resp                  Right _      -> Left "bad sasl ecdsa response message"

@@ -76,7 +76,7 @@   Ptr () {- ^ extension state -} ->   IO () --- | Type of @typedef enum process_result process_message(void *glirc, void *S, const struct glirc_message *);@+-- | @typedef enum process_result process_message(void *glirc, void *S, const struct glirc_message *);@ type ProcessMessage =   Ptr ()     {- ^ api token       -} ->   Ptr ()     {- ^ extention state -} ->

@@ -276,6 +276,8 @@ commands :: Recognizer Command commands = fromCommands (expandAliases commandsList) ++-- | Raw list of commands in the order used for @/help@ commandsList :: [Command] commandsList =   --

@@ -35,12 +35,18 @@   { wcmStartPrefix, wcmStartSuffix, wcmMiddlePrefix, wcmMiddleSuffix :: String }   deriving Show ++-- | Word completion without adding any prefix or suffix plainWordCompleteMode :: WordCompletionMode plainWordCompleteMode = WordCompletionMode "" "" "" "" ++-- | Word completion adding a ": " suffix at the beginning of lines defaultNickWordCompleteMode :: WordCompletionMode defaultNickWordCompleteMode = WordCompletionMode "" ": " "" "" ++-- | Word completion using a "@" prefix intended slackNickWordCompleteMode :: WordCompletionMode slackNickWordCompleteMode = WordCompletionMode "@" " " "@" "" @@ -87,6 +93,10 @@              | otherwise               = mpfx ++ str ++ msfx     in over Edit.content (Edit.insertString str1) box1 ++-- | Find the word preceeding the cursor skipping over any+-- characters that can be found in the prefix and suffix for+-- the current completion mode. currentWord :: WordCompletionMode -> Edit.EditBox -> String currentWord (WordCompletionMode spfx ssfx mpfx msfx) box   = dropWhile (`elem`pfx)@@ -124,6 +134,8 @@   toString = Text.unpack  +-- | Find the next entry in a list of possible choices using an alphabetical+-- ordering. tabSearch ::   Prefix a =>   Bool {- ^ reversed        -} ->

@@ -270,7 +270,8 @@     "tls"                 -> setFieldWith   ssTls           parseUseTls     "tls-client-cert"     -> setFieldWithMb ssTlsClientCert parseString     "tls-client-key"      -> setFieldWithMb ssTlsClientKey  parseString-    "server-certificates" -> setFieldWith   ssServerCerts   (parseList parseString)+    "tls-server-cert"     -> setFieldWithMb ssTlsServerCert parseString+    "tls-ciphers"         -> setFieldWith   ssTlsCiphers    parseString     "connect-cmds"        -> setFieldWith   ssConnectCmds   (parseList parseMacroCommand)     "socks-host"          -> setFieldWithMb ssSocksHost     parseString     "socks-port"          -> setFieldWith   ssSocksPort     parseNum@@ -293,8 +294,10 @@          return $! set l x ss      setFieldWithMb l p =-      do x <- p v-         return $! set l (Just x) ss+      do x <- case v of+                Atom "clear" -> return Nothing+                _            -> Just <$> p v+         return $! set l x ss  parseNicks :: Value -> ConfigParser (NonEmpty Text) parseNicks (Text nick) = return (nick NonEmpty.:| [])

@@ -31,10 +31,11 @@   , ssTls   , ssTlsClientCert   , ssTlsClientKey+  , ssTlsServerCert+  , ssTlsCiphers   , ssConnectCmds   , ssSocksHost   , ssSocksPort-  , ssServerCerts   , ssChanservChannels   , ssFloodPenalty   , ssFloodThreshold@@ -80,10 +81,11 @@   , _ssTls              :: !UseTls -- ^ use TLS to connect   , _ssTlsClientCert    :: !(Maybe FilePath) -- ^ path to client TLS certificate   , _ssTlsClientKey     :: !(Maybe FilePath) -- ^ path to client TLS key+  , _ssTlsServerCert    :: !(Maybe FilePath) -- ^ additional CA certificates for validating server+  , _ssTlsCiphers       :: String            -- ^ OpenSSL cipher suite   , _ssConnectCmds      :: ![[ExpansionChunk]] -- ^ commands to execute upon successful connection   , _ssSocksHost        :: !(Maybe HostName) -- ^ hostname of SOCKS proxy   , _ssSocksPort        :: !PortNumber -- ^ port of SOCKS proxy-  , _ssServerCerts      :: ![FilePath] -- ^ additional CA certificates for validating server   , _ssChanservChannels :: ![Identifier] -- ^ Channels with chanserv permissions   , _ssFloodPenalty     :: !Rational -- ^ Flood limiter penalty (seconds)   , _ssFloodThreshold   :: !Rational -- ^ Flood limited threshold (seconds)@@ -126,10 +128,11 @@        , _ssTls           = UseInsecure        , _ssTlsClientCert = Nothing        , _ssTlsClientKey  = Nothing+       , _ssTlsServerCert = Nothing+       , _ssTlsCiphers    = "HIGH"        , _ssConnectCmds   = []        , _ssSocksHost     = Nothing        , _ssSocksPort     = 1080-       , _ssServerCerts   = []        , _ssChanservChannels = []        , _ssFloodPenalty     = 2 -- RFC 1459 defaults        , _ssFloodThreshold   = 10

@@ -54,7 +54,7 @@ import           Irc.Message import           Irc.RawIrcMsg import           LensUtils-import           Network.Connection+import           Hookup   -- | Sum of the three possible event types the event loop handles@@ -203,8 +203,8 @@     shouldReconnect =       case view csPingStatus cs of         PingConnecting n _ | n == 0 || n > reconnectAttempts          -> False-        _ | Just HostNotResolved{}   <-              fromException ex -> True-          | Just HostCannotConnect{} <-              fromException ex -> True+        _ | Just ConnectionFailure{}  <-             fromException ex -> True+          | Just HostnameResolutionFailure{} <-      fromException ex -> True           | Just PingTimeout         <-              fromException ex -> True           | Just ResourceVanished    <- ioe_type <$> fromException ex -> True           | Just NoSuchThing         <- ioe_type <$> fromException ex -> True

@@ -16,9 +16,9 @@  import           Control.Exception import           Data.List.NonEmpty (NonEmpty(..))-import           Network.Connection-import           Network.TLS import           Network.Socks5+import           OpenSSL.Session+import           Hookup  -- | Compute the message message text to be used for a connection error exceptionToLines ::@@ -36,17 +36,14 @@   NonEmpty String {- ^ client lines  -} exceptionToLines' ex -  -- TLS package errors-  | Just tls <- fromException ex = explainTLSException tls-   -- connection package errors-  | Just (HostNotResolved str) <- fromException ex =-      ("Host not resolved: " ++ str) :| []--  | Just (HostCannotConnect str exs) <- fromException ex =-      ("Host cannot connect: " ++ str) :| map explainIOError exs+  | Just err  <- fromException ex = explainHookupError err -  | Just LineTooLong <- fromException ex = "Server IRC message too long" :| []+  -- HsOpenSSL errors+  | Just err <- fromException ex :: Maybe ConnectionAbruptlyTerminated =+     "Connection abruptly terminated" :| []+  | Just (ProtocolError e) <- fromException ex =+     ("TLS protocol error: " ++ e) :| []    -- socks package errors   | Just err <- fromException ex = explainSocksError err :| []@@ -61,35 +58,21 @@ explainIOError :: IOError -> String explainIOError ioe = "IO error: " ++ displayException ioe -explainTLSException :: TLSException -> NonEmpty String-explainTLSException ex =-  case ex of-    ConnectionNotEstablished ->-      "Attempt to use connection out of order" :| []-    Terminated _ _ tlsError ->-        "Connection closed due to early-termination in TLS layer"-      :| explainTLSError tlsError-    HandshakeFailed (Error_Packet_Parsing str) ->-        "Connection closed due to handshake failure in TLS layer" :|-      [ "Packet parse error: " ++ str-      , "Please verify you're using a TLS enabled port"-      ]-    HandshakeFailed tlsError ->-        "Connection closed due to handshake failure in TLS layer"-      :| explainTLSError tlsError+explainHookupError :: ConnectionFailure -> NonEmpty String+explainHookupError e =+  case e of+    HostnameResolutionFailure ioe ->+      ("Host not resolved: " ++ displayException ioe) :| [] -explainTLSError :: TLSError -> [String]-explainTLSError ex =-  case ex of-    Error_Misc str                 -> ["Miscellaneous error: " ++ str]-    Error_Protocol (str, _, _desc) -> ["Protocol error: "      ++ str]-    Error_Certificate str          -> ["Certificate error: "   ++ str]-    Error_HandshakePolicy str      -> ["Handshake policy: "    ++ str]-    Error_EOF                      -> ["Unexpected end of connection"]-    Error_Packet str               -> ["Packet error: "        ++ str]-    Error_Packet_unexpected msg expect -> ("Packet unexpected: " ++ msg)-                                        : [ expect | not (null expect) ]-    Error_Packet_Parsing str       -> ["Packet parse error: " ++ str]+    ConnectionFailure exs ->+      "Connect failed" :| map explainIOError exs++    LineTooLong ->+      "IRC message too long" :| []++    LineTruncated ->+      "IRC message incomplete" :| []+  explainSocksError :: SocksError -> String explainSocksError ex =

@@ -50,6 +50,9 @@       , latencyImage st       ] ++-- | The minor status line is used when rendering the @/splits@ and+-- @/mentions@ views to show the associated window name. minorStatusLineImage :: Focus -> ClientState -> Image minorStatusLineImage focus st =   content <|> charFill defAttr '─' fillSize 1@@ -58,6 +61,7 @@     fillSize = max 0 (view clientWidth st - imageWidth content)  +-- | Indicate when the client is scrolling and old messages are being shown. scrollImage :: ClientState -> Image scrollImage st   | 0 == view clientScroll st = emptyImage@@ -66,6 +70,9 @@     pal  = clientPalette st     attr = view palLabel pal ++-- | Indicate when the client is potentially showing a subset of the+-- available chat messages. filterImage :: ClientState -> Image filterImage st =   case clientActiveRegex st of@@ -75,6 +82,10 @@     pal  = clientPalette st     attr = view palLabel pal ++-- | Indicate the current connection health. This will either indicate+-- that the connection is being established or that a ping has been+-- sent or long the previous ping round-trip was. latencyImage :: ClientState -> Image latencyImage st   | Just network <- views clientFocus focusNetwork st@@ -95,9 +106,14 @@   where     pal = clientPalette st ++-- | Wrap some text in parentheses to make it suitable for inclusion in the+-- status line. infoBubble :: Image -> Image infoBubble img = string defAttr "─(" <|> img <|> string defAttr ")" ++-- | Indicate that the client is in the /detailed/ view. detailImage :: ClientState -> Image detailImage st   | view clientDetailView st = infoBubble (string attr "detail")@@ -106,6 +122,9 @@     pal  = clientPalette st     attr = view palLabel pal ++-- | Indicate that the client isn't showing the metadata lines in /normal/+-- view. nometaImage :: ClientState -> Image nometaImage st   | view clientShowMetadata st = emptyImage

@@ -31,13 +31,17 @@ import           System.Directory import           System.FilePath ++-- | Log entry queued in client to be written by the event loop data LogLine = LogLine-  { logBaseDir :: FilePath-  , logDay     :: Day-  , logTarget  :: Text-  , logLine    :: L.Text+  { logBaseDir :: FilePath -- ^ log directory from server settings+  , logDay     :: Day      -- ^ localtime day+  , logTarget  :: Text     -- ^ channel or nickname+  , logLine    :: L.Text   -- ^ formatted log message text   } ++-- | Write the given log entry to the filesystem. writeLogLine ::   LogLine  {- ^ log line -} ->   IO ()@@ -50,9 +54,14 @@      createDirectoryIfMissing recursiveFlag dir'      L.appendFile file (logLine ll) ++-- | Ignore all 'IOErrors' ignoreProblems :: IO () -> IO () ignoreProblems m = () <$ (try m :: IO (Either IOError ())) ++-- | Construct a 'LogLine' for the given 'ClientMessage' when appropriate.+-- Only chat messages result in a log line. renderLogLine ::   ClientMessage {- ^ message       -} ->   FilePath      {- ^ log directory -} ->

@@ -27,7 +27,7 @@   , NetworkId   , NetworkEvent(..)   , createConnection-  , send+  , Client.Network.Async.send    -- * Abort connections   , abortConnection@@ -44,9 +44,10 @@ import           Control.Monad import           Data.ByteString (ByteString) import qualified Data.ByteString as B+import           Data.Foldable import           Data.Time import           Irc.RateLimit-import           Network.Connection+import           Hookup   -- | Identifier used to match connection events to connections.@@ -102,16 +103,15 @@ createConnection ::   Int {- ^ delay in seconds -} ->   NetworkId {- ^ Identifier to be used on incoming events -} ->-  ConnectionContext ->   ServerSettings ->   TQueue NetworkEvent {- Queue for incoming events -} ->   IO NetworkConnection-createConnection delay network cxt settings inQueue =+createConnection delay network settings inQueue =    do outQueue <- atomically newTQueue        supervisor <- async $                       threadDelay (delay * 1000000) >>-                      startConnection network cxt settings inQueue outQueue+                      startConnection network settings inQueue outQueue        -- Having this reporting thread separate from the supervisor ensures       -- that canceling the supervisor with abortConnection doesn't interfere@@ -139,16 +139,15 @@  startConnection ::   NetworkId ->-  ConnectionContext ->   ServerSettings ->   TQueue NetworkEvent ->   TQueue ByteString ->   IO ()-startConnection network cxt settings inQueue outQueue =+startConnection network settings inQueue outQueue =   do rate <- newRateLimit                (view ssFloodPenalty settings)                (view ssFloodThreshold settings)-     withConnection cxt settings $ \h ->+     withConnection settings $ \h ->        do reportNetworkOpen network inQueue           withAsync (sendLoop h outQueue rate) $ \sender ->             withAsync (receiveLoop network h inQueue) $ \receiver ->@@ -169,15 +168,16 @@   forever $     do msg <- atomically (readTQueue outQueue)        tickRateLimit rate-       connectionPut h msg+       Hookup.send h msg  ircMaxMessageLength :: Int ircMaxMessageLength = 512  receiveLoop :: NetworkId -> Connection -> TQueue NetworkEvent -> IO () receiveLoop network h inQueue =-  do msg <- connectionGetLine ircMaxMessageLength h-     unless (B.null msg) $+  do mb <- recvLine h (2*ircMaxMessageLength)+     for_ mb $ \msg ->        do now <- getZonedTime-          atomically (writeTQueue inQueue (NetworkLine network now (B.init msg)))+          atomically $ writeTQueue inQueue+                     $ NetworkLine network now msg           receiveLoop network h inQueue

@@ -20,38 +20,45 @@  import           Client.Configuration import           Client.Configuration.ServerSettings+import           Control.Applicative import           Control.Exception  (bracket) import           Control.Lens import           Control.Monad import           Data.Default.Class (def) import           Data.Monoid        ((<>))-import           Data.X509          (CertificateChain(..))-import           Data.X509.CertificateStore (CertificateStore, makeCertificateStore)-import           Data.X509.File     (readSignedObject, readKeyFile)-import           Network.Connection import           Network.Socket     (PortNumber)-import           Network.TLS-import           Network.TLS.Extra  (ciphersuite_strong)-import           System.X509        (getSystemCertificateStore)+import           Hookup  buildConnectionParams :: ServerSettings -> IO ConnectionParams buildConnectionParams args =-  do useSecure <- case view ssTls args of-                    UseInsecure -> return Nothing-                    _           -> Just <$> buildTlsSettings args+  do let resPath = traverse resolveConfigurationPath -     let proxySettings = view ssSocksHost args <&> \host ->-                           SockSettingsSimple+     tlsParams <- TlsParams+        <$> resPath (view ssTlsClientCert args)+        <*> resPath (view ssTlsClientKey  args <|>+                     view ssTlsClientCert args)+        <*> resPath (view ssTlsServerCert args)+        <*> pure    (view ssTlsCiphers    args)++     let useSecure =+           case view ssTls args of+             UseInsecure    -> Nothing+             UseInsecureTls -> Just (tlsParams True)+             UseTls         -> Just (tlsParams False)++         proxySettings = view ssSocksHost args <&> \host ->+                           SocksParams                              host                              (view ssSocksPort args)       return ConnectionParams-       { connectionHostname  = view ssHostName args-       , connectionPort      = ircPort args-       , connectionUseSecure = useSecure-       , connectionUseSocks  = proxySettings+       { cpHost  = view ssHostName args+       , cpPort  = ircPort args+       , cpTls   = useSecure+       , cpSocks = proxySettings        } + ircPort :: ServerSettings -> PortNumber ircPort args =   case view ssPort args of@@ -61,62 +68,10 @@         UseInsecure -> 6667         _           -> 6697 -buildCertificateStore :: ServerSettings -> IO CertificateStore-buildCertificateStore args =-  do systemStore <- getSystemCertificateStore-     userCerts   <- traverse (readSignedObject <=< resolveConfigurationPath)-                             (view ssServerCerts args)-     let userStore = makeCertificateStore (concat userCerts)-     return (userStore <> systemStore) -buildTlsSettings :: ServerSettings -> IO TLSSettings-buildTlsSettings args =-  do store <- buildCertificateStore args--     let noValidation =-           ValidationCache-             (\_ _ _ -> return ValidationCachePass)-             (\_ _ _ -> return ())--     return $ TLSSettings ClientParams-       { clientWantSessionResume    = Nothing-       , clientUseMaxFragmentLength = Nothing-       , clientServerIdentification =-           error "buildTlsSettings: field initialized by connectTo"-       , clientUseServerNameIndication = False-       , clientShared = def-           { sharedCAStore = store-           , sharedValidationCache =-               case view ssTls args of-                 UseInsecureTls -> noValidation-                 _              -> def-           }-       , clientHooks = def-           { onCertificateRequest = \_ -> loadClientCredentials args }-       , clientSupported = def-           { supportedCiphers = ciphersuite_strong }-       , clientDebug = def-       }--loadClientCredentials :: ServerSettings -> IO (Maybe (CertificateChain, PrivKey))-loadClientCredentials args =-  case view ssTlsClientCert args of-    Nothing       -> return Nothing-    Just certPath ->-      do certPath' <- resolveConfigurationPath certPath-         cert      <- readSignedObject certPath'--         keyPath   <- case view ssTlsClientKey args of-                        Nothing      -> return certPath'-                        Just keyPath -> resolveConfigurationPath keyPath-         keys  <- readKeyFile keyPath-         case keys of-           [key] -> return (Just (CertificateChain cert, key))-           []    -> fail "No private keys found"-           _     -> fail "Too many private keys found"---- | Create a new 'Connection' which will be closed when the continuation finishes.-withConnection :: ConnectionContext -> ServerSettings -> (Connection -> IO a) -> IO a-withConnection cxt settings k =+-- | Create a new 'Connection' which will be closed when the continuation+-- finishes.+withConnection :: ServerSettings -> (Connection -> IO a) -> IO a+withConnection settings k =   do params <- buildConnectionParams settings-     bracket (connectTo cxt params) connectionClose k+     bracket (connect params) close k

@@ -26,7 +26,6 @@   , clientFocus   , clientPrevFocus   , clientExtraFocus-  , clientConnectionContext   , clientConfig   , clientScroll   , clientDetailView@@ -140,7 +139,6 @@ import           Irc.RawIrcMsg import           Irc.UserInfo import           LensUtils-import           Network.Connection (ConnectionContext, initConnectionContext) import           Text.Regex.TDFA import           Text.Regex.TDFA.String (compile) @@ -149,12 +147,11 @@   { _clientWindows           :: !(Map Focus Window) -- ^ client message buffers   , _clientPrevFocus         :: !Focus              -- ^ previously focused buffer   , _clientFocus             :: !Focus              -- ^ currently focused buffer-  , _clientSubfocus          :: !Subfocus           -- ^ sec+  , _clientSubfocus          :: !Subfocus           -- ^ current view mode   , _clientExtraFocus        :: ![Focus]            -- ^ extra messages windows to view    , _clientConnections       :: !(IntMap NetworkState) -- ^ state of active connections-  , _clientNextConnectionId  :: !Int-  , _clientConnectionContext :: !ConnectionContext        -- ^ network connection context+  , _clientNextConnectionId  :: !NetworkId              -- ^ next available 'NetworkId'   , _clientEvents            :: !(TQueue NetworkEvent)    -- ^ incoming network event queue   , _clientNetworkMap        :: !(HashMap Text NetworkId) -- ^ network name to connection ID @@ -179,16 +176,24 @@   , _clientLogQueue          :: ![LogLine]                -- ^ log lines ready to write   } ++-- | State of the extension API including loaded extensions and the mechanism used+-- to support reentry into the Haskell runtime from the C API. data ExtensionState = ExtensionState-  { _esActive    :: [ActiveExtension]-  , _esMVar      :: MVar ClientState-  , _esStablePtr :: StablePtr (MVar ClientState)+  { _esActive    :: [ActiveExtension]            -- ^ active extensions+  , _esMVar      :: MVar ClientState             -- ^ 'MVar' used to with 'clientPark'+  , _esStablePtr :: StablePtr (MVar ClientState) -- ^ 'StablePtr' used with 'clientPark'   }  makeLenses ''ClientState makeLenses ''ExtensionState -clientPark :: ClientState -> (Ptr () -> IO a) -> IO (ClientState, a)++-- | Prepare the client to support reentry from the extension API.+clientPark ::+  ClientState      {- ^ client state                                        -} ->+  (Ptr () -> IO a) {- ^ continuation using the stable pointer to the client -} ->+  IO (ClientState, a) clientPark st k =   do let mvar = view (clientExtensions . esMVar) st      putMVar mvar st@@ -222,8 +227,7 @@    withExtensionState $ \exts -> -  do cxt            <- initConnectionContext-     events         <- atomically newTQueue+  do events         <- atomically newTQueue      k ClientState         { _clientWindows           = _Empty # ()         , _clientNetworkMap        = _Empty # ()@@ -238,7 +242,6 @@         , _clientFocus             = Unfocused         , _clientSubfocus          = FocusMessages         , _clientExtraFocus        = []-        , _clientConnectionContext = cxt         , _clientConfig            = cfg         , _clientScroll            = 0         , _clientDetailView        = False@@ -386,7 +389,13 @@       | identIgnored (userNick who) st = Just (userNick who)       | otherwise                      = Nothing -identIgnored :: Identifier -> ClientState -> Bool+++-- | Predicate for nicknames to determine if messages should be ignored.+identIgnored ::+  Identifier  {- ^ nickname     -} ->+  ClientState {- ^ client state -} ->+  Bool        {- ^ is ignored   -} identIgnored who st = HashSet.member who (view clientIgnores st)  @@ -552,7 +561,12 @@ channelUserList network channel =   views (clientConnection network . csChannels . ix channel . chanUsers) HashMap.keys -clientMatcher :: ClientState -> Text -> Bool++-- | Returns the current filtering predicate.+clientMatcher ::+  ClientState {- ^ client state  -} ->+  Text        {- ^ text to match -} ->+  Bool        {- ^ is match      -} clientMatcher st =   case clientActiveRegex st of     Nothing -> const True@@ -586,6 +600,7 @@     _                -> Nothing  +-- | Regular expression for matching HTTP/HTTPS URLs in chat text. urlPattern :: Regex Right urlPattern =   compile@@ -594,6 +609,9 @@     "https?://([[:alnum:]-]+\\.)*([[:alnum:]-]+)(:[[:digit:]]+)?(/[^[:cntrl:][:space:]]*)|\     \<https?://[^>]*>" ++-- | Find all the URL matches using 'urlPattern' in a given 'Text' suitable+-- for being opened. Surrounding @<@ and @>@ are removed. urlMatches :: Text -> [Text] urlMatches txt = removeBrackets . extractText . (^?! ix 0)              <$> matchAll urlPattern (Text.unpack txt)@@ -643,7 +661,6 @@      c <- createConnection             delay             i-            (view clientConnectionContext st')             settings             (view clientEvents st') @@ -697,10 +714,14 @@  applyWindowRenames _ _ st = st ++-- | Actions to be run when exiting the client. clientShutdown :: ClientState -> IO () clientShutdown st = () <$ clientStopExtensions st  -- other shutdown stuff might be added here later ++-- | Unload all active extensions. clientStopExtensions :: ClientState -> IO ClientState clientStopExtensions st =   do let (aes,st1) = (clientExtensions . esActive <<.~ []) st