{-# 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 qualified Data.Map as M
import Data.ConfigFile hiding (readfile)
import Data.List (intercalate)
import Data.Char (toLower, toUpper, isDigit)
import qualified Data.Text as T
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
forceEither :: Show e => Either e a -> a
forceEither :: forall e a. Show e => Either e a -> a
forceEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id
getConfigFromFile :: FilePath -> IO Config
getConfigFromFile :: String -> IO Config
getConfigFromFile String
fname = do
ConfigParser
cp <- IO ConfigParser
getDefaultConfigParser
forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> IO (m ConfigParser)
readfile ConfigParser
cp String
fname forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigParser -> IO Config
extractConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Show e => Either e a -> a
forceEither
getConfigFromFiles :: [FilePath] -> IO Config
getConfigFromFiles :: [String] -> IO Config
getConfigFromFiles [String]
fnames = do
ConfigParser
config <- [String] -> IO ConfigParser
getConfigParserFromFiles [String]
fnames
ConfigParser -> IO Config
extractConfig ConfigParser
config
getConfigParserFromFiles :: [FilePath] ->
IO ConfigParser
getConfigParserFromFiles :: [String] -> IO ConfigParser
getConfigParserFromFiles (String
fname:[String]
fnames) = do
ConfigParser
cp <- [String] -> IO ConfigParser
getConfigParserFromFiles [String]
fnames
Either (CPErrorData, String) ConfigParser
config <- forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> IO (m ConfigParser)
readfile ConfigParser
cp String
fname
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e a. Show e => Either e a -> a
forceEither Either (CPErrorData, String) ConfigParser
config
getConfigParserFromFiles [] = IO ConfigParser
getDefaultConfigParser
readfile :: MonadError CPError m
=> ConfigParser
-> FilePath
-> IO (m ConfigParser)
readfile :: forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> IO (m ConfigParser)
readfile ConfigParser
cp String
path' = do
Text
contents <- String -> IO Text
readFileUTF8 String
path'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> m ConfigParser
readstring ConfigParser
cp forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
contents
extractConfig :: ConfigParser -> IO Config
ConfigParser
cp = do
Either (CPErrorData, String) Config
config' <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
String
cfRepositoryType <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"repository-type"
String
cfRepositoryPath <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"repository-path"
String
cfDefaultPageType <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"default-page-type"
String
cfDefaultExtension <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"default-extension"
String
cfMathMethod <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"math"
String
cfMathjaxScript <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"mathjax-script"
Bool
cfShowLHSBirdTracks <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"show-lhs-bird-tracks"
String
cfRequireAuthentication <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"require-authentication"
String
cfAuthenticationMethod <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"authentication-method"
String
cfUserFile <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"user-file"
String
cfSessionTimeout <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"session-timeout"
String
cfTemplatesDir <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"templates-dir"
String
cfLogFile <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"log-file"
String
cfLogLevel <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"log-level"
String
cfStaticDir <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"static-dir"
String
cfPlugins <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"plugins"
Bool
cfTableOfContents <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"table-of-contents"
String
cfMaxUploadSize <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"max-upload-size"
String
cfMaxPageSize <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"max-page-size"
String
cfAddress <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"address"
String
cfPort <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"port"
Bool
cfDebugMode <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"debug-mode"
String
cfFrontPage <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"front-page"
String
cfNoEdit <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"no-edit"
String
cfNoDelete <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"no-delete"
String
cfDefaultSummary <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"default-summary"
String
cfDeleteSummary <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"delete-summary"
Bool
cfDisableRegistration <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"disable-registration"
String
cfAccessQuestion <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"access-question"
String
cfAccessQuestionAnswers <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"access-question-answers"
Bool
cfUseRecaptcha <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"use-recaptcha"
String
cfRecaptchaPublicKey <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"recaptcha-public-key"
String
cfRecaptchaPrivateKey <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"recaptcha-private-key"
String
cfRPXDomain <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"rpx-domain"
String
cfRPXKey <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"rpx-key"
Bool
cfCompressResponses <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"compress-responses"
Bool
cfUseCache <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"use-cache"
String
cfCacheDir <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"cache-dir"
String
cfMimeTypesFile <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"mime-types-file"
String
cfMailCommand <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"mail-command"
String
cfResetPasswordMessage <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"reset-password-message"
Bool
cfUseFeed <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"use-feed"
String
cfBaseUrl <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"base-url"
Bool
cfAbsoluteUrls <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"absolute-urls"
String
cfWikiTitle <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"wiki-title"
String
cfFeedDays <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"feed-days"
String
cfFeedRefreshTime <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"feed-refresh-time"
String
cfPandocUserData <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"pandoc-user-data"
Bool
cfXssSanitize <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"xss-sanitize"
Int
cfRecentActivityDays <- forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"DEFAULT" String
"recent-activity-days"
let (PageType
pt, Bool
lhs) = String -> (PageType, Bool)
parsePageType String
cfDefaultPageType
let markupHelpFile :: String
markupHelpFile = forall a. Show a => a -> String
show PageType
pt forall a. [a] -> [a] -> [a]
++ if Bool
lhs then String
"+LHS" else String
""
String
markupHelpPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO String
getDataFileName forall a b. (a -> b) -> a -> b
$ String
"data" String -> String -> String
</> String
"markupHelp" String -> String -> String
</> String
markupHelpFile
Text
markupHelp' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Text
readFileUTF8 String
markupHelpPath
Text
markupHelpText <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Either PandocError a -> IO a
handleError forall a b. (a -> b) -> a -> b
$ forall a. PandocPure a -> Either PandocError a
runPure forall a b. (a -> b) -> a -> b
$ do
Pandoc
helpDoc <- forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMarkdown forall a. Default a => a
def{ readerExtensions :: Extensions
readerExtensions = Text -> Extensions
getDefaultExtensions Text
"markdown" } Text
markupHelp'
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String forall a. Default a => a
def Pandoc
helpDoc
Map String String
mimeMap' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Map String String)
readMimeTypesFile String
cfMimeTypesFile
let authMethod :: String
authMethod = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cfAuthenticationMethod
let stripTrailingSlash :: String -> String
stripTrailingSlash = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
let repotype' :: FileStoreType
repotype' = case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cfRepositoryType of
String
"git" -> FileStoreType
Git
String
"darcs" -> FileStoreType
Darcs
String
"mercurial" -> FileStoreType
Mercurial
String
x -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown repository type: " forall a. [a] -> [a] -> [a]
++ String
x
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
authMethod forall a. Eq a => a -> a -> Bool
== String
"rpx" Bool -> Bool -> Bool
&& String
cfRPXDomain forall a. Eq a => a -> a -> Bool
== String
"") forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"gitit" Priority
WARNING String
"rpx-domain is not set"
GithubConfig
ghConfig <- forall (m :: * -> *).
(Functor m, MonadError (CPErrorData, String) m) =>
ConfigParser -> m GithubConfig
extractGithubConfig ConfigParser
cp
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cfUserFile) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"gitit" Priority
ERROR String
"user-file is empty"
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 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
_ -> forall a. a -> a
id
, requireAuthentication :: AuthenticationLevel
requireAuthentication = case 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" -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ Bool -> [Handler]
formAuthHandlers Bool
cfDisableRegistration
String
"github" -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ GithubConfig -> [Handler]
githubAuthHandlers GithubConfig
ghConfig
String
"http" -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Handler]
httpAuthHandlers
String
"rpx" -> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Handler]
rpxAuthHandlers
String
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
, userFile :: String
userFile = String
cfUserFile
, sessionTimeout :: Int
sessionTimeout = forall a. (Num a, Read a) => String -> String -> a
readNumber String
"session-timeout" String
cfSessionTimeout 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 = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
levels
then forall a. Read a => String -> a
read String
levelString
else forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Invalid log-level.\nLegal values are: " forall a. [a] -> [a] -> [a]
++ 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 = forall a. (Num a, Read a) => String -> String -> a
readSize String
"max-upload-size" String
cfMaxUploadSize
, maxPageSize :: Integer
maxPageSize = forall a. (Num a, Read a) => String -> String -> a
readSize String
"max-page-size" String
cfMaxPageSize
, address :: String
address = String
cfAddress
, portNumber :: Int
portNumber = forall a. (Num a, Read a) => String -> String -> a
readNumber String
"port" String
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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cfAccessQuestion
then forall a. Maybe a
Nothing
else 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 -> String
fromQuotedMultiline 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 = forall a. (Num a, Read a) => String -> String -> a
readNumber String
"feed-days" String
cfFeedDays
, feedRefreshTime :: Integer
feedRefreshTime = forall a. (Num a, Read a) => String -> String -> a
readNumber String
"feed-refresh-time" String
cfFeedRefreshTime
, pandocUserData :: Maybe String
pandocUserData = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cfPandocUserData
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just String
cfPandocUserData
, xssSanitize :: Bool
xssSanitize = Bool
cfXssSanitize
, recentActivityDays :: Int
recentActivityDays = Int
cfRecentActivityDays
, githubAuth :: GithubConfig
githubAuth = GithubConfig
ghConfig
}
case Either (CPErrorData, String) Config
config' of
Left (ParseError String
e, String
e') -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Parse error: " forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
e'
Left (CPErrorData, String)
e -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (CPErrorData, String)
e)
Right Config
c -> forall (m :: * -> *) a. Monad m => a -> m a
return Config
c
extractGithubConfig :: (Functor m, MonadError CPError m) => ConfigParser
-> m GithubConfig
ConfigParser
cp = do
String
cfOauthClientId <- String -> m String
getGithubProp String
"oauthClientId"
String
cfOauthClientSecret <- String -> m String
getGithubProp String
"oauthClientSecret"
URIRef Absolute
cfOauthCallback <- forall {b}.
(MonadError (CPErrorData, b) m, IsString b) =>
String -> m (URIRef Absolute)
getUrlProp String
"oauthCallback"
URIRef Absolute
cfOauthOAuthorizeEndpoint <- forall {b}.
(MonadError (CPErrorData, b) m, IsString b) =>
String -> m (URIRef Absolute)
getUrlProp String
"oauthOAuthorizeEndpoint"
URIRef Absolute
cfOauthAccessTokenEndpoint <- forall {b}.
(MonadError (CPErrorData, b) m, IsString b) =>
String -> m (URIRef Absolute)
getUrlProp String
"oauthAccessTokenEndpoint"
Maybe String
cfOrg <- if String -> Bool
hasGithubProp String
"github-org"
then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (String -> m String
getGithubProp String
"github-org")
else forall (m :: * -> *) a. Monad m => a -> m a
return 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
}
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OAuth2 -> Maybe Text -> GithubConfig
githubConfig OAuth2
cfgOAuth2 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Maybe String
cfOrg
where getGithubProp :: String -> m String
getGithubProp = forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
get ConfigParser
cp String
"Github"
hasGithubProp :: String -> Bool
hasGithubProp = ConfigParser -> String -> String -> Bool
has_option ConfigParser
cp String
"Github"
getUrlProp :: String -> m (URIRef Absolute)
getUrlProp String
prop = String -> m String
getGithubProp String
prop 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 -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> CPErrorData
ParseError forall a b. (a -> b) -> a -> b
$ String
"couldn't parse url " forall a. [a] -> [a] -> [a]
++ String
s
forall a. [a] -> [a] -> [a]
++ String
" from (Github/" forall a. [a] -> [a] -> [a]
++ String
prop forall a. [a] -> [a] -> [a]
++ String
"): "
forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show URIParseError
e)
, b
"getUrlProp")
Right URIRef Absolute
uri -> forall (m :: * -> *) a. Monad m => a -> m a
return URIRef Absolute
uri
fromQuotedMultiline :: String -> String
fromQuotedMultiline :: String -> String
fromQuotedMultiline = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> String
doline forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ',Char
'\t',Char
'\n'])
where doline :: String -> String
doline = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ',Char
'\t']) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropGt
dropGt :: String -> String
dropGt (Char
'>':Char
' ':String
xs) = String
xs
dropGt (Char
'>':String
xs) = String
xs
dropGt String
x = String
x
readNumber :: (Num a, Read a) => String -> String -> a
readNumber :: forall a. (Num a, Read a) => String -> String -> a
readNumber String
_ String
x | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
x = forall a. Read a => String -> a
read String
x
readNumber String
opt String
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
opt forall a. [a] -> [a] -> [a]
++ String
" must be a number."
readSize :: (Num a, Read a) => String -> String -> a
readSize :: forall a. (Num a, Read a) => String -> String -> a
readSize String
opt String
x =
case forall a. [a] -> [a]
reverse String
x of
(Char
'K':String
_) -> forall a. (Num a, Read a) => String -> String -> a
readNumber String
opt (forall a. [a] -> [a]
init String
x) forall a. Num a => a -> a -> a
* a
1000
(Char
'M':String
_) -> forall a. (Num a, Read a) => String -> String -> a
readNumber String
opt (forall a. [a] -> [a]
init String
x) forall a. Num a => a -> a -> a
* a
1000000
(Char
'G':String
_) -> forall a. (Num a, Read a) => String -> String -> a
readNumber String
opt (forall a. [a] -> [a]
init String
x) forall a. Num a => a -> a -> a
* a
1000000000
String
_ -> forall a. (Num a, Read a) => String -> String -> a
readNumber String
opt String
x
splitCommaList :: String -> [String]
splitCommaList :: String -> [String]
splitCommaList String
l =
let (String
first,String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
',') String
l
first' :: String
first' = String -> String
lrStrip String
first
in case String
rest of
[] -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
first' then [] else [String
first']
(Char
_:String
rs) -> String
first' forall a. a -> [a] -> [a]
: String -> [String]
splitCommaList String
rs
lrStrip :: String -> String
lrStrip :: String -> String
lrStrip = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace
where isWhitespace :: Char -> Bool
isWhitespace = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ',Char
'\t',Char
'\n'])
getDefaultConfigParser :: IO ConfigParser
getDefaultConfigParser :: IO ConfigParser
getDefaultConfigParser = do
Either (CPErrorData, String) ConfigParser
cp <- String -> IO String
getDataFileName String
"data/default.conf" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> IO (m ConfigParser)
readfile ConfigParser
emptyCP
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e a. Show e => Either e a -> a
forceEither Either (CPErrorData, String) ConfigParser
cp
getDefaultConfig :: IO Config
getDefaultConfig :: IO Config
getDefaultConfig = IO ConfigParser
getDefaultConfigParser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigParser -> IO Config
extractConfig
readMimeTypesFile :: FilePath -> IO (M.Map String String)
readMimeTypesFile :: String -> IO (Map String String)
readMimeTypesFile String
f = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
(forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {a}. Ord a => [a] -> Map a a -> Map a a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) forall k a. Map k a
M.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall a b. (a -> b) -> a -> 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (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 forall a b. (a -> b) -> a -> b
$ String
"Could not read mime types file: " forall a. [a] -> [a] -> [a]
++
String
f forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SomeException
e forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
"Using defaults instead."
forall (m :: * -> *) a. Monad m => a -> m a
return Map String String
mimeTypes