Reaktor.Internal: play ping-pong quietly

3 files changed, 52 insertions, 36 deletions

diff --git a/src/Reaktor.hs b/src/Reaktor.hs
index 2d3e7f5..77db22c 100644
--- a/src/Reaktor.hs
+++ b/src/Reaktor.hs
@@ -10,9 +10,10 @@ module Reaktor
 import Blessings
 import Control.Concurrent.Extended
 import Control.Exception
-import Data.Attoparsec.ByteString.Char8
+import Data.Attoparsec.ByteString.Char8 (feed,parse)
+import Data.Attoparsec.ByteString.Char8 (IResult(Done,Fail,Partial))
 import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Char8.Extended as BS
 import Data.Foldable (toList)
 import Data.Time.Clock.System
 import Data.Time.Format
@@ -61,11 +62,14 @@ run Config{..} getPlugins =
       let actions = Actions{..}
           aIsSecure = cUseTLS
           aLog = putLog
-          aLogMsg msg = do
-              let bs = formatMessage msg
-              putLog $ SGR [38,5,235] "> " <> SGR [35,1] (Plain bs)
-          aSendQuiet = putOutMsg
-          aSend msg = aLogMsg msg >> aSendQuiet msg
+          aSend msg = logMsg msg >> putOutMsg msg
+
+          logMsg msg =
+              case logMsgFilter msg of
+                Just msg' -> do
+                  let bs = formatMessage msg'
+                  aLog $ SGR [38,5,235] "> " <> SGR [35,1] (Plain bs)
+                Nothing -> return ()
 
       mapM_ (\(s, f) -> installHandler s (Catch f) Nothing) [
           (sigINT, shutdown)
@@ -107,8 +111,7 @@ receiver Actions{..} putInMsg sockRecv =
   where
     receive "" =
         sockRecv >>= \case
-          Nothing -> do
-            aLog $ SGR [34,1] (Plain "# EOL")
+          Nothing -> logErr "EOL"
           Just buf -> receive buf
 
     receive buf =
@@ -117,21 +120,27 @@ receiver Actions{..} putInMsg sockRecv =
         go :: IResult ByteString Message -> IO ()
         go = \case
             Done rest msg -> do
-              -- TODO log message only if h hasn't disabled logging for it
-              let bs = formatMessage msg
-              aLog $ SGR [38,5,235] "< " <> SGR [38,5,244] (Plain bs)
+              logMsg msg
               putInMsg msg
               receive rest
 
-            p@(Partial _) -> do
+            p@(Partial _) ->
               sockRecv >>= \case
-                Nothing -> do
-                  aLog $ SGR [31] (Plain "EOF")
-                Just msg ->
-                  go (feed p msg)
+                Nothing -> logErr ("EOF with partial " <> Plain (BS.show p))
+                Just msg -> go (feed p msg)
+
+            f@(Fail _i _errorContexts _errMessage) ->
+              logErr ("failed to parse message: " <> Plain (BS.show f))
+
+    logErr s = aLog $ SGR [31,1] ("! receive: " <> s)
+
+    logMsg msg =
+        case logMsgFilter msg of
+          Just msg' -> do
+            let bs = formatMessage msg'
+            aLog $ SGR [38,5,235] "< " <> SGR [38,5,244] (Plain bs)
+          Nothing -> return ()
 
-            f@(Fail _i _errorContexts _errMessage) -> do
-              aLog $ SGR [31,1] (Plain (BS.pack $ show f))
 
 sender :: IO Message -> (ByteString -> IO ()) -> IO ()
 sender takeOutMsg sockSend =
@@ -144,6 +153,21 @@ splitter plugins takeInMsg =
       mapM_ (\f -> forkIO (f msg)) plugins
 
 
+logMsgFilter :: Message -> Maybe Message
+logMsgFilter = \case
+    Message _ "PING" _ -> Nothing
+    Message _ "PONG" _ -> Nothing
+    Message p "PRIVMSG" ["NickServ",xs] | check -> do
+        Just (Message p "PRIVMSG" ["NickServ",xs'])
+      where
+        check = elem cmd ["IDENTIFY","RELEASE"] && length ws > 2
+        ws = BS.words xs
+        (cmd:ws') = ws
+        (nick:_) = ws'
+        xs' = BS.unwords [cmd, nick, "<password>"]
+    msg -> Just msg
+
+
 privmsg :: ByteString -> [ByteString] -> Message
 privmsg msgtarget xs =
     Message Nothing "PRIVMSG" (msgtarget:BS.intercalate " " xs:[])
diff --git a/src/Reaktor/Internal.hs b/src/Reaktor/Internal.hs
index 74db9c3..48a3f24 100644
--- a/src/Reaktor/Internal.hs
+++ b/src/Reaktor/Internal.hs
@@ -15,10 +15,7 @@ data Actions = Actions
     { aIsSecure :: Bool
 
     , aSend :: Message -> IO ()
-    , aSendQuiet :: Message -> IO ()
-
     , aLog :: Blessings ByteString -> IO ()
-    , aLogMsg :: Message -> IO ()
 
     , aSetNick :: ByteString -> IO ()
     , aGetNick :: IO ByteString
diff --git a/src/Reaktor/Plugins/Register.hs b/src/Reaktor/Plugins/Register.hs
index 314fc6f..ec3a11e 100644
--- a/src/Reaktor/Plugins/Register.hs
+++ b/src/Reaktor/Plugins/Register.hs
@@ -52,9 +52,7 @@ new Config{..} Actions{..} = do
         Just ConfigNickServ{..} = cNickServ
 
         release nick pass = do
-          -- TODO Password type that doesn't get logged?
-          aLogMsg (privmsg "NickServ" ["RELEASE", nick, "<password>"])
-          aSendQuiet (privmsg "NickServ" ["RELEASE", nick, pass])
+          aSend (privmsg "NickServ" ["RELEASE", nick, pass])
 
         channelsArg = BS.intercalate "," cChannels
         -- TODO make this similar to privmsg (i.e. don't aSend)
@@ -113,8 +111,7 @@ new Config{..} Actions{..} = do
         -- RFC2812 RPL_WELCOME
         Message _ "001" [msgtarget,_text] -> do
           nick <- aGetNick
-          aLogMsg (privmsg "NickServ" ["IDENTIFY", nick, "<password>"])
-          aSendQuiet (privmsg "NickServ" ["IDENTIFY", nick, pass])
+          aSend (privmsg "NickServ" ["IDENTIFY", nick, pass])
           when (msgtarget /= nick) (release nick pass)
 
         -- TODO structured prefix, and check just for "NickServ"?
@@ -124,22 +121,20 @@ new Config{..} Actions{..} = do
             let stx = ("\STX"<>) . (<>"\STX")
             if
               | text == "You are now identified for " <> stx nick <> "." -> do
-                -- XXX if msgtarget == nick then do
-                -- XXX   join
-                -- XXX else do
-                -- XXX   aSend (Message Nothing "NICK" [nick])
-
                 -- otherwise join at NICK
                 when (msgtarget == nick) join
 
               | text == stx nick <> " has been released." -> do
                 aSend (Message Nothing "NICK" [nick])
+
               | text == "Invalid password for " <> stx nick <> "." -> do
-                -- TODO change nick + warning
-                error (BS.unpack text)
+                -- TODO warning
+                when (msgtarget == nick) join
+
               | text == stx nick <> " is not a registered nickname." -> do
-                -- TODO change nick + warning
-                error (BS.unpack text)
+                -- TODO warning
+                when (msgtarget == nick) join
+
               | otherwise ->
                 pure ()