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
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Network.Spacecookie.Config
( Config (..)
, LogConfig (..)
) where
import Control.Monad (mzero, join)
import Control.Applicative ((<|>))
import Data.Aeson
import Data.Aeson.Types (Parser ())
import Data.ByteString (ByteString ())
import Data.Text (toLower, Text ())
import Network.Gopher (GopherLogLevel (..))
import Network.Gopher.Util
data Config
= Config
{ serverName :: ByteString
, listenAddr :: Maybe ByteString
, serverPort :: Integer
, runUserName :: Maybe String
, rootDirectory :: FilePath
, logConfig :: LogConfig
}
-- We only use string literals with 'maybePath', so we can just switch between
-- Key and Text, since both have an IsString instance for OverloadedStrings.
#if MIN_VERSION_aeson(2,0,0)
maybePath :: FromJSON a => [Key] -> Object -> Parser (Maybe a)
#else
maybePath :: FromJSON a => [Text] -> Object -> Parser (Maybe a)
#endif
maybePath [] _ = fail "got empty path"
maybePath [x] v = v .:? x
maybePath (x:xs) v = v .:? x >>= fmap join . traverse (maybePath xs)
instance FromJSON Config where
parseJSON (Object v) = Config
<$> v .: "hostname"
<*> maybePath [ "listen", "addr" ] v
<*> parseListenPort v .!= 70
<*> v .:? "user"
<*> v .: "root"
<*> v .:? "log" .!= defaultLogConfig
parseJSON _ = mzero
-- Use '(<|>)' over the 'Maybe's in the parser rather
-- to only fallback on 'Nothing' and not on @empty@.
-- This way a parse error in listen → port doesn't get
-- promoted to just 'Nothing'.
parseListenPort :: Object -> Parser (Maybe Integer)
parseListenPort v = (<|>)
<$> maybePath [ "listen", "port" ] v
<*> (v .:? "port")
data LogConfig
= LogConfig
{ logEnable :: Bool
, logHideIps :: Bool
, logHideTime :: Bool
, logLevel :: GopherLogLevel
}
defaultLogConfig :: LogConfig
defaultLogConfig = LogConfig True True False GopherLogLevelInfo
instance FromJSON LogConfig where
parseJSON (Object v) = LogConfig
<$> v .:? "enable" .!= logEnable defaultLogConfig
<*> v .:? "hide-ips" .!= logHideIps defaultLogConfig
<*> v .:? "hide-time" .!= logHideTime defaultLogConfig
<*> v .:? "level" .!= logLevel defaultLogConfig
parseJSON _ = mzero
-- auxiliary instances for types that have no default instance
instance FromJSON GopherLogLevel where
parseJSON (String s) =
case toLower s of
"info" -> pure GopherLogLevelInfo
"warn" -> pure GopherLogLevelWarn
"error" -> pure GopherLogLevelError
_ -> mzero
parseJSON _ = mzero
instance FromJSON ByteString where
parseJSON s@(String _) = uEncode <$> parseJSON s
parseJSON _ = mzero
instance ToJSON ByteString where
toJSON = toJSON . uDecode
|
