src: use more simple functionsv0.1.0

16 files changed, 530 insertions, 627 deletions

diff --git a/src/Control/Concurrent/Extended.hs b/src/Control/Concurrent/Extended.hs
new file mode 100644
index 0000000..933e3a6
--- /dev/null
+++ b/src/Control/Concurrent/Extended.hs
@@ -0,0 +1,24 @@
+module Control.Concurrent.Extended
+    ( module Exports
+    , newChan
+    , newRef
+    , newRelay
+    , newSemaphore
+    ) where
+
+import Control.Arrow
+import Control.Concurrent as Exports hiding (newChan,readChan,writeChan)
+import qualified Control.Concurrent.Chan.Unagi as U
+import Data.IORef
+
+newChan :: IO (a -> IO (), IO a)
+newChan = (U.writeChan *** U.readChan) <$> U.newChan
+
+newRef :: a -> IO (a -> IO (), IO a)
+newRef v0 = (atomicWriteIORef &&& readIORef) <$> newIORef v0
+
+newRelay :: IO (a -> IO (), IO a)
+newRelay = (putMVar &&& takeMVar) <$> newEmptyMVar
+
+newSemaphore :: IO (IO (), IO ())
+newSemaphore = first ($()) <$> newRelay
diff --git a/src/Prelude/Extended.hs b/src/Prelude/Extended.hs
new file mode 100644
index 0000000..5885033
--- /dev/null
+++ b/src/Prelude/Extended.hs
@@ -0,0 +1,8 @@
+module Prelude.Extended
+    ( module Exports
+    ) where
+
+import Control.Monad as Exports (forever,unless,when)
+import Data.Default as Exports (Default,def)
+import Data.Maybe as Exports (fromMaybe,isJust)
+import Prelude as Exports
diff --git a/src/Reaktor.hs b/src/Reaktor.hs
index fd943c7..2d3e7f5 100644
--- a/src/Reaktor.hs
+++ b/src/Reaktor.hs
@@ -1,236 +1,171 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Reaktor (run) where
-
-import           Blessings (Blessings(Append,Empty,Plain,SGR),pp)
-import           Control.Arrow
-import           Control.Concurrent (forkIO,killThread,threadDelay)
-import           Control.Concurrent (newEmptyMVar,putMVar,takeMVar)
-import           Control.Exception (finally)
-import           Control.Monad (foldM,forever,unless)
-import           Control.Monad.Trans.State.Lazy
-import           Data.Aeson
-import           Data.Attoparsec.ByteString.Char8 (IResult(Done,Fail,Partial))
-import           Data.Attoparsec.ByteString.Char8 (feed,parse)
-import qualified Data.ByteString.Char8.Extended as BS
-import           Data.Foldable (toList)
-import qualified Data.Text as T
-import           Data.Time.Clock.System
-import           Data.Time.Format
+{-# LANGUAGE RecordWildCards #-}
+module Reaktor
+    ( module Exports
+    , privmsg
+    , run
+    ) where
+
+import Blessings
+import Control.Concurrent.Extended
+import Control.Exception
+import Data.Attoparsec.ByteString.Char8
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import Data.Foldable (toList)
+import Data.Time.Clock.System
+import Data.Time.Format
 import qualified Network.Simple.TCP as TCP
 import qualified Network.Simple.TCP.TLS as TLS
-import           Reaktor.Config
-import           Reaktor.Internal
-import           Reaktor.Parser (message)
-import qualified Reaktor.Plugins
-import           System.IO (BufferMode(LineBuffering),hSetBuffering)
-import           System.IO (Handle)
-import           System.IO (hIsTerminalDevice)
-import           System.IO (hPutStr,hPutStrLn,stderr)
-import           System.Posix.Signals
-
-
-run :: Config -> IO ()
-run cfg0 = do
-
-    let logh = stderr
-
-    let cfg1 = addPlugin "ping" (Reaktor.Plugins.get "ping" Null) cfg0
-
-    cfg <- initPlugins cfg1
-
-    let tlsPlugins =
-          T.unpack $
-          T.intercalate ", " $
-          map pi_name $
-          filter (requireTLS . either undefined id . pi_plugin)
-                 (pluginInstances cfg)
-
-    unless (useTLS cfg || null tlsPlugins) $ do
-      error $ "Not using TLS, but following plugins require it: " <> tlsPlugins
-
-    -- TODO reset when done?
-    hSetBuffering logh LineBuffering
-    logToTTY <- hIsTerminalDevice logh
-    let logFilter = if logToTTY then id else stripSGR
-
-    connect cfg $ \send_ recv_ -> do
-      (putLog, takeLog) <- newRelay
-      (putMsg, takeMsg) <- newRelay
+import Network.Socket as Exports (HostName,ServiceName)
+import Prelude.Extended
+import Reaktor.Internal
+import Reaktor.Internal as Exports (Actions(..))
+import Reaktor.Internal as Exports (Message(Message,Start))
+import Reaktor.Internal as Exports (formatMessage)
+import Reaktor.Nick as Exports
+import Reaktor.Nick as Nick
+import qualified Reaktor.Parser as Parser
+import qualified System.IO
+import System.IO (BufferMode(LineBuffering),hSetBuffering)
+import System.IO (hIsTerminalDevice)
+import System.Posix.Signals
+
+
+run :: Config -> (Actions -> IO [Message -> IO ()]) -> IO ()
+run Config{..} getPlugins =
+    if cUseTLS then do
+      s <- TLS.getDefaultClientSettings (cHostName, BS.pack cServiceName)
+      TLS.connect s cHostName cServiceName $ \(ctx, sockAddr) ->
+        withSocket sockAddr (TLS.send ctx) (TLS.recv ctx)
+    else do
+      TCP.connect cHostName cServiceName $ \(sock, sockAddr) ->
+        withSocket sockAddr (TCP.send sock) (TCP.recv sock 512)
+  where
+    withSocket _sockAddr sockSend sockRecv = do
+
+      hSetBuffering cLogHandle LineBuffering -- TODO reset
+      logToTTY <- hIsTerminalDevice cLogHandle
+      (putLog, takeLog0) <- newChan
+      let
+          takeLog1 = if cLogTime then takeLog0 >>= prefixTimestamp else takeLog0
+          takeLog2 = if logToTTY then takeLog1 else stripSGR <$> takeLog1
+          takeLog = takeLog2
+
+      (putInMsg, takeInMsg) <- newChan
+      (putOutMsg, takeOutMsg) <- newChan
       (shutdown, awaitShutdown) <- newSemaphore
+      (aSetNick,aGetNick) <- newRef =<< maybe Nick.getRandom return cNick
+
+      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
 
       mapM_ (\(s, f) -> installHandler s (Catch f) Nothing) [
           (sigINT, shutdown)
         ]
 
-      let prefixTimestamp s = do
-              t <- SGR [38,5,239] . Plain . BS.pack <$> getTimestamp
-              return (t <> " " <> s)
+      plugins <- getPlugins actions
 
-          takeLog' =
-            if logTime cfg
-              then takeLog >>= prefixTimestamp
-              else takeLog
-
-      threadIds <- mapM (\f -> forkIO $ f `finally` shutdown) [
-          driver cfg putLog putMsg recv_,
-          logger logFilter takeLog' logh,
-          pinger putLog putMsg,
-          sender takeMsg send_
+      threads <- mapM (\f -> forkIO $ f `finally` shutdown) [
+          receiver actions putInMsg sockRecv,
+          logger cLogHandle takeLog,
+          pinger aSend,
+          sender takeOutMsg sockSend,
+          splitter plugins takeInMsg
         ]
 
+      putInMsg Start
+
       awaitShutdown
-      mapM_ killThread threadIds
-      hPutStrLn logh ""
+      mapM_ killThread threads
+      putStrLn ""
+
+
+logger :: System.IO.Handle -> IO (Blessings ByteString) -> IO ()
+logger h takeLog = forever $ do
+    s <- takeLog
+    let s' = if lastChar s == '\n' then s else s <> Plain "\n"
+    System.IO.hPutStr h $ pp $ fmap BS.unpack s'
+
+pinger :: (Message -> IO ()) -> IO ()
+pinger aSend = forever $ do
+    threadDelay time
+    aSend (Message Nothing "PING" ["heartbeat"])
   where
+    time = 300 * 1000000
 
-    pinger :: (Blessings BS.ByteString -> IO ()) -> (Message -> IO ()) -> IO ()
-    pinger putLog putMsg = forever $ do
-        threadDelay time
-        sendIO putLog putMsg (Message Nothing "PING" ["heartbeat"])
-      where
-        time = 300 * 1000000
-
-    sender :: IO Message -> (BS.ByteString -> IO ()) -> IO ()
-    sender takeMsg send_ =
-        forever $ takeMsg >>= send_ . formatMessage
-
-    logger :: (Blessings BS.ByteString -> Blessings BS.ByteString)
-           -> IO (Blessings BS.ByteString)
-           -> Handle
-           -> IO ()
-    logger f takeLog h = forever $ do
-        s <- takeLog
-        let s' = if lastChar s == '\n' then s else s <> Plain "\n"
-        hPutStr h $ pp $ fmap BS.unpack (f s')
-      where
-        lastChar :: Blessings BS.ByteString -> Char
-        lastChar = BS.last . last . toList
-
-    stripSGR :: Blessings a -> Blessings a
-    stripSGR = \case
-        Append t1 t2 -> Append (stripSGR t1) (stripSGR t2)
-        SGR _ t -> stripSGR t
-        Plain x -> Plain x
-        Empty -> Empty
-
-
-connect :: Config
-        -> ((BS.ByteString -> IO ()) -> IO (Maybe BS.ByteString) -> IO ())
-        -> IO ()
-connect cfg action = do
-    if useTLS cfg then do
-      s <- TLS.getDefaultClientSettings (hostname cfg, BS.pack (port cfg))
-      TLS.connect s (hostname cfg) (port cfg) $ \(ctx, _sockAddr) -> do
-        let send = TLS.send ctx
-            recv = TLS.recv ctx
-        action send recv
-    else do
-      TCP.connect (hostname cfg) (port cfg) $ \(sock, _sockAddr) -> do
-        let send = TCP.send sock
-            recv = TCP.recv sock 512
-        action send recv
-
-driver :: Config
-          -> (Blessings BS.ByteString -> IO ())
-          -> (Message -> IO ())
-          -> IO (Maybe BS.ByteString)
-          -> IO ()
-
-driver cfg putLog putMsg recv_ = do
-    cfg' <- handleMessage cfg putMsg putLog (Message Nothing "<start>" [])
-    drive cfg' putMsg putLog recv_ ""
-
-drive :: Config
-      -> (Message -> IO ())
-      -> (Blessings BS.ByteString -> IO ())
-      -> IO (Maybe BS.ByteString)
-      -> BS.ByteString
-      -> IO ()
-drive cfg putMsg putLog recv_ "" =
-    recv_ >>= \case
-      Nothing -> putLog $ SGR [34,1] (Plain "# EOL")
-      Just msg -> drive cfg putMsg putLog recv_ msg
-
-drive cfg putMsg putLog recv_ buf =
-    go (parse message buf)
+receiver :: Actions -> (Message -> IO ()) -> IO (Maybe ByteString) -> IO ()
+receiver Actions{..} putInMsg sockRecv =
+    receive ""
   where
-    go :: IResult BS.ByteString Message -> IO ()
-    go = \case
-        Done rest msg -> do
-          -- TODO log message only if h hasn't disabled logging for it
-          let s = formatMessage msg
-          putLog $ SGR [38,5,235] "< " <> SGR [38,5,244] (Plain s)
-          cfg' <- handleMessage cfg putMsg putLog msg
-          drive cfg' putMsg putLog recv_ rest
-
-        p@(Partial _) -> do
-          recv_ >>= \case
-            Nothing -> do
-              putLog $ SGR [34,1] (Plain "# EOL")
-            Just msg ->
-              go (feed p msg)
-
-        f@(Fail _i _errorContexts _errMessage) ->
-          putLog $ SGR [31,1] (Plain (BS.pack $ show f))
-
-handleMessage :: Config
-              -> (Message -> IO ())
-              -> (Blessings BS.ByteString -> IO ())
-              -> Message
-              -> IO Config
-handleMessage cfg putMsg putLog msg = do
-    let
-        q0 = PluginState {
-              s_putLog = putLog,
-              s_nick = nick cfg,
-              s_sendMsg = sendIO putLog putMsg,
-              s_sendMsg' = sendIO' putLog putMsg
-            }
-
-        f q i =
-          execStateT (pluginFunc (either undefined id (pi_plugin i)) msg) q
-
-    q' <- foldM f q0 (pluginInstances cfg)
-
-    return cfg { nick = s_nick q' }
-
-
-formatMessage :: Message -> BS.ByteString
-formatMessage (Message mb_prefix cmd params) =
-    maybe "" (\x -> ":" <> x <> " ") mb_prefix
-        <> cmd
-        <> BS.concat (map (" "<>) (init params))
-        <> if null params then "" else " :" <> last params
-        <> "\r\n"
+    receive "" =
+        sockRecv >>= \case
+          Nothing -> do
+            aLog $ SGR [34,1] (Plain "# EOL")
+          Just buf -> receive buf
+
+    receive buf =
+        go (parse Parser.message buf)
+      where
+        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)
+              putInMsg msg
+              receive rest
 
+            p@(Partial _) -> do
+              sockRecv >>= \case
+                Nothing -> do
+                  aLog $ SGR [31] (Plain "EOF")
+                Just msg ->
+                  go (feed p msg)
+
+            f@(Fail _i _errorContexts _errMessage) -> do
+              aLog $ SGR [31,1] (Plain (BS.pack $ show f))
+
+sender :: IO Message -> (ByteString -> IO ()) -> IO ()
+sender takeOutMsg sockSend =
+    forever $ takeOutMsg >>= sockSend . formatMessage
+
+splitter :: [Message -> IO ()] -> IO Message -> IO ()
+splitter plugins takeInMsg =
+    forever $ do
+      msg <- takeInMsg
+      mapM_ (\f -> forkIO (f msg)) plugins
 
-getTimestamp :: IO String
-getTimestamp =
-    formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%SZ")
-    . systemToUTCTime <$> getSystemTime
 
+privmsg :: ByteString -> [ByteString] -> Message
+privmsg msgtarget xs =
+    Message Nothing "PRIVMSG" (msgtarget:BS.intercalate " " xs:[])
 
-newRelay :: IO (a -> IO (), IO a)
-newRelay = (putMVar &&& takeMVar) <$> newEmptyMVar
 
+lastChar :: Blessings ByteString -> Char
+lastChar = BS.last . last . toList
 
-newSemaphore :: IO (IO (), IO ())
-newSemaphore = first ($()) <$> newRelay
+prefixTimestamp :: Blessings ByteString -> IO (Blessings ByteString)
+prefixTimestamp s = do
+    t <- SGR [38,5,239] . Plain . BS.pack <$> getTimestamp
+    return (t <> " " <> s)
 
+stripSGR :: Blessings a -> Blessings a
+stripSGR = \case
+    Append t1 t2 -> Append (stripSGR t1) (stripSGR t2)
+    SGR _ t -> stripSGR t
+    Plain x -> Plain x
+    Empty -> Empty
 
-sendIO :: (Blessings BS.ByteString -> IO ())
-       -> (Message -> IO ())
-       -> Message
-       -> IO ()
-sendIO putLog putMsg msg =
-    sendIO' putLog putMsg msg msg
 
-sendIO' :: (Blessings BS.ByteString -> IO ())
-       -> (Message -> IO ())
-       -> Message
-       -> Message
-       -> IO ()
-sendIO' putLog putMsg msg logMsg = do
-    putLog $ SGR [38,5,235] "> " <> SGR [35,1] (Plain $ formatMessage logMsg)
-    putMsg msg
+getTimestamp :: IO String
+getTimestamp =
+    formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%SZ")
+    . systemToUTCTime <$> getSystemTime
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/P