{-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables, OverloadedStrings #-}
{-
Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

{- | Functions for parsing command line options and reading the config file.
-}

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)

-- | Get configuration from config file.
getConfigFromFile :: FilePath -> IO Config
getConfigFromFile :: String -> IO Config
getConfigFromFile String
fname = [String] -> IO Config
getConfigFromFiles [String
fname]

-- | Get configuration from config files, or default.
getConfigFromFiles :: [FilePath] -> IO Config
getConfigFromFiles :: [String] -> IO Config
getConfigFromFiles [String]
fnames = do
  -- we start with default values from the data file
  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'

-- | Returns the default gitit configuration.
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 () ()
pComment :: ParsecT Text () Identity ()
pComment = 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
extractConfig :: ConfigMap -> ExceptT String IO Config
extractConfig 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  -- convert minutes -> seconds
    , 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
extractGithubConfig :: ConfigMap -> ExceptT String IO GithubConfig
extractGithubConfig 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


-- | Read a file associating mime types with extensions, and return a
-- map from extensions to types. Each line of the file consists of a
-- mime type, followed by space, followed by a list of zero or more
-- extensions, separated by spaces. Example: text/plain txt text
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  -- skip blank lines
           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"