glirc 2.31 → 2.32

raw patch · 15 files changed

+137/−183 lines, 15 filesdep ~config-schemadep ~config-valuedep ~irc-coresetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: config-schema, config-value, irc-core

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Setup.hs +4/−44
• glirc.cabal +5/−5
• src/Client/Authentication/Ecdsa.hs +3/−3
• src/Client/Commands/Interpolation.hs +6/−6
• src/Client/Configuration.hs +35/−54
• src/Client/Configuration/Colors.hs +24/−18
• src/Client/Configuration/Macros.hs +8/−8
• src/Client/Configuration/ServerSettings.hs +29/−29
• src/Client/Configuration/Sts.hs +3/−3
• src/Client/EventLoop/Actions.hs +5/−3
• src/Client/Hook/Snotice.hs +1/−3
• src/Client/Network/Async.hs +2/−2
• src/Client/State.hs +1/−1
• src/Client/State/Network.hs +5/−4

@@ -1,5 +1,11 @@ # Revision history for glirc2 +## 2.32++* Fix SASL EXTERNAL+* Better /url matching+* Support for config-schema improvements+ ## 2.31  * Added TLS fingerprint pinning with `tls-cert-fingerprint` and `tls-pubkey-fingerprint`

@@ -9,16 +9,14 @@ transitive dependencies of this package use free licenses and generates a Build module detailing the versions of build tools and transitive library dependencies.-+  -}  module Main (main) where  import           Control.Monad (unless) import           Data.Char (isAlphaNum)-import           Data.List (delete) import           Distribution.InstalledPackageInfo (InstalledPackageInfo, sourcePackageId, license)-import qualified Distribution.ModuleName as ModuleName import           Distribution.PackageDescription hiding (license) import           Distribution.Simple import           Distribution.Simple.LocalBuildInfo (LocalBuildInfo, installedPkgs, withLibLBI)@@ -30,9 +28,7 @@  import           Distribution.Simple.BuildPaths (autogenComponentModulesDir) -import qualified Distribution.SPDX               as SPDX - -- | Default Setup main extended to generate a Build module and to validate -- the licenses of transitive dependencies. main :: IO ()@@ -43,45 +39,9 @@          validateLicenses pkgs          generateBuildModule (fromFlag (configVerbosity flags)) pkg lbi pkgs          postConf simpleUserHooks args flags pkg lbi--  , sDistHook = \pkg mbLbi hooks flags ->-      do let pkg' = forgetBuildModule pkg-         sDistHook simpleUserHooks pkg' mbLbi hooks flags   }  --- | Remove the Build module from the package description. This is needed--- when building a source distribution tarball because the Build module--- should be generated dynamically at configuration time.-forgetBuildModule ::-  PackageDescription {- ^ package description with Build module    -} ->-  PackageDescription {- ^ package description without Build module -}-forgetBuildModule pkg = pkg-  { library     = forgetInLibrary    <$> library     pkg-  , executables = forgetInExecutable <$> executables pkg-  , benchmarks  = forgetInBenchmark  <$> benchmarks  pkg-  , testSuites  = forgetInTestSuite  <$> testSuites  pkg-  }-  where-    forget = delete (ModuleName.fromString (buildModuleName pkg))--    forgetInBuildInfo x = x-      { otherModules = forget (otherModules x) }--    forgetInLibrary x = x-      { exposedModules = forget (exposedModules x)-      , libBuildInfo   = forgetInBuildInfo (libBuildInfo x) }--    forgetInTestSuite x = x-      { testBuildInfo = forgetInBuildInfo (testBuildInfo x) }--    forgetInBenchmark x = x-      { benchmarkBuildInfo = forgetInBuildInfo (benchmarkBuildInfo x) }--    forgetInExecutable x = x-      { buildInfo = forgetInBuildInfo (buildInfo x) }-- -- | Compute the name of the Build module for a given package buildModuleName ::   PackageDescription {- ^ package description -} ->@@ -137,11 +97,11 @@   IO () validateLicenses pkgs =   do let toLicense = either licenseFromSPDX id-         p pkg   = toLicense (license pkg) `notElem` freeLicenses-         badPkgs = filter p pkgs+         isBad pkg = toLicense (license pkg) `notElem` freeLicenses+         badPkgs   = filter isBad pkgs       unless (null badPkgs) $-       do mapM_ print [ toLicense (license p) | p <- badPkgs ]+       do mapM_ print [ toLicense (license pkg) | pkg <- badPkgs ]           fail "BAD LICENSE"  

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                glirc-version:             2.31+version:             2.32 synopsis:            Console IRC client description:         Console IRC client                      .@@ -19,7 +19,7 @@                      exec/macos_exported_symbols.txt homepage:            https://github.com/glguy/irc-core bug-reports:         https://github.com/glguy/irc-core/issues-tested-with:         GHC==8.6.4+tested-with:         GHC==8.6.5  custom-setup   setup-depends: base     >=4.11 && <4.13,@@ -142,8 +142,8 @@                        attoparsec           >=0.13   && <0.14,                        base64-bytestring    >=1.0.0.1&& <1.1,                        bytestring           >=0.10.8 && <0.11,-                       config-schema        >=0.4    && <0.6,-                       config-value         >=0.6    && <0.7,+                       config-schema        ^>=1.1.0.0,+                       config-value         ^>=0.6,                        containers           >=0.5.7  && <0.7,                        directory            >=1.2.6  && <1.4,                        filepath             >=1.4.1  && <1.5,@@ -151,7 +151,7 @@                        gitrev               >=1.2    && <1.4,                        hashable             >=1.2.4  && <1.4,                        hookup               >=0.2.3  && <0.3,-                       irc-core             >=2.7    && <2.8,+                       irc-core             >=2.7.1  && <2.8,                        kan-extensions       >=5.0    && <5.3,                        lens                 >=4.14   && <4.18,                        network              >=2.6.2  && <3.2,

@@ -21,12 +21,12 @@   ) where  import           Control.Exception (displayException, try)-import           Data.ByteString.Base64 as Enc import           Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import           System.IO.Error (IOError) import           System.Process (readProcess)+import           Irc.Commands (AuthenticatePayload(..))   -- | Identifier for SASL ECDSA challenge response authentication@@ -40,8 +40,8 @@ -- | Encode a username as specified in this authentication mode. encodeUsername ::   Text {- ^ username                 -} ->-  Text {- ^ base-64 encoded username -}-encodeUsername = Text.decodeUtf8 . Enc.encode . Text.encodeUtf8+  AuthenticatePayload {- ^ base-64 encoded username -}+encodeUsername = AuthenticatePayload . Text.encodeUtf8   -- | Compute the response for a given challenge using the @ecdsatool@

@@ -65,11 +65,11 @@ noMacroArguments :: MacroSpec noMacroArguments = MacroSpec (pure []) -parseMacroSpecs :: Text -> Maybe MacroSpec+parseMacroSpecs :: Text -> Either Text MacroSpec parseMacroSpecs txt =   case parseOnly (macroSpecs <* endOfInput) txt of-    Left{}     -> Nothing-    Right spec -> Just spec+    Left e     -> Left (Text.pack e)+    Right spec -> Right spec  macroSpecs :: Parser MacroSpec macroSpecs =@@ -89,11 +89,11 @@  -- | Parse a 'Text' searching for the expansions as specified in -- 'ExpansionChunk'. @$$@ is used to escape a single @$@.-parseExpansion :: Text -> Maybe [ExpansionChunk]+parseExpansion :: Text -> Either Text [ExpansionChunk] parseExpansion txt =   case parseOnly (many parseChunk <* endOfInput) txt of-    Left{}       -> Nothing-    Right chunks -> Just chunks+    Left e       -> Left (Text.pack e)+    Right chunks -> Right chunks  parseChunk :: Parser ExpansionChunk parseChunk =

@@ -75,7 +75,7 @@ import           Control.Exception import           Control.Monad                       (unless) import           Control.Lens                        hiding (List)-import           Data.Foldable                       (toList, find)+import           Data.Foldable                       (toList) import           Data.Functor.Alt                    ((<!>)) import           Data.HashMap.Strict                 (HashMap) import qualified Data.HashMap.Strict                 as HashMap@@ -241,39 +241,15 @@          Right rawcfg -> return rawcfg       case loadValue configurationSpec rawcfg of-       Left es -> throwIO-                $ ConfigurationMalformed path-                $ Text.unpack-                $ Text.unlines-                $ map explainLoadError (toList es)+       Left e -> throwIO+               $ ConfigurationMalformed path+               $ displayException e        Right cfg ->          do cfg' <- resolvePaths path (cfg def home)                     >>= validateDirectories path             return (path, cfg')  --- | Generate a human-readable explanation of an error arising from--- an attempt to load a configuration file.-explainLoadError :: LoadError Position -> Text-explainLoadError (LoadError pos path problem) =-  Text.concat [ positionText, " at ", pathText, ": ", problemText]--  where-    positionText =-     Text.unwords ["line"  , Text.pack (show (posLine   pos)),-                   "column", Text.pack (show (posColumn pos))]--    pathText-      | null path = "top-level"-      | otherwise = Text.intercalate ":" path--    problemText =-      case problem of-        UnusedSection  s -> "unknown section `"          <> s <> "`"-        MissingSection s -> "missing required section `" <> s <> "`"-        SpecMismatch   t -> "expected "                  <> t-- -- | Resolve all the potentially relative file paths in the configuration file resolvePaths :: FilePath -> Configuration -> IO Configuration resolvePaths file cfg =@@ -304,8 +280,8 @@     noWriteableMsg = "The download-dir doesn't point to a writeable directory."  configurationSpec ::-  ValueSpecs (ServerSettings -> FilePath -> Configuration)-configurationSpec = sectionsSpec "" $+  ValueSpec (ServerSettings -> FilePath -> Configuration)+configurationSpec = sectionsSpec "config-file" $    do let sec' def name spec info = fromMaybe def <$> optSection' name spec info          identifierSetSpec       = HashSet.fromList <$> listSpec identifierSpec@@ -316,7 +292,7 @@                                "Configuration parameters for IRC servers"      _configPalette         <- sec' defaultPalette "palette" paletteSpec                                "Customize the client color choices"-     _configWindowNames     <- sec' defaultWindowNames "window-names" valuesSpec+     _configWindowNames     <- sec' defaultWindowNames "window-names" anySpec                                "Window names to use for quick jumping with jump-modifier key"      _configJumpModifier    <- sec' [MMeta] "jump-modifier" modifierSpec                                "Modifier used to jump to a window by name. Defaults to `meta`."@@ -330,7 +306,7 @@                                "Extra words to highlight in chat messages"      _configNickPadding     <- sec' NoPadding "nick-padding" nickPaddingSpec                                "Amount of space to reserve for nicknames in chat messages"-     _configIgnores         <- sec' [] "ignores" valuesSpec+     _configIgnores         <- sec' [] "ignores" anySpec                                "Set of nicknames to ignore on startup"      _configActivityBar     <- sec' False  "activity-bar" yesOrNoSpec                                "Show channel names and message counts for activity on\@@ -365,7 +341,7 @@ -- > nick-padding: -- >   side: right -- >   width: 16-nickPaddingSpec :: ValueSpecs PaddingMode+nickPaddingSpec :: ValueSpec PaddingMode nickPaddingSpec = defaultPaddingSide <$> nonnegativeSpec <!> fullNickPaddingSpec  -- | Full nick padding specification:@@ -373,7 +349,7 @@ -- > nick-padding: -- >   side: left -- >   width: 15-fullNickPaddingSpec :: ValueSpecs PaddingMode+fullNickPaddingSpec :: ValueSpec PaddingMode fullNickPaddingSpec = sectionsSpec "nick-padding" (sideSec <*> amtSec)   where     sideSpec = LeftPadding  <$ atomSpec "left" <!>@@ -387,7 +363,7 @@  -- | Parse either a single modifier key or a list of modifier keys: -- @meta@, @alt@, @ctrl@-modifierSpec :: ValueSpecs [Modifier]+modifierSpec :: ValueSpec [Modifier] modifierSpec = toList <$> oneOrNonemptySpec modifier1Spec   where     modifier1Spec = namedSpec "modifier"@@ -397,13 +373,13 @@  -- | Parse either @one-column@ or @two-column@ and return the corresponding -- 'LayoutMode' value.-layoutSpec :: ValueSpecs LayoutMode+layoutSpec :: ValueSpec LayoutMode layoutSpec = OneColumn <$ atomSpec "one-column"          <!> TwoColumn <$ atomSpec "two-column"  -- | Parse a single key binding. This can be an action binding, command -- binding, or an unbinding specification.-keyBindingSpec :: ValueSpecs (KeyMap -> KeyMap)+keyBindingSpec :: ValueSpec (KeyMap -> KeyMap) keyBindingSpec = actBindingSpec <!> cmdBindingSpec <!> unbindingSpec  -- | Parse a single action key binding. Action bindings are a map specifying@@ -411,7 +387,7 @@ -- -- > bind: "M-a" -- > action: jump-to-activity-actBindingSpec :: ValueSpecs (KeyMap -> KeyMap)+actBindingSpec :: ValueSpec (KeyMap -> KeyMap) actBindingSpec = sectionsSpec "action-binding" $   do ~(m,k) <- reqSection' "bind" keySpec                "Key to be bound (e.g. a, C-b, M-c C-M-d)"@@ -419,7 +395,7 @@                "Action name (see `/keymap`)"      return (addKeyBinding m k a) -cmdBindingSpec :: ValueSpecs (KeyMap -> KeyMap)+cmdBindingSpec :: ValueSpec (KeyMap -> KeyMap) cmdBindingSpec = sectionsSpec "command-binding" $   do ~(m,k) <- reqSection' "bind" keySpec                "Key to be bound (e.g. a, C-b, M-c C-M-d)"@@ -427,7 +403,7 @@                "Client command to execute (exclude leading `/`)"      return (addKeyBinding m k (ActCommand cmd)) -unbindingSpec :: ValueSpecs (KeyMap -> KeyMap)+unbindingSpec :: ValueSpec (KeyMap -> KeyMap) unbindingSpec = sectionsSpec "remove-binding" $   do ~(m,k) <- reqSection' "unbind" keySpec                "Key to be unbound (e.g. a, C-b, M-c C-M-d)"@@ -435,34 +411,39 @@   -- | Custom configuration specification for emacs-style key descriptions-keySpec :: ValueSpecs ([Modifier], Key)-keySpec = customSpec "emacs-key" stringSpec parseKey+keySpec :: ValueSpec ([Modifier], Key)+keySpec = customSpec "emacs-key" stringSpec+        $ \key -> case parseKey key of+                    Nothing -> Left "unknown key"+                    Just x  -> Right x  -nonnegativeSpec :: (Ord a, Num a) => ValueSpecs a-nonnegativeSpec = customSpec "non-negative" numSpec $ \x -> find (0 <=) [x]+nonnegativeSpec :: (Ord a, Num a) => ValueSpec a+nonnegativeSpec = customSpec "non-negative" numSpec+                $ \x -> if x < 0 then Left "negative number"+                                 else Right x  -paletteSpec :: ValueSpecs Palette+paletteSpec :: ValueSpec Palette paletteSpec = sectionsSpec "palette" $   (ala Endo (foldMap . foldMap) ?? defaultPalette) <$> sequenceA fields    where-    nickColorsSpec :: ValueSpecs (Palette -> Palette)+    nickColorsSpec :: ValueSpec (Palette -> Palette)     nickColorsSpec = set palNicks . Vector.fromList . NonEmpty.toList                  <$> nonemptySpec attrSpec -    modeColorsSpec :: Lens' Palette (HashMap Char Attr) -> ValueSpecs (Palette -> Palette)+    modeColorsSpec :: Lens' Palette (HashMap Char Attr) -> ValueSpec (Palette -> Palette)     modeColorsSpec l       = fmap (set l)       $ customSpec "modes" (assocSpec attrSpec)       $ fmap HashMap.fromList       . traverse (\(mode, attr) ->           case Text.unpack mode of-            [m] -> Just (m, attr)-            _   -> Nothing)+            [m] -> Right (m, attr)+            _   -> Left "expected single letter") -    fields :: [SectionSpecs (Maybe (Palette -> Palette))]+    fields :: [SectionsSpec (Maybe (Palette -> Palette))]     fields = optSection' "nick-colors" nickColorsSpec              "Colors used to highlight nicknames" @@ -477,7 +458,7 @@             : [ optSection' lbl (set l <$> attrSpec) "" | (lbl, Lens l) <- paletteMap ] -extensionSpec :: ValueSpecs ExtensionConfiguration+extensionSpec :: ValueSpec ExtensionConfiguration extensionSpec = simpleExtensionSpec <!> fullExtensionSpec  -- | Default dynamic linker flags: @RTLD_LOCAL@ and @RTLD_NOW@@@ -486,7 +467,7 @@  -- | Given only a filepath build an extension configuration that -- loads the extension using the 'defaultRtldFlags' and no arguments.-simpleExtensionSpec :: ValueSpecs ExtensionConfiguration+simpleExtensionSpec :: ValueSpec ExtensionConfiguration simpleExtensionSpec =   do _extensionPath <- stringSpec      pure ExtensionConfiguration@@ -497,7 +478,7 @@ -- | Full extension configuration allows the RTLD flags to be manually -- specified. This can be useful if the extension defines symbols that -- need to be visible to libraries that the extension is linked against.-fullExtensionSpec :: ValueSpecs ExtensionConfiguration+fullExtensionSpec :: ValueSpec ExtensionConfiguration fullExtensionSpec =   sectionsSpec "extension" $   do _extensionPath      <- reqSection' "path"       stringSpec@@ -509,7 +490,7 @@                             "Extension-specific configuration arguments"      pure ExtensionConfiguration {..} -rtldFlagSpec :: ValueSpecs RTLDFlags+rtldFlagSpec :: ValueSpec RTLDFlags rtldFlagSpec = namedSpec "rtld-flag"              $ RTLD_LOCAL  <$ atomSpec "local"            <!> RTLD_GLOBAL <$ atomSpec "global"

@@ -26,12 +26,12 @@ -- | Parse a text attribute. This value should be a sections with the @fg@ and/or -- @bg@ attributes. Otherwise it should be a color entry that will be used -- for the foreground color. An empty sections value will result in 'defAttr'-attrSpec :: ValueSpecs Attr+attrSpec :: ValueSpec Attr attrSpec = namedSpec "attr" $            withForeColor defAttr <$> colorSpec        <!> fullAttrSpec -fullAttrSpec :: ValueSpecs Attr+fullAttrSpec :: ValueSpec Attr fullAttrSpec = sectionsSpec "full-attr" $   do mbFg <- optSection' "fg"    colorSpec "Foreground color"      mbBg <- optSection' "bg"    colorSpec "Background color"@@ -44,10 +44,10 @@     aux f xs z = foldl f z xs  -stylesSpec :: ValueSpecs [Style]+stylesSpec :: ValueSpec [Style] stylesSpec = oneOrList styleSpec -styleSpec :: ValueSpecs Style+styleSpec :: ValueSpec Style styleSpec = namedSpec "style" $       blink        <$ atomSpec "blink"   <!> bold         <$ atomSpec "bold"@@ -62,29 +62,35 @@ -- * Number between 0-255 -- * Name of color -- * RGB values of color as a list-colorSpec :: ValueSpecs Color+colorSpec :: ValueSpec Color colorSpec = namedSpec "color" (colorNumberSpec <!> colorNameSpec <!> rgbSpec) -colorNameSpec :: ValueSpecs Color-colorNameSpec = customSpec "color name" anyAtomSpec (`HashMap.lookup` namedColors)+colorNameSpec :: ValueSpec Color+colorNameSpec = customSpec "color name" anyAtomSpec+              $ \name -> case HashMap.lookup name namedColors of+                           Nothing -> Left "unknown color"+                           Just c  -> Right c  -- | Match integers between 0 and 255 as Terminal colors.-colorNumberSpec :: ValueSpecs Color-colorNumberSpec = customSpec "terminal color" valuesSpec $ \i ->-  if      i <   0 then Nothing-  else if i <  16 then Just (ISOColor (fromInteger i))-  else if i < 256 then Just (Color240 (fromInteger (i - 16)))-  else Nothing+colorNumberSpec :: ValueSpec Color+colorNumberSpec = customSpec "terminal color" anySpec $ \i ->+  if      i <   0 then Left "minimum color is 0"+  else if i <  16 then Right (ISOColor (fromInteger i))+  else if i < 256 then Right (Color240 (fromInteger (i - 16)))+  else Left "maximum color is 255"  -- | Configuration section that matches 3 integers in the range 0-255 -- representing red, green, and blue values.-rgbSpec :: ValueSpecs Color-rgbSpec = customSpec "RGB" valuesSpec $ \rgb ->+rgbSpec :: ValueSpec Color+rgbSpec = customSpec "RGB" anySpec $ \rgb ->   case rgb of-    [r,g,b] | valid r, valid g, valid b -> Just (rgbColor r g b)-    _                                   -> Nothing+    [r,g,b] -> rgbColor <$> valid r <*> valid g <*> valid b+    _ -> Left "expected 3 numbers"   where-    valid x = 0 <= x && x < (256 :: Integer)+    valid x+      | x < 0     = Left "minimum color value is 0"+      | x < 256   = Right (x :: Integer)+      | otherwise = Left "maximum color value is 255"  namedColors :: HashMap Text Color namedColors = HashMap.fromList

@@ -20,19 +20,19 @@ import           Data.Maybe (fromMaybe) import           Data.Text (Text) -macroMapSpec :: ValueSpecs (Recognizer Macro)-macroMapSpec = fromCommands <$> listSpec macroValueSpecs+macroMapSpec :: ValueSpec (Recognizer Macro)+macroMapSpec = fromCommands <$> listSpec macroValueSpec -macroValueSpecs :: ValueSpecs (Text, Macro)-macroValueSpecs = sectionsSpec "macro" $+macroValueSpec :: ValueSpec (Text, Macro)+macroValueSpec = sectionsSpec "macro" $   do name     <- reqSection "name" ""      spec     <- fromMaybe noMacroArguments              <$> optSection' "arguments" macroArgumentsSpec ""      commands <- reqSection' "commands" (oneOrList macroCommandSpec) ""      return (name, Macro spec commands) -macroArgumentsSpec :: ValueSpecs MacroSpec-macroArgumentsSpec = customSpec "macro-arguments" valuesSpec parseMacroSpecs+macroArgumentsSpec :: ValueSpec MacroSpec+macroArgumentsSpec = customSpec "macro-arguments" anySpec parseMacroSpecs -macroCommandSpec :: ValueSpecs [ExpansionChunk]-macroCommandSpec = customSpec "macro-command" valuesSpec parseExpansion+macroCommandSpec :: ValueSpec [ExpansionChunk]+macroCommandSpec = customSpec "macro-command" anySpec parseExpansion

@@ -75,7 +75,6 @@ import           Data.Text (Text) import           Data.List.Split (chunksOf, splitOn) import qualified Data.Text as Text-import           Data.Word (Word8) import           Irc.Identifier (Identifier, mkId) import           Network.Socket (HostName, PortNumber, Family(..)) import           Numeric (readHex)@@ -175,7 +174,7 @@        , _ssTlsCertFingerprint   = Nothing        } -serverSpec :: ValueSpecs (ServerSettings -> ServerSettings)+serverSpec :: ValueSpec (ServerSettings -> ServerSettings) serverSpec = sectionsSpec "server-settings" $   composeMaybe <$> sequenceA settings   where@@ -192,9 +191,9 @@       $ set l . Just <$> s <!>         set l Nothing <$ atomSpec "clear" -    settings :: [SectionSpecs (Maybe (ServerSettings -> ServerSettings))]+    settings :: [SectionsSpec (Maybe (ServerSettings -> ServerSettings))]     settings =-      [ opt "name" ssName valuesSpec+      [ opt "name" ssName anySpec         "The name used to identify this server in the client"        , req "hostname" ssHostName stringSpec@@ -206,22 +205,22 @@       , req "nick" ssNicks nicksSpec         "Nicknames to connect with in order" -      , opt "password" ssPassword valuesSpec+      , opt "password" ssPassword anySpec         "Server password" -      , req "username" ssUser valuesSpec+      , req "username" ssUser anySpec         "Second component of _!_@_ usermask" -      , req "realname" ssReal valuesSpec+      , req "realname" ssReal anySpec         "\"GECOS\" name sent to server visible in /whois" -      , req "userinfo" ssUserInfo valuesSpec+      , req "userinfo" ssUserInfo anySpec         "CTCP userinfo (currently unused)" -      , opt "sasl-username" ssSaslUsername valuesSpec+      , opt "sasl-username" ssSaslUsername anySpec         "Username for SASL authentication to NickServ" -      , opt "sasl-password" ssSaslPassword valuesSpec+      , opt "sasl-password" ssSaslPassword anySpec         "Password for SASL authentication to NickServ"        , opt "sasl-ecdsa-key" ssSaslEcdsaFile stringSpec@@ -254,16 +253,16 @@       , req "chanserv-channels" ssChanservChannels (listSpec identifierSpec)         "Channels with ChanServ permissions available" -      , req "flood-penalty" ssFloodPenalty valuesSpec+      , req "flood-penalty" ssFloodPenalty anySpec         "RFC 1459 rate limiting, seconds of penalty per message (default 2)" -      , req "flood-threshold" ssFloodThreshold valuesSpec+      , req "flood-threshold" ssFloodThreshold anySpec         "RFC 1459 rate limiting, seconds of allowed penalty accumulation (default 10)" -      , req "message-hooks" ssMessageHooks valuesSpec+      , req "message-hooks" ssMessageHooks anySpec         "Special message hooks to enable: \"buffextras\" available" -      , req "reconnect-attempts" ssReconnectAttempts valuesSpec+      , req "reconnect-attempts" ssReconnectAttempts anySpec         "Number of reconnection attempts on lost connection"        , req "autoconnect" ssAutoconnect yesOrNoSpec@@ -295,22 +294,23 @@ -- 00112233aaFF -- 00:11:22:33:aa:FF -- @-fingerprintSpec :: ValueSpecs Fingerprint+fingerprintSpec :: ValueSpec Fingerprint fingerprintSpec =   customSpec "fingerprint" stringSpec $ \str ->     do bytes <- B.pack <$> traverse readWord8 (byteStrs str)        case B.length bytes of-         20 -> Just (FingerprintSha1   bytes)-         32 -> Just (FingerprintSha256 bytes)-         64 -> Just (FingerprintSha512 bytes)-         _  -> Nothing+         20 -> Right (FingerprintSha1   bytes)+         32 -> Right (FingerprintSha256 bytes)+         64 -> Right (FingerprintSha512 bytes)+         _  -> Left "expected 20, 32, or 64 bytes"   where     -- read a single byte in hex-    readWord8 :: String -> Maybe Word8     readWord8 i =       case readHex i of-        [(x,"")] | 0 <= x, x < 256 -> Just (fromIntegral (x :: Integer))-        _                           -> Nothing+        [(x,"")]+          | 0 <= x, x < 256 -> Right (fromIntegral (x :: Integer))+          | otherwise -> Left "byte out-of-bounds"+        _ -> Left "bad hex-encoded byte"      byteStrs :: String -> [String]     byteStrs str@@ -318,28 +318,28 @@       | otherwise      = chunksOf 2  str  -- | Specification for IP protocol family.-protocolFamilySpec :: ValueSpecs Family+protocolFamilySpec :: ValueSpec Family protocolFamilySpec =       AF_INET   <$ atomSpec "inet"   <!> AF_INET6  <$ atomSpec "inet6"  -nicksSpec :: ValueSpecs (NonEmpty Text)-nicksSpec = oneOrNonemptySpec valuesSpec+nicksSpec :: ValueSpec (NonEmpty Text)+nicksSpec = oneOrNonemptySpec anySpec  -useTlsSpec :: ValueSpecs UseTls+useTlsSpec :: ValueSpec UseTls useTlsSpec =       UseTls         <$ atomSpec "yes"   <!> UseInsecureTls <$ atomSpec "yes-insecure"   <!> UseInsecure    <$ atomSpec "no"  -nickCompletionSpec :: ValueSpecs WordCompletionMode+nickCompletionSpec :: ValueSpec WordCompletionMode nickCompletionSpec =       defaultNickWordCompleteMode <$ atomSpec "default"   <!> slackNickWordCompleteMode   <$ atomSpec "slack"  -identifierSpec :: ValueSpecs Identifier-identifierSpec = mkId <$> valuesSpec+identifierSpec :: ValueSpec Identifier+identifierSpec = mkId <$> anySpec

@@ -45,10 +45,10 @@  makeLenses ''StsPolicy -policySpec :: ValueSpecs StsPolicies+policySpec :: ValueSpec StsPolicies policySpec = HashMap.fromList <$> listSpec policyEntry -policyEntry :: ValueSpecs (Text, StsPolicy)+policyEntry :: ValueSpec (Text, StsPolicy) policyEntry =   sectionsSpec "sts-policy" $   do hostname   <- reqSection "host" "Hostname"@@ -102,7 +102,7 @@              writeFile path (encodePolicy sts ++ "\n")) :: IO (Either IOError ())      return () -dateTimeSpec :: ValueSpecs UTCTime+dateTimeSpec :: ValueSpec UTCTime dateTimeSpec   = customSpec "date-time" stringSpec   $ parseTimeM False defaultTimeLocale dateTimeFormat

@@ -100,9 +100,11 @@      , (k,a) <- Map.toList m1      ] -instance Spec Action where-  valuesSpec = customSpec "action" anyAtomSpec $ \a ->-                fst <$> HashMap.lookup a actionInfos+instance HasSpec Action where+  anySpec = customSpec "action" anyAtomSpec+          $ \a -> case HashMap.lookup a actionInfos of+                    Nothing -> Left "unknown action"+                    Just x  -> Right (fst x)   -- | Names and default key bindings for each action.

@@ -88,12 +88,10 @@     (0, "k", [str|^Propagated ban for |]),     -- Chancreate     (1, "u", [str|^[^ ]+ is creating new channel #|]),-     -- m_filter     (0, "u", [str|^FILTER: |]),     (0, "m", [str|^New filters loaded.$|]),     (0, "m", [str|^Filtering enabled.$|]),-     -- Failed login     (0, "f", [str|^Warning: [0-9]+ failed login attempts|]),     -- Temporary kline added, more complete regex: ^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} added temporary [0-9]+ min. K-Line for \[[^ ]+\] \[.*\]$@@ -114,7 +112,7 @@      -- PATTERN LIST, uncommon snotes. regex performance isn't very important beyond this point     (2, "a", [str|^Possible Flooder|]),-    (2, "a", [str|^New Max Local Clients: [0-9]+$|]),+    (0, "a", [str|^New Max Local Clients: [0-9]+$|]),      (1, "f", [str|^Failed (OPER|CHALLENGE) attempt - host mismatch|]),     (3, "f", [str|^Failed (OPER|CHALLENGE) attempt|]), -- ORDER IMPORTANT - catch all failed attempts that aren't host mismatch

@@ -71,7 +71,7 @@   = NetworkOpen  !ZonedTime [Text]   -- | Event for a new recieved line (newline removed)   | NetworkLine  !ZonedTime !ByteString-  -- | Final message indicating the network connection failed+  -- | Report an error on network connection network connection failed   | NetworkError !ZonedTime !SomeException   -- | Final message indicating the network connection finished   | NetworkClose !ZonedTime@@ -232,7 +232,7 @@  receiveLoop :: Connection -> TQueue NetworkEvent -> IO () receiveLoop h inQueue =-  do mb <- recvLine h (2*ircMaxMessageLength)+  do mb <- recvLine h (4*ircMaxMessageLength)      for_ mb $ \msg ->        do unless (B.null msg) $ -- RFC says to ignore empty messages             do now <- getZonedTime

@@ -678,7 +678,7 @@   compile     defaultCompOpt     defaultExecOpt{captureGroups=False}-    "https?://([[:alnum:]-]+\\.)*([[:alnum:]-]+)(:[[:digit:]]+)?(/[-0-9a-zA-Z$_.+!*'(),%?=:@/;]*)?|\+    "https?://([[:alnum:]-]+\\.)*([[:alnum:]-]+)(:[[:digit:]]+)?(/[-0-9a-zA-Z$_.+!*'(),%?=:@/;~#]*)?|\     \<https?://[^>]*>|\     \\\(https?://[^\\)]*\\)" 

@@ -711,7 +711,8 @@     ss = view csSettings cs     sasl = ["sasl" | isJust (view ssSaslUsername ss)                    , isJust (view ssSaslPassword ss) ||-                     isJust (view ssSaslEcdsaFile ss) ]+                     isJust (view ssSaslEcdsaFile ss) ||+                     isJust (view ssTlsClientCert ss) ]  doAuthenticate :: Text -> NetworkState -> ([RawIrcMsg], NetworkState) doAuthenticate param cs =@@ -720,19 +721,19 @@       | "+"       <- param       , Just user <- view ssSaslUsername ss       , Just pass <- view ssSaslPassword ss-      -> ([ircAuthenticate (encodePlainAuthentication user pass)],+      -> (ircAuthenticates (encodePlainAuthentication user pass),           set csAuthenticationState AS_None cs)      AS_ExternalStarted       | "+"       <- param       , Just user <- view ssSaslUsername ss-      -> ([ircAuthenticate (encodeExternalAuthentication user)],+      -> (ircAuthenticates (encodeExternalAuthentication user),           set csAuthenticationState AS_None cs)      AS_EcdsaStarted       | "+"       <- param       , Just user <- view ssSaslUsername ss-      -> ([ircAuthenticate (Ecdsa.encodeUsername user)],+      -> (ircAuthenticates (Ecdsa.encodeUsername user),           set csAuthenticationState AS_EcdsaWaitChallenge cs)      AS_EcdsaWaitChallenge -> ([], cs) -- handled in Client.EventLoop!