diff options
| author | tv <tv@krebsco.de> | 2019-01-29 20:49:47 +0100 |
|---|---|---|
| committer | tv <tv@krebsco.de> | 2019-01-29 20:50:31 +0100 |
| commit | 9f4e2644188f985d7cd806c13e2c0dee1688b9f0 (patch) | |
| tree | b7b99a856bcab4caee867936dd759e832d7547c3 | |
| parent | 92ca5dbea78d4520e1cc0a3162cee2bbeb6c4c88 (diff) | |
Reaktor: add send delay support
| -rw-r--r-- | reaktor2.cabal | 2 | ||||
| -rw-r--r-- | src/Reaktor.hs | 11 | ||||
| -rw-r--r-- | src/Reaktor/Internal.hs | 4 |
3 files changed, 11 insertions, 6 deletions
diff --git a/reaktor2.cabal b/reaktor2.cabal index 5780c1e..6757561 100644 --- a/reaktor2.cabal +++ b/reaktor2.cabal @@ -1,5 +1,5 @@ name: reaktor2 -version: 0.2.1 +version: 0.2.2 license: MIT author: tv <tv@krebsco.de> maintainer: tv <tv@krebsco.de> diff --git a/src/Reaktor.hs b/src/Reaktor.hs index 042fcfe..0910e0b 100644 --- a/src/Reaktor.hs +++ b/src/Reaktor.hs @@ -86,7 +86,7 @@ run Config{..} getPlugins = receiver actions putInMsg sockRecv, logger cLogHandle takeLog, pinger aSend, - sender takeOutMsg sockSend, + sender cSendDelay takeOutMsg sockSend, splitter plugins takeInMsg ] @@ -147,9 +147,12 @@ receiver Actions{..} putInMsg sockRecv = aLog $ SGR [38,5,235] "< " <> SGR [38,5,244] (Plain bs) -sender :: IO Message -> (ByteString -> IO ()) -> IO () -sender takeOutMsg sockSend = - forever $ takeOutMsg >>= sockSend . T.encodeUtf8 . formatMessage +sender :: Maybe Int -> IO Message -> (ByteString -> IO ()) -> IO () +sender cSendDelay takeOutMsg sockSend = + forever send + where + send = maybe send0 ((send0 >>) . threadDelay) cSendDelay + send0 = takeOutMsg >>= sockSend . T.encodeUtf8 . formatMessage splitter :: [Message -> IO ()] -> IO Message -> IO () splitter plugins takeInMsg = diff --git a/src/Reaktor/Internal.hs b/src/Reaktor/Internal.hs index 66e00af..bd3d241 100644 --- a/src/Reaktor/Internal.hs +++ b/src/Reaktor/Internal.hs @@ -32,11 +32,12 @@ data Config = Config , cNick :: Maybe Text , cLogHandle :: Handle , cLogTime :: Bool + , cSendDelay :: Maybe Int } deriving Show instance Default Config where - def = Config False "irc.r" "6667" Nothing stderr True + def = Config False "irc.r" "6667" Nothing stderr True Nothing instance FromJSON Config where parseJSON = \case @@ -47,6 +48,7 @@ instance FromJSON Config where cNick <- v .:? "nick" cLogHandle <- pure (cLogHandle def) cLogTime <- v .:? "logTime" .!= cLogTime def + cSendDelay <- fmap (round . (*(1e6 :: Float))) <$> v .:? "sendDelaySec" pure Config{..} invalid -> typeMismatch "Config" invalid where |