irc-core 1.1.3 → 1.1.4

raw patch · 10 files changed

+55/−54 lines, 10 filesdep ~basedep ~timedep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, time, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +4/−3
• driver/ClientState.hs +0/−2
• driver/CommandArgs.hs +6/−0
• driver/Connection.hs +12/−23
• driver/Main.hs +4/−9
• driver/ServerSettings.hs +1/−0
• irc-core.cabal +13/−9
• src/Irc/Core.hs +4/−4
• src/Irc/Model.hs +5/−4

@@ -1,3 +1,9 @@+1.1.4+-------+* Support host-specific server-certificate sections+* Make message parsing more permissive for use with slack irc bridge+* Fix parsing of INVITE reply message+ 1.1.3 ------- * Support for running commands upon connection

@@ -104,9 +104,10 @@       * "JOIN #favoritechannel,#otherchannel"       * "PRIVMSG mybot another command" --- Specify additional certificates beyond the system CAs-server-certificates:-  * "/path/to/extra/certificate.pem"+    -- Specify additional certificates beyond the system CAs+    server-certificates:+      * "/path/to/extra/certificate.pem"+ ```  Commands

@@ -23,7 +23,6 @@ import Data.Time (TimeZone, UTCTime) import Graphics.Vty.Image import System.IO (Handle)-import qualified Config import qualified Data.ByteString as B import qualified Data.Map as Map import qualified Data.Set as Set@@ -76,7 +75,6 @@   , _clientAutomation :: [EventHandler]   , _clientTimers     :: Map UTCTime [TimerEvent]   , _clientTimeZone   :: TimeZone-  , _clientConfig     :: Config.Value   }   -- TODO: split this record into logical pieces 

@@ -188,6 +188,12 @@                                let p = maybe defaultSocksPort fromIntegral                                      $ defaultNum hostTxt "socks-port" args                                return (h,p)++       , _ssServerCerts   = toListOf+                              ( cmdArgConfigValue+                              . configPath hostTxt "server-certificates"+                              . values . text . unpacked+                              ) args        }  

@@ -21,7 +21,6 @@ import Data.Default.Class (def) import Data.Maybe         (fromMaybe) import Data.Monoid        ((<>))-import Data.Text.Lens     (unpacked) import Data.X509          (CertificateChain(..)) import Data.X509.CertificateStore (CertificateStore, makeCertificateStore) import Data.X509.File     (readSignedObject, readKeyFile)@@ -30,8 +29,6 @@ import Network.TLS import Network.TLS.Extra  (ciphersuite_strong) import System.X509        (getSystemCertificateStore)-import qualified Config-import qualified Config.Lens as Config import qualified Data.ByteString.Char8 as B8  import ServerSettings@@ -44,10 +41,10 @@      return (if B8.null b then b else B8.init b)         -- empty lines will still fail, just later and nicely -buildConnectionParams :: Config.Value -> ServerSettings -> IO ConnectionParams-buildConnectionParams config args =+buildConnectionParams :: ServerSettings -> IO ConnectionParams+buildConnectionParams args =   do useSecure <- if view ssTls args-                     then fmap Just (buildTlsSettings config args)+                     then fmap Just (buildTlsSettings args)                      else return Nothing       let proxySettings = fmap (uncurry SockSettingsSimple)@@ -67,24 +64,16 @@     Nothing | view ssTls args -> 6697             | otherwise       -> 6667 -buildCertificateStore :: Config.Value -> IO CertificateStore-buildCertificateStore config =+buildCertificateStore :: ServerSettings -> IO CertificateStore+buildCertificateStore args =   do systemStore <- getSystemCertificateStore-     userCerts   <- traverse readSignedObject (configExtraCertificates config)+     userCerts   <- traverse readSignedObject (view ssServerCerts args)      let userStore = makeCertificateStore (concat userCerts)      return (userStore <> systemStore) -configExtraCertificates :: Config.Value -> [FilePath]-configExtraCertificates =-  toListOf $ Config.key "server-certificates"-           . Config.list-           . folded-           . Config.text-           . unpacked--buildTlsSettings :: Config.Value -> ServerSettings -> IO TLSSettings-buildTlsSettings config args =-  do store <- buildCertificateStore config+buildTlsSettings :: ServerSettings -> IO TLSSettings+buildTlsSettings args =+  do store <- buildCertificateStore args       let portString = B8.pack (show (view ssPort args))          paramsClient = defaultParamsClient (view ssHostName args) portString@@ -120,8 +109,8 @@            []    -> fail "No private keys found"            _     -> fail "Too many private keys found" -connect :: Config.Value -> ServerSettings -> IO Connection-connect config args = do+connect :: ServerSettings -> IO Connection+connect args = do   connectionContext <- initConnectionContext-  connectionParams  <- buildConnectionParams config args+  connectionParams  <- buildConnectionParams args   connectTo connectionContext connectionParams

@@ -31,7 +31,6 @@ import Network.Connection import System.IO import System.IO.Error (isEOFError)-import qualified Config import qualified Config.Lens as C import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8@@ -86,8 +85,7 @@   withVty $ \vty ->     do _ <- forkIO (vtyEventLoop vtyEventChan vty)        settings <- initialServerSettings args-       server0  <- startIrcConnection (view cmdArgConfigValue args)-                     recvChan settings hErr+       server0  <- startIrcConnection recvChan settings hErr        (width,height) <- displayBounds (outputIface vty)        zone <- getCurrentTimeZone @@ -112,7 +110,6 @@                , _clientAutomation      = [ctcpHandler,cancelDeopTimerOnDeop,connectCmds]                , _clientTimers          = mempty                , _clientTimeZone        = zone-               , _clientConfig          = view cmdArgConfigValue args                }        st1 <- schedulePing st0 @@ -124,13 +121,12 @@      bracket (mkVty cfg) shutdown k  startIrcConnection ::-  Config.Value                   {- ^ user configuration     -} ->   TChan (UTCTime, MsgFromServer) {- ^ incoming client events -} ->   ServerSettings                 {- ^ network parameters     -} ->   Maybe Handle                   {- ^ error log              -} ->   IO ClientConnection-startIrcConnection config recvChan settings hErr =-  do connectRes <- try (connect config settings)+startIrcConnection recvChan settings hErr =+  do connectRes <- try (connect settings)      case connectRes of        Left e -> connectionFailed e        Right h -> connectionSuceeded h@@ -609,8 +605,7 @@      let settings = view ccServerSettings server0          recvChan = view clientRecvChan st          hErr     = view clientErrors st-         config   = view clientConfig st-     server0' <- startIrcConnection config recvChan settings hErr+     server0' <- startIrcConnection recvChan settings hErr      return (set clientServer0 server0' st)  doNick ::

@@ -22,6 +22,7 @@   , _ssTlsClientKey  :: Maybe FilePath   , _ssConnectCmds   :: [Text]   , _ssSocksProxy    :: Maybe (HostName,PortNumber)+  , _ssServerCerts   :: [FilePath]   }  makeLenses ''ServerSettings

@@ -1,5 +1,5 @@ name:                irc-core-version:             1.1.3+version:             1.1.4 homepage:            https://github.com/glguy/irc-core bug-reports:         https://github.com/glguy/irc-core/issues license:             BSD3@@ -11,7 +11,7 @@ build-type:          Simple cabal-version:       >=1.10 synopsis:            An IRC client library and text client-tested-with:         GHC == 7.8.4, GHC == 7.10.2+tested-with:         GHC == 7.8.4, GHC == 7.10.3 description:   This package provides an IRC connection library as well as a console-based IRC client   that uses the library.@@ -89,7 +89,7 @@   -- to use an absurd amount of RAM when compiling.   -- The base >= 4.7.0.2 is to protect people from finding   -- this out the hard way.-  build-depends:       base             >= 4.7.0.2  && < 4.9,+  build-depends:       base             >= 4.7.0.2  && < 4.10,                         array            >= 0.5      && < 0.6,                        attoparsec       >= 0.12.1.2 && < 0.14,@@ -99,11 +99,11 @@                        free             >= 4.11     && < 4.13,                        lens             >= 4.7      && < 4.14,                        text             >= 1.2.0.4  && < 1.3,-                       transformers     >= 0.2      && < 0.5,+                       transformers     >= 0.2      && < 0.6,                        regex-tdfa       >= 1.2      && < 1.3    if flag(time15)-    build-depends:     time             >= 1.5      && < 1.6+    build-depends:     time             >= 1.5      && < 1.7   else     build-depends:     time             >= 1.4.2    && < 1.5,                        old-locale       >= 1.0.0.6  && < 1.1@@ -141,7 +141,7 @@                  x509-validation  >= 1.5.1    && < 1.7,                   array            >= 0.5      && < 0.6,-                 base             >= 4.7      && < 4.9,+                 base             >= 4.7      && < 4.10,                  bytestring       >= 0.10.4.0 && < 0.11,                  containers       >= 0.5      && < 0.6,                  config-value     >= 0.4      && < 0.5,@@ -150,16 +150,20 @@                  filepath         >= 1.3.0.2  && < 1.5,                  lens             >= 4.7      && < 4.14,                  network          >= 2.6.0.2  && < 2.7,-                 old-locale       >= 1.0.0.6  && < 1.1,                  split            >= 0.2.2    && < 0.3,                  stm              >= 2.4.4    && < 2.5,                  text             >= 1.2.0.4  && < 1.3,-                 time             >= 1.4.2    && < 1.6,                  vty              >= 5.2.7    && < 5.5,                  haskell-lexer    >= 1.0      && < 1.1,-                 transformers     >= 0.2      && < 0.5,+                 transformers     >= 0.2      && < 0.6,                  regex-tdfa       >= 1.2      && < 1.3   default-language:    Haskell2010++  if flag(time15)+    build-depends:     time             >= 1.5      && < 1.7+  else+    build-depends:     time             >= 1.4.2    && < 1.5,+                       old-locale       >= 1.0.0.6  && < 1.1  source-repository head   type: git

@@ -148,7 +148,7 @@    | Away UserInfo (Maybe ByteString)   | Ping ByteString-  | Pong ByteString (Maybe ByteString)+  | Pong (Maybe ByteString) ByteString   | Notice  UserInfo Identifier ByteString   | Topic UserInfo Identifier ByteString   | PrivMsg UserInfo Identifier ByteString@@ -393,7 +393,7 @@     ("333",[_,chan,who,time]) ->        Just (RplTopicWhoTime (mkId chan) who (asTimeStamp time)) -    ("341",[_,nick,chan,_]) ->+    ("341",_:nick:chan:_) ->        Just (RplInviting (mkId nick) (mkId chan))      ("346",[_,chan,mask,who,time]) ->@@ -692,8 +692,8 @@      ("PING",[txt]) -> Just (Ping txt) -    ("PONG",[server    ]) -> Just (Pong server Nothing)-    ("PONG",[server,txt]) -> Just (Pong server (Just txt))+    ("PONG",[txt       ]) -> Just (Pong Nothing txt)+    ("PONG",[server,txt]) -> Just (Pong (Just server) txt)      ("PRIVMSG",[dst,txt]) ->       do src <- msgPrefix ircmsg

@@ -275,15 +275,15 @@        Ping x -> sendMessage (pongCmd x) >> return conn         -- Treat numbers as POSIX times when PING was sent-       Pong _ (Just txt)+       Pong _ txt           | Just sec <- readMaybe (B8.unpack txt) ->                 do now <- getStamp                    let past = posixSecondsToUTCTime (realToFrac (sec :: Pico))                        delta = realToFrac (now `diffUTCTime` past)                    return (set connPingTime (Just delta) conn) -       Pong server mbMsg ->-         doServerMessage "Pong" (server <> maybe "" (" "<>) mbMsg) conn+       Pong mbServer msg ->+         doServerMessage "Pong" (maybe "" (<>" ") mbServer <> msg) conn         RplWelcome  txt -> doServerMessage "Welcome" txt                         $ set connPhase ActivePhase conn@@ -825,7 +825,8 @@   supportedCaps = saslSupport                ++ ["away-notify","account-notify","userhost-in-names",                    "extended-join","multi-prefix",-                   "znc.in/server-time-iso","server-time"]+                   "znc.in/server-time-iso","server-time",+                   "znc.in/self-message"]   saslSupport =     case view connSasl conn of       Nothing -> []