{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables, OverloadedStrings #-}
module Network.Gitit.Config ( getConfigFromFile
, getConfigFromFiles
, getDefaultConfig
, readMimeTypesFile )
where
import Network.Gitit.Types
import Network.Gitit.Server (mimeTypes)
import Network.Gitit.Framework
import Network.Gitit.Authentication (formAuthHandlers, rpxAuthHandlers, httpAuthHandlers, githubAuthHandlers)
import Network.Gitit.Util (parsePageType, readFileUTF8)
import System.Log.Logger (logM, Priority(..))
import System.IO (hPutStrLn, stderr)
import System.Exit (ExitCode(..), exitWith)
import qualified Data.Map as M
import Data.List (intercalate, foldl')
import Data.Char (toLower, toUpper, isAlphaNum)
import qualified Data.Text as T
import Data.Text (Text)
import Paths_gitit (getDataFileName)
import System.FilePath ((</>))
import Text.Pandoc hiding (ERROR, WARNING, MathJax, MathML, WebTeX, getDataFileName)
import qualified Control.Exception as E
import Network.OAuth.OAuth2 (OAuth2(..))
import URI.ByteString (parseURI, laxURIParserOptions)
import qualified Data.ByteString.Char8 as BS
import Network.Gitit.Compat.Except
import Control.Monad
import Control.Monad.Trans
import Text.Parsec
import Text.Read (readMaybe)
getConfigFromFile :: FilePath -> IO Config
getConfigFromFile :: String -> IO Config
getConfigFromFile String
fname = [String] -> IO Config
getConfigFromFiles [String
fname]
getConfigFromFiles :: [FilePath] -> IO Config
getConfigFromFiles :: [String] -> IO Config
getConfigFromFiles [String]
fnames = do
String
cp <- String -> IO String
getDataFileName String
"data/default.conf"
ConfigMap
cfgmap <- (ConfigMap -> String -> IO ConfigMap)
-> ConfigMap -> [String] -> IO ConfigMap
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ConfigMap -> String -> IO ConfigMap
alterConfigMap ConfigMap
forall a. Monoid a => a
mempty (String
cp String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
fnames)
Either String Config
res <- ExceptT String IO Config -> IO (Either String Config)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO Config -> IO (Either String Config))
-> ExceptT String IO Config -> IO (Either String Config)
forall a b. (a -> b) -> a -> b
$ ConfigMap -> ExceptT String IO Config
extractConfig ConfigMap
cfgmap
case Either String Config
res of
Right Config
conf -> Config -> IO Config
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
conf
Left String
e -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Error parsing config:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e)
ExitCode -> IO Config
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
type ConfigMap = M.Map (Text, Text) Text
alterConfigMap :: ConfigMap -> FilePath -> IO ConfigMap
alterConfigMap :: ConfigMap -> String -> IO ConfigMap
alterConfigMap ConfigMap
cfmap String
fname = do
Text
contents <- String -> IO Text
readFileUTF8 String
fname
let contents' :: Text
contents' = Text
"[DEFAULT]\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
case String -> Text -> Either String [Section]
parseConfig String
fname Text
contents' of
Left String
msg -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Error parsing config " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg)
ExitCode -> IO ConfigMap
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right [Section]
secs -> ConfigMap -> IO ConfigMap
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConfigMap -> IO ConfigMap) -> ConfigMap -> IO ConfigMap
forall a b. (a -> b) -> a -> b
$ (ConfigMap -> Section -> ConfigMap)
-> ConfigMap -> [Section] -> ConfigMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ConfigMap -> Section -> ConfigMap
go ConfigMap
cfmap [Section]
secs
where
go :: ConfigMap -> Section -> ConfigMap
go ConfigMap
cfmap' (Section Text
name [(Text, Text)]
fields) = (ConfigMap -> (Text, Text) -> ConfigMap)
-> ConfigMap -> [(Text, Text)] -> ConfigMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Text -> ConfigMap -> (Text, Text) -> ConfigMap
forall {a} {b} {a}.
(Ord a, Ord b) =>
a -> Map (a, b) a -> (b, a) -> Map (a, b) a
go' Text
name) ConfigMap
cfmap' [(Text, Text)]
fields
go' :: a -> Map (a, b) a -> (b, a) -> Map (a, b) a
go' a
name Map (a, b) a
cfmap' (b
k,a
v) = (a, b) -> a -> Map (a, b) a -> Map (a, b) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (a
name, b
k) a
v Map (a, b) a
cfmap'
getDefaultConfig :: IO Config
getDefaultConfig :: IO Config
getDefaultConfig = [String] -> IO Config
getConfigFromFiles []
data Section = Section Text [(Text, Text)]
deriving (Int -> Section -> String -> String
[Section] -> String -> String
Section -> String
(Int -> Section -> String -> String)
-> (Section -> String)
-> ([Section] -> String -> String)
-> Show Section
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Section -> String -> String
showsPrec :: Int -> Section -> String -> String
$cshow :: Section -> String
show :: Section -> String
$cshowList :: [Section] -> String -> String
showList :: [Section] -> String -> String
Show)
parseConfig :: FilePath -> Text -> Either String [Section]
parseConfig :: String -> Text -> Either String [Section]
parseConfig String
fname Text
txt = (ParseError -> Either String [Section])
-> ([Section] -> Either String [Section])
-> Either ParseError [Section]
-> Either String [Section]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String [Section]
forall a b. a -> Either a b
Left (String -> Either String [Section])
-> (ParseError -> String) -> ParseError -> Either String [Section]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) [Section] -> Either String [Section]
forall a b. b -> Either a b
Right (Either ParseError [Section] -> Either String [Section])
-> Either ParseError [Section] -> Either String [Section]
forall a b. (a -> b) -> a -> b
$ Parsec Text () [Section]
-> String -> Text -> Either ParseError [Section]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT Text () Identity Section -> Parsec Text () [Section]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Section
pSection) String
fname Text
txt
pSection :: Parsec Text () Section
pSection :: ParsecT Text () Identity Section
pSection = do
ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT Text () Identity ()
pComment ParsecT Text () Identity ()
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
Text -> [(Text, Text)] -> Section
Section (Text -> [(Text, Text)] -> Section)
-> ParsecT Text () Identity Text
-> ParsecT Text () Identity ([(Text, Text)] -> Section)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Text
pSectionName ParsecT Text () Identity ([(Text, Text)] -> Section)
-> ParsecT Text () Identity [(Text, Text)]
-> ParsecT Text () Identity Section
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity [(Text, Text)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity (Text, Text)
pValue
pComment :: Parsec Text () ()
= Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Char -> Bool) -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')) ParsecT Text () Identity ()
-> ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
pKeyChar :: Parsec Text () Char
pKeyChar :: ParsecT Text () Identity Char
pKeyChar = (Char -> Bool) -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
pSectionName :: Parsec Text () Text
pSectionName :: ParsecT Text () Identity Text
pSectionName = do
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
Text -> Text
T.toUpper (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> ParsecT Text () Identity String -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')
pValue :: Parsec Text () (Text, Text)
pValue :: ParsecT Text () Identity (Text, Text)
pValue = ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity (Text, Text)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity (Text, Text))
-> ParsecT Text () Identity (Text, Text)
-> ParsecT Text () Identity (Text, Text)
forall a b. (a -> b) -> a -> b
$ do
ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT Text () Identity ()
pComment ParsecT Text () Identity ()
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
Text
k <- String -> Text
T.pack (String -> Text)
-> ParsecT Text () Identity String -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Identity Char
pKeyChar (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t")
Text
v <- String -> Text
T.pack (String -> Text)
-> ParsecT Text () Identity String -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT Text () Identity ()
pComment ParsecT Text () Identity ()
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
Text
vs <- [Text] -> Text
T.unlines ([Text] -> Text)
-> ParsecT Text () Identity [Text] -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Text -> ParsecT Text () Identity [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Text
pMultiline
(Text, Text) -> ParsecT Text () Identity (Text, Text)
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text
T.toLower Text
k, Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
vs)
pMultiline :: Parsec Text () Text
pMultiline :: ParsecT Text () Identity Text
pMultiline = ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity Text -> ParsecT Text () Identity Text)
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall a b. (a -> b) -> a -> b
$ do
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')
String -> Text
T.pack (String -> Text)
-> ParsecT Text () Identity String -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
extractConfig :: ConfigMap -> ExceptT String IO Config
ConfigMap
cfgmap = do
let get :: Text -> Text -> f String
get Text
name Text
field = f String -> (Text -> f String) -> Maybe Text -> f String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> f String
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
forall a. Monoid a => a
mempty) (String -> f String
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> f String) -> (Text -> String) -> Text -> f String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Maybe Text -> f String) -> Maybe Text -> f String
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> ConfigMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text
name, Text
field) ConfigMap
cfgmap
String
cfRepositoryType <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"repository-type"
String
cfRepositoryPath <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"repository-path"
String
cfDefaultPageType <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"default-page-type"
String
cfDefaultExtension <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"default-extension"
String
cfMathMethod <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"math"
String
cfMathjaxScript <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"mathjax-script"
Bool
cfShowLHSBirdTracks <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"show-lhs-bird-tracks" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
String
cfRequireAuthentication <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"require-authentication"
String
cfAuthenticationMethod <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"authentication-method"
String
cfUserFile <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"user-file"
Int
cfSessionTimeout <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"session-timeout" ExceptT String IO String
-> (String -> ExceptT String IO Int) -> ExceptT String IO Int
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Int
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber
String
cfTemplatesDir <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"templates-dir"
String
cfLogFile <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"log-file"
String
cfLogLevel <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"log-level"
String
cfStaticDir <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"static-dir"
String
cfPlugins <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"plugins"
Bool
cfTableOfContents <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"table-of-contents" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
Integer
cfMaxUploadSize <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"max-upload-size" ExceptT String IO String
-> (String -> ExceptT String IO Integer)
-> ExceptT String IO Integer
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Integer
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readSize
Integer
cfMaxPageSize <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"max-page-size" ExceptT String IO String
-> (String -> ExceptT String IO Integer)
-> ExceptT String IO Integer
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Integer
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readSize
String
cfAddress <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"address"
Int
cfPort <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"port" ExceptT String IO String
-> (String -> ExceptT String IO Int) -> ExceptT String IO Int
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Int
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber
Bool
cfDebugMode <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"debug-mode" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
String
cfFrontPage <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"front-page"
String
cfNoEdit <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"no-edit"
String
cfNoDelete <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"no-delete"
String
cfDefaultSummary <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"default-summary"
String
cfDeleteSummary <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"delete-summary"
Bool
cfDisableRegistration <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"disable-registration" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
String
cfAccessQuestion <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"access-question"
String
cfAccessQuestionAnswers <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"access-question-answers"
Bool
cfUseRecaptcha <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"use-recaptcha" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
String
cfRecaptchaPublicKey <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"recaptcha-public-key"
String
cfRecaptchaPrivateKey <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"recaptcha-private-key"
String
cfRPXDomain <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"rpx-domain"
String
cfRPXKey <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"rpx-key"
Bool
cfCompressResponses <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"compress-responses" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
Bool
cfUseCache <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"use-cache" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
String
cfCacheDir <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"cache-dir"
String
cfMimeTypesFile <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"mime-types-file"
String
cfMailCommand <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"mail-command"
String
cfResetPasswordMessage <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"reset-password-message"
Bool
cfUseFeed <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"use-feed" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
String
cfBaseUrl <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"base-url"
Bool
cfAbsoluteUrls <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"absolute-urls" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
String
cfWikiTitle <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"wiki-title"
Integer
cfFeedDays <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"feed-days" ExceptT String IO String
-> (String -> ExceptT String IO Integer)
-> ExceptT String IO Integer
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Integer
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber
Integer
cfFeedRefreshTime <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"feed-refresh-time" ExceptT String IO String
-> (String -> ExceptT String IO Integer)
-> ExceptT String IO Integer
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Integer
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber
String
cfPandocUserData <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"pandoc-user-data"
Bool
cfXssSanitize <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"xss-sanitize" ExceptT String IO String
-> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Bool
forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool
Int
cfRecentActivityDays <- Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"DEFAULT" Text
"recent-activity-days" ExceptT String IO String
-> (String -> ExceptT String IO Int) -> ExceptT String IO Int
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ExceptT String IO Int
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber
let (PageType
pt, Bool
lhs) = String -> (PageType, Bool)
parsePageType String
cfDefaultPageType
let markupHelpFile :: String
markupHelpFile = PageType -> String
forall a. Show a => a -> String
show PageType
pt String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
lhs then String
"+LHS" else String
""
String
markupHelpPath <- IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT String IO String)
-> IO String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getDataFileName (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"data" String -> String -> String
</> String
"markupHelp" String -> String -> String
</> String
markupHelpFile
Text
markupHelp' <- IO Text -> ExceptT String IO Text
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT String IO Text)
-> IO Text -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
readFileUTF8 String
markupHelpPath
Text
markupHelpText <- IO Text -> ExceptT String IO Text
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT String IO Text)
-> IO Text -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$ Either PandocError Text -> IO Text
forall a. Either PandocError a -> IO a
handleError (Either PandocError Text -> IO Text)
-> Either PandocError Text -> IO Text
forall a b. (a -> b) -> a -> b
$ PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure (PandocPure Text -> Either PandocError Text)
-> PandocPure Text -> Either PandocError Text
forall a b. (a -> b) -> a -> b
$ do
Pandoc
helpDoc <- ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMarkdown ReaderOptions
forall a. Default a => a
def{ readerExtensions = getDefaultExtensions "markdown" } Text
markupHelp'
WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
forall a. Default a => a
def Pandoc
helpDoc
Map String String
mimeMap' <- IO (Map String String) -> ExceptT String IO (Map String String)
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map String String) -> ExceptT String IO (Map String String))
-> IO (Map String String) -> ExceptT String IO (Map String String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Map String String)
readMimeTypesFile String
cfMimeTypesFile
let authMethod :: String
authMethod = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cfAuthenticationMethod
let stripTrailingSlash :: String -> String
stripTrailingSlash = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
FileStoreType
repotype' <- case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cfRepositoryType of
String
"git" -> FileStoreType -> ExceptT String IO FileStoreType
forall a. a -> ExceptT String IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileStoreType
Git
String
"darcs" -> FileStoreType -> ExceptT String IO FileStoreType
forall a. a -> ExceptT String IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileStoreType
Darcs
String
"mercurial" -> FileStoreType -> ExceptT String IO FileStoreType
forall a. a -> ExceptT String IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileStoreType
Mercurial
String
x -> String -> ExceptT String IO FileStoreType
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO FileStoreType)
-> String -> ExceptT String IO FileStoreType
forall a b. (a -> b) -> a -> b
$ String
"Unknown repository type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
Bool -> ExceptT String IO () -> ExceptT String IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
authMethod String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rpx" Bool -> Bool -> Bool
&& String
cfRPXDomain String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"") (ExceptT String IO () -> ExceptT String IO ())
-> ExceptT String IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$
IO () -> ExceptT String IO ()
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT String IO ()) -> IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"gitit" Priority
WARNING String
"rpx-domain is not set"
GithubConfig
ghConfig <- ConfigMap -> ExceptT String IO GithubConfig
extractGithubConfig ConfigMap
cfgmap
Bool -> ExceptT String IO () -> ExceptT String IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cfUserFile) (ExceptT String IO () -> ExceptT String IO ())
-> ExceptT String IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$
IO () -> ExceptT String IO ()
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT String IO ()) -> IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"gitit" Priority
ERROR String
"user-file is empty"
Config -> ExceptT String IO Config
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Config{
repositoryPath :: String
repositoryPath = String
cfRepositoryPath
, repositoryType :: FileStoreType
repositoryType = FileStoreType
repotype'
, defaultPageType :: PageType
defaultPageType = PageType
pt
, defaultExtension :: String
defaultExtension = String
cfDefaultExtension
, mathMethod :: MathMethod
mathMethod = case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cfMathMethod of
String
"mathml" -> MathMethod
MathML
String
"mathjax" -> String -> MathMethod
MathJax String
cfMathjaxScript
String
"google" -> String -> MathMethod
WebTeX String
"http://chart.apis.google.com/chart?cht=tx&chl="
String
_ -> MathMethod
RawTeX
, defaultLHS :: Bool
defaultLHS = Bool
lhs
, showLHSBirdTracks :: Bool
showLHSBirdTracks = Bool
cfShowLHSBirdTracks
, withUser :: Handler -> Handler
withUser = case String
authMethod of
String
"form" -> Handler -> Handler
withUserFromSession
String
"github" -> Handler -> Handler
withUserFromSession
String
"http" -> Handler -> Handler
withUserFromHTTPAuth
String
"rpx" -> Handler -> Handler
withUserFromSession
String
_ -> Handler -> Handler
forall a. a -> a
id
, requireAuthentication :: AuthenticationLevel
requireAuthentication = case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cfRequireAuthentication of
String
"none" -> AuthenticationLevel
Never
String
"modify" -> AuthenticationLevel
ForModify
String
"read" -> AuthenticationLevel
ForRead
String
_ -> AuthenticationLevel
ForModify
, authHandler :: Handler
authHandler = case String
authMethod of
String
"form" -> [Handler] -> Handler
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Handler] -> Handler) -> [Handler] -> Handler
forall a b. (a -> b) -> a -> b
$ Bool -> [Handler]
formAuthHandlers Bool
cfDisableRegistration
String
"github" -> [Handler] -> Handler
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Handler] -> Handler) -> [Handler] -> Handler
forall a b. (a -> b) -> a -> b
$ GithubConfig -> [Handler]
githubAuthHandlers GithubConfig
ghConfig
String
"http" -> [Handler] -> Handler
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Handler]
httpAuthHandlers
String
"rpx" -> [Handler] -> Handler
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Handler]
rpxAuthHandlers
String
_ -> Handler
forall a. ServerPartT (ReaderT WikiState IO) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
, userFile :: String
userFile = String
cfUserFile
, sessionTimeout :: Int
sessionTimeout = Int
cfSessionTimeout Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60
, templatesDir :: String
templatesDir = String
cfTemplatesDir
, logFile :: String
logFile = String
cfLogFile
, logLevel :: Priority
logLevel = let levelString :: String
levelString = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
cfLogLevel
levels :: [String]
levels = [String
"DEBUG", String
"INFO", String
"NOTICE", String
"WARNING", String
"ERROR",
String
"CRITICAL", String
"ALERT", String
"EMERGENCY"]
in if String
levelString String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
levels
then String -> Priority
forall a. Read a => String -> a
read String
levelString
else String -> Priority
forall a. HasCallStack => String -> a
error (String -> Priority) -> String -> Priority
forall a b. (a -> b) -> a -> b
$ String
"Invalid log-level.\nLegal values are: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
levels
, staticDir :: String
staticDir = String
cfStaticDir
, pluginModules :: [String]
pluginModules = String -> [String]
splitCommaList String
cfPlugins
, tableOfContents :: Bool
tableOfContents = Bool
cfTableOfContents
, maxUploadSize :: Integer
maxUploadSize = Integer
cfMaxUploadSize
, maxPageSize :: Integer
maxPageSize = Integer
cfMaxPageSize
, address :: String
address = String
cfAddress
, portNumber :: Int
portNumber = Int
cfPort
, debugMode :: Bool
debugMode = Bool
cfDebugMode
, frontPage :: String
frontPage = String
cfFrontPage
, noEdit :: [String]
noEdit = String -> [String]
splitCommaList String
cfNoEdit
, noDelete :: [String]
noDelete = String -> [String]
splitCommaList String
cfNoDelete
, defaultSummary :: String
defaultSummary = String
cfDefaultSummary
, deleteSummary :: String
deleteSummary = String
cfDeleteSummary
, disableRegistration :: Bool
disableRegistration = Bool
cfDisableRegistration
, accessQuestion :: Maybe (String, [String])
accessQuestion = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cfAccessQuestion
then Maybe (String, [String])
forall a. Maybe a
Nothing
else (String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
cfAccessQuestion,
String -> [String]
splitCommaList String
cfAccessQuestionAnswers)
, useRecaptcha :: Bool
useRecaptcha = Bool
cfUseRecaptcha
, recaptchaPublicKey :: String
recaptchaPublicKey = String
cfRecaptchaPublicKey
, recaptchaPrivateKey :: String
recaptchaPrivateKey = String
cfRecaptchaPrivateKey
, rpxDomain :: String
rpxDomain = String
cfRPXDomain
, rpxKey :: String
rpxKey = String
cfRPXKey
, compressResponses :: Bool
compressResponses = Bool
cfCompressResponses
, useCache :: Bool
useCache = Bool
cfUseCache
, cacheDir :: String
cacheDir = String
cfCacheDir
, mimeMap :: Map String String
mimeMap = Map String String
mimeMap'
, mailCommand :: String
mailCommand = String
cfMailCommand
, resetPasswordMessage :: String
resetPasswordMessage = String
cfResetPasswordMessage
, markupHelp :: Text
markupHelp = Text
markupHelpText
, useFeed :: Bool
useFeed = Bool
cfUseFeed
, baseUrl :: String
baseUrl = String -> String
stripTrailingSlash String
cfBaseUrl
, useAbsoluteUrls :: Bool
useAbsoluteUrls = Bool
cfAbsoluteUrls
, wikiTitle :: String
wikiTitle = String
cfWikiTitle
, feedDays :: Integer
feedDays = Integer
cfFeedDays
, feedRefreshTime :: Integer
feedRefreshTime = Integer
cfFeedRefreshTime
, pandocUserData :: Maybe String
pandocUserData = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cfPandocUserData
then Maybe String
forall a. Maybe a
Nothing
else String -> Maybe String
forall a. a -> Maybe a
Just String
cfPandocUserData
, xssSanitize :: Bool
xssSanitize = Bool
cfXssSanitize
, recentActivityDays :: Int
recentActivityDays = Int
cfRecentActivityDays
, githubAuth :: GithubConfig
githubAuth = GithubConfig
ghConfig
}
extractGithubConfig :: ConfigMap -> ExceptT String IO GithubConfig
ConfigMap
cfgmap = do
String
cfOauthClientId <- Text -> ExceptT String IO String
getGithubProp Text
"oauthclientid"
String
cfOauthClientSecret <- Text -> ExceptT String IO String
getGithubProp Text
"oauthclientsecret"
URIRef Absolute
cfOauthCallback <- Text -> ExceptT String IO (URIRef Absolute)
getUrlProp Text
"oauthcallback"
URIRef Absolute
cfOauthOAuthorizeEndpoint <- Text -> ExceptT String IO (URIRef Absolute)
getUrlProp Text
"oauthoauthorizeendpoint"
URIRef Absolute
cfOauthAccessTokenEndpoint <- Text -> ExceptT String IO (URIRef Absolute)
getUrlProp Text
"oauthaccesstokenendpoint"
String
cfOrg' <- Text -> ExceptT String IO String
getGithubProp Text
"github-org"
let cfOrg :: Maybe String
cfOrg = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cfOrg'
then String -> Maybe String
forall a. a -> Maybe a
Just String
cfOrg'
else Maybe String
forall a. Maybe a
Nothing
let cfgOAuth2 :: OAuth2
cfgOAuth2 = OAuth2 {
oauth2ClientId :: Text
oauth2ClientId = String -> Text
T.pack String
cfOauthClientId
, oauth2ClientSecret :: Text
oauth2ClientSecret = String -> Text
T.pack String
cfOauthClientSecret
, oauth2RedirectUri :: URIRef Absolute
oauth2RedirectUri = URIRef Absolute
cfOauthCallback
, oauth2AuthorizeEndpoint :: URIRef Absolute
oauth2AuthorizeEndpoint = URIRef Absolute
cfOauthOAuthorizeEndpoint
, oauth2TokenEndpoint :: URIRef Absolute
oauth2TokenEndpoint = URIRef Absolute
cfOauthAccessTokenEndpoint
}
GithubConfig -> ExceptT String IO GithubConfig
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GithubConfig -> ExceptT String IO GithubConfig)
-> GithubConfig -> ExceptT String IO GithubConfig
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Maybe Text -> GithubConfig
githubConfig OAuth2
cfgOAuth2 (Maybe Text -> GithubConfig) -> Maybe Text -> GithubConfig
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Maybe String
cfOrg
where
get :: Text -> Text -> f String
get Text
name Text
field = f String -> (Text -> f String) -> Maybe Text -> f String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> f String
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
forall a. Monoid a => a
mempty) (String -> f String
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> f String) -> (Text -> String) -> Text -> f String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Maybe Text -> f String) -> Maybe Text -> f String
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> ConfigMap -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text
name, Text
field) ConfigMap
cfgmap
getGithubProp :: Text -> ExceptT String IO String
getGithubProp = Text -> Text -> ExceptT String IO String
forall {f :: * -> *}. Applicative f => Text -> Text -> f String
get Text
"GITHUB"
getUrlProp :: Text -> ExceptT String IO (URIRef Absolute)
getUrlProp Text
prop = Text -> ExceptT String IO String
getGithubProp Text
prop ExceptT String IO String
-> (String -> ExceptT String IO (URIRef Absolute))
-> ExceptT String IO (URIRef Absolute)
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
s ->
case URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
laxURIParserOptions (String -> ByteString
BS.pack String
s) of
Left URIParseError
e -> String -> ExceptT String IO (URIRef Absolute)
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO (URIRef Absolute))
-> String -> ExceptT String IO (URIRef Absolute)
forall a b. (a -> b) -> a -> b
$ String
"couldn't parse url " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from (Github/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
prop
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ URIParseError -> String
forall a. Show a => a -> String
show URIParseError
e
Right URIRef Absolute
uri -> URIRef Absolute -> ExceptT String IO (URIRef Absolute)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return URIRef Absolute
uri
readMimeTypesFile :: FilePath -> IO (M.Map String String)
readMimeTypesFile :: String -> IO (Map String String)
readMimeTypesFile String
f = IO (Map String String)
-> (SomeException -> IO (Map String String))
-> IO (Map String String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
((String -> Map String String -> Map String String)
-> Map String String -> [String] -> Map String String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([String] -> Map String String -> Map String String
forall {a}. Ord a => [a] -> Map a a -> Map a a
go ([String] -> Map String String -> Map String String)
-> (String -> [String])
-> String
-> Map String String
-> Map String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) Map String String
forall k a. Map k a
M.empty ([String] -> Map String String)
-> (Text -> [String]) -> Text -> Map String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Map String String) -> IO Text -> IO (Map String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
readFileUTF8 String
f)
SomeException -> IO (Map String String)
handleMimeTypesFileNotFound
where go :: [a] -> Map a a -> Map a a
go [] Map a a
m = Map a a
m
go (a
x:[a]
xs) Map a a
m = (a -> Map a a -> Map a a) -> Map a a -> [a] -> Map a a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a -> Map a a -> Map a a
forall k a. Ord k => k -> a -> Map k a -> Map k a
`M.insert` a
x) Map a a
m [a]
xs
handleMimeTypesFileNotFound :: SomeException -> IO (Map String String)
handleMimeTypesFileNotFound (SomeException
e :: E.SomeException) = do
String -> Priority -> String -> IO ()
logM String
"gitit" Priority
WARNING (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Could not read mime types file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Using defaults instead."
Map String String -> IO (Map String String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Map String String
mimeTypes
readNumber :: (Monad m, Num a, Read a) => String -> ExceptT String m a
readNumber :: forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber String
x = case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
x of
Just a
n -> a -> ExceptT String m a
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
Maybe a
_ -> String -> ExceptT String m a
forall a. String -> ExceptT String m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String m a) -> String -> ExceptT String m a
forall a b. (a -> b) -> a -> b
$ String
"Could not parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" as an integer."
readSize :: (Monad m, Num a, Read a) => String -> ExceptT String m a
readSize :: forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readSize [] = String -> ExceptT String m a
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber String
""
readSize String
x =
case String -> Char
forall a. HasCallStack => [a] -> a
last String
x of
Char
'K' -> (a -> a -> a
forall a. Num a => a -> a -> a
* a
1000) (a -> a) -> ExceptT String m a -> ExceptT String m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT String m a
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x)
Char
'M' -> (a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000) (a -> a) -> ExceptT String m a -> ExceptT String m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT String m a
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x)
Char
'G' -> (a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000000) (a -> a) -> ExceptT String m a -> ExceptT String m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT String m a
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x)
Char
_ -> String -> ExceptT String m a
forall (m :: * -> *) a.
(Monad m, Num a, Read a) =>
String -> ExceptT String m a
readNumber String
x
splitCommaList :: String -> [String]
splitCommaList :: String -> [String]
splitCommaList String
l =
let (String
first,String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') String
l
first' :: String
first' = String -> String
lrStrip String
first
in case String
rest of
[] -> [String
first' | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
first')]
(Char
_:String
rs) -> String
first' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitCommaList String
rs
lrStrip :: String -> String
lrStrip :: String -> String
lrStrip = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace
where isWhitespace :: Char -> Bool
isWhitespace = (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ',Char
'\t',Char
'\n'])
readBool :: Monad m => String -> ExceptT String m Bool
readBool :: forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
readBool String
s =
case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
String
"yes" -> Bool -> ExceptT String m Bool
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
String
"y" -> Bool -> ExceptT String m Bool
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
String
"no" -> Bool -> ExceptT String m Bool
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
String
"n" -> Bool -> ExceptT String m Bool
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
String
"true" -> Bool -> ExceptT String m Bool
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
String
"t" -> Bool -> ExceptT String m Bool
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
String
"false" -> Bool -> ExceptT String m Bool
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
String
"f" -> Bool -> ExceptT String m Bool
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
String
_ -> String -> ExceptT String m Bool
forall a. String -> ExceptT String m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String m Bool)
-> String -> ExceptT String m Bool
forall a b. (a -> b) -> a -> b
$ String
"Could not read " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" as boolean"