module Colog.Syslog.Config
(
SyslogConfig (..)
, Collector (..)
, Family (..)
, HostName
, PortNumber
) where
import Universum
import Colog.Syslog.Priority (Facility (..))
import Data.Aeson (FromJSON(..), ToJSON(..), Value (..), withText, withObject,
withScientific, (.:), (.:?), (.!=), (.=), object)
import Fmt ((+|), (|+))
import Network.Socket (Family (..), HostName, PortNumber)
data SyslogConfig = SyslogConfig
{ collector :: !Collector
, facility :: !Facility
, appName :: !Text
} deriving (Show, Read, Eq)
instance FromJSON SyslogConfig where
parseJSON = withObject "SyslogConfig" $ \v -> SyslogConfig
<$> v .:? "collector" .!= AutoLocal
<*> v .:? "facility" .!= User
<*> v .: "app-name"
instance ToJSON SyslogConfig where
toJSON SyslogConfig {..} = object
[ "collector" .= collector
, "facility" .= facility
, "app-name" .= appName
]
data Collector
= AutoLocal
| Local String
| Remote Family HostName PortNumber
deriving (Show, Read, Eq)
instance FromJSON Collector where
parseJSON = withObject "Collector" $ \v -> do
collectorType <- v .: "collector-type"
case collectorType :: Text of
"auto" -> return AutoLocal
"local" -> Local
<$> v .:? "fifo-path" .!= "/dev/log"
"remote" -> Remote
<$> v .:? "family" .!= AF_INET
<*> v .:? "hostname" .!= "localhost"
<*> v .:? "port-number" .!= 514
_ -> fail "Parsing Collector failed: unknown \"collector-type\""
instance ToJSON Collector where
toJSON = \case
AutoLocal -> object
[ "collector-type" .= ("auto" :: Text)
]
Local fifoPath -> object
[ "collector-type" .= ("local" :: Text)
, "fifo-path" .= fifoPath
]
Remote family hostname portNum -> object
[ "collector-type" .= ("remote" :: Text)
, "family" .= family
, "hostname" .= hostname
, "port-number" .= portNum
]
instance FromJSON Family where
parseJSON = withText "Family" $ \t ->
maybe (fail $ "Unknown Family: \""+|t|+"\"") pure . readMaybe $ toString t
instance ToJSON Family where
toJSON = String . show
instance FromJSON PortNumber where
parseJSON = withScientific "PortNumber" $ pure . round
instance ToJSON PortNumber where
toJSON = Number . fromIntegral