{-# 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 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(..), oauthCallback, oauthOAuthorizeEndpoint, oauthClientId, oauthClientSecret)
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 :: Either e a -> a
forceEither = (e -> a) -> (a -> a) -> Either e a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> (e -> [Char]) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> [Char]
forall a. Show a => a -> [Char]
show) a -> a
forall a. a -> a
id

-- | Get configuration from config file.
getConfigFromFile :: FilePath -> IO Config
getConfigFromFile :: [Char] -> IO Config
getConfigFromFile [Char]
fname = do
  ConfigParser
cp <- IO ConfigParser
getDefaultConfigParser
  ConfigParser -> [Char] -> IO (Either CPError ConfigParser)
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> [Char] -> IO (m ConfigParser)
readfile ConfigParser
cp [Char]
fname IO (Either CPError ConfigParser)
-> (Either CPError ConfigParser -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigParser -> IO Config
extractConfig (ConfigParser -> IO Config)
-> (Either CPError ConfigParser -> ConfigParser)
-> Either CPError ConfigParser
-> IO Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CPError ConfigParser -> ConfigParser
forall e a. Show e => Either e a -> a
forceEither

-- | Get configuration from config files.
getConfigFromFiles :: [FilePath] -> IO Config
getConfigFromFiles :: [[Char]] -> IO Config
getConfigFromFiles [[Char]]
fnames = do
  ConfigParser
config <- [[Char]] -> IO ConfigParser
getConfigParserFromFiles [[Char]]
fnames
  ConfigParser -> IO Config
extractConfig ConfigParser
config

getConfigParserFromFiles :: [FilePath] ->
                            IO ConfigParser
getConfigParserFromFiles :: [[Char]] -> IO ConfigParser
getConfigParserFromFiles ([Char]
fname:[[Char]]
fnames) = do
  ConfigParser
cp <- [[Char]] -> IO ConfigParser
getConfigParserFromFiles [[Char]]
fnames
  Either CPError ConfigParser
config <- ConfigParser -> [Char] -> IO (Either CPError ConfigParser)
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> [Char] -> IO (m ConfigParser)
readfile ConfigParser
cp [Char]
fname
  ConfigParser -> IO ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> IO ConfigParser)
-> ConfigParser -> IO ConfigParser
forall a b. (a -> b) -> a -> b
$ Either CPError ConfigParser -> ConfigParser
forall e a. Show e => Either e a -> a
forceEither Either CPError ConfigParser
config
getConfigParserFromFiles [] = IO ConfigParser
getDefaultConfigParser

-- | A version of readfile that treats the file as UTF-8.
readfile :: MonadError CPError m
          => ConfigParser
          -> FilePath
          -> IO (m ConfigParser)
readfile :: ConfigParser -> [Char] -> IO (m ConfigParser)
readfile ConfigParser
cp [Char]
path' = do
  Text
contents <- [Char] -> IO Text
readFileUTF8 [Char]
path'
  m ConfigParser -> IO (m ConfigParser)
forall (m :: * -> *) a. Monad m => a -> m a
return (m ConfigParser -> IO (m ConfigParser))
-> m ConfigParser -> IO (m ConfigParser)
forall a b. (a -> b) -> a -> b
$ ConfigParser -> [Char] -> m ConfigParser
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> [Char] -> m ConfigParser
readstring ConfigParser
cp ([Char] -> m ConfigParser) -> [Char] -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
contents

extractConfig :: ConfigParser -> IO Config
extractConfig :: ConfigParser -> IO Config
extractConfig ConfigParser
cp = do
  Either CPError Config
config' <- ExceptT CPError IO Config -> IO (Either CPError Config)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CPError IO Config -> IO (Either CPError Config))
-> ExceptT CPError IO Config -> IO (Either CPError Config)
forall a b. (a -> b) -> a -> b
$ do
      [Char]
cfRepositoryType <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"repository-type"
      [Char]
cfRepositoryPath <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"repository-path"
      [Char]
cfDefaultPageType <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"default-page-type"
      [Char]
cfDefaultExtension <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"default-extension"
      [Char]
cfMathMethod <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"math"
      [Char]
cfMathjaxScript <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"mathjax-script"
      Bool
cfShowLHSBirdTracks <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"show-lhs-bird-tracks"
      [Char]
cfRequireAuthentication <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"require-authentication"
      [Char]
cfAuthenticationMethod <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"authentication-method"
      [Char]
cfUserFile <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"user-file"
      [Char]
cfSessionTimeout <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"session-timeout"
      [Char]
cfTemplatesDir <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"templates-dir"
      [Char]
cfLogFile <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"log-file"
      [Char]
cfLogLevel <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"log-level"
      [Char]
cfStaticDir <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"static-dir"
      [Char]
cfPlugins <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"plugins"
      Bool
cfTableOfContents <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"table-of-contents"
      [Char]
cfMaxUploadSize <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"max-upload-size"
      [Char]
cfMaxPageSize <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"max-page-size"
      [Char]
cfAddress <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"address"
      [Char]
cfPort <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"port"
      Bool
cfDebugMode <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"debug-mode"
      [Char]
cfFrontPage <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"front-page"
      [Char]
cfNoEdit <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"no-edit"
      [Char]
cfNoDelete <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"no-delete"
      [Char]
cfDefaultSummary <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"default-summary"
      [Char]
cfDeleteSummary <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"delete-summary"
      Bool
cfDisableRegistration <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"disable-registration"
      [Char]
cfAccessQuestion <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"access-question"
      [Char]
cfAccessQuestionAnswers <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"access-question-answers"
      Bool
cfUseRecaptcha <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"use-recaptcha"
      [Char]
cfRecaptchaPublicKey <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"recaptcha-public-key"
      [Char]
cfRecaptchaPrivateKey <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"recaptcha-private-key"
      [Char]
cfRPXDomain <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"rpx-domain"
      [Char]
cfRPXKey <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"rpx-key"
      Bool
cfCompressResponses <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"compress-responses"
      Bool
cfUseCache <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"use-cache"
      [Char]
cfCacheDir <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"cache-dir"
      [Char]
cfMimeTypesFile <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"mime-types-file"
      [Char]
cfMailCommand <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"mail-command"
      [Char]
cfResetPasswordMessage <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"reset-password-message"
      Bool
cfUseFeed <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"use-feed"
      [Char]
cfBaseUrl <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"base-url"
      Bool
cfAbsoluteUrls <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"absolute-urls"
      [Char]
cfWikiTitle <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"wiki-title"
      [Char]
cfFeedDays <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"feed-days"
      [Char]
cfFeedRefreshTime <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"feed-refresh-time"
      [Char]
cfPandocUserData <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"pandoc-user-data"
      Bool
cfXssSanitize <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Bool
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"xss-sanitize"
      Int
cfRecentActivityDays <- ConfigParser -> [Char] -> [Char] -> ExceptT CPError IO Int
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"DEFAULT" [Char]
"recent-activity-days"
      let (PageType
pt, Bool
lhs) = [Char] -> (PageType, Bool)
parsePageType [Char]
cfDefaultPageType
      let markupHelpFile :: [Char]
markupHelpFile = PageType -> [Char]
forall a. Show a => a -> [Char]
show PageType
pt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
lhs then [Char]
"+LHS" else [Char]
""
      [Char]
markupHelpPath <- IO [Char] -> ExceptT CPError IO [Char]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> ExceptT CPError IO [Char])
-> IO [Char] -> ExceptT CPError IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
getDataFileName ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"data" [Char] -> [Char] -> [Char]
</> [Char]
"markupHelp" [Char] -> [Char] -> [Char]
</> [Char]
markupHelpFile
      Text
markupHelp' <- IO Text -> ExceptT CPError IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT CPError IO Text)
-> IO Text -> ExceptT CPError IO Text
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Text
readFileUTF8 [Char]
markupHelpPath
      Text
markupHelpText <- IO Text -> ExceptT CPError IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT CPError IO Text)
-> IO Text -> ExceptT CPError 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 :: Extensions
readerExtensions = Text -> Extensions
getDefaultExtensions Text
"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 [Char] [Char]
mimeMap' <- IO (Map [Char] [Char]) -> ExceptT CPError IO (Map [Char] [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map [Char] [Char]) -> ExceptT CPError IO (Map [Char] [Char]))
-> IO (Map [Char] [Char]) -> ExceptT CPError IO (Map [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Map [Char] [Char])
readMimeTypesFile [Char]
cfMimeTypesFile
      let authMethod :: [Char]
authMethod = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
cfAuthenticationMethod
      let stripTrailingSlash :: [Char] -> [Char]
stripTrailingSlash = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse
      let repotype' :: FileStoreType
repotype' = case (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
cfRepositoryType of
                        [Char]
"git"       -> FileStoreType
Git
                        [Char]
"darcs"     -> FileStoreType
Darcs
                        [Char]
"mercurial" -> FileStoreType
Mercurial
                        [Char]
x           -> [Char] -> FileStoreType
forall a. HasCallStack => [Char] -> a
error ([Char] -> FileStoreType) -> [Char] -> FileStoreType
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown repository type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x
      Bool -> ExceptT CPError IO () -> ExceptT CPError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
authMethod [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"rpx" Bool -> Bool -> Bool
&& [Char]
cfRPXDomain [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"") (ExceptT CPError IO () -> ExceptT CPError IO ())
-> ExceptT CPError IO () -> ExceptT CPError IO ()
forall a b. (a -> b) -> a -> b
$
         IO () -> ExceptT CPError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT CPError IO ()) -> IO () -> ExceptT CPError IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Priority -> [Char] -> IO ()
logM [Char]
"gitit" Priority
WARNING [Char]
"rpx-domain is not set"
      GithubConfig
ghConfig <- ConfigParser -> ExceptT CPError IO GithubConfig
forall (m :: * -> *).
(Functor m, MonadError CPError m) =>
ConfigParser -> m GithubConfig
extractGithubConfig ConfigParser
cp

      Bool -> ExceptT CPError IO () -> ExceptT CPError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cfUserFile) (ExceptT CPError IO () -> ExceptT CPError IO ())
-> ExceptT CPError IO () -> ExceptT CPError IO ()
forall a b. (a -> b) -> a -> b
$
         IO () -> ExceptT CPError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT CPError IO ()) -> IO () -> ExceptT CPError IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Priority -> [Char] -> IO ()
logM [Char]
"gitit" Priority
ERROR [Char]
"user-file is empty"

      Config -> ExceptT CPError IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config :: [Char]
-> FileStoreType
-> PageType
-> [Char]
-> MathMethod
-> Bool
-> Bool
-> (Handler -> Handler)
-> AuthenticationLevel
-> Handler
-> [Char]
-> Int
-> [Char]
-> [Char]
-> Priority
-> [Char]
-> [[Char]]
-> Bool
-> Integer
-> Integer
-> [Char]
-> Int
-> Bool
-> [Char]
-> [[Char]]
-> [[Char]]
-> [Char]
-> [Char]
-> Maybe ([Char], [[Char]])
-> Bool
-> Bool
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> Bool
-> Bool
-> [Char]
-> Map [Char] [Char]
-> [Char]
-> [Char]
-> Text
-> Bool
-> [Char]
-> Bool
-> [Char]
-> Integer
-> Integer
-> Maybe [Char]
-> Bool
-> Int
-> GithubConfig
-> Config
Config{
          repositoryPath :: [Char]
repositoryPath       = [Char]
cfRepositoryPath
        , repositoryType :: FileStoreType
repositoryType       = FileStoreType
repotype'
        , defaultPageType :: PageType
defaultPageType      = PageType
pt
        , defaultExtension :: [Char]
defaultExtension     = [Char]
cfDefaultExtension
        , mathMethod :: MathMethod
mathMethod           = case (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
cfMathMethod of
                                      [Char]
"mathml"   -> MathMethod
MathML
                                      [Char]
"mathjax"  -> [Char] -> MathMethod
MathJax [Char]
cfMathjaxScript
                                      [Char]
"google"   -> [Char] -> MathMethod
WebTeX [Char]
"http://chart.apis.google.com/chart?cht=tx&chl="
                                      [Char]
_          -> MathMethod
RawTeX
        , defaultLHS :: Bool
defaultLHS           = Bool
lhs
        , showLHSBirdTracks :: Bool
showLHSBirdTracks    = Bool
cfShowLHSBirdTracks
        , withUser :: Handler -> Handler
withUser             = case [Char]
authMethod of
                                      [Char]
"form"     -> Handler -> Handler
withUserFromSession
                                      [Char]
"github"   -> Handler -> Handler
withUserFromSession
                                      [Char]
"http"     -> Handler -> Handler
withUserFromHTTPAuth
                                      [Char]
"rpx"      -> Handler -> Handler
withUserFromSession
                                      [Char]
_          -> Handler -> Handler
forall a. a -> a
id
        , requireAuthentication :: AuthenticationLevel
requireAuthentication = case (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
cfRequireAuthentication of
                                       [Char]
"none"    -> AuthenticationLevel
Never
                                       [Char]
"modify"  -> AuthenticationLevel
ForModify
                                       [Char]
"read"    -> AuthenticationLevel
ForRead
                                       [Char]
_         -> AuthenticationLevel
ForModify

        , authHandler :: Handler
authHandler          = case [Char]
authMethod of
                                      [Char]
"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
                                      [Char]
"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
                                      [Char]
"http"     -> [Handler] -> Handler
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Handler]
httpAuthHandlers
                                      [Char]
"rpx"      -> [Handler] -> Handler
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Handler]
rpxAuthHandlers
                                      [Char]
_          -> Handler
forall (m :: * -> *) a. MonadPlus m => m a
mzero
        , userFile :: [Char]
userFile             = [Char]
cfUserFile
        , sessionTimeout :: Int
sessionTimeout       = [Char] -> [Char] -> Int
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readNumber [Char]
"session-timeout" [Char]
cfSessionTimeout Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60  -- convert minutes -> seconds
        , templatesDir :: [Char]
templatesDir         = [Char]
cfTemplatesDir
        , logFile :: [Char]
logFile              = [Char]
cfLogFile
        , logLevel :: Priority
logLevel             = let levelString :: [Char]
levelString = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
cfLogLevel
                                     levels :: [[Char]]
levels = [[Char]
"DEBUG", [Char]
"INFO", [Char]
"NOTICE", [Char]
"WARNING", [Char]
"ERROR",
                                               [Char]
"CRITICAL", [Char]
"ALERT", [Char]
"EMERGENCY"]
                                 in  if [Char]
levelString [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
levels
                                        then [Char] -> Priority
forall a. Read a => [Char] -> a
read [Char]
levelString
                                        else [Char] -> Priority
forall a. HasCallStack => [Char] -> a
error ([Char] -> Priority) -> [Char] -> Priority
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid log-level.\nLegal values are: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
levels
        , staticDir :: [Char]
staticDir            = [Char]
cfStaticDir
        , pluginModules :: [[Char]]
pluginModules        = [Char] -> [[Char]]
splitCommaList [Char]
cfPlugins
        , tableOfContents :: Bool
tableOfContents      = Bool
cfTableOfContents
        , maxUploadSize :: Integer
maxUploadSize        = [Char] -> [Char] -> Integer
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readSize [Char]
"max-upload-size" [Char]
cfMaxUploadSize
        , maxPageSize :: Integer
maxPageSize          = [Char] -> [Char] -> Integer
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readSize [Char]
"max-page-size" [Char]
cfMaxPageSize
        , address :: [Char]
address              = [Char]
cfAddress
        , portNumber :: Int
portNumber           = [Char] -> [Char] -> Int
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readNumber [Char]
"port" [Char]
cfPort
        , debugMode :: Bool
debugMode            = Bool
cfDebugMode
        , frontPage :: [Char]
frontPage            = [Char]
cfFrontPage
        , noEdit :: [[Char]]
noEdit               = [Char] -> [[Char]]
splitCommaList [Char]
cfNoEdit
        , noDelete :: [[Char]]
noDelete             = [Char] -> [[Char]]
splitCommaList [Char]
cfNoDelete
        , defaultSummary :: [Char]
defaultSummary       = [Char]
cfDefaultSummary
        , deleteSummary :: [Char]
deleteSummary        = [Char]
cfDeleteSummary
        , disableRegistration :: Bool
disableRegistration  = Bool
cfDisableRegistration
        , accessQuestion :: Maybe ([Char], [[Char]])
accessQuestion       = if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cfAccessQuestion
                                    then Maybe ([Char], [[Char]])
forall a. Maybe a
Nothing
                                    else ([Char], [[Char]]) -> Maybe ([Char], [[Char]])
forall a. a -> Maybe a
Just ([Char]
cfAccessQuestion, [Char] -> [[Char]]
splitCommaList [Char]
cfAccessQuestionAnswers)
        , useRecaptcha :: Bool
useRecaptcha         = Bool
cfUseRecaptcha
        , recaptchaPublicKey :: [Char]
recaptchaPublicKey   = [Char]
cfRecaptchaPublicKey
        , recaptchaPrivateKey :: [Char]
recaptchaPrivateKey  = [Char]
cfRecaptchaPrivateKey
        , rpxDomain :: [Char]
rpxDomain            = [Char]
cfRPXDomain
        , rpxKey :: [Char]
rpxKey               = [Char]
cfRPXKey
        , compressResponses :: Bool
compressResponses    = Bool
cfCompressResponses
        , useCache :: Bool
useCache             = Bool
cfUseCache
        , cacheDir :: [Char]
cacheDir             = [Char]
cfCacheDir
        , mimeMap :: Map [Char] [Char]
mimeMap              = Map [Char] [Char]
mimeMap'
        , mailCommand :: [Char]
mailCommand          = [Char]
cfMailCommand
        , resetPasswordMessage :: [Char]
resetPasswordMessage = [Char] -> [Char]
fromQuotedMultiline [Char]
cfResetPasswordMessage
        , markupHelp :: Text
markupHelp           = Text
markupHelpText
        , useFeed :: Bool
useFeed              = Bool
cfUseFeed
        , baseUrl :: [Char]
baseUrl              = [Char] -> [Char]
stripTrailingSlash [Char]
cfBaseUrl
        , useAbsoluteUrls :: Bool
useAbsoluteUrls      = Bool
cfAbsoluteUrls
        , wikiTitle :: [Char]
wikiTitle            = [Char]
cfWikiTitle
        , feedDays :: Integer
feedDays             = [Char] -> [Char] -> Integer
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readNumber [Char]
"feed-days" [Char]
cfFeedDays
        , feedRefreshTime :: Integer
feedRefreshTime      = [Char] -> [Char] -> Integer
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readNumber [Char]
"feed-refresh-time" [Char]
cfFeedRefreshTime
        , pandocUserData :: Maybe [Char]
pandocUserData       = if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cfPandocUserData
                                    then Maybe [Char]
forall a. Maybe a
Nothing
                                    else [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
cfPandocUserData
        , xssSanitize :: Bool
xssSanitize          = Bool
cfXssSanitize
        , recentActivityDays :: Int
recentActivityDays   = Int
cfRecentActivityDays
        , githubAuth :: GithubConfig
githubAuth           = GithubConfig
ghConfig
        }
  case Either CPError Config
config' of
        Left (ParseError [Char]
e, [Char]
e') -> [Char] -> IO Config
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO Config) -> [Char] -> IO Config
forall a b. (a -> b) -> a -> b
$ [Char]
"Parse error: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e'
        Left CPError
e                  -> [Char] -> IO Config
forall a. HasCallStack => [Char] -> a
error (CPError -> [Char]
forall a. Show a => a -> [Char]
show CPError
e)
        Right Config
c                 -> Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
c

extractGithubConfig ::  (Functor m, MonadError CPError m) => ConfigParser
                    -> m GithubConfig
extractGithubConfig :: ConfigParser -> m GithubConfig
extractGithubConfig ConfigParser
cp = do
      [Char]
cfOauthClientId <- [Char] -> m [Char]
getGithubProp [Char]
"oauthClientId"
      [Char]
cfOauthClientSecret <- [Char] -> m [Char]
getGithubProp [Char]
"oauthClientSecret"
      URIRef Absolute
cfOauthCallback <- [Char] -> m (URIRef Absolute)
forall b.
(MonadError (CPErrorData, b) m, IsString b) =>
[Char] -> m (URIRef Absolute)
getUrlProp [Char]
"oauthCallback"
      URIRef Absolute
cfOauthOAuthorizeEndpoint  <- [Char] -> m (URIRef Absolute)
forall b.
(MonadError (CPErrorData, b) m, IsString b) =>
[Char] -> m (URIRef Absolute)
getUrlProp [Char]
"oauthOAuthorizeEndpoint"
      URIRef Absolute
cfOauthAccessTokenEndpoint <- [Char] -> m (URIRef Absolute)
forall b.
(MonadError (CPErrorData, b) m, IsString b) =>
[Char] -> m (URIRef Absolute)
getUrlProp [Char]
"oauthAccessTokenEndpoint"
      Maybe [Char]
cfOrg <- if [Char] -> Bool
hasGithubProp [Char]
"github-org"
                 then ([Char] -> Maybe [Char]) -> m [Char] -> m (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> m [Char]
getGithubProp [Char]
"github-org")
                 else Maybe [Char] -> m (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
      let cfgOAuth2 :: OAuth2
cfgOAuth2 = OAuth2 :: Text
-> Maybe Text
-> URIRef Absolute
-> URIRef Absolute
-> Maybe (URIRef Absolute)
-> OAuth2
OAuth2 { oauthClientId :: Text
oauthClientId = [Char] -> Text
T.pack [Char]
cfOauthClientId
#if MIN_VERSION_hoauth2(1, 11, 0)
                          , oauthClientSecret :: Maybe Text
oauthClientSecret = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
cfOauthClientSecret
#else
                          , oauthClientSecret = T.pack cfOauthClientSecret
#endif
                          , oauthCallback :: Maybe (URIRef Absolute)
oauthCallback = URIRef Absolute -> Maybe (URIRef Absolute)
forall a. a -> Maybe a
Just URIRef Absolute
cfOauthCallback
                          , oauthOAuthorizeEndpoint :: URIRef Absolute
oauthOAuthorizeEndpoint = URIRef Absolute
cfOauthOAuthorizeEndpoint
                          , oauthAccessTokenEndpoint :: URIRef Absolute
oauthAccessTokenEndpoint = URIRef Absolute
cfOauthAccessTokenEndpoint
                          }
      GithubConfig -> m GithubConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (GithubConfig -> m GithubConfig) -> GithubConfig -> m 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
$ ([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack Maybe [Char]
cfOrg
  where getGithubProp :: [Char] -> m [Char]
getGithubProp = ConfigParser -> [Char] -> [Char] -> m [Char]
forall a (m :: * -> *).
(Get_C a, MonadError CPError m) =>
ConfigParser -> [Char] -> [Char] -> m a
get ConfigParser
cp [Char]
"Github"
        hasGithubProp :: [Char] -> Bool
hasGithubProp = ConfigParser -> [Char] -> [Char] -> Bool
has_option ConfigParser
cp [Char]
"Github"
        getUrlProp :: [Char] -> m (URIRef Absolute)
getUrlProp [Char]
prop = [Char] -> m [Char]
getGithubProp [Char]
prop m [Char] -> ([Char] -> m (URIRef Absolute)) -> m (URIRef Absolute)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
s ->
                            case URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
laxURIParserOptions ([Char] -> ByteString
BS.pack [Char]
s) of
                              Left URIParseError
e    -> (CPErrorData, b) -> m (URIRef Absolute)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> CPErrorData
ParseError ([Char] -> CPErrorData) -> [Char] -> CPErrorData
forall a b. (a -> b) -> a -> b
$ [Char]
"couldn't parse url " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s
                                                                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" from (Github/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
prop [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"): "
                                                                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (URIParseError -> [Char]
forall a. Show a => a -> [Char]
show URIParseError
e)
                                                      , b
"getUrlProp")
                              Right URIRef Absolute
uri -> URIRef Absolute -> m (URIRef Absolute)
forall (m :: * -> *) a. Monad m => a -> m a
return URIRef Absolute
uri

fromQuotedMultiline :: String -> String
fromQuotedMultiline :: [Char] -> [Char]
fromQuotedMultiline = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
doline ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> ([Char] -> [Char]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ',Char
'\t',Char
'\n'])
  where doline :: [Char] -> [Char]
doline = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ',Char
'\t']) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
dropGt
        dropGt :: [Char] -> [Char]
dropGt (Char
'>':Char
' ':[Char]
xs) = [Char]
xs
        dropGt (Char
'>':[Char]
xs) = [Char]
xs
        dropGt [Char]
x = [Char]
x

readNumber :: (Num a, Read a) => String -> String -> a
readNumber :: [Char] -> [Char] -> a
readNumber [Char]
_   [Char]
x | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
x = [Char] -> a
forall a. Read a => [Char] -> a
read [Char]
x
readNumber [Char]
opt [Char]
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
opt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" must be a number."

readSize :: (Num a, Read a) => String -> String -> a
readSize :: [Char] -> [Char] -> a
readSize [Char]
opt [Char]
x =
  case [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
x of
       (Char
'K':[Char]
_) -> [Char] -> [Char] -> a
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readNumber [Char]
opt ([Char] -> [Char]
forall a. [a] -> [a]
init [Char]
x) a -> a -> a
forall a. Num a => a -> a -> a
* a
1000
       (Char
'M':[Char]
_) -> [Char] -> [Char] -> a
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readNumber [Char]
opt ([Char] -> [Char]
forall a. [a] -> [a]
init [Char]
x) a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000
       (Char
'G':[Char]
_) -> [Char] -> [Char] -> a
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readNumber [Char]
opt ([Char] -> [Char]
forall a. [a] -> [a]
init [Char]
x) a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000000
       [Char]
_       -> [Char] -> [Char] -> a
forall a. (Num a, Read a) => [Char] -> [Char] -> a
readNumber [Char]
opt [Char]
x

splitCommaList :: String -> [String]
splitCommaList :: [Char] -> [[Char]]
splitCommaList [Char]
l =
  let ([Char]
first,[Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') [Char]
l
      first' :: [Char]
first' = [Char] -> [Char]
lrStrip [Char]
first
  in case [Char]
rest of
         []     -> if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
first' then [] else [[Char]
first']
         (Char
_:[Char]
rs) -> [Char]
first' [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
splitCommaList [Char]
rs

lrStrip :: String -> String
lrStrip :: [Char] -> [Char]
lrStrip = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace
    where isWhitespace :: Char -> Bool
isWhitespace = (Char -> [Char] -> Bool
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 CPError ConfigParser
cp <- [Char] -> IO [Char]
getDataFileName [Char]
"data/default.conf" IO [Char]
-> ([Char] -> IO (Either CPError ConfigParser))
-> IO (Either CPError ConfigParser)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigParser -> [Char] -> IO (Either CPError ConfigParser)
forall (m :: * -> *).
MonadError CPError m =>
ConfigParser -> [Char] -> IO (m ConfigParser)
readfile ConfigParser
emptyCP
  ConfigParser -> IO ConfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> IO ConfigParser)
-> ConfigParser -> IO ConfigParser
forall a b. (a -> b) -> a -> b
$ Either CPError ConfigParser -> ConfigParser
forall e a. Show e => Either e a -> a
forceEither Either CPError ConfigParser
cp

-- | Returns the default gitit configuration.
getDefaultConfig :: IO Config
getDefaultConfig :: IO Config
getDefaultConfig = IO ConfigParser
getDefaultConfigParser IO ConfigParser -> (ConfigParser -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigParser -> IO Config
extractConfig

-- | 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 :: [Char] -> IO (Map [Char] [Char])
readMimeTypesFile [Char]
f = IO (Map [Char] [Char])
-> (SomeException -> IO (Map [Char] [Char]))
-> IO (Map [Char] [Char])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
  ((Text -> Map [Char] [Char]) -> IO Text -> IO (Map [Char] [Char])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (([Char] -> Map [Char] [Char] -> Map [Char] [Char])
-> Map [Char] [Char] -> [[Char]] -> Map [Char] [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([[Char]] -> Map [Char] [Char] -> Map [Char] [Char]
forall k. Ord k => [k] -> Map k k -> Map k k
go ([[Char]] -> Map [Char] [Char] -> Map [Char] [Char])
-> ([Char] -> [[Char]])
-> [Char]
-> Map [Char] [Char]
-> Map [Char] [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words)  Map [Char] [Char]
forall k a. Map k a
M.empty ([[Char]] -> Map [Char] [Char])
-> (Text -> [[Char]]) -> Text -> Map [Char] [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> (Text -> [Char]) -> Text -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) (IO Text -> IO (Map [Char] [Char]))
-> IO Text -> IO (Map [Char] [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Text
readFileUTF8 [Char]
f)
  SomeException -> IO (Map [Char] [Char])
handleMimeTypesFileNotFound
     where go :: [k] -> Map k k -> Map k k
go []     Map k k
m = Map k k
m  -- skip blank lines
           go (k
x:[k]
xs) Map k k
m = (k -> Map k k -> Map k k) -> Map k k -> [k] -> Map k k
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (k -> k -> Map k k -> Map k k
forall k a. Ord k => k -> a -> Map k a -> Map k a
`M.insert` k
x) Map k k
m [k]
xs
           handleMimeTypesFileNotFound :: SomeException -> IO (Map [Char] [Char])
handleMimeTypesFileNotFound (SomeException
e :: E.SomeException) = do
             [Char] -> Priority -> [Char] -> IO ()
logM [Char]
"gitit" Priority
WARNING ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read mime types file: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
               [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Using defaults instead."
             Map [Char] [Char] -> IO (Map [Char] [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Map [Char] [Char]
mimeTypes

{-
-- | Ready collection of common mime types. (Copied from
-- Happstack.Server.HTTP.FileServe.)
mimeTypes :: M.Map String String
mimeTypes = M.fromList
        [("xml","application/xml")
        ,("xsl","application/xml")
        ,("js","text/javascript")
        ,("html","text/html")
        ,("htm","text/html")
        ,("css","text/css")
        ,("gif","image/gif")
        ,("jpg","image/jpeg")
        ,("png","image/png")
        ,("txt","text/plain")
        ,("doc","application/msword")
        ,("exe","application/octet-stream")
        ,("pdf","application/pdf")
        ,("zip","application/zip")
        ,("gz","application/x-gzip")
        ,("ps","application/postscript")
        ,("rtf","application/rtf")
        ,("wav","application/x-wav")
        ,("hs","text/plain")]
-}