module Network.Gitit (
wiki
, reloadTemplates
, runHandler
, module Network.Gitit.Initialize
, module Network.Gitit.Config
, loginUserForm
, module Network.Gitit.Types
, module Network.Gitit.Framework
, module Network.Gitit.Layout
, module Network.Gitit.ContentTransformer
, module Network.Gitit.Page
, getFileStore
, getUser
, getConfig
, queryGititState
, updateGititState
)
where
import Network.Gitit.Types
import Network.Gitit.Server
import Network.Gitit.Framework
import Network.Gitit.Handlers
import Network.Gitit.Initialize
import Network.Gitit.Config
import Network.Gitit.Layout
import Network.Gitit.State
(getFileStore, getUser, getConfig, queryGititState, updateGititState)
import Network.Gitit.ContentTransformer
import Network.Gitit.Page
import Network.Gitit.Authentication (loginUserForm)
import Paths_gitit (getDataFileName)
import Control.Monad.Reader
import Prelude hiding (readFile)
import qualified Data.ByteString.Char8 as B
import System.FilePath ((</>))
import System.Directory (getTemporaryDirectory)
import Safe
wiki :: Config -> ServerPart Response
wiki :: Config -> ServerPart Response
wiki Config
conf = do
String
tempDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getTemporaryDirectory
let maxSize :: Int64
maxSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Config -> Integer
maxUploadSize Config
conf
forall (m :: * -> *).
(ServerMonad m, MonadPlus m, MonadIO m, FilterMonad Response m,
WebMonad Response m) =>
BodyPolicy -> m ()
decodeBody forall a b. (a -> b) -> a -> b
$ String -> Int64 -> Int64 -> Int64 -> BodyPolicy
defaultBodyPolicy String
tempDir Int64
maxSize Int64
maxSize Int64
maxSize
let static :: String
static = Config -> String
staticDir Config
conf
String
defaultStatic <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO String
getDataFileName forall a b. (a -> b) -> a -> b
$ String
"data" String -> String -> String
</> String
"static"
let staticHandler :: ServerPart Response
staticHandler = forall (m :: * -> *). ServerMonad m => m Response -> m Response
withExpiresHeaders forall a b. (a -> b) -> a -> b
$
String -> ServerPart Response
serveDirectory' String
static forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` String -> ServerPart Response
serveDirectory' String
defaultStatic
let debugHandler' :: ServerPartT (ReaderT WikiState IO) Response
debugHandler' = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ServerPartT (ReaderT WikiState IO) Response
debugHandler | Config -> Bool
debugMode Config
conf]
let handlers :: ServerPartT (ReaderT WikiState IO) Response
handlers = ServerPartT (ReaderT WikiState IO) Response
debugHandler' forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Config -> ServerPartT (ReaderT WikiState IO) Response
authHandler Config
conf forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForRead (forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ServerPartT (ReaderT WikiState IO) Response]
wikiHandlers)
let fs :: FileStore
fs = Config -> FileStore
filestoreFromConfig Config
conf
let ws :: WikiState
ws = WikiState { wikiConfig :: Config
wikiConfig = Config
conf, wikiFileStore :: FileStore
wikiFileStore = FileStore
fs }
if Config -> Bool
compressResponses Config
conf
then forall (m :: * -> *).
(FilterMonad Response m, MonadPlus m, WebMonad Response m,
ServerMonad m, MonadFail m) =>
m String
compressedResponseFilter
else forall (m :: * -> *) a. Monad m => a -> m a
return String
""
ServerPart Response
staticHandler forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` WikiState
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPart Response
runHandler WikiState
ws (Config
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
withUser Config
conf ServerPartT (ReaderT WikiState IO) Response
handlers)
serveDirectory' :: FilePath -> ServerPart Response
serveDirectory' :: String -> ServerPart Response
serveDirectory' String
p = do
Request
rq <- forall (m :: * -> *). ServerMonad m => m Request
askRq
Response
resp' <- forall (m :: * -> *).
(WebMonad Response m, ServerMonad m, FilterMonad Response m,
MonadIO m, MonadPlus m) =>
Browsing -> [String] -> String -> m Response
serveDirectory Browsing
EnableBrowsing [] String
p
if Response -> Int
rsCode Response
resp' forall a. Eq a => a -> a -> Bool
== Int
404 Bool -> Bool -> Bool
|| forall a. Partial => String -> [a] -> a
lastNote String
"fileServeStrict'" (Request -> String
rqUri Request
rq) forall a. Eq a => a -> a -> Bool
== Char
'/'
then forall (m :: * -> *) a. MonadPlus m => m a
mzero
else
case forall r. HasHeaders r => String -> r -> Maybe ByteString
getHeader String
"Content-Type" Response
resp' of
Just ByteString
ct | String -> ByteString
B.pack String
"text/" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
ct -> forall (m :: * -> *) a. Monad m => a -> m a
return Response
resp'
Maybe ByteString
_ -> forall a (m :: * -> *). FilterMonad a m => m ()
ignoreFilters forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Response
resp'
wikiHandlers :: [Handler]
wikiHandlers :: [ServerPartT (ReaderT WikiState IO) Response]
wikiHandlers =
[
GititServerPart ()
guardBareBase forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). ServerMonad m => m String
getWikiBase forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
b -> forall (m :: * -> *) a res.
(FilterMonad Response m, ToSURI a) =>
a -> res -> m res
movedPermanently (String
b forall a. [a] -> [a] -> [a]
++ String
"/") (forall a. ToMessage a => a -> Response
toResponse ())
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_activity" ServerPartT (ReaderT WikiState IO) Response
showActivity
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_go" ServerPartT (ReaderT WikiState IO) Response
goToPage
, forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_search" ServerPartT (ReaderT WikiState IO) Response
searchResults
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_upload" forall a b. (a -> b) -> a -> b
$ do forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool
uploadsAllowed forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GititServerPart Config
getConfig
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify ServerPartT (ReaderT WikiState IO) Response
uploadForm
, forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify ServerPartT (ReaderT WikiState IO) Response
uploadFile ]
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_random" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
randomPage
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_index" ServerPartT (ReaderT WikiState IO) Response
indexPage
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_feed" ServerPartT (ReaderT WikiState IO) Response
feedHandler
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_category" ServerPartT (ReaderT WikiState IO) Response
categoryPage
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_categories" ServerPartT (ReaderT WikiState IO) Response
categoryListPage
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_expire" ServerPartT (ReaderT WikiState IO) Response
expireCache
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_showraw" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
[ ServerPartT (ReaderT WikiState IO) Response
showRawPage
, (String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isSourceCode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showFileAsText ]
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_history" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
[ ServerPartT (ReaderT WikiState IO) Response
showPageHistory
, (String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isSourceCode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showFileHistory ]
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_edit" forall a b. (a -> b) -> a -> b
$ AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify (ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
unlessNoEdit ServerPartT (ReaderT WikiState IO) Response
editPage ServerPartT (ReaderT WikiState IO) Response
showPage)
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_diff" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
[ ServerPartT (ReaderT WikiState IO) Response
showPageDiff
, (String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isSourceCode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showFileDiff ]
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_discuss" ServerPartT (ReaderT WikiState IO) Response
discussPage
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_delete" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
[ forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify (ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
unlessNoDelete ServerPartT (ReaderT WikiState IO) Response
confirmDelete ServerPartT (ReaderT WikiState IO) Response
showPage)
, forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify (ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
unlessNoDelete ServerPartT (ReaderT WikiState IO) Response
deletePage ServerPartT (ReaderT WikiState IO) Response
showPage) ]
, forall (m :: * -> *) a.
(ServerMonad m, MonadPlus m) =>
String -> m a -> m a
dir String
"_preview" ServerPartT (ReaderT WikiState IO) Response
preview
, GititServerPart ()
guardIndex forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
indexPage
, forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> GititServerPart ()
guardCommand String
"cancel" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showPage
, forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> GititServerPart ()
guardCommand String
"update" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
AuthenticationLevel
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
authenticate AuthenticationLevel
ForModify (ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPartT (ReaderT WikiState IO) Response
unlessNoEdit ServerPartT (ReaderT WikiState IO) Response
updatePage ServerPartT (ReaderT WikiState IO) Response
showPage)
, ServerPartT (ReaderT WikiState IO) Response
showPage
, (String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isSourceCode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
GET forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
showHighlightedSource
, ServerPartT (ReaderT WikiState IO) Response
handleAny
, forall (m :: * -> *) a. FilterMonad Response m => a -> m a
notFound forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((String -> Bool) -> GititServerPart ()
guardPath String -> Bool
isPage forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ServerPartT (ReaderT WikiState IO) Response
createPage)
]
reloadTemplates :: ServerPart Response
reloadTemplates :: ServerPart Response
reloadTemplates = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
recompilePageTemplate
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok forall a b. (a -> b) -> a -> b
$ forall a. ToMessage a => a -> Response
toResponse String
"Page templates have been recompiled."
runHandler :: WikiState -> Handler -> ServerPart Response
runHandler :: WikiState
-> ServerPartT (ReaderT WikiState IO) Response
-> ServerPart Response
runHandler = forall (m :: * -> *) a (n :: * -> *) b.
(UnWebT m a -> UnWebT n b) -> ServerPartT m a -> ServerPartT n b
mapServerPartT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. s -> UnWebT (ReaderT s IO) a -> UnWebT IO a
unpackReaderT
unpackReaderT :: s -> UnWebT (ReaderT s IO) a -> UnWebT IO a
unpackReaderT :: forall s a. s -> UnWebT (ReaderT s IO) a -> UnWebT IO a
unpackReaderT s
st UnWebT (ReaderT s IO) a
uw = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT UnWebT (ReaderT s IO) a
uw s
st