src: use more simple functions

12 files changed, 311 insertions, 413 deletions

diff --git a/src/Reaktor/Config.hs b/src/Reaktor/Config.hs
deleted file mode 100644
index 908f9a8..0000000
--- a/src/Reaktor/Config.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Config where
-
-import           Data.Aeson
-import qualified Data.HashMap.Lazy as HML
-import qualified Data.Text as T
-import           Reaktor.Internal
-import qualified Reaktor.Plugins
-
-
-instance FromJSON Config where
-  parseJSON (Object v) = do
-      p <- v .:? "port" .!= defaultPort
-
-      Config
-        <$> v .: "hostname"
-        <*> pure p
-        <*> v .: "nick"
-        <*> v .:? "useTLS" .!= (p == tlsPort)
-        <*> v .:? "logTime" .!= True
-        <*> v .:? "plugins" .!= []
-  parseJSON _ = pure undefined
-
-
-data Config = Config {
-      hostname :: HostName,
-      port :: ServiceName,
-      nick :: Nickname,
-      useTLS :: Bool,
-      logTime :: Bool,
-      pluginInstances :: [PluginInstance]
-    }
-
-
-addPlugin :: T.Text -> IO Plugin -> Config -> Config
-addPlugin name p r =
-    r { pluginInstances = pluginInstances r <> [PluginInstance name (Left p)] }
-
-
-defaultPort :: ServiceName
-defaultPort = tlsPort
-
-tlsPort :: ServiceName
-tlsPort = "6697"
-
-
-data PluginInstance = PluginInstance {
-      pi_name :: T.Text,
-      pi_plugin :: Either (IO Plugin) Plugin
-    }
-
-instance FromJSON PluginInstance where
-  parseJSON o@(Object v) =
-      case HML.lookup "plugin" v of
-        Just (String name) -> do
-          let p = Reaktor.Plugins.get name
-              c = HML.lookupDefault (Object HML.empty) "config" v
-          pure $ PluginInstance name (Left $ p c)
-        Just _ -> error ("bad plugin object: " <> show o)
-        _ -> error ("mising 'plugin' attribute: " <> show o)
-  parseJSON x =
-      error ("bad plugin type: " <> show x)
-
-
-initPlugins :: Config -> IO Config
-initPlugins cfg = do
-    plugins' <- mapM initPlugin (pluginInstances cfg)
-    return cfg { pluginInstances = plugins' }
-  where
-    initPlugin :: PluginInstance -> IO PluginInstance
-    initPlugin i = do
-      p <-
-        case pi_plugin i of
-          Right p -> return p
-          Left f -> f
-      return i { pi_plugin = Right p }
diff --git a/src/Reaktor/Internal.hs b/src/Reaktor/Internal.hs
index d3ac9cf..26294b4 100644
--- a/src/Reaktor/Internal.hs
+++ b/src/Reaktor/Internal.hs
@@ -1,58 +1,68 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Internal (module Reaktor.Internal, module X) where
-
-import           Blessings (Blessings)
-import           Control.Monad.Trans.Class as X (lift)
-import           Control.Monad.Trans.State as X (gets,modify)
-import           Control.Monad.Trans.State (StateT)
-import           Data.Aeson
-import           Data.Aeson.Types
+{-# LANGUAGE RecordWildCards #-}
+module Reaktor.Internal where
+
+import Blessings
+import Data.Aeson
+import Data.ByteString (ByteString)
+import Network.Socket as Exports (HostName,ServiceName)
+import Prelude.Extended
 import qualified Data.ByteString.Char8.Extended as BS
-import           Network.Socket as X (HostName,ServiceName)
+import System.IO
 
 
-type Prefix = BS.ByteString
+data Actions = Actions
+    { aIsSecure :: Bool
 
-type Nickname = BS.ByteString
-type Password = BS.ByteString
-type MsgTarget = BS.ByteString
-type Channel = MsgTarget
+    , aSend :: Message -> IO ()
+    , aSendQuiet :: Message -> IO ()
 
-data PluginState = PluginState {
-      s_putLog :: Blessings BS.ByteString -> IO (),
-      s_nick :: BS.ByteString,
-      s_sendMsg :: Message -> IO (),
-      s_sendMsg' :: Message -> Message -> IO ()
-    }
-
-setNick :: Nickname -> PluginIO ()
-setNick newnick = modify (\q -> q { s_nick = newnick })
-
-getNick :: PluginIO Nickname
-getNick = gets s_nick
-
-sendMsg :: Message -> PluginIO ()
-sendMsg msg = gets s_sendMsg >>= \f -> lift $ f msg
-
-sendMsg' :: Message -> Message -> PluginIO ()
-sendMsg' msg logMsg = gets s_sendMsg' >>= \f -> lift $ f msg logMsg
+    , aLog :: Blessings ByteString -> IO ()
+    , aLogMsg :: Message -> IO ()
 
-
-type PluginIO = StateT PluginState IO
-
-type PluginFunc = Message -> PluginIO ()
-
-data Plugin = Plugin {
-      pluginFunc :: PluginFunc,
-      requireTLS :: Bool
+    , aSetNick :: ByteString -> IO ()
+    , aGetNick :: IO ByteString
     }
 
-simplePlugin :: FromJSON a => (a -> PluginFunc) -> Value -> IO Plugin
-simplePlugin f v =
-    either error (\x -> return $ Plugin (f x) False) (parseEither parseJSON v)
 
+data Config = Config
+    { cUseTLS :: Bool
+    , cHostName :: HostName
+    , cServiceName :: ServiceName
+    , cNick :: Maybe ByteString
+    , cLogHandle :: Handle
+    , cLogTime :: Bool
+    }
 
-type Param = BS.ByteString
-type Command = BS.ByteString
-data Message = Message (Maybe Prefix) Command [Param]
+instance Default Config where
+  def = Config False "irc.r" "6667" Nothing stderr True
+
+instance FromJSON Config where
+  parseJSON = \case
+      Object v -> do
+        cServiceName <- v .:? "port" .!= cServiceName def
+        cUseTLS <- v .:? "useTLS" .!= (cServiceName == tlsPort)
+        cHostName <- v .:? "hostname" .!= cHostName def
+        cNick <- v .:? "nick"
+        cLogHandle <- pure (cLogHandle def)
+        cLogTime <- v .:? "logTime" .!= cLogTime def
+        pure Config{..}
+      _ -> undefined
+    where
+      tlsPort :: ServiceName
+      tlsPort = "6697"
+
+
+data Message = Message (Maybe ByteString) ByteString [ByteString] | Start
   deriving Show
+
+formatMessage :: Message -> ByteString
+formatMessage = \case
+    Message mb_prefix cmd params ->
+      maybe "" ((":"<>) . (<>" ")) mb_prefix
+          <> cmd
+          <> BS.concat (map (" "<>) (init params))
+          <> if null params then "" else " :" <> last params
+          <> "\r\n"
+    x -> error ("cannot format " <> show x)
diff --git a/src/Reaktor/Message.hs b/src/Reaktor/Message.hs
deleted file mode 100644
index c679d78..0000000
--- a/src/Reaktor/Message.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Message where
-
-import qualified Data.ByteString.Char8.Extended as BS
-import           Reaktor.Internal
-
-
-privmsg :: BS.ByteString -> [BS.ByteString] -> Message
-privmsg msgtarget xs =
-    Message Nothing "PRIVMSG" (msgtarget:BS.intercalate " " xs:[])
-
-notice :: BS.ByteString -> [BS.ByteString] -> Message
-notice msgtarget xs =
-    Message Nothing "NOTICE" (msgtarget:BS.intercalate " " xs:[])
diff --git a/src/Reaktor/Utils.hs b/src/Reaktor/Nick.hs
index a31cd15..591ea4b 100644
--- a/src/Reaktor/Utils.hs
+++ b/src/Reaktor/Nick.hs
@@ -1,14 +1,14 @@
-module Reaktor.Utils where
+module Reaktor.Nick where
 
+import Data.ByteString.Char8.Extended (ByteString)
 import qualified Data.ByteString.Char8.Extended as BS
 import           Data.Char (chr)
 import           Data.Char (isDigit)
-import           Reaktor.Internal
 import           System.Random (getStdRandom, randomR)
 
 
-nextNick :: Nickname -> Nickname
-nextNick nick_ = nick'
+getNext :: ByteString -> ByteString
+getNext nick_ = nick'
   where
     splitNick s =
            (prefix, maybe 0 fst (BS.readInt suffix))
@@ -19,8 +19,8 @@ nextNick nick_ = nick'
     nick' = nickPrefix <> (BS.pack . show $ nickSuffix + 1)
 
 
-randomNick :: IO Nickname
-randomNick = do
+getRandom :: IO ByteString
+getRandom = do
     h_chr <- getRandomChar nickhead
     t_len <- getStdRandom (randomR (4,8)) :: IO Int
     t_str <- mapM (const $ getRandomChar nicktail) [1..t_len]
@@ -28,10 +28,17 @@ randomNick = do
   where
     getRandomChar cs = (cs!!) <$> getStdRandom (randomR (0, length cs - 1))
 
-    nickhead  = letters <> specials
-    nicktail  = letters <> digits <> specials <> minus
+    -- RFC2812 (doesn't work with charybdis)
+    --nickhead  = letters <> specials
+    --nicktail  = letters <> digits <> specials <> minus
+    --letters   = map chr $ [0x41..0x5A] <> [0x61..0x7A]
+    --digits    = map chr $ [0x30..0x39]
+    --specials  = map chr $ [0x5B..0x60] <> [0x7B..0x7D]
+    --minus     = map chr $ [0x2D]
 
+    -- RFC1459
+    nickhead  = letters
+    nicktail  = letters <> number <> special
     letters   = map chr $ [0x41..0x5A] <> [0x61..0x7A]
-    digits    = map chr $ [0x30..0x39]
-    specials  = map chr $ [0x5B..0x60] <> [0x7B..0x7D]
-    minus     = map chr $ [0x2D]
+    number    = map chr $ [0x30..0x39]
+    special   = map chr $ [0x5B..0x60] <> [0x7B..0x7D] <> [0x2D]
diff --git a/src/Reaktor/Parser.hs b/src/Reaktor/Parser.hs
index 12d5ace..1b358fc 100644
--- a/src/Reaktor/Parser.hs
+++ b/src/Reaktor/Parser.hs
@@ -1,35 +1,37 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Reaktor.Parser where
 
-import           Control.Applicative
-import           Data.Attoparsec.ByteString.Char8
-import qualified Data.ByteString.Char8.Extended as BS
+import Control.Applicative
+import Data.ByteString (ByteString)
+import Data.Attoparsec.ByteString.Char8
+--import qualified Data.ByteString.Char8.Extended as BS
+import qualified Data.ByteString.Char8 as BS
 import qualified Data.Char
-import           Reaktor.Internal
+import Reaktor.Internal
 
 
-prefix :: Parser Prefix
+prefix :: Parser ByteString
 prefix = BS.pack <$> many (satisfy Data.Char.isAlphaNum <|>
                            satisfy (flip elem (":.-@/!~[]\\`_^{|}" :: String)))
 
-command :: Parser Command
+command :: Parser ByteString
 command = BS.pack <$> many1 (satisfy Data.Char.isAlphaNum)
 
 nospcrlfcl :: Parser Char
 nospcrlfcl =
   satisfy (flip notElem ("\NUL\CR\LF :" :: String)) <?> "nospcrlfcl"
 
-middle :: Parser Param
+middle :: Parser ByteString
 middle =
     BS.pack <$> ((:) <$> nospcrlfcl <*> many (char ':' <|> nospcrlfcl))
     <?> "middle"
 
-trailing :: Parser Param
+trailing :: Parser ByteString
 trailing =
     BS.pack <$> many (char ':' <|> char ' ' <|> nospcrlfcl)
     <?> "trailing"
 
-params :: Parser [Param]
+params :: Parser [ByteString]
 params = (do
     a <- many (char ' ' *> middle)
     b <- optional (char ' ' *> char ':' *> trailing)
diff --git a/src/Reaktor/Plugins.hs b/src/Reaktor/Plugins.hs
deleted file mode 100644
index 86e1f2a..0000000
--- a/src/Reaktor/Plugins.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Plugins (get,registry) where
-
-import           Data.Aeson (Value)
-import qualified Data.Map as M
-import qualified Data.Text as T
-import qualified Reaktor.Plugins.Mention
-import qualified Reaktor.Plugins.NickServ
-import qualified Reaktor.Plugins.Ping
-import qualified Reaktor.Plugins.Register
-import qualified Reaktor.Plugins.System
-import           Reaktor.Internal (Plugin)
-
-
-get :: T.Text -> Value -> IO Plugin
-get name =
-    case M.lookup name registry of
-      Just p -> p
-      Nothing -> error ("unknown plugin: " <> T.unpack name)
-
-registry :: M.Map T.Text (Value -> IO Plugin)
-registry = M.fromList [
-    ("mention", Reaktor.Plugins.Mention.plugin),
-    ("NickServ", Reaktor.Plugins.NickServ.plugin),
-    ("ping", Reaktor.Plugins.Ping.plugin),
-    ("register", Reaktor.Plugins.Register.plugin),
-    ("system", Reaktor.Plugins.System.plugin)
-  ]
diff --git a/src/Reaktor/Plugins/Mention.hs b/src/Reaktor/Plugins/Mention.hs
index 75de87c..379bd38 100644
--- a/src/Reaktor/Plugins/Mention.hs
+++ b/src/Reaktor/Plugins/Mention.hs
@@ -1,26 +1,22 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Plugins.Mention (plugin) where
+{-# LANGUAGE RecordWildCards #-}
+module Reaktor.Plugins.Mention (new) where
 
-import           Control.Monad (when)
-import           Data.Aeson
+import Prelude.Extended
 import qualified Data.ByteString.Char8.Extended as BS
 import qualified Data.Char
-import           Reaktor.Internal
-import           Reaktor.Message
+import Reaktor
 
 
-plugin :: Value -> IO Plugin
-plugin _ = return (Plugin run False)
-
-
-run :: PluginFunc
-run = \case
-    Message _ "PRIVMSG" (msgtarget:text:[]) -> do
-        nick <- getNick
-        when (isMention nick text) $ do
-          sendMsg (privmsg msgtarget ["I'm famous!"])
-    _ -> return ()
+new :: Actions -> IO (Message -> IO ())
+new Actions{..} = do
+    pure $ \case
+      Message _ "PRIVMSG" (msgtarget:text:[]) -> do
+          nick <- aGetNick
+          when (isMention nick text) $ do
+            aSend (privmsg msgtarget ["I'm famous!"])
+      _ -> return ()
   where
     isMention nick text =
       not (BS.isPrefixOf (nick <> ":") text) &&
diff --git a/src/Reaktor/Plugins/NickServ.hs b/src/Reaktor/Plugins/NickServ.hs
deleted file mode 100644
index 36b8917..0000000
--- a/src/Reaktor/Plugins/NickServ.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Plugins.NickServ (plugin) where
-
-import           Control.Monad (when)
-import           Data.Aeson
-import           Data.Aeson.Types (parseEither)
-import qualified Data.ByteString.Char8.Extended as BS
-import           GHC.Generics
-import           Reaktor.Internal
-import           Reaktor.Message
-import           Reaktor.Utils (randomNick)
-
-
-data NickServConfig = NickServConfig {
-      passFile :: FilePath,
-      prefix :: BS.ByteString,
-      channels :: [BS.ByteString]
-    }
-  deriving (FromJSON,Generic)
-
-
-plugin :: Value -> IO Plugin
-plugin v =
-    case parseEither parseJSON v of
-      Right cfg -> do
-        pass <- do
-          [pass] <- lines <$> readFile (passFile cfg)
-          return (BS.pack pass)
-
-        return $ Plugin (run pass cfg) True
-      Left err ->
-        error err
-
-
-run :: BS.ByteString -> NickServConfig -> PluginFunc
-run pass cfg msg = do
-    nick_ <- getNick
-    case msg of
-
-      Message _ "<start>" _ -> do
-        nick0 <- lift randomNick
-        sendMsg (Message Nothing "NICK" [nick0])
-        sendMsg (Message Nothing "USER" [nick_, "*", "0", nick_])
-
-      -- TODO structured prefix, and check just for "NickServ"
-      Message (Just _prefix@"NickServ!NickServ@services.")
-                       "NOTICE"
-                       (_msgtarget:text:[]) -> do
-       if
-         | text == "You are now identified for \STX" <> nick_ <> "\STX." -> do
-           sendMsg (Message Nothing "NICK" [nick_])
-         | text == "\STX" <> nick_ <> "\STX has been released." -> do
-           sendMsg (Message Nothing "NICK" [nick_])
-         | text == "Invalid password for \STX" <> nick_ <> "\STX." -> do
-           error (BS.unpack text)
-         | text == "\STX" <> nick_ <> "\STX is not a registered nickname." -> do
-           error (BS.unpack text)
-         | otherwise ->
-           return ()
-
-
-      Message (Just _self) "NICK" (newnick:[]) -> do
-        when (newnick == nick_) $ do
-          -- TODO JOIN only if not already joined
-          --      i.e. not during subsequent nick changes
-          sendMsg (Message Nothing "JOIN" [ BS.intercalate "," (channels cfg) ])
-
-
-      -- RFC1459 ERR_NICKNAMEINUSE
-      Message (Just _servername) "433" (_msgtarget:nickinuse:_reason:[]) -> do
-        if nickinuse == nick_
-          then do
-            sendMsg (privmsg "NickServ" ["RELEASE", nickinuse])
-          else do
-            nick0 <- lift randomNick
-            sendMsg (Message Nothing "NICK" [nick0])
-
-      --RFC2812 ERR_UNAVAILRESOURCE
-      Message (Just _servername) "437" (_msgtarget:nickunavail:_reason:[]) -> do
-        when (nickunavail == nick_) $ do
-          sendMsg (privmsg "NickServ" ["RELEASE", nickunavail])
-
-      --RFC2812 RPL_WELCOME
-      Message _ "001" [_nick,_s] -> do
-        sendMsg' (privmsg "NickServ" ["IDENTIFY", nick_, pass])
-                 (privmsg "NickServ" ["IDENTIFY", nick_, "<password>"])
-
-
-      _ -> return ()
diff --git a/src/Reaktor/Plugins/Ping.hs b/src/Reaktor/Plugins/Ping.hs
index de3fe53..436ebe2 100644
--- a/src/Reaktor/Plugins/Ping.hs
+++ b/src/Reaktor/Plugins/Ping.hs
@@ -1,15 +1,15 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Plugins.Ping (plugin) where
-
-import           Control.Monad (when)
-import           Data.Aeson (Value(Null))
-import           Reaktor.Internal
-
-
-plugin :: Value -> IO Plugin
-plugin = simplePlugin (\Null -> run)
-
-run :: PluginFunc
-run (Message _ ircCommand args) =
-    when (ircCommand == "PING") $
-      sendMsg (Message Nothing "PONG" args)
+{-# LANGUAGE RecordWildCards #-}
+module Reaktor.Plugins.Ping where
+
+import Prelude.Extended
+import Reaktor
+
+new :: Actions -> IO (Message -> IO ())
+new Actions{..} =
+    return $ \case
+      Message _ cmd args ->
+        when (cmd == "PING") $
+          aSend (Message Nothing "PONG" args)
+      _ -> pure ()
diff --git a/src/Reaktor/Plugins/Register.hs b/src/Reaktor/Plugins/Register.hs
index 5e987a7..314fc6f 100644
--- a/src/Reaktor/Plugins/Register.hs
+++ b/src/Reaktor/Plugins/Register.hs
@@ -1,65 +1,163 @@
-{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Plugins.Register (plugin) where
+{-# LANGUAGE RecordWildCards #-}
+module Reaktor.Plugins.Register where
 
-import           Control.Monad (when)
-import           Data.Aeson
+import Blessings
+import Prelude.Extended
+import Data.Aeson
+import Data.ByteString.Char8.Extended (ByteString)
 import qualified Data.ByteString.Char8.Extended as BS
-import           GHC.Generics
-import           Reaktor.Internal
-import           Reaktor.Utils (nextNick,randomNick)
+import qualified Reaktor.Nick as Nick
+import Reaktor
+import System.Environment (lookupEnv)
 
+data ConfigNickServ = ConfigNickServ
+    { cnsPassFile :: FilePath
+    , cnsPrefix :: ByteString
+    }
+instance FromJSON ConfigNickServ where
+  parseJSON = \case
+    Object v ->
+      ConfigNickServ
+        <$> v .: "passFile"
+        <*> v .:? "prefix" .!= "NickServ!NickServ@services."
+    _ -> undefined
 
-data RegisterConfig = RegisterConfig {
-      channels :: [BS.ByteString]
+data Config = Config
+    { cNick :: Maybe ByteString
+    , cUser :: Maybe ByteString
+    , cReal :: ByteString
+    , cChannels :: [ByteString]
+    , cNickServ :: Maybe ConfigNickServ
     }
-  deriving (FromJSON,Generic)
+instance Default Config where
+  def = Config def def "reaktor2" def def
+instance FromJSON Config where
+  parseJSON = \case
+    Object v -> do
+      cNick <- v .:? "nick" .!= Nothing
+      cUser <- v .:? "user"
+      cReal <- v .:? "real" .!= cReal def
+      cChannels <- v .:? "channels" .!= []
+      cNickServ <- v .:? "NickServ" .!= cNickServ def
+      pure Config{..}
+    _ -> undefined
+
+new :: Config -> Actions -> IO (Message -> IO ())
+new Config{..} Actions{..} = do
+    let
+        isNickServEnabled = aIsSecure && isJust cNickServ
+        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])
 
+        channelsArg = BS.intercalate "," cChannels
+        -- TODO make this similar to privmsg (i.e. don't aSend)
+        join = do
+            -- TODO JOIN only if not already joined
+            --      i.e. not during subsequent nick changes
+            unless (BS.null channelsArg) $
+              aSend (Message Nothing "JOIN" [channelsArg])
 
-plugin :: Value -> IO Plugin
-plugin = simplePlugin run
+        start = do
+          nick <- maybe aGetNick pure cNick
+          user <-
+            maybe (maybe nick BS.pack <$> lookupEnv "LOGNAME") pure cUser
+          aSetNick nick
+          aSend (Message Nothing "NICK" [nick])
+          aSend (Message Nothing "USER" [user, "*", "0", cReal])
+        onNick newnick = do
+          nick <- aGetNick
+          when (newnick == nick) join
+        useRandomNick = do
+          nick <- Nick.getRandom
+          aSetNick nick
+          aSend (Message Nothing "NICK" [nick])
+        useNextNick = do
+          nick0 <- aGetNick
+          let nick = Nick.getNext nick0
+          aSetNick nick
+          aSend (Message Nothing "NICK" [nick])
+        useNextNickTemporarily = do
+          nick <- aGetNick
+          let tmpNick = Nick.getNext nick
+          -- do not aSetNick tmpNick 
+          aSend (Message Nothing "NICK" [tmpNick])
 
+    if not isNickServEnabled then do
+      when (isJust cNickServ) $ do
+        aLog $ SGR [38,5,202] "! disabling NickServ due to insecure connection"
+      pure $ \case
+        Start -> start
+        Message (Just _self) "NICK" (newnick:[]) -> onNick newnick
+        Message _ "001" _ -> join
+        Message _ "432" _ -> useRandomNick
+        Message _ "433" _ -> useNextNick
+        Message _ "437" (_msgtarget:res:_reason:[]) -> do
+          nick <- aGetNick
+          when (res == nick) useNextNick
+        _ -> pure ()
 
-run :: RegisterConfig -> PluginFunc
-run cfg msg = do
-    nick_ <- getNick
-    case msg of
+    else do
+      -- TODO do not fail, but disable NicServ
+      [pass] <- BS.lines <$> BS.readFile cnsPassFile
+      pure $ \case
+        Start -> start
+        Message (Just _self) "NICK" (newnick:[]) -> onNick newnick
 
-      Message _ "<start>" _ -> do
-        sendMsg (Message Nothing "NICK" [nick_])
-        sendMsg (Message Nothing "USER" [nick_, "*", "0", nick_])
+        -- RFC2812 RPL_WELCOME
+        Message _ "001" [msgtarget,_text] -> do
+          nick <- aGetNick
+          aLogMsg (privmsg "NickServ" ["IDENTIFY", nick, "<password>"])
+          aSendQuiet (privmsg "NickServ" ["IDENTIFY", nick, pass])
+          when (msgtarget /= nick) (release nick pass)
 
-      Message (Just _self) "NICK" (newnick:[]) -> do
-        when (newnick == nick_) $ do
-          -- TODO JOIN only if not already joined
-          --      i.e. not during subsequent nick changes
-          sendMsg (Message Nothing "JOIN" [ BS.intercalate "," (channels cfg) ])
+        -- TODO structured prefix, and check just for "NickServ"?
+        Message (Just prefix) "NOTICE" (msgtarget:text:[]) ->
+          when (prefix == cnsPrefix) $ do
+            nick <- aGetNick
+            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])
 
-      -- RFC1459 ERR_NICKNAMEINUSE
-      Message (Just _servername) "433" (_msgtarget:nickinuse:_reason:[]) -> do
-        if nickinuse == nick_ then do
-          let nick' = nextNick nickinuse
-          sendMsg (Message Nothing "NICK" [nick'])
-          -- TODO change state on "NICK"
-          setNick nick'
+                -- otherwise join at NICK
+                when (msgtarget == nick) join
 
-        -- TODO is this just for NickServ? (also check that module if it has
-        -- stuff only for "Register")
-        else do
-          nick' <- lift randomNick
-          sendMsg (Message Nothing "NICK" [nick'])
-          -- TODO set nick on "NICK" message
-          setNick nick'
+              | 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)
+              | text == stx nick <> " is not a registered nickname." -> do
+                -- TODO change nick + warning
+                error (BS.unpack text)
+              | otherwise ->
+                pure ()
 
-      -- RFC2812 ERR_UNAVAILRESOURCE
-      --Message (Just _servername) "437" (_msgtarget:nickunavail:_reason:[]) -> do
+        -- RFC1459 ERR_ERRONEUSNICKNAME
+        Message (Just _servername) "432" (_msgtarget:_nick:_reason:[]) ->
+          useRandomNick
 
-      -- RFC2812 RPL_WELCOME
-      Message _ "001" [_nick,_s] -> do
-        --logStrLn $ SGR [32,1] (Plain s)
-        sendMsg (Message Nothing "JOIN" [ BS.intercalate "," (channels cfg) ])
+        -- RFC1459 ERR_NICKNAMEINUSE
+        Message (Just _servername) "433" (_msgtarget:_nick:_reason:[]) ->
+          -- TODO what if nick0 /= nick? OR assert/prove nick0 == nick?
+          useNextNickTemporarily
 
+        --RFC2812 ERR_UNAVAILRESOURCE
+        Message (Just _servername) "437" (msgtarget:res:_reason:[]) -> do
+          nick <- aGetNick
+          when (res == nick) $
+            case msgtarget of
+              "*" -> useNextNickTemporarily
+              _ -> release nick pass
 
-      _ -> return ()
+        _ -> pure ()
diff --git a/src/Reaktor/Plugins/System.hs b/src/Reaktor/Plugins/System.hs
index 781409b..88b8d84 100644
--- a/src/Reaktor/Plugins/System.hs
+++ b/src/Reaktor/Plugins/System.hs
@@ -2,58 +2,49 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Reaktor.Plugins.System (plugin) where
-
-import           Blessings
-import           Control.Applicative
-import           Control.Concurrent (forkIO)
-import           Control.Exception (finally)
-import           Data.Aeson
+{-# LANGUAGE RecordWildCards #-}
+module Reaktor.Plugins.System (new) where
+
+--import Prelude.Extended
+import Blessings
+import Control.Applicative
+import Control.Concurrent (forkIO)
+import Control.Exception (finally)
+--import Data.Aeson
+import Data.ByteString.Char8.Extended (ByteString)
 import qualified Data.ByteString.Char8.Extended as BS
 import qualified Data.Map as M
-import           Reaktor.Message
-import           Reaktor.Internal
-import           Reaktor.Plugins.System.Internal
-import           System.Environment (getEnvironment)
-import           System.FilePath.Posix (takeBaseName)
-import           System.IO (Handle,hClose,hPutStr,hIsEOF)
-import           System.IO (BufferMode(LineBuffering),hSetBuffering)
-import           System.Process (StdStream(CreatePipe),waitForProcess)
-import           System.Process (createProcess,CreateProcess(..),proc)
+import Reaktor
+import System.Environment (getEnvironment)
+import System.FilePath.Posix (takeBaseName)
+import System.IO (BufferMode(LineBuffering),hSetBuffering)
+import System.IO (Handle,hClose,hPutStr,hIsEOF)
+import Reaktor.Plugins.System.Internal -- TODO rename to Reaktor.Plugins.System again
+import System.Process (StdStream(CreatePipe),waitForProcess)
+import System.Process (createProcess,CreateProcess(..),proc)
 import qualified Text.Regex.PCRE.Heavy as RE
 import qualified Text.Regex.PCRE.Light as RE
 
 
-plugin :: Value -> IO Plugin
-plugin = simplePlugin run
-
-
--- TODO indicated whether other plugins should run
-run :: SystemConfig -> PluginFunc
+new :: Config -> Actions -> IO (Message -> IO ())
+new config@Config{..} actions@Actions{..} = do
+    pure $ \case
+        Message (Just prefix) "PRIVMSG" (msgtarget:text:[]) -> do
 
-run cfg (Message (Just prefix) "PRIVMSG" (msgtarget:text:[])) = do
-    nick_ <- getNick
-    let hs = maybe [] id (M.lookup "PRIVMSG" (hooks cfg))
-    mapM_ (\h -> run1 cfg nick_ h prefix msgtarget text) hs
+          nick_ <- aGetNick
+          let hs = maybe [] id (M.lookup "PRIVMSG" cHooks)
+          mapM_ (\h -> run1 config actions nick_ h prefix msgtarget text) hs
 
-run cfg (Message (Just prefix) "JOIN" (channel:[])) = do
-    nick_ <- getNick
-    let hs = maybe [] id (M.lookup "JOIN" (hooks cfg))
-    mapM_ (\h -> run1 cfg nick_ h prefix channel "") hs
+        Message (Just prefix) "JOIN" (channel:[]) -> do
+          nick_ <- aGetNick
+          let hs = maybe [] id (M.lookup "JOIN" cHooks)
+          mapM_ (\h -> run1 config actions nick_ h prefix channel "") hs
 
--- TODO warning?
-run _ _ = return ()
+        _ -> pure ()
 
 
-run1 ::
-    SystemConfig
-    -> Nickname
-    -> SystemParams
-    -> BS.ByteString
-    -> BS.ByteString
-    -> BS.ByteString
-    -> PluginIO ()
-run1 cfg nick_ params prefix msgtarget text = do
+run1 :: Config -> Actions -> ByteString -> SystemParams -> ByteString -> ByteString -> ByteString -> IO ()
+run1 config@Config{..} actions@Actions{..} nick_ params prefix msgtarget text = do
     let
         isActivated =
           case activate params of
@@ -88,6 +79,7 @@ run1 cfg nick_ params prefix msgtarget text = do
 
         from = BS.takeWhile (/='!') prefix
           --maybe prefix (flip BS.take prefix) $ BS.findIndex (=='!') prefix
+
     case isActivated of
       Just trigger -> do
         let cmdline = BS.dropWhile (==' ') $ BS.drop (BS.length trigger) text
@@ -141,36 +133,35 @@ run1 cfg nick_ params prefix msgtarget text = do
 
         case command' of
           Just c -> do
-            sendMsg_ <- gets s_sendMsg
-            putLog_ <- gets s_putLog
+            -- aSend <- gets s_sendMsg
+            -- putLog_ <- gets s_putLog
             let onErrLine s =
-                  putLog_ $ SGR [31,1] $
+                  aLog $ SGR [31,1] $
                     Plain (BS.pack (takeBaseName $ commandPath c) <> ": "<> s)
 
                 onOutLine s =
-                  sendMsg_ (privmsg audience [s])
+                  aSend (privmsg audience [s])
 
                 extraEnv = [("_prefix", BS.unpack prefix),
                             ("_from", BS.unpack from)]
 
-            lift $ fork cfg c args' (Just extraEnv) "" onOutLine onErrLine
+            fork config actions c args' (Just extraEnv) "" onOutLine onErrLine
 
           Nothing -> do
-            sendMsg (privmsg audience (resultPrefix <> [cmdName <> ": command not found"]))
+            aSend (privmsg audience (resultPrefix <> [cmdName <> ": command not found"]))
 
       Nothing -> return ()
 
-
-
-fork :: SystemConfig
+fork :: Config
+     -> Actions
      -> SystemCommand
      -> [String]
      -> Maybe [(String, String)]
      -> String
-     -> (BS.ByteString -> IO ())
-     -> (BS.ByteString -> IO ())
+     -> (ByteString -> IO ())
+     -> (ByteString -> IO ())
      -> IO ()
-fork cfg cmd args extraEnv input onOutLine onErrLine = do
+fork Config{..} Actions{..} cmd args extraEnv input onOutLine onErrLine = do
 
     baseEnv <- getEnvironment
 
@@ -183,7 +174,7 @@ fork cfg cmd args extraEnv input onOutLine onErrLine = do
     (inh, outh, errh) <- do
       (Just inh, Just outh, Just errh, ph) <-
         createProcess (proc (commandPath cmd) args) {
-          cwd = commandWorkDir cmd <|> defaultWorkDir cfg,
+          cwd = commandWorkDir cmd <|> cDefaultWorkDir,
           env = Just procEnv,
           std_in = CreatePipe,
           std_out = CreatePipe,
@@ -202,7 +193,7 @@ fork cfg cmd args extraEnv input onOutLine onErrLine = do
       ]
 
 
-hWithLines :: Handle -> (BS.ByteString -> IO ()) -> IO ()
+hWithLines :: Handle -> (ByteString -> IO ()) -> IO ()
 hWithLines h f = do
     hSetBuffering h LineBuffering
     go `finally` hClose h
diff --git a/src/Reaktor/Plugins/System/Internal.hs b/src/Reaktor/Plugins/System/Internal.hs
index 4a64e0b..2ed923d 100644
--- a/src/Reaktor/Plugins/System/Internal.hs
+++ b/src/Reaktor/Plugins/System/Internal.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Reaktor.Plugins.System.Internal where
 
-import           Data.Aeson
+import Prelude.Extended
+import Data.Aeson
 import qualified Data.ByteString.Char8.Extended as BS
 import qualified Data.Map as M
-import           Reaktor.Internal ()
+import Reaktor ()
 
 
 -- TODO this needs better names :)
@@ -24,15 +25,18 @@ instance FromJSON Activate where
   parseJSON (String "query") = pure Query
   parseJSON _ = undefined
 
-data SystemConfig = SystemConfig {
-  defaultWorkDir :: Maybe FilePath,
+data Config =