{-# LANGUAGE TypeSynonymInstances, ScopedTypeVariables, FlexibleInstances #-}
{-
Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>,
Anton van Straaten <anton@appsolutions.com>

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
-}

{- | Types for Gitit modules.
-}

module Network.Gitit.Types (
                            PageType(..)
                           , FileStoreType(..)
                           , MathMethod(..)
                           , AuthenticationLevel(..)
                           , Config(..)
                           , Page(..)
                           , SessionKey(..)
                           -- we do not export SessionData constructors, in case we need to extend  SessionData with other data in the future
                           , SessionData
                           , SessionGithubData
                           , sessionData
                           , sessionGithubData
                           , sessionDataGithubStateUrl
                           , sessionUser
                           , sessionGithubState
                           , sessionGithubDestination
                           , User(..)
                           , Sessions(..)
                           , Password(..)
                           , GititState(..)
                           , HasContext
                           , modifyContext
                           , getContext
                           , ContentTransformer
                           , Plugin(..)
                           , PluginData(..)
                           , PluginM
                           , runPluginM
                           , Context(..)
                           , PageLayout(..)
                           , Tab(..)
                           , Recaptcha(..)
                           , Params(..)
                           , Command(..)
                           , WikiState(..)
                           , GititServerPart
                           , Handler
                           , fromEntities
                           , GithubConfig
                           , oAuth2
                           , org
                           , githubConfig) where

import Control.Monad.Reader (ReaderT, runReaderT, mplus)
import Control.Monad.State (StateT, runStateT, get, modify)
import Control.Monad (liftM)
import System.Log.Logger (Priority(..))
import Text.Pandoc.Definition (Pandoc)
import Text.XHtml (Html)
import qualified Data.Map as M
import Data.Text (Text)
import Data.List (intersect)
import Data.Time (parseTimeM)
#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
import Data.FileStore.Types
import Network.Gitit.Server
import Text.HTML.TagSoup.Entity (lookupEntity)
import Data.Char (isSpace)
import Network.OAuth.OAuth2

data PageType = Markdown
              | CommonMark
              | RST
              | LaTeX
              | HTML
              | Textile
              | Org
              | DocBook
              | MediaWiki
                deriving (ReadPrec [PageType]
ReadPrec PageType
Int -> ReadS PageType
ReadS [PageType]
(Int -> ReadS PageType)
-> ReadS [PageType]
-> ReadPrec PageType
-> ReadPrec [PageType]
-> Read PageType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PageType]
$creadListPrec :: ReadPrec [PageType]
readPrec :: ReadPrec PageType
$creadPrec :: ReadPrec PageType
readList :: ReadS [PageType]
$creadList :: ReadS [PageType]
readsPrec :: Int -> ReadS PageType
$creadsPrec :: Int -> ReadS PageType
Read, Int -> PageType -> ShowS
[PageType] -> ShowS
PageType -> String
(Int -> PageType -> ShowS)
-> (PageType -> String) -> ([PageType] -> ShowS) -> Show PageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageType] -> ShowS
$cshowList :: [PageType] -> ShowS
show :: PageType -> String
$cshow :: PageType -> String
showsPrec :: Int -> PageType -> ShowS
$cshowsPrec :: Int -> PageType -> ShowS
Show, PageType -> PageType -> Bool
(PageType -> PageType -> Bool)
-> (PageType -> PageType -> Bool) -> Eq PageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageType -> PageType -> Bool
$c/= :: PageType -> PageType -> Bool
== :: PageType -> PageType -> Bool
$c== :: PageType -> PageType -> Bool
Eq)

data FileStoreType = Git | Darcs | Mercurial deriving Int -> FileStoreType -> ShowS
[FileStoreType] -> ShowS
FileStoreType -> String
(Int -> FileStoreType -> ShowS)
-> (FileStoreType -> String)
-> ([FileStoreType] -> ShowS)
-> Show FileStoreType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileStoreType] -> ShowS
$cshowList :: [FileStoreType] -> ShowS
show :: FileStoreType -> String
$cshow :: FileStoreType -> String
showsPrec :: Int -> FileStoreType -> ShowS
$cshowsPrec :: Int -> FileStoreType -> ShowS
Show

data MathMethod = MathML | WebTeX String | RawTeX | MathJax String
                  deriving (ReadPrec [MathMethod]
ReadPrec MathMethod
Int -> ReadS MathMethod
ReadS [MathMethod]
(Int -> ReadS MathMethod)
-> ReadS [MathMethod]
-> ReadPrec MathMethod
-> ReadPrec [MathMethod]
-> Read MathMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MathMethod]
$creadListPrec :: ReadPrec [MathMethod]
readPrec :: ReadPrec MathMethod
$creadPrec :: ReadPrec MathMethod
readList :: ReadS [MathMethod]
$creadList :: ReadS [MathMethod]
readsPrec :: Int -> ReadS MathMethod
$creadsPrec :: Int -> ReadS MathMethod
Read, Int -> MathMethod -> ShowS
[MathMethod] -> ShowS
MathMethod -> String
(Int -> MathMethod -> ShowS)
-> (MathMethod -> String)
-> ([MathMethod] -> ShowS)
-> Show MathMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MathMethod] -> ShowS
$cshowList :: [MathMethod] -> ShowS
show :: MathMethod -> String
$cshow :: MathMethod -> String
showsPrec :: Int -> MathMethod -> ShowS
$cshowsPrec :: Int -> MathMethod -> ShowS
Show, MathMethod -> MathMethod -> Bool
(MathMethod -> MathMethod -> Bool)
-> (MathMethod -> MathMethod -> Bool) -> Eq MathMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MathMethod -> MathMethod -> Bool
$c/= :: MathMethod -> MathMethod -> Bool
== :: MathMethod -> MathMethod -> Bool
$c== :: MathMethod -> MathMethod -> Bool
Eq)

data AuthenticationLevel = Never | ForModify | ForRead
                  deriving (ReadPrec [AuthenticationLevel]
ReadPrec AuthenticationLevel
Int -> ReadS AuthenticationLevel
ReadS [AuthenticationLevel]
(Int -> ReadS AuthenticationLevel)
-> ReadS [AuthenticationLevel]
-> ReadPrec AuthenticationLevel
-> ReadPrec [AuthenticationLevel]
-> Read AuthenticationLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthenticationLevel]
$creadListPrec :: ReadPrec [AuthenticationLevel]
readPrec :: ReadPrec AuthenticationLevel
$creadPrec :: ReadPrec AuthenticationLevel
readList :: ReadS [AuthenticationLevel]
$creadList :: ReadS [AuthenticationLevel]
readsPrec :: Int -> ReadS AuthenticationLevel
$creadsPrec :: Int -> ReadS AuthenticationLevel
Read, Int -> AuthenticationLevel -> ShowS
[AuthenticationLevel] -> ShowS
AuthenticationLevel -> String
(Int -> AuthenticationLevel -> ShowS)
-> (AuthenticationLevel -> String)
-> ([AuthenticationLevel] -> ShowS)
-> Show AuthenticationLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationLevel] -> ShowS
$cshowList :: [AuthenticationLevel] -> ShowS
show :: AuthenticationLevel -> String
$cshow :: AuthenticationLevel -> String
showsPrec :: Int -> AuthenticationLevel -> ShowS
$cshowsPrec :: Int -> AuthenticationLevel -> ShowS
Show, AuthenticationLevel -> AuthenticationLevel -> Bool
(AuthenticationLevel -> AuthenticationLevel -> Bool)
-> (AuthenticationLevel -> AuthenticationLevel -> Bool)
-> Eq AuthenticationLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationLevel -> AuthenticationLevel -> Bool
$c/= :: AuthenticationLevel -> AuthenticationLevel -> Bool
== :: AuthenticationLevel -> AuthenticationLevel -> Bool
$c== :: AuthenticationLevel -> AuthenticationLevel -> Bool
Eq, Eq AuthenticationLevel
Eq AuthenticationLevel
-> (AuthenticationLevel -> AuthenticationLevel -> Ordering)
-> (AuthenticationLevel -> AuthenticationLevel -> Bool)
-> (AuthenticationLevel -> AuthenticationLevel -> Bool)
-> (AuthenticationLevel -> AuthenticationLevel -> Bool)
-> (AuthenticationLevel -> AuthenticationLevel -> Bool)
-> (AuthenticationLevel
    -> AuthenticationLevel -> AuthenticationLevel)
-> (AuthenticationLevel
    -> AuthenticationLevel -> AuthenticationLevel)
-> Ord AuthenticationLevel
AuthenticationLevel -> AuthenticationLevel -> Bool
AuthenticationLevel -> AuthenticationLevel -> Ordering
AuthenticationLevel -> AuthenticationLevel -> AuthenticationLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AuthenticationLevel -> AuthenticationLevel -> AuthenticationLevel
$cmin :: AuthenticationLevel -> AuthenticationLevel -> AuthenticationLevel
max :: AuthenticationLevel -> AuthenticationLevel -> AuthenticationLevel
$cmax :: AuthenticationLevel -> AuthenticationLevel -> AuthenticationLevel
>= :: AuthenticationLevel -> AuthenticationLevel -> Bool
$c>= :: AuthenticationLevel -> AuthenticationLevel -> Bool
> :: AuthenticationLevel -> AuthenticationLevel -> Bool
$c> :: AuthenticationLevel -> AuthenticationLevel -> Bool
<= :: AuthenticationLevel -> AuthenticationLevel -> Bool
$c<= :: AuthenticationLevel -> AuthenticationLevel -> Bool
< :: AuthenticationLevel -> AuthenticationLevel -> Bool
$c< :: AuthenticationLevel -> AuthenticationLevel -> Bool
compare :: AuthenticationLevel -> AuthenticationLevel -> Ordering
$ccompare :: AuthenticationLevel -> AuthenticationLevel -> Ordering
$cp1Ord :: Eq AuthenticationLevel
Ord)

-- | Data structure for information read from config file.
data Config = Config {
  -- | Path of repository containing filestore
  Config -> String
repositoryPath       :: FilePath,
  -- | Type of repository
  Config -> FileStoreType
repositoryType       :: FileStoreType,
  -- | Default page markup type for this wiki
  Config -> PageType
defaultPageType      :: PageType,
  -- | Default file extension for pages in this wiki
  Config -> String
defaultExtension     :: String,
  -- | How to handle LaTeX math in pages?
  Config -> MathMethod
mathMethod           :: MathMethod,
  -- | Treat as literate haskell by default?
  Config -> Bool
defaultLHS           :: Bool,
  -- | Show Haskell code with bird tracks
  Config -> Bool
showLHSBirdTracks    :: Bool,
  -- | Combinator to set @REMOTE_USER@ request header
  Config -> Handler -> Handler
withUser             :: Handler -> Handler,
  -- | Handler for login, logout, register, etc.
  Config -> AuthenticationLevel
requireAuthentication :: AuthenticationLevel,
  -- | Specifies which actions require authentication.
  Config -> Handler
authHandler          :: Handler,
  -- | Path of users database
  Config -> String
userFile             :: FilePath,
  -- | Seconds of inactivity before session expires
  Config -> Int
sessionTimeout       :: Int,
  -- | Directory containing page templates
  Config -> String
templatesDir         :: FilePath,
  -- | Path of server log file
  Config -> String
logFile              :: FilePath,
  -- | Severity filter for log messages (DEBUG, INFO,
  -- NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY)
  Config -> Priority
logLevel             :: Priority,
  -- | Path of static directory
  Config -> String
staticDir            :: FilePath,
  -- | Names of plugin modules to load
  Config -> [String]
pluginModules        :: [String],
  -- | Show table of contents on each page?
  Config -> Bool
tableOfContents      :: Bool,
  -- | Max size of file uploads
  Config -> Integer
maxUploadSize        :: Integer,
  -- | Max size of page uploads
  Config -> Integer
maxPageSize          :: Integer,
  -- | IP address to bind to
  Config -> String
address              :: String,
  -- | Port number to serve content on
  Config -> Int
portNumber           :: Int,
  -- | Print debug info to the console?
  Config -> Bool
debugMode            :: Bool,
  -- | The front page of the wiki
  Config -> String
frontPage            :: String,
  -- | Pages that cannot be edited via web
  Config -> [String]
noEdit               :: [String],
  -- | Pages that cannot be deleted via web
  Config -> [String]
noDelete             :: [String],
  -- | Default summary if description left blank
  Config -> String
defaultSummary       :: String,
  -- | Delete summary
  Config -> String
deleteSummary        :: String,
  -- | @Nothing@ = anyone can register.
  -- @Just (prompt, answers)@ = a user will
  -- be given the prompt and must give
  -- one of the answers to register.
  Config -> Maybe (String, [String])
accessQuestion       :: Maybe (String, [String]),
  -- | Disable Registration?
  Config -> Bool
disableRegistration  :: Bool,
  -- | Use ReCAPTCHA for user registration.
  Config -> Bool
useRecaptcha         :: Bool,
  Config -> String
recaptchaPublicKey   :: String,
  Config -> String
recaptchaPrivateKey  :: String,
  -- | RPX domain and key
  Config -> String
rpxDomain            :: String,
  Config -> String
rpxKey               :: String,
  -- | Should responses be compressed?
  Config -> Bool
compressResponses    :: Bool,
  -- | Should responses be cached?
  Config -> Bool
useCache             :: Bool,
  -- | Directory to hold cached pages
  Config -> String
cacheDir             :: FilePath,
  -- | Map associating mime types with file extensions
  Config -> Map String String
mimeMap              :: M.Map String String,
  -- | Command to send notification emails
  Config -> String
mailCommand          :: String,
  -- | Text of password reset email
  Config -> String
resetPasswordMessage :: String,
  -- | Markup syntax help for edit sidebar
  Config -> Text
markupHelp           :: Text,
  -- | Provide an atom feed?
  Config -> Bool
useFeed              :: Bool,
  -- | Base URL of wiki, for use in feed
  Config -> String
baseUrl              :: String,
  -- | Title of wiki, used in feed
  Config -> Bool
useAbsoluteUrls      :: Bool,
  -- | Should WikiLinks be absolute w.r.t. the base URL?
  Config -> String
wikiTitle            :: String,
  -- | Number of days history to be included in feed
  Config -> Integer
feedDays             :: Integer,
  -- | Number of minutes to cache feeds before refreshing
  Config -> Integer
feedRefreshTime      :: Integer,
  -- | Directory to search for pandoc customizations
  Config -> Maybe String
pandocUserData       :: Maybe FilePath,
  -- | Filter HTML through xss-sanitize
  Config -> Bool
xssSanitize          :: Bool,
  -- | The default number of days in the past to look for \"recent\" activity
  Config -> Int
recentActivityDays   :: Int,
  -- | Github client data for authentication (id, secret, callback,
  -- authorize endpoint, access token endpoint)
  Config -> GithubConfig
githubAuth           :: GithubConfig
  }

-- | Data for rendering a wiki page.
data Page = Page {
    Page -> String
pageName        :: String
  , Page -> PageType
pageFormat      :: PageType
  , Page -> Bool
pageLHS         :: Bool
  , Page -> Bool
pageTOC         :: Bool
  , Page -> String
pageTitle       :: String
  , Page -> [String]
pageCategories  :: [String]
  , Page -> String
pageText        :: String
  , Page -> [(String, String)]
pageMeta        :: [(String, String)]
} deriving (ReadPrec [Page]
ReadPrec Page
Int -> ReadS Page
ReadS [Page]
(Int -> ReadS Page)
-> ReadS [Page] -> ReadPrec Page -> ReadPrec [Page] -> Read Page
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Page]
$creadListPrec :: ReadPrec [Page]
readPrec :: ReadPrec Page
$creadPrec :: ReadPrec Page
readList :: ReadS [Page]
$creadList :: ReadS [Page]
readsPrec :: Int -> ReadS Page
$creadsPrec :: Int -> ReadS Page
Read, Int -> Page -> ShowS
[Page] -> ShowS
Page -> String
(Int -> Page -> ShowS)
-> (Page -> String) -> ([Page] -> ShowS) -> Show Page
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Page] -> ShowS
$cshowList :: [Page] -> ShowS
show :: Page -> String
$cshow :: Page -> String
showsPrec :: Int -> Page -> ShowS
$cshowsPrec :: Int -> Page -> ShowS
Show)

newtype SessionKey = SessionKey Integer
  deriving (ReadPrec [SessionKey]
ReadPrec SessionKey
Int -> ReadS SessionKey
ReadS [SessionKey]
(Int -> ReadS SessionKey)
-> ReadS [SessionKey]
-> ReadPrec SessionKey
-> ReadPrec [SessionKey]
-> Read SessionKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SessionKey]
$creadListPrec :: ReadPrec [SessionKey]
readPrec :: ReadPrec SessionKey
$creadPrec :: ReadPrec SessionKey
readList :: ReadS [SessionKey]
$creadList :: ReadS [SessionKey]
readsPrec :: Int -> ReadS SessionKey
$creadsPrec :: Int -> ReadS SessionKey
Read, Int -> SessionKey -> ShowS
[SessionKey] -> ShowS
SessionKey -> String
(Int -> SessionKey -> ShowS)
-> (SessionKey -> String)
-> ([SessionKey] -> ShowS)
-> Show SessionKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionKey] -> ShowS
$cshowList :: [SessionKey] -> ShowS
show :: SessionKey -> String
$cshow :: SessionKey -> String
showsPrec :: Int -> SessionKey -> ShowS
$cshowsPrec :: Int -> SessionKey -> ShowS
Show, SessionKey -> SessionKey -> Bool
(SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> Bool) -> Eq SessionKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionKey -> SessionKey -> Bool
$c/= :: SessionKey -> SessionKey -> Bool
== :: SessionKey -> SessionKey -> Bool
$c== :: SessionKey -> SessionKey -> Bool
Eq, Eq SessionKey
Eq SessionKey
-> (SessionKey -> SessionKey -> Ordering)
-> (SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> SessionKey)
-> (SessionKey -> SessionKey -> SessionKey)
-> Ord SessionKey
SessionKey -> SessionKey -> Bool
SessionKey -> SessionKey -> Ordering
SessionKey -> SessionKey -> SessionKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SessionKey -> SessionKey -> SessionKey
$cmin :: SessionKey -> SessionKey -> SessionKey
max :: SessionKey -> SessionKey -> SessionKey
$cmax :: SessionKey -> SessionKey -> SessionKey
>= :: SessionKey -> SessionKey -> Bool
$c>= :: SessionKey -> SessionKey -> Bool
> :: SessionKey -> SessionKey -> Bool
$c> :: SessionKey -> SessionKey -> Bool
<= :: SessionKey -> SessionKey -> Bool
$c<= :: SessionKey -> SessionKey -> Bool
< :: SessionKey -> SessionKey -> Bool
$c< :: SessionKey -> SessionKey -> Bool
compare :: SessionKey -> SessionKey -> Ordering
$ccompare :: SessionKey -> SessionKey -> Ordering
$cp1Ord :: Eq SessionKey
Ord)

data SessionData = SessionData {
  SessionData -> Maybe String
sessionUser :: Maybe String,
  SessionData -> Maybe SessionGithubData
sessionGithubData :: Maybe SessionGithubData
} deriving (ReadPrec [SessionData]
ReadPrec SessionData
Int -> ReadS SessionData
ReadS [SessionData]
(Int -> ReadS SessionData)
-> ReadS [SessionData]
-> ReadPrec SessionData
-> ReadPrec [SessionData]
-> Read SessionData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SessionData]
$creadListPrec :: ReadPrec [SessionData]
readPrec :: ReadPrec SessionData
$creadPrec :: ReadPrec SessionData
readList :: ReadS [SessionData]
$creadList :: ReadS [SessionData]
readsPrec :: Int -> ReadS SessionData
$creadsPrec :: Int -> ReadS SessionData
Read,Int -> SessionData -> ShowS
[SessionData] -> ShowS
SessionData -> String
(Int -> SessionData -> ShowS)
-> (SessionData -> String)
-> ([SessionData] -> ShowS)
-> Show SessionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionData] -> ShowS
$cshowList :: [SessionData] -> ShowS
show :: SessionData -> String
$cshow :: SessionData -> String
showsPrec :: Int -> SessionData -> ShowS
$cshowsPrec :: Int -> SessionData -> ShowS
Show,SessionData -> SessionData -> Bool
(SessionData -> SessionData -> Bool)
-> (SessionData -> SessionData -> Bool) -> Eq SessionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionData -> SessionData -> Bool
$c/= :: SessionData -> SessionData -> Bool
== :: SessionData -> SessionData -> Bool
$c== :: SessionData -> SessionData -> Bool
Eq)

data SessionGithubData = SessionGithubData {
  SessionGithubData -> String
sessionGithubState :: String,
  SessionGithubData -> String
sessionGithubDestination :: String
} deriving (ReadPrec [SessionGithubData]
ReadPrec SessionGithubData
Int -> ReadS SessionGithubData
ReadS [SessionGithubData]
(Int -> ReadS SessionGithubData)
-> ReadS [SessionGithubData]
-> ReadPrec SessionGithubData
-> ReadPrec [SessionGithubData]
-> Read SessionGithubData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SessionGithubData]
$creadListPrec :: ReadPrec [SessionGithubData]
readPrec :: ReadPrec SessionGithubData
$creadPrec :: ReadPrec SessionGithubData
readList :: ReadS [SessionGithubData]
$creadList :: ReadS [SessionGithubData]
readsPrec :: Int -> ReadS SessionGithubData
$creadsPrec :: Int -> ReadS SessionGithubData
Read, Int -> SessionGithubData -> ShowS
[SessionGithubData] -> ShowS
SessionGithubData -> String
(Int -> SessionGithubData -> ShowS)
-> (SessionGithubData -> String)
-> ([SessionGithubData] -> ShowS)
-> Show SessionGithubData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionGithubData] -> ShowS
$cshowList :: [SessionGithubData] -> ShowS
show :: SessionGithubData -> String
$cshow :: SessionGithubData -> String
showsPrec :: Int -> SessionGithubData -> ShowS
$cshowsPrec :: Int -> SessionGithubData -> ShowS
Show, SessionGithubData -> SessionGithubData -> Bool
(SessionGithubData -> SessionGithubData -> Bool)
-> (SessionGithubData -> SessionGithubData -> Bool)
-> Eq SessionGithubData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionGithubData -> SessionGithubData -> Bool
$c/= :: SessionGithubData -> SessionGithubData -> Bool
== :: SessionGithubData -> SessionGithubData -> Bool
$c== :: SessionGithubData -> SessionGithubData -> Bool
Eq)

sessionData :: String -> SessionData
sessionData :: String -> SessionData
sessionData String
user = Maybe String -> Maybe SessionGithubData -> SessionData
SessionData (String -> Maybe String
forall a. a -> Maybe a
Just String
user) Maybe SessionGithubData
forall a. Maybe a
Nothing

sessionDataGithubStateUrl :: String -> String -> SessionData
sessionDataGithubStateUrl :: String -> String -> SessionData
sessionDataGithubStateUrl String
githubState String
destination = Maybe String -> Maybe SessionGithubData -> SessionData
SessionData Maybe String
forall a. Maybe a
Nothing (SessionGithubData -> Maybe SessionGithubData
forall a. a -> Maybe a
Just (SessionGithubData -> Maybe SessionGithubData)
-> SessionGithubData -> Maybe SessionGithubData
forall a b. (a -> b) -> a -> b
$ String -> String -> SessionGithubData
SessionGithubData String
githubState String
destination)

data Sessions a = Sessions {Sessions a -> Map SessionKey a
unsession :: M.Map SessionKey a}
  deriving (ReadPrec [Sessions a]
ReadPrec (Sessions a)
Int -> ReadS (Sessions a)
ReadS [Sessions a]
(Int -> ReadS (Sessions a))
-> ReadS [Sessions a]
-> ReadPrec (Sessions a)
-> ReadPrec [Sessions a]
-> Read (Sessions a)
forall a. Read a => ReadPrec [Sessions a]
forall a. Read a => ReadPrec (Sessions a)
forall a. Read a => Int -> ReadS (Sessions a)
forall a. Read a => ReadS [Sessions a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Sessions a]
$creadListPrec :: forall a. Read a => ReadPrec [Sessions a]
readPrec :: ReadPrec (Sessions a)
$creadPrec :: forall a. Read a => ReadPrec (Sessions a)
readList :: ReadS [Sessions a]
$creadList :: forall a. Read a => ReadS [Sessions a]
readsPrec :: Int -> ReadS (Sessions a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Sessions a)
Read,Int -> Sessions a -> ShowS
[Sessions a] -> ShowS
Sessions a -> String
(Int -> Sessions a -> ShowS)
-> (Sessions a -> String)
-> ([Sessions a] -> ShowS)
-> Show (Sessions a)
forall a. Show a => Int -> Sessions a -> ShowS
forall a. Show a => [Sessions a] -> ShowS
forall a. Show a => Sessions a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sessions a] -> ShowS
$cshowList :: forall a. Show a => [Sessions a] -> ShowS
show :: Sessions a -> String
$cshow :: forall a. Show a => Sessions a -> String
showsPrec :: Int -> Sessions a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Sessions a -> ShowS
Show,Sessions a -> Sessions a -> Bool
(Sessions a -> Sessions a -> Bool)
-> (Sessions a -> Sessions a -> Bool) -> Eq (Sessions a)
forall a. Eq a => Sessions a -> Sessions a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sessions a -> Sessions a -> Bool
$c/= :: forall a. Eq a => Sessions a -> Sessions a -> Bool
== :: Sessions a -> Sessions a -> Bool
$c== :: forall a. Eq a => Sessions a -> Sessions a -> Bool
Eq)

-- Password salt hashedPassword
data Password = Password { Password -> String
pSalt :: String, Password -> String
pHashed :: String }
  deriving (ReadPrec [Password]
ReadPrec Password
Int -> ReadS Password
ReadS [Password]
(Int -> ReadS Password)
-> ReadS [Password]
-> ReadPrec Password
-> ReadPrec [Password]
-> Read Password
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Password]
$creadListPrec :: ReadPrec [Password]
readPrec :: ReadPrec Password
$creadPrec :: ReadPrec Password
readList :: ReadS [Password]
$creadList :: ReadS [Password]
readsPrec :: Int -> ReadS Password
$creadsPrec :: Int -> ReadS Password
Read,Int -> Password -> ShowS
[Password] -> ShowS
Password -> String
(Int -> Password -> ShowS)
-> (Password -> String) -> ([Password] -> ShowS) -> Show Password
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Password] -> ShowS
$cshowList :: [Password] -> ShowS
show :: Password -> String
$cshow :: Password -> String
showsPrec :: Int -> Password -> ShowS
$cshowsPrec :: Int -> Password -> ShowS
Show,Password -> Password -> Bool
(Password -> Password -> Bool)
-> (Password -> Password -> Bool) -> Eq Password
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Password -> Password -> Bool
$c/= :: Password -> Password -> Bool
== :: Password -> Password -> Bool
$c== :: Password -> Password -> Bool
Eq)

data User = User {
  User -> String
uUsername :: String,
  User -> Password
uPassword :: Password,
  User -> String
uEmail    :: String
} deriving (Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show,ReadPrec [User]
ReadPrec User
Int -> ReadS User
ReadS [User]
(Int -> ReadS User)
-> ReadS [User] -> ReadPrec User -> ReadPrec [User] -> Read User
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [User]
$creadListPrec :: ReadPrec [User]
readPrec :: ReadPrec User
$creadPrec :: ReadPrec User
readList :: ReadS [User]
$creadList :: ReadS [User]
readsPrec :: Int -> ReadS User
$creadsPrec :: Int -> ReadS User
Read)

-- | Common state for all gitit wikis in an application.
data GititState = GititState {
  GititState -> Sessions SessionData
sessions       :: Sessions SessionData,
  GititState -> Map String User
users          :: M.Map String User,
  GititState -> String
templatesPath  :: FilePath,
  GititState -> PageLayout -> Html -> Handler
renderPage     :: PageLayout -> Html -> Handler,
  GititState -> [Plugin]
plugins        :: [Plugin]
}

type ContentTransformer = StateT Context GititServerPart

data Plugin = PageTransform (Pandoc -> PluginM Pandoc)
            | PreParseTransform (String -> PluginM String)
            | PreCommitTransform (String -> PluginM String)

data PluginData = PluginData { PluginData -> Config
pluginConfig    :: Config
                             , PluginData -> Maybe User
pluginUser      :: Maybe User
                             , PluginData -> Request
pluginRequest   :: Request
                             , PluginData -> FileStore
pluginFileStore :: FileStore
                             }

type PluginM = ReaderT PluginData (StateT Context IO)

runPluginM :: PluginM a -> PluginData -> Context -> IO (a, Context)
runPluginM :: PluginM a -> PluginData -> Context -> IO (a, Context)
runPluginM PluginM a
plugin = StateT Context IO a -> Context -> IO (a, Context)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT Context IO a -> Context -> IO (a, Context))
-> (PluginData -> StateT Context IO a)
-> PluginData
-> Context
-> IO (a, Context)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginM a -> PluginData -> StateT Context IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT PluginM a
plugin

data Context = Context { Context -> String
ctxFile            :: String
                       , Context -> PageLayout
ctxLayout          :: PageLayout
                       , Context -> Bool
ctxCacheable       :: Bool
                       , Context -> Bool
ctxTOC             :: Bool
                       , Context -> Bool
ctxBirdTracks      :: Bool
                       , Context -> [String]
ctxCategories      :: [String]
                       , Context -> [(String, String)]
ctxMeta            :: [(String, String)]
                       }

class (Monad m) => HasContext m where
  getContext    :: m Context
  modifyContext :: (Context -> Context) -> m ()

instance HasContext ContentTransformer where
  getContext :: ContentTransformer Context
getContext    = ContentTransformer Context
forall s (m :: * -> *). MonadState s m => m s
get
  modifyContext :: (Context -> Context) -> ContentTransformer ()
modifyContext = (Context -> Context) -> ContentTransformer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify

instance HasContext PluginM where
  getContext :: PluginM Context
getContext    = PluginM Context
forall s (m :: * -> *). MonadState s m => m s
get
  modifyContext :: (Context -> Context) -> PluginM ()
modifyContext = (Context -> Context) -> PluginM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify

-- | Abstract representation of page layout (tabs, scripts, etc.)
data PageLayout = PageLayout
  { PageLayout -> String
pgPageName       :: String
  , PageLayout -> Maybe String
pgRevision       :: Maybe String
  , PageLayout -> Bool
pgPrintable      :: Bool
  , PageLayout -> [String]
pgMessages       :: [String]
  , PageLayout -> String
pgTitle          :: String
  , PageLayout -> [String]
pgScripts        :: [String]
  , PageLayout -> Bool
pgShowPageTools  :: Bool
  , PageLayout -> Bool
pgShowSiteNav    :: Bool
  , PageLayout -> Maybe Text
pgMarkupHelp     :: Maybe Text
  , PageLayout -> [Tab]
pgTabs           :: [Tab]
  , PageLayout -> Tab
pgSelectedTab    :: Tab
  , PageLayout -> Bool
pgLinkToFeed     :: Bool
  }

data Tab = ViewTab
         | EditTab
         | HistoryTab
         | DiscussTab
         | DiffTab
         deriving (Tab -> Tab -> Bool
(Tab -> Tab -> Bool) -> (Tab -> Tab -> Bool) -> Eq Tab
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tab -> Tab -> Bool
$c/= :: Tab -> Tab -> Bool
== :: Tab -> Tab -> Bool
$c== :: Tab -> Tab -> Bool
Eq, Int -> Tab -> ShowS
[Tab] -> ShowS
Tab -> String
(Int -> Tab -> ShowS)
-> (Tab -> String) -> ([Tab] -> ShowS) -> Show Tab
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tab] -> ShowS
$cshowList :: [Tab] -> ShowS
show :: Tab -> String
$cshow :: Tab -> String
showsPrec :: Int -> Tab -> ShowS
$cshowsPrec :: Int -> Tab -> ShowS
Show)

data Recaptcha = Recaptcha {
    Recaptcha -> String
recaptchaChallengeField :: String
  , Recaptcha -> String
recaptchaResponseField  :: String
  } deriving (ReadPrec [Recaptcha]
ReadPrec Recaptcha
Int -> ReadS Recaptcha
ReadS [Recaptcha]
(Int -> ReadS Recaptcha)
-> ReadS [Recaptcha]
-> ReadPrec Recaptcha
-> ReadPrec [Recaptcha]
-> Read Recaptcha
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Recaptcha]
$creadListPrec :: ReadPrec [Recaptcha]
readPrec :: ReadPrec Recaptcha
$creadPrec :: ReadPrec Recaptcha
readList :: ReadS [Recaptcha]
$creadList :: ReadS [Recaptcha]
readsPrec :: Int -> ReadS Recaptcha
$creadsPrec :: Int -> ReadS Recaptcha
Read, Int -> Recaptcha -> ShowS
[Recaptcha] -> ShowS
Recaptcha -> String
(Int -> Recaptcha -> ShowS)
-> (Recaptcha -> String)
-> ([Recaptcha] -> ShowS)
-> Show Recaptcha
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recaptcha] -> ShowS
$cshowList :: [Recaptcha] -> ShowS
show :: Recaptcha -> String
$cshow :: Recaptcha -> String
showsPrec :: Int -> Recaptcha -> ShowS
$cshowsPrec :: Int -> Recaptcha -> ShowS
Show)

instance FromData SessionKey where
     fromData :: RqData SessionKey
fromData = String -> RqData SessionKey
forall (m :: * -> *) a.
(Functor m, Monad m, HasRqData m, FromReqURI a) =>
String -> m a
readCookieValue String
"sid"

data Params = Params { Params -> String
pUsername     :: String
                     , Params -> String
pPassword     :: String
                     , Params -> String
pPassword2    :: String
                     , Params -> Maybe String
pRevision     :: Maybe String
                     , Params -> String
pDestination  :: String
                     , Params -> Maybe String
pForUser      :: Maybe String
                     , Params -> Maybe UTCTime
pSince        :: Maybe UTCTime
                     , Params -> String
pRaw          :: String
                     , Params -> Int
pLimit        :: Int
                     , Params -> [String]
pPatterns     :: [String]
                     , Params -> String
pGotoPage     :: String
                     , Params -> String
pFileToDelete :: String
                     , Params -> Maybe String
pEditedText   :: Maybe String
                     , Params -> [String]
pMessages     :: [String]
                     , Params -> Maybe String
pFrom         :: Maybe String
                     , Params -> Maybe String
pTo           :: Maybe String
                     , Params -> String
pFormat       :: String
                     , Params -> String
pSHA1         :: String
                     , Params -> String
pLogMsg       :: String
                     , Params -> String
pEmail        :: String
                     , Params -> String
pFullName     :: String
                     , Params -> String
pAccessCode   :: String
                     , Params -> String
pWikiname     :: String
                     , Params -> Bool
pPrintable    :: Bool
                     , Params -> Bool
pOverwrite    :: Bool
                     , Params -> String
pFilename     :: String
                     , Params -> String
pFilePath     :: FilePath
                     , Params -> Bool
pConfirm      :: Bool
                     , Params -> Maybe SessionKey
pSessionKey   :: Maybe SessionKey
                     , Params -> Recaptcha
pRecaptcha    :: Recaptcha
                     , Params -> String
pResetCode    :: String
                     , Params -> Maybe Bool
pRedirect     :: Maybe Bool
                     }  deriving Int -> Params -> ShowS
[Params] -> ShowS
Params -> String
(Int -> Params -> ShowS)
-> (Params -> String) -> ([Params] -> ShowS) -> Show Params
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Params] -> ShowS
$cshowList :: [Params] -> ShowS
show :: Params -> String
$cshow :: Params -> String
showsPrec :: Int -> Params -> ShowS
$cshowsPrec :: Int -> Params -> ShowS
Show

instance FromReqURI SessionKey where
 fromReqURI :: String -> Maybe SessionKey
fromReqURI String
s = case String -> Maybe Integer
forall a. FromReqURI a => String -> Maybe a
fromReqURI String
s of
                       Just Integer
i -> SessionKey -> Maybe SessionKey
forall a. a -> Maybe a
Just (SessionKey -> Maybe SessionKey) -> SessionKey -> Maybe SessionKey
forall a b. (a -> b) -> a -> b
$ Integer -> SessionKey
SessionKey Integer
i
                       Maybe Integer
Nothing -> Maybe SessionKey
forall a. Maybe a
Nothing

instance FromData Params where
     fromData :: RqData Params
fromData = do
         let look' :: String -> RqData String
look' = String -> RqData String
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m String
look
         String
un <- String -> RqData String
look' String
"username"       RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
pw <- String -> RqData String
look' String
"password"       RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
p2 <- String -> RqData String
look' String
"password2"      RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         Maybe String
rv <- (String -> RqData String
look' String
"revision" RqData String
-> (String -> RqData (Maybe String)) -> RqData (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
s ->
                 Maybe String -> RqData (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
s))
                 RqData (Maybe String)
-> RqData (Maybe String) -> RqData (Maybe String)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> RqData (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
         Maybe String
fu <- (String -> Maybe String) -> RqData String -> RqData (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Maybe String
forall a. a -> Maybe a
Just (String -> RqData String
look' String
"forUser") RqData (Maybe String)
-> RqData (Maybe String) -> RqData (Maybe String)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> RqData (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
         Maybe UTCTime
si <- (String -> Maybe UTCTime)
-> RqData String -> RqData (Maybe UTCTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%Y-%m-%d") (String -> RqData String
look' String
"since")
                 RqData (Maybe UTCTime)
-> RqData (Maybe UTCTime) -> RqData (Maybe UTCTime)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe UTCTime -> RqData (Maybe UTCTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UTCTime
forall a. Maybe a
Nothing  -- YYYY-mm-dd format
         String
ds <- String -> RqData String
look' String
"destination" RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
ra <- String -> RqData String
look' String
"raw"            RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         Int
lt <- String -> RqData Int
forall (m :: * -> *) a.
(Functor m, Monad m, HasRqData m, FromReqURI a) =>
String -> m a
lookRead String
"limit"       RqData Int -> RqData Int -> RqData Int
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Int -> RqData Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
100
         String
pa <- String -> RqData String
look' String
"patterns"       RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
gt <- String -> RqData String
look' String
"gotopage"       RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
ft <- String -> RqData String
look' String
"filetodelete"   RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         [String]
me <- String -> RqData [String]
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [String]
looks String
"message"
         Maybe String
fm <- (String -> Maybe String) -> RqData String -> RqData (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Maybe String
forall a. a -> Maybe a
Just (String -> RqData String
look' String
"from") RqData (Maybe String)
-> RqData (Maybe String) -> RqData (Maybe String)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> RqData (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
         Maybe String
to <- (String -> Maybe String) -> RqData String -> RqData (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Maybe String
forall a. a -> Maybe a
Just (String -> RqData String
look' String
"to")   RqData (Maybe String)
-> RqData (Maybe String) -> RqData (Maybe String)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> RqData (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
         Maybe String
et <- (String -> Maybe String) -> RqData String -> RqData (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\r')) (String -> RqData String
look' String
"editedText")
                 RqData (Maybe String)
-> RqData (Maybe String) -> RqData (Maybe String)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> RqData (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
         String
fo <- String -> RqData String
look' String
"format"         RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
sh <- String -> RqData String
look' String
"sha1"           RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
lm <- String -> RqData String
look' String
"logMsg"         RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
em <- String -> RqData String
look' String
"email"          RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
na <- String -> RqData String
look' String
"full_name_1"    RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
wn <- String -> RqData String
look' String
"wikiname"       RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         Bool
pr <- (String -> RqData String
look' String
"printable" RqData String -> RqData Bool -> RqData Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> RqData Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) RqData Bool -> RqData Bool -> RqData Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Bool -> RqData Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         Bool
ow <- (String -> Bool) -> RqData String -> RqData Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"yes") (String -> RqData String
look' String
"overwrite") RqData Bool -> RqData Bool -> RqData Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Bool -> RqData Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         Maybe (String, String, ContentType)
fileparams <- ((String, String, ContentType)
 -> Maybe (String, String, ContentType))
-> RqData (String, String, ContentType)
-> RqData (Maybe (String, String, ContentType))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (String, String, ContentType)
-> Maybe (String, String, ContentType)
forall a. a -> Maybe a
Just (String -> RqData (String, String, ContentType)
forall (m :: * -> *).
(Monad m, HasRqData m) =>
String -> m (String, String, ContentType)
lookFile String
"file") RqData (Maybe (String, String, ContentType))
-> RqData (Maybe (String, String, ContentType))
-> RqData (Maybe (String, String, ContentType))
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (String, String, ContentType)
-> RqData (Maybe (String, String, ContentType))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, String, ContentType)
forall a. Maybe a
Nothing
         let (String
fp, String
fn) = case Maybe (String, String, ContentType)
fileparams of
                             Just (String
x,String
y,ContentType
_) -> (String
x,String
y)
                             Maybe (String, String, ContentType)
Nothing      -> (String
"",String
"")
         String
ac <- String -> RqData String
look' String
"accessCode"     RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         Bool
cn <- (String -> RqData String
look' String
"confirm" RqData String -> RqData Bool -> RqData Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> RqData Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) RqData Bool -> RqData Bool -> RqData Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Bool -> RqData Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         Maybe SessionKey
sk <- (SessionKey -> Maybe SessionKey)
-> RqData SessionKey -> RqData (Maybe SessionKey)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM SessionKey -> Maybe SessionKey
forall a. a -> Maybe a
Just (String -> RqData SessionKey
forall (m :: * -> *) a.
(Functor m, Monad m, HasRqData m, FromReqURI a) =>
String -> m a
readCookieValue String
"sid") RqData (Maybe SessionKey)
-> RqData (Maybe SessionKey) -> RqData (Maybe SessionKey)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe SessionKey -> RqData (Maybe SessionKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SessionKey
forall a. Maybe a
Nothing
         String
rc <- String -> RqData String
look' String
"recaptcha_challenge_field" RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
rr <- String -> RqData String
look' String
"recaptcha_response_field" RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         String
rk <- String -> RqData String
look' String
"reset_code" RqData String -> RqData String -> RqData String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> RqData String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         Maybe Bool
rd <- (String -> RqData String
look' String
"redirect" RqData String
-> (String -> RqData (Maybe Bool)) -> RqData (Maybe Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
r -> Maybe Bool -> RqData (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (case String
r of
             String
"yes" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
             String
"no" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
             String
_ -> Maybe Bool
forall a. Maybe a
Nothing)) RqData (Maybe Bool) -> RqData (Maybe Bool) -> RqData (Maybe Bool)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Bool -> RqData (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing
         Params -> RqData Params
forall (m :: * -> *) a. Monad m => a -> m a
return   Params :: String
-> String
-> String
-> Maybe String
-> String
-> Maybe String
-> Maybe UTCTime
-> String
-> Int
-> [String]
-> String
-> String
-> Maybe String
-> [String]
-> Maybe String
-> Maybe String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> Bool
-> Bool
-> String
-> String
-> Bool
-> Maybe SessionKey
-> Recaptcha
-> String
-> Maybe Bool
-> Params
Params { pUsername :: String
pUsername     = String
un
                         , pPassword :: String
pPassword     = String
pw
                         , pPassword2 :: String
pPassword2    = String
p2
                         , pRevision :: Maybe String
pRevision     = Maybe String
rv
                         , pForUser :: Maybe String
pForUser      = Maybe String
fu
                         , pSince :: Maybe UTCTime
pSince        = Maybe UTCTime
si
                         , pDestination :: String
pDestination  = String
ds
                         , pRaw :: String
pRaw          = String
ra
                         , pLimit :: Int
pLimit        = Int
lt
                         , pPatterns :: [String]
pPatterns     = String -> [String]
words String
pa
                         , pGotoPage :: String
pGotoPage     = String
gt
                         , pFileToDelete :: String
pFileToDelete = String
ft
                         , pMessages :: [String]
pMessages     = [String]
me
                         , pFrom :: Maybe String
pFrom         = Maybe String
fm
                         , pTo :: Maybe String
pTo           = Maybe String
to
                         , pEditedText :: Maybe String
pEditedText   = Maybe String
et
                         , pFormat :: String
pFormat       = String
fo
                         , pSHA1 :: String
pSHA1         = String
sh
                         , pLogMsg :: String
pLogMsg       = String
lm
                         , pEmail :: String
pEmail        = String
em
                         , pFullName :: String
pFullName     = String
na
                         , pWikiname :: String
pWikiname     = String
wn
                         , pPrintable :: Bool
pPrintable    = Bool
pr
                         , pOverwrite :: Bool
pOverwrite    = Bool
ow
                         , pFilename :: String
pFilename     = String
fn
                         , pFilePath :: String
pFilePath     = String
fp
                         , pAccessCode :: String
pAccessCode   = String
ac
                         , pConfirm :: Bool
pConfirm      = Bool
cn
                         , pSessionKey :: Maybe SessionKey
pSessionKey   = Maybe SessionKey
sk
                         , pRecaptcha :: Recaptcha
pRecaptcha    = Recaptcha :: String -> String -> Recaptcha
Recaptcha {
                              recaptchaChallengeField :: String
recaptchaChallengeField = String
rc,
                              recaptchaResponseField :: String
recaptchaResponseField = String
rr }
                         , pResetCode :: String
pResetCode    = String
rk
                         , pRedirect :: Maybe Bool
pRedirect     = Maybe Bool
rd
                         }

data Command = Command (Maybe String) deriving Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show

instance FromData Command where
     fromData :: RqData Command
fromData = do
       [(String, Either String String)]
pairs <- RqData [(String, Either String String)]
forall (m :: * -> *).
(Monad m, HasRqData m) =>
m [(String, Either String String)]
lookPairs
       Command -> RqData Command
forall (m :: * -> *) a. Monad m => a -> m a
return (Command -> RqData Command) -> Command -> RqData Command
forall a b. (a -> b) -> a -> b
$ case ((String, Either String String) -> String)
-> [(String, Either String String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Either String String) -> String
forall a b. (a, b) -> a
fst [(String, Either String String)]
pairs [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [String]
commandList of
                 []          -> Maybe String -> Command
Command Maybe String
forall a. Maybe a
Nothing
                 (String
c:[String]
_)       -> Maybe String -> Command
Command (Maybe String -> Command) -> Maybe String -> Command
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
c
               where commandList :: [String]
commandList = [String
"update", String
"cancel"]

-- | State for a single wiki.
data WikiState = WikiState {
                     WikiState -> Config
wikiConfig    :: Config
                   , WikiState -> FileStore
wikiFileStore :: FileStore
                   }

type GititServerPart = ServerPartT (ReaderT WikiState IO)

type Handler = GititServerPart Response

-- Unescapes XML entities
fromEntities :: String -> String
fromEntities :: ShowS
fromEntities (Char
'&':String
xs) =
  case String -> Maybe String
lookupEntity String
ent of
        Just String
c  -> String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
fromEntities String
rest
        Maybe String
Nothing -> Char
'&' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
fromEntities String
xs
    where (String
ent, String
rest) = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';') String
xs of
                             (String
zs,Char
';':String
ys) -> (String
zs,String
ys)
                             (String, String)
_           -> (String
"",String
xs)
fromEntities (Char
x:String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
fromEntities String
xs
fromEntities [] = []

data GithubConfig = GithubConfig { GithubConfig -> OAuth2
oAuth2 :: OAuth2
                                 , GithubConfig -> Maybe Text
org :: Maybe Text
                                 }

githubConfig :: OAuth2 -> Maybe Text -> GithubConfig
githubConfig :: OAuth2 -> Maybe Text -> GithubConfig
githubConfig = OAuth2 -> Maybe Text -> GithubConfig
GithubConfig