{-# 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(..))
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 = (e -> a) -> (a -> a) -> Either e a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (e -> String) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a. Show a => a -> String
show) a -> a
forall a. a -> a
id

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

-- | Get configuration from config files.
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 <- ConfigParser
-> String -> IO (Either (CPErrorData, String) ConfigParser)
forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> IO (m ConfigParser)
readfile ConfigParser
cp String
fname
  ConfigParser -> IO ConfigParser
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> IO ConfigParser)
-> ConfigParser -> IO ConfigParser
forall a b. (a -> b) -> a -> b
$ Either (CPErrorData, String) ConfigParser -> ConfigParser
forall e a. Show e => Either e a -> a
forceEither Either (CPErrorData, String) 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 :: 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'
  m ConfigParser -> IO (m ConfigParser)
forall a. a -> IO a
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 -> String -> m ConfigParser
forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> m ConfigParser
readstring ConfigParser
cp (String -> m ConfigParser) -> String -> m ConfigParser
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
contents

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

      Bool
-> ExceptT (CPErrorData, String) IO ()
-> ExceptT (CPErrorData, 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 (CPErrorData, String) IO ()
 -> ExceptT (CPErrorData, String) IO ())
-> ExceptT (CPErrorData, String) IO ()
-> ExceptT (CPErrorData, String) IO ()
forall a b. (a -> b) -> a -> b
$
         IO () -> ExceptT (CPErrorData, String) IO ()
forall a. IO a -> ExceptT (CPErrorData, String) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT (CPErrorData, String) IO ())
-> IO () -> ExceptT (CPErrorData, 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 (CPErrorData, String) IO Config
forall a. a -> ExceptT (CPErrorData, 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       = String -> String -> Int
forall a. (Num a, Read a) => String -> String -> a
readNumber String
"session-timeout" String
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        = String -> String -> Integer
forall a. (Num a, Read a) => String -> String -> a
readSize String
"max-upload-size" String
cfMaxUploadSize
        , maxPageSize :: Integer
maxPageSize          = String -> String -> Integer
forall a. (Num a, Read a) => String -> String -> a
readSize String
"max-page-size" String
cfMaxPageSize
        , address :: String
address              = String
cfAddress
        , portNumber :: Int
portNumber           = String -> String -> Int
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 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 -> 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             = String -> String -> Integer
forall a. (Num a, Read a) => String -> String -> a
readNumber String
"feed-days" String
cfFeedDays
        , feedRefreshTime :: Integer
feedRefreshTime      = String -> String -> Integer
forall a. (Num a, Read a) => String -> String -> a
readNumber String
"feed-refresh-time" String
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
        }
  case Either (CPErrorData, String) Config
config' of
        Left (ParseError String
e, String
e') -> String -> IO Config
forall a. HasCallStack => String -> a
error (String -> IO Config) -> String -> IO Config
forall a b. (a -> b) -> a -> b
$ String
"Parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e'
        Left (CPErrorData, String)
e                  -> String -> IO Config
forall a. HasCallStack => String -> a
error ((CPErrorData, String) -> String
forall a. Show a => a -> String
show (CPErrorData, String)
e)
        Right Config
c                 -> Config -> IO Config
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
c

extractGithubConfig ::  (Functor m, MonadError CPError m) => ConfigParser
                    -> m GithubConfig
extractGithubConfig :: forall (m :: * -> *).
(Functor m, MonadError (CPErrorData, String) m) =>
ConfigParser -> m GithubConfig
extractGithubConfig ConfigParser
cp = do
      String
cfOauthClientId <- String -> m String
getGithubProp String
"oauthClientId"
      String
cfOauthClientSecret <- String -> m String
getGithubProp String
"oauthClientSecret"
      URIRef Absolute
cfOauthCallback <- String -> m (URIRef Absolute)
getUrlProp String
"oauthCallback"
      URIRef Absolute
cfOauthOAuthorizeEndpoint  <- String -> m (URIRef Absolute)
getUrlProp String
"oauthOAuthorizeEndpoint"
      URIRef Absolute
cfOauthAccessTokenEndpoint <- String -> m (URIRef Absolute)
getUrlProp String
"oauthAccessTokenEndpoint"
      Maybe String
cfOrg <- if String -> Bool
hasGithubProp String
"github-org"
                 then (String -> Maybe String) -> m String -> m (Maybe String)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (String -> m String
getGithubProp String
"github-org")
                 else Maybe String -> m (Maybe String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> m GithubConfig
forall a. a -> m a
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
$ (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 getGithubProp :: String -> m String
getGithubProp = ConfigParser -> String -> String -> m String
forall a (m :: * -> *).
(Get_C a, MonadError (CPErrorData, String) m) =>
ConfigParser -> String -> String -> m a
forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> String -> m String
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 m String -> (String -> m (URIRef Absolute)) -> m (URIRef Absolute)
forall a b. m a -> (a -> m b) -> m 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    -> (CPErrorData, String) -> m (URIRef Absolute)
forall a. (CPErrorData, String) -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> CPErrorData
ParseError (String -> CPErrorData) -> String -> CPErrorData
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]
++ String
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)
                                                      , String
"getUrlProp")
                              Right URIRef Absolute
uri -> URIRef Absolute -> m (URIRef Absolute)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return URIRef Absolute
uri

fromQuotedMultiline :: String -> String
fromQuotedMultiline :: String -> String
fromQuotedMultiline = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
doline ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (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 -> 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'])
  where doline :: String -> String
doline = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (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']) (String -> String) -> (String -> String) -> String -> String
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 | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
x = String -> a
forall a. Read a => String -> a
read String
x
readNumber String
opt String
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
opt String -> String -> String
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 String -> String
forall a. [a] -> [a]
reverse String
x of
       (Char
'K':String
_) -> String -> String -> a
forall a. (Num a, Read a) => String -> String -> a
readNumber String
opt (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x) a -> a -> a
forall a. Num a => a -> a -> a
* a
1000
       (Char
'M':String
_) -> String -> String -> a
forall a. (Num a, Read a) => String -> String -> a
readNumber String
opt (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x) a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000
       (Char
'G':String
_) -> String -> String -> a
forall a. (Num a, Read a) => String -> String -> a
readNumber String
opt (String -> String
forall a. HasCallStack => [a] -> [a]
init String
x) a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000000
       String
_       -> String -> String -> a
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) = (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
         []     -> if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
first' then [] else [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'])

getDefaultConfigParser :: IO ConfigParser
getDefaultConfigParser :: IO ConfigParser
getDefaultConfigParser = do
  Either (CPErrorData, String) ConfigParser
cp <- String -> IO String
getDataFileName String
"data/default.conf" IO String
-> (String -> IO (Either (CPErrorData, String) ConfigParser))
-> IO (Either (CPErrorData, String) ConfigParser)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigParser
-> String -> IO (Either (CPErrorData, String) ConfigParser)
forall (m :: * -> *).
MonadError (CPErrorData, String) m =>
ConfigParser -> String -> IO (m ConfigParser)
readfile ConfigParser
emptyCP
  ConfigParser -> IO ConfigParser
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigParser -> IO ConfigParser)
-> ConfigParser -> IO ConfigParser
forall a b. (a -> b) -> a -> b
$ Either (CPErrorData, String) ConfigParser -> ConfigParser
forall e a. Show e => Either e a -> a
forceEither Either (CPErrorData, String) 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 a b. IO a -> (a -> IO b) -> IO b
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 :: 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
  ((Text -> Map String String) -> IO Text -> IO (Map String String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((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) (IO Text -> IO (Map String String))
-> IO Text -> IO (Map String String)
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  -- 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

{-
-- | 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")]
-}