aboutsummaryrefslogtreecommitdiffstats
path: root/src/Reaktor/Internal.hs
blob: 824c57ef394cd7a460ff6c6c80beb355cc9ddf98 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Reaktor.Internal where

import Prelude.Extended
import Blessings
import Data.Aeson
import Data.Aeson.Types (typeMismatch)
import Data.String.Conversions (convertString)
import qualified Data.Text as T
import Network.Socket as Exports (HostName,ServiceName)
import Reaktor.IRC
import System.IO


data Actions = Actions
    { aIsSecure :: Bool

    , aSend :: Message -> IO ()
    , aLog :: Blessings Text -> IO ()

    , aSetNick :: Text -> IO ()
    , aGetNick :: IO Text
    }


data Config = Config
    { cUseTLS :: Bool
    , cHostName :: HostName
    , cServiceName :: ServiceName
    , 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 Nothing

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
        cSendDelay <- fmap (round . (*(1e6 :: Float))) <$> v .:? "sendDelaySec"
        pure Config{..}
      invalid -> typeMismatch "Config" invalid
    where
      tlsPort :: ServiceName
      tlsPort = "6697"

data Message = Message (Maybe Text) Command [Text] | Start
  deriving Show

instance FromJSON Message where
  parseJSON = \case
      Object v -> do
        mb_prefix <- v .:? "prefix"
        cmd <- v .: "command"
        params <- v .: "params"
        pure (Message mb_prefix cmd params)
      invalid -> typeMismatch "Message" invalid

formatMessage :: Message -> Text
formatMessage = \case
    Message mb_prefix cmd params ->
      maybe "" ((":"<>) . (<>" ")) mb_prefix
          <> convertString cmd
          <> T.concat (map (" "<>) (init params))
          <> if null params then "" else " :" <> last params
          <> "\r\n"
    x -> error ("cannot format " <> show x)