Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 349 lines (313 sloc) 13.757 kb
589fb6e @jgm Large architecture change.
authored
1 {-# LANGUAGE ScopedTypeVariables #-}
56e7c53 @jgm Began moving general framework functions to Gitit.Framework.
authored
2 {-
3 Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
4 This program is free software; you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation; either version 2 of the License, or
7 (at your option) any later version.
8 This program is distributed in the hope that it will be useful,
9 but WITHOUT ANY WARRANTY; without even the implied warranty of
10 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 GNU General Public License for more details.
12 You should have received a copy of the GNU General Public License
13 along with this program; if not, write to the Free Software
14 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
15 -}
16
0e9bde0 @jgm Added some headings to exports.
authored
17 {- | Useful functions for defining wiki handlers.
56e7c53 @jgm Began moving general framework functions to Gitit.Framework.
authored
18 -}
19
0e9bde0 @jgm Added some headings to exports.
authored
20 module Network.Gitit.Framework (
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
21 -- * Combinators for dealing with users
0e9bde0 @jgm Added some headings to exports.
authored
22 withUserFromSession
068e780 @jgm Major architectural revision of authentication system.
authored
23 , withUserFromHTTPAuth
726e0b3 @jgm Added authentication-required field.
authored
24 , authenticateUserThat
25 , authenticate
5b911a7 @jgm Changed config to take user handlers rather than AuthenticationMethod.
authored
26 , getLoggedInUser
0e9bde0 @jgm Added some headings to exports.
authored
27 -- * Combinators to exclude certain actions
3c019e8 @jgm Added CustomAuth option, w/ a custom getLoggedInUser function.
authored
28 , unlessNoEdit
29 , unlessNoDelete
0e9bde0 @jgm Added some headings to exports.
authored
30 -- * Guards for routing
31 , guardCommand
32 , guardPath
33 , guardIndex
34 , guardBareBase
35 -- * Functions to get info from the request
3c019e8 @jgm Added CustomAuth option, w/ a custom getLoggedInUser function.
authored
36 , getPath
37 , getPage
38 , getReferer
39 , getWikiBase
40 , uriPath
0e9bde0 @jgm Added some headings to exports.
authored
41 -- * Useful predicates
3c019e8 @jgm Added CustomAuth option, w/ a custom getLoggedInUser function.
authored
42 , isPage
43 , isPageFile
44 , isDiscussPage
45 , isDiscussPageFile
46 , isSourceCode
0e9bde0 @jgm Added some headings to exports.
authored
47 -- * Combinators that change the request locally
48 , withMessages
49 -- * Miscellaneous
3c019e8 @jgm Added CustomAuth option, w/ a custom getLoggedInUser function.
authored
50 , urlForPage
51 , pathForPage
52 , getMimeTypeForExtension
53 , validate
d7d984f @jgm Refactoring:
authored
54 , filestoreFromConfig
3c019e8 @jgm Added CustomAuth option, w/ a custom getLoggedInUser function.
authored
55 )
56e7c53 @jgm Began moving general framework functions to Gitit.Framework.
authored
56 where
85d15a6 safify, replace unsafe last last with lastNote, which at least gives a m...
Thomas Hartman authored
57 import Safe
2e4d87e @jgm Moved Gitit under Network namespace.
authored
58 import Network.Gitit.Server
59 import Network.Gitit.State
60 import Network.Gitit.Types
d7d984f @jgm Refactoring:
authored
61 import Data.FileStore
2128afb @jgm Fixed URL encoding for pages.
authored
62 import Data.Char (toLower)
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
63 import Control.Monad (mzero, liftM, unless, MonadPlus)
56e7c53 @jgm Began moving general framework functions to Gitit.Framework.
authored
64 import qualified Data.Map as M
8609002 @jgm Updated for happstack 7.
authored
65 import qualified Data.ByteString.UTF8 as UTF8
66 import qualified Data.ByteString.Lazy.UTF8 as LazyUTF8
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
67 import Data.Maybe (fromJust, fromMaybe)
befa443 @jgm Use languagesByFilename instead of languagesByExtension in isSource.
authored
68 import Data.List (intercalate, isPrefixOf, isInfixOf)
69 import System.FilePath ((<.>), takeExtension, takeFileName)
e8d5c65 @jgm Major reorganization.
authored
70 import Text.Highlighting.Kate
99bba58 @jgm Added http-authentication to configuration.
authored
71 import Text.ParserCombinators.Parsec
851676b @jgm Fixed rqUri to include query; proper escaping in urlForPage.
authored
72 import Network.URL (decString, encString)
2128afb @jgm Fixed URL encoding for pages.
authored
73 import Network.URI (isUnescapedInURI)
8609002 @jgm Updated for happstack 7.
authored
74 import Data.ByteString.Base64 (decodeLenient)
068e780 @jgm Major architectural revision of authentication system.
authored
75 import Network.HTTP (urlEncodeVars)
76
726e0b3 @jgm Added authentication-required field.
authored
77 -- | Require a logged in user if the authentication level demands it.
78 -- Run the handler if a user is logged in, otherwise redirect
c822759 @jgm Added haddocks to Framework.
authored
79 -- to login page.
726e0b3 @jgm Added authentication-required field.
authored
80 authenticate :: AuthenticationLevel -> Handler -> Handler
81 authenticate = authenticateUserThat (const True)
068e780 @jgm Major architectural revision of authentication system.
authored
82
726e0b3 @jgm Added authentication-required field.
authored
83 -- | Like 'authenticate', but with a predicate that the user must satisfy.
84 authenticateUserThat :: (User -> Bool) -> AuthenticationLevel -> Handler -> Handler
85 authenticateUserThat predicate level handler = do
86 cfg <- getConfig
87 if level <= requireAuthentication cfg
88 then do
89 mbUser <- getLoggedInUser
90 rq <- askRq
91 let url = rqUri rq ++ rqQuery rq
92 case mbUser of
93 Nothing -> tempRedirect ("/_login?" ++ urlEncodeVars [("destination", url)]) $ toResponse ()
94 Just u -> if predicate u
95 then handler
96 else error "Not authorized."
97 else handler
068e780 @jgm Major architectural revision of authentication system.
authored
98
c822759 @jgm Added haddocks to Framework.
authored
99 -- | Run the handler after setting @REMOTE_USER@ with the user from
100 -- the session.
068e780 @jgm Major architectural revision of authentication system.
authored
101 withUserFromSession :: Handler -> Handler
102 withUserFromSession handler = withData $ \(sk :: Maybe SessionKey) -> do
5b911a7 @jgm Changed config to take user handlers rather than AuthenticationMethod.
authored
103 mbSd <- maybe (return Nothing) getSession sk
7212791 @jgm Added session-timeout config setting.
authored
104 cfg <- getConfig
068e780 @jgm Major architectural revision of authentication system.
authored
105 mbUser <- case mbSd of
106 Nothing -> return Nothing
107 Just sd -> do
c0f4586 @jgm Migrated to happstack-6.
authored
108 addCookie (MaxAge $ sessionTimeout cfg) (mkCookie "sid" (show $ fromJust sk)) -- refresh timeout
068e780 @jgm Major architectural revision of authentication system.
authored
109 getUser $! sessionUser sd
110 let user = maybe "" uUsername mbUser
111 localRq (setHeader "REMOTE_USER" user) handler
112
c822759 @jgm Added haddocks to Framework.
authored
113 -- | Run the handler after setting @REMOTE_USER@ from the "authorization"
114 -- header. Works with simple HTTP authentication or digest authentication.
068e780 @jgm Major architectural revision of authentication system.
authored
115 withUserFromHTTPAuth :: Handler -> Handler
116 withUserFromHTTPAuth handler = do
5b911a7 @jgm Changed config to take user handlers rather than AuthenticationMethod.
authored
117 req <- askRq
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
118 let user = case getHeader "authorization" req of
068e780 @jgm Major architectural revision of authentication system.
authored
119 Nothing -> ""
8609002 @jgm Updated for happstack 7.
authored
120 Just authHeader -> case parse pAuthorizationHeader "" (UTF8.toString authHeader) of
068e780 @jgm Major architectural revision of authentication system.
authored
121 Left _ -> ""
122 Right u -> u
123 localRq (setHeader "REMOTE_USER" user) handler
5b911a7 @jgm Changed config to take user handlers rather than AuthenticationMethod.
authored
124
c822759 @jgm Added haddocks to Framework.
authored
125 -- | Returns @Just@ logged in user or @Nothing@.
ebf01df @jgm Use GititServerPart instead of ServerPart.
authored
126 getLoggedInUser :: GititServerPart (Maybe User)
5b911a7 @jgm Changed config to take user handlers rather than AuthenticationMethod.
authored
127 getLoggedInUser = do
068e780 @jgm Major architectural revision of authentication system.
authored
128 req <- askRq
8609002 @jgm Updated for happstack 7.
authored
129 case maybe "" UTF8.toString (getHeader "REMOTE_USER" req) of
068e780 @jgm Major architectural revision of authentication system.
authored
130 "" -> return Nothing
131 u -> do
132 mbUser <- getUser u
133 case mbUser of
134 Just user -> return $ Just user
135 Nothing -> return $ Just User{uUsername = u, uEmail = "", uPassword = undefined}
99bba58 @jgm Added http-authentication to configuration.
authored
136
137 pAuthorizationHeader :: GenParser Char st String
e31bb8e @jgm Added support for basic HTTP authentication.
authored
138 pAuthorizationHeader = try pBasicHeader <|> pDigestHeader
139
140 pDigestHeader :: GenParser Char st String
141 pDigestHeader = do
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
142 _ <- string "Digest username=\""
e08c0dc @jgm Changed showActivity to a Handler type.
authored
143 result' <- many (noneOf "\"")
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
144 _ <- char '"'
e08c0dc @jgm Changed showActivity to a Handler type.
authored
145 return result'
56e7c53 @jgm Began moving general framework functions to Gitit.Framework.
authored
146
e31bb8e @jgm Added support for basic HTTP authentication.
authored
147 pBasicHeader :: GenParser Char st String
148 pBasicHeader = do
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
149 _ <- string "Basic "
e08c0dc @jgm Changed showActivity to a Handler type.
authored
150 result' <- many (noneOf " \t\n")
8609002 @jgm Updated for happstack 7.
authored
151 return $ takeWhile (/=':') $ UTF8.toString
152 $ decodeLenient $ UTF8.fromString result'
e31bb8e @jgm Added support for basic HTTP authentication.
authored
153
c822759 @jgm Added haddocks to Framework.
authored
154 -- | @unlessNoEdit responder fallback@ runs @responder@ unless the
155 -- page has been designated not editable in configuration; in that
156 -- case, runs @fallback@.
6ad56de @jgm Removed Params as explicit parameter of Handlers.
authored
157 unlessNoEdit :: Handler
158 -> Handler
159 -> Handler
160 unlessNoEdit responder fallback = withData $ \(params :: Params) -> do
161 cfg <- getConfig
162 page <- getPage
163 if page `elem` noEdit cfg
aeef8c9 @jgm Fixed merge on edit conflicts (mostly).
authored
164 then withMessages ("Page is locked." : pMessages params) fallback
6ad56de @jgm Removed Params as explicit parameter of Handlers.
authored
165 else responder
166
c822759 @jgm Added haddocks to Framework.
authored
167 -- | @unlessNoDelete responder fallback@ runs @responder@ unless the
168 -- page has been designated not deletable in configuration; in that
169 -- case, runs @fallback@.
6ad56de @jgm Removed Params as explicit parameter of Handlers.
authored
170 unlessNoDelete :: Handler
171 -> Handler
172 -> Handler
173 unlessNoDelete responder fallback = withData $ \(params :: Params) -> do
174 cfg <- getConfig
175 page <- getPage
176 if page `elem` noDelete cfg
aeef8c9 @jgm Fixed merge on edit conflicts (mostly).
authored
177 then withMessages ("Page cannot be deleted." : pMessages params) fallback
6ad56de @jgm Removed Params as explicit parameter of Handlers.
authored
178 else responder
589fb6e @jgm Large architecture change.
authored
179
7de0272 @jgm Haddock changes.
authored
180 -- | Returns the current path (subtracting initial commands like @\/_edit@).
589fb6e @jgm Large architecture change.
authored
181 getPath :: ServerMonad m => m String
8e8907d @qnikst remove additional URL decoding
qnikst authored
182 getPath = liftM (intercalate "/" . rqPaths) askRq
589fb6e @jgm Large architecture change.
authored
183
c822759 @jgm Added haddocks to Framework.
authored
184 -- | Returns the current page name (derived from the path).
ebf01df @jgm Use GititServerPart instead of ServerPart.
authored
185 getPage :: GititServerPart String
589fb6e @jgm Large architecture change.
authored
186 getPage = do
187 conf <- getConfig
188 path' <- getPath
189 if null path'
190 then return (frontPage conf)
5ec9aa0 @jgm Have getPage fail if page name not valid.
authored
191 else if isPage path'
192 then return path'
193 else mzero -- fail if not valid page name
589fb6e @jgm Large architecture change.
authored
194
c822759 @jgm Added haddocks to Framework.
authored
195 -- | Returns the contents of the "referer" header.
589fb6e @jgm Large architecture change.
authored
196 getReferer :: ServerMonad m => m String
197 getReferer = do
eeab543 @jgm Simplified 'handle' using askRq instead of uriPath.
authored
198 req <- askRq
9fceaab @jgm Use getWikiBase to construct URLs in templates, handlers.
authored
199 base' <- getWikiBase
589fb6e @jgm Large architecture change.
authored
200 return $ case getHeader "referer" req of
8609002 @jgm Updated for happstack 7.
authored
201 Just r -> case UTF8.toString r of
9fceaab @jgm Use getWikiBase to construct URLs in templates, handlers.
authored
202 "" -> base'
589fb6e @jgm Large architecture change.
authored
203 s -> s
9fceaab @jgm Use getWikiBase to construct URLs in templates, handlers.
authored
204 Nothing -> base'
e8d5c65 @jgm Major reorganization.
authored
205
b7709e5 @jgm Added getWikiBase.
authored
206 -- | Returns the base URL of the wiki in the happstack server.
7de0272 @jgm Haddock changes.
authored
207 -- So, if the wiki handlers are behind a @dir 'foo'@, getWikiBase will
208 -- return @\/foo/@. getWikiBase doesn't know anything about HTTP
209 -- proxies, so if you use proxies to map a gitit wiki to @\/foo/@,
b7709e5 @jgm Added getWikiBase.
authored
210 -- you'll still need to follow the instructions in README.
211 getWikiBase :: ServerMonad m => m String
212 getWikiBase = do
213 path' <- getPath
bf801f0 @jgm Improved getWikiBase to properly handle all cases.
authored
214 uri' <- liftM (fromJust . decString True . rqUri) askRq
6b43043 @jgm Factored out pure part of wikiBase for easier testing.
authored
215 case calculateWikiBase path' uri' of
216 Just b -> return b
217 Nothing -> error $ "Could not getWikiBase: (path, uri) = " ++ show (path',uri')
218
7de0272 @jgm Haddock changes.
authored
219 -- | The pure core of 'getWikiBase'.
6b43043 @jgm Factored out pure part of wikiBase for easier testing.
authored
220 calculateWikiBase :: String -> String -> Maybe String
221 calculateWikiBase path' uri' =
bf801f0 @jgm Improved getWikiBase to properly handle all cases.
authored
222 let revpaths = reverse . filter (not . null) $ splitOn '/' path'
223 revuris = reverse . filter (not . null) $ splitOn '/' uri'
6b43043 @jgm Factored out pure part of wikiBase for easier testing.
authored
224 in if revpaths `isPrefixOf` revuris
225 then let revbase = drop (length revpaths) revuris
226 -- a path like _feed is not part of the base...
227 revbase' = case revbase of
228 (x:xs) | startsWithUnderscore x -> xs
229 xs -> xs
230 base' = intercalate "/" $ reverse revbase'
231 in Just $ if null base' then "" else '/' : base'
232 else Nothing
bf801f0 @jgm Improved getWikiBase to properly handle all cases.
authored
233
234 startsWithUnderscore :: String -> Bool
235 startsWithUnderscore ('_':_) = True
236 startsWithUnderscore _ = False
237
238 splitOn :: Eq a => a -> [a] -> [[a]]
239 splitOn c cs =
240 let (next, rest) = break (==c) cs
965336a use case expression instead of unsafe tail.
Thomas Hartman authored
241 in case rest of
0732a48 Code reformatting to avoid warnings.
John MacFarlane authored
242 [] -> [next]
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
243 (_:rs) -> next : splitOn c rs
b7709e5 @jgm Added getWikiBase.
authored
244
7de0272 @jgm Haddock changes.
authored
245 -- | Returns path portion of URI, without initial @\/@.
246 -- Consecutive spaces are collapsed. We don't want to distinguish
247 -- @Hi There@ and @Hi There@.
e8d5c65 @jgm Major reorganization.
authored
248 uriPath :: String -> String
249 uriPath = unwords . words . drop 1 . takeWhile (/='?')
250
251 isPage :: String -> Bool
a258490 @jgm Major routing changes.
authored
252 isPage "" = False
253 isPage ('_':_) = False
254 isPage s = all (`notElem` "*?") s && not (".." `isInfixOf` s) && not ("/_" `isInfixOf` s)
7de0272 @jgm Haddock changes.
authored
255 -- for now, we disallow @*@ and @?@ in page names, because git filestore
2d95dea @jgm Disallow page names containing '..', '?', or '*'.
authored
256 -- does not deal with them properly, and darcs filestore disallows them.
e8d5c65 @jgm Major reorganization.
authored
257
a2e3f0f Code cleanup/refactoring.
John MacFarlane authored
258 isPageFile :: FilePath -> Bool
259 isPageFile f = takeExtension f == ".page"
260
e8d5c65 @jgm Major reorganization.
authored
261 isDiscussPage :: String -> Bool
4420ca3 @jgm Changed discuss pages from foo:discuss -> @foo.
authored
262 isDiscussPage ('@':xs) = isPage xs
263 isDiscussPage _ = False
e8d5c65 @jgm Major reorganization.
authored
264
a2e3f0f Code cleanup/refactoring.
John MacFarlane authored
265 isDiscussPageFile :: FilePath -> Bool
4420ca3 @jgm Changed discuss pages from foo:discuss -> @foo.
authored
266 isDiscussPageFile ('@':xs) = isPageFile xs
267 isDiscussPageFile _ = False
a2e3f0f Code cleanup/refactoring.
John MacFarlane authored
268
e8d5c65 @jgm Major reorganization.
authored
269 isSourceCode :: String -> Bool
e08c0dc @jgm Changed showActivity to a Handler type.
authored
270 isSourceCode path' =
befa443 @jgm Use languagesByFilename instead of languagesByExtension in isSource.
authored
271 let langs = languagesByFilename $ takeFileName path'
9aa3b68 @jgm Serve svg file as image, not source code!
authored
272 in not (null langs || takeExtension path' == ".svg")
273 -- allow svg to be served as image
e8d5c65 @jgm Major reorganization.
authored
274
7de0272 @jgm Haddock changes.
authored
275 -- | Returns encoded URL path for the page with the given name, relative to
276 -- the wiki base.
a258490 @jgm Major routing changes.
authored
277 urlForPage :: String -> String
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
278 urlForPage page = '/' : encString False isUnescapedInURI page
e8d5c65 @jgm Major reorganization.
authored
279
7de0272 @jgm Haddock changes.
authored
280 -- | Returns the filestore path of the file containing the page's source.
e8d5c65 @jgm Major reorganization.
authored
281 pathForPage :: String -> FilePath
282 pathForPage page = page <.> "page"
283
c822759 @jgm Added haddocks to Framework.
authored
284 -- | Retrieves a mime type based on file extension.
65e1e24 @jgm Put map of mime types in config instead of filepath.
authored
285 getMimeTypeForExtension :: String -> GititServerPart String
9ffbb78 @jgm moved getMimeTypeForExtension from State to Framework.
authored
286 getMimeTypeForExtension ext = do
65e1e24 @jgm Put map of mime types in config instead of filepath.
authored
287 mimes <- liftM mimeMap getConfig
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
288 return $ fromMaybe "application/octet-stream"
289 (M.lookup (dropWhile (== '.') $ map toLower ext) mimes)
56e7c53 @jgm Began moving general framework functions to Gitit.Framework.
authored
290
7de0272 @jgm Haddock changes.
authored
291 -- | Simple helper for validation of forms.
a3d9f20 @jgm Moved validate to Framework.
authored
292 validate :: [(Bool, String)] -- ^ list of conditions and error messages
293 -> [String] -- ^ list of error messages
294 validate = foldl go []
295 where go errs (condition, msg) = if condition then msg:errs else errs
296
ebf01df @jgm Use GititServerPart instead of ServerPart.
authored
297 guardCommand :: String -> GititServerPart ()
589fb6e @jgm Large architecture change.
authored
298 guardCommand command = withData $ \(com :: Command) ->
299 case com of
300 Command (Just c) | c == command -> return ()
301 _ -> mzero
302
ebf01df @jgm Use GititServerPart instead of ServerPart.
authored
303 guardPath :: (String -> Bool) -> GititServerPart ()
ff511d6 @jgm Make guardPath use rqUri rather than rqPaths.
authored
304 guardPath pred' = guardRq (pred' . rqUri)
efedc42 @jgm Added guardIndex, which will work even if the wiki is not at base /.
authored
305
7de0272 @jgm Haddock changes.
authored
306 -- | Succeeds if path is an index path: e.g. @\/foo\/bar/@.
efedc42 @jgm Added guardIndex, which will work even if the wiki is not at base /.
authored
307 guardIndex :: GititServerPart ()
308 guardIndex = do
309 base <- getWikiBase
310 uri' <- liftM rqUri askRq
5bddae9 @jgm Fixed bug in guardIndex.
authored
311 let localpath = drop (length base) uri'
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
312 unless (length localpath > 1 && lastNote "guardIndex" uri' == '/')
313 mzero
efedc42 @jgm Added guardIndex, which will work even if the wiki is not at base /.
authored
314
7de0272 @jgm Haddock changes.
authored
315 -- Guard against a path like @\/wiki@ when the wiki is being
316 -- served at @\/wiki@.
4634d1d @jgm Redirect /wiki to /wiki/ when gitit served at /wiki.
authored
317 guardBareBase :: GititServerPart ()
318 guardBareBase = do
319 base' <- getWikiBase
320 uri' <- liftM rqUri askRq
2465bcb @gwern Strip trailing whitespace; misc -Wall and hlint
gwern authored
321 unless (not (null base') && base' == uri')
322 mzero
4634d1d @jgm Redirect /wiki to /wiki/ when gitit served at /wiki.
authored
323
c822759 @jgm Added haddocks to Framework.
authored
324 -- | Runs a server monad in a local context after setting
325 -- the "messages" request header.
70113a5 @jgm Made withInput and withMessages more polymorphic.
authored
326 withMessages :: ServerMonad m => [String] -> m a -> m a
c0f4586 @jgm Migrated to happstack-6.
authored
327 withMessages messages handler = do
871c7e3 @jgm Added withInput.
authored
328 req <- askRq
c0f4586 @jgm Migrated to happstack-6.
authored
329 let inps = filter (\(n,_) -> n /= "messages") $ rqInputsQuery req
330 let newInp = ("messages", Input {
8609002 @jgm Updated for happstack 7.
authored
331 inputValue = Right
332 $ LazyUTF8.fromString $ show messages
871c7e3 @jgm Added withInput.
authored
333 , inputFilename = Nothing
334 , inputContentType = ContentType {
335 ctType = "text"
336 , ctSubtype = "plain"
337 , ctParameters = [] }
338 })
c0f4586 @jgm Migrated to happstack-6.
authored
339 localRq (\rq -> rq{ rqInputsQuery = newInp : inps }) handler
871c7e3 @jgm Added withInput.
authored
340
c822759 @jgm Added haddocks to Framework.
authored
341 -- | Returns a filestore object derived from the
342 -- repository path and filestore type specified in configuration.
d7d984f @jgm Refactoring:
authored
343 filestoreFromConfig :: Config -> FileStore
344 filestoreFromConfig conf =
345 case repositoryType conf of
13b66f4 @jgm Added support for the new mercurial filestore backend.
authored
346 Git -> gitFileStore $ repositoryPath conf
347 Darcs -> darcsFileStore $ repositoryPath conf
348 Mercurial -> mercurialFileStore $ repositoryPath conf
Something went wrong with that request. Please try again.