gitit 0.16.0.2 → 0.16.1
raw patch · 16 files changed
+87/−157 lines, 16 filesdep ~basedep ~directorydep ~feedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, directory, feed, hoauth2, mtl, pandoc, time
API changes (from Hackage documentation)
Files
- CHANGES +19/−0
- gitit.cabal +11/−11
- gitit.hs +3/−1
- src/Network/Gitit/Authentication.hs +3/−2
- src/Network/Gitit/Authentication/Github.hs +10/−19
- src/Network/Gitit/Cache.hs +0/−10
- src/Network/Gitit/Compat/Except.hs +0/−15
- src/Network/Gitit/Config.hs +4/−5
- src/Network/Gitit/ContentTransformer.hs +7/−14
- src/Network/Gitit/Feed.hs +3/−42
- src/Network/Gitit/Handlers.hs +7/−10
- src/Network/Gitit/Initialize.hs +0/−5
- src/Network/Gitit/Page.hs +2/−2
- src/Network/Gitit/Plugins.hs +18/−5
- src/Network/Gitit/Types.hs +0/−8
- src/Network/Gitit/Util.hs +0/−8
CHANGES view
@@ -1,3 +1,22 @@+Version 0.16.1 released 06 Nov 2026++ * Add `-I0` to default RTS options (#712). This prevents a wakeup+ for gc every 1 second and dramatically reduces CPU usage of a+ gitit server.++ * Log requests at log level INFO (#715, Michał Antkiewicz).++ * Add support for loading dynamic plugins for GHC >= 9.4 (#714,+ Michał Antkiewicz).++ * Bump pandoc upper bound to allow 3.13++ * Change base lower bound. We only support ghc >= 9.6.++ * Bump some lower bounds and remove unneeded CPP.++ * Remove stack.yaml, use cabal on Windows CI+ Version 0.16.0.2 released 29 Sep 2026 * Support for pandoc 3.12.
gitit.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: gitit-version: 0.16.0.2+version: 0.16.1 build-type: Simple synopsis: Wiki using happstack, git or darcs, and pandoc. description: Gitit is a wiki backed by a git, darcs, or mercurial@@ -120,7 +120,7 @@ Network.Gitit.Compat.Except, Paths_gitit autogen-modules: Paths_gitit- build-depends: base >= 4.9 && < 5,+ build-depends: base >= 4.18 && < 5, syb, filepath, safe,@@ -130,11 +130,11 @@ containers, process, filepath,- directory,- mtl,+ directory >= 1.2,+ mtl >= 2.2.1, old-time, temporary,- pandoc >= 2.9 && < 2.20 || >= 3.0 && < 3.13,+ pandoc >= 3.11 && < 3.14, pandoc-types >= 1.20 && < 1.24, skylighting >= 0.8.2.3 && < 0.16, bytestring,@@ -145,7 +145,7 @@ HTTP >= 4000.0, HStringTemplate >= 0.8.8 && < 0.9, old-locale,- time,+ time >= 1.5, recaptcha >= 0.1, filestore >= 0.6.5.1 && < 0.7, zlib >= 0.5 && < 0.8,@@ -154,7 +154,7 @@ base64-bytestring >= 0.1, xml >= 1.3.5, hslogger >= 1,- feed >= 1.0 && < 1.4,+ feed >= 1.3 && < 1.4, xml-types >= 0.3, xss-sanitize >= 0.3 && < 0.4, tagsoup >= 0.13 && < 0.15,@@ -162,7 +162,7 @@ json >= 0.4 && < 0.12, uri-bytestring >= 0.2.3.3, split,- hoauth2 >= 2.3.0 && < 2.16,+ hoauth2 >= 2.15 && < 2.16, xml-conduit >= 1.5 && < 1.11, http-conduit >= 2.1.6 && < 2.4, http-client-tls >= 0.2.2 && < 0.5,@@ -184,7 +184,7 @@ Executable gitit hs-source-dirs: . main-is: gitit.hs- build-depends: base >= 4.15 && < 5,+ build-depends: base >= 4.18 && < 5, gitit, mtl, hslogger,@@ -198,13 +198,13 @@ autogen-modules: Paths_gitit default-extensions: CPP default-language: Haskell2010- ghc-options: -Wall -threaded -fno-warn-unused-do-bind+ ghc-options: -Wall -threaded -fno-warn-unused-do-bind -rtsopts "-with-rtsopts=-I0" ghc-prof-options: -fprof-auto-exported -rtsopts Executable expireGititCache hs-source-dirs: . main-is: expireGititCache.hs- build-depends: base >= 4.9 && < 5, HTTP, url, filepath, syb,+ build-depends: base >= 4.18 && < 5, HTTP, url, filepath, syb, network-uri >= 2.6, network >= 2.6 ghc-options: -Wall
gitit.hs view
@@ -90,8 +90,10 @@ -- initialize state initializeGititState conf + -- Requests are logged (in combined log format, to serverLogger) at level INFO and below. let serverConf = nullConf { validator = Nothing, port = portNumber conf,- timeout = 20, logAccess = Nothing }+ timeout = 20,+ logAccess = if level <= INFO then logAccess nullConf else Nothing } -- open the requested interface sock <- socket AF_INET Stream defaultProtocol
src/Network/Gitit/Authentication.hs view
@@ -177,8 +177,9 @@ T.setAttribute "port" (show $ portNumber cfg) . T.setAttribute "resetlink" (resetLink base' user) $ messageTemplate- let (mailcommand:args) = words $ substitute "%s" (uEmail user)- (mailCommand cfg)+ (mailcommand, args) <- case words $ substitute "%s" (uEmail user) (mailCommand cfg) of+ [] -> fail "No mail command defined in config"+ (x:xs) -> pure (x, xs) (exitCode, _pOut, pErr) <- liftIO $ readProcessWithExitCode mailcommand args filledTemplate liftIO $ logM "gitit" WARNING $ "Sent reset password email to " ++ uUsername user ++
src/Network/Gitit/Authentication/Github.hs view
@@ -16,11 +16,7 @@ import qualified Data.ByteString.Lazy as BSL import qualified URI.ByteString as URI import Network.HTTP.Conduit-#if MIN_VERSION_hoauth2(2,15,0) import Network.OAuth2-#else-import Network.OAuth.OAuth2-#endif import Control.Monad (liftM, mplus, mzero) import Data.Maybe import Data.Aeson@@ -61,10 +57,14 @@ where getUserInternal mgr = liftIO $ runExceptT $ do- let (Just state) = rState githubCallbackPars+ state <- case rState githubCallbackPars of+ Just st -> pure st+ Nothing -> fail "rState == Nothing in githubCallbackPars" if state == githubState then do- let (Just code) = rCode githubCallbackPars+ code <- case rCode githubCallbackPars of+ Just co -> pure co+ Nothing -> fail "rcode == Nothig in githubCallbackPars" at <- withExceptT (oauthToGithubError "No access token found yet") $ fetchAccessToken mgr (oAuth2 ghConfig) (ExchangeToken $ pack code) liftIO >=> liftEither $ ifSuccess "User Authentication failed"@@ -75,7 +75,10 @@ (\githubUserMail -> do let gitLogin = gLogin githubUser user <- mkUser (unpack gitLogin)- (unpack $ email $ head (filter primary githubUserMail))+ (unpack $+ case filter primary githubUserMail of+ (m:_) -> email m+ [] -> "") "none" let mbOrg = org ghConfig case mbOrg of@@ -106,25 +109,13 @@ vState <- liftM Just (look "state") `mplus` return Nothing return GithubCallbackPars {rCode = vCode, rState = vState} -#if MIN_VERSION_hoauth2(1, 9, 0) userInfo :: Manager -> AccessToken -> IO (Either BSL.ByteString GithubUser)-#else-userInfo :: Manager -> AccessToken -> IO (OAuth2Result OA.Errors GithubUser)-#endif userInfo mgr token = runExceptT $ authGetJSON mgr token $ githubUri "/user" -#if MIN_VERSION_hoauth2(1, 9, 0) mailInfo :: Manager -> AccessToken -> IO (Either BSL.ByteString [GithubUserMail])-#else-mailInfo :: Manager -> AccessToken -> IO (OAuth2Result OA.Errors [GithubUserMail])-#endif mailInfo mgr token = runExceptT $ authGetJSON mgr token $ githubUri "/user/emails" -#if MIN_VERSION_hoauth2(1, 9, 0) orgInfo :: Text -> Text -> Manager -> AccessToken -> IO (Either BSL.ByteString BSL.ByteString)-#else-orgInfo :: Text -> Text -> Manager -> AccessToken -> IO (OAuth2Result OA.Errors BSL.ByteString)-#endif orgInfo gitLogin githubOrg mgr token = do let url = githubUri $ "/orgs/" `BS.append` encodeUtf8 githubOrg `BS.append` "/members/" `BS.append` encodeUtf8 gitLogin runExceptT $ authGetBS mgr token url
src/Network/Gitit/Cache.hs view
@@ -29,11 +29,6 @@ import System.FilePath import System.Directory (doesFileExist, removeFile, createDirectoryIfMissing, getModificationTime) import Data.Time.Clock (UTCTime)-#if MIN_VERSION_directory(1,2,0)-#else-import System.Time (ClockTime(..))-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-#endif import Network.Gitit.State import Network.Gitit.Types import Control.Monad@@ -56,12 +51,7 @@ exists <- liftIO $ doesFileExist target if exists then liftIO $ do-#if MIN_VERSION_directory(1,2,0) modtime <- getModificationTime target-#else- TOD secs _ <- getModificationTime target- let modtime = posixSecondsToUTCTime $ fromIntegral secs-#endif contents <- B.readFile target return $ Just (modtime, contents) else return Nothing
src/Network/Gitit/Compat/Except.hs view
@@ -10,7 +10,6 @@ , catchError ) where -#if MIN_VERSION_mtl(2,2,1) import Control.Monad.Except class Error a where@@ -20,17 +19,3 @@ noMsg = strMsg "" strMsg _ = noMsg -#else-import Control.Monad.Error-import Control.Monad.Identity (Identity, runIdentity)--type ExceptT = ErrorT--type Except s a = ErrorT s Identity a--runExceptT :: ExceptT e m a -> m (Either e a)-runExceptT = runErrorT--runExcept :: ExceptT e Identity a -> Either e a-runExcept = runIdentity . runExceptT-#endif
src/Network/Gitit/Config.hs view
@@ -34,7 +34,10 @@ import System.IO (hPutStrLn, stderr) import System.Exit (ExitCode(..), exitWith) import qualified Data.Map as M-import Data.List (intercalate, foldl')+import Data.List (intercalate)+#if !MIN_VERSION_base(4,20,0)+import Data.List (foldl')+#endif import Data.Char (toLower, toUpper, isAlphaNum) import qualified Data.Text as T import Data.Text (Text)@@ -42,11 +45,7 @@ import System.FilePath ((</>)) import Text.Pandoc hiding (ERROR, WARNING, MathJax, MathML, WebTeX, getDataFileName) import qualified Control.Exception as E-#if MIN_VERSION_hoauth2(2,15,0) import Network.OAuth2 (OAuth2(..))-#else-import Network.OAuth.OAuth2 (OAuth2(..))-#endif import URI.ByteString (parseURI, laxURIParserOptions) import qualified Data.ByteString.Char8 as BS import Network.Gitit.Compat.Except
src/Network/Gitit/ContentTransformer.hs view
@@ -98,7 +98,7 @@ import qualified Data.Text as T import qualified Data.ByteString as S (concat) import qualified Data.ByteString.Char8 as SC (pack, unpack)-import qualified Data.ByteString.Lazy as L (toChunks, fromChunks)+import qualified Data.ByteString.Lazy as L (toChunks, fromStrict) import qualified Data.FileStore as FS import qualified Text.Pandoc as Pandoc import Data.String (IsString(fromString))@@ -254,7 +254,9 @@ cacheable <- getCacheable cfg <- lift getConfig when (useCache cfg && cacheable && isNothing (pRevision params) && not (pPrintable params)) $- lift $ cacheContents file $ S.concat $ L.toChunks $ rsBody resp'+ case resp' of+ Response{} -> lift $ cacheContents file $ S.concat $ L.toChunks $ rsBody resp'+ SendFile{} -> pure () return resp' -- | Returns cached page if available, otherwise mzero.@@ -265,8 +267,9 @@ cfg <- lift getConfig if useCache cfg && not (pPrintable params) && isNothing (pRevision params) then do mbCached <- lift $ lookupCache file- let emptyResponse = setContentType "text/html; charset=utf-8" . toResponse $ ()- maybe mzero (\(_modtime, contents) -> lift . ok $ emptyResponse{rsBody = L.fromChunks [contents]}) mbCached+ maybe mzero (\(_modtime, contents) ->+ lift . ok $ toResponseBS "text/html; charset=utf-8"+ (L.fromStrict contents)) mbCached else mzero --@@ -508,22 +511,14 @@ (if xssSanitize cfg then sanitizeBalance else id) $ either E.throw id . runPure $ writeHtml5String def{ writerTemplate = Just compiledTemplate-#if MIN_VERSION_pandoc(3,11,0) , writerMathMethod =-#else- , writerHTMLMathMethod =-#endif case mathMethod cfg of MathML -> Pandoc.MathML WebTeX u -> Pandoc.WebTeX $ T.pack u MathJax u -> Pandoc.MathJax $ T.pack u RawTeX -> Pandoc.PlainMath , writerTableOfContents = toc-#if MIN_VERSION_pandoc(3,8,0) , writerHighlightMethod = Skylighting pygments-#else- , writerHighlightStyle = Just pygments-#endif , writerExtensions = if bird then enableExtension Ext_literate_haskell $ writerExtensions def@@ -720,9 +715,7 @@ Superscript xs -> mconcat $ map go xs Subscript xs -> mconcat $ map go xs SmallCaps xs -> mconcat $ map go xs-#if MIN_VERSION_pandoc(2,10,0) Underline xs -> mconcat $ map go xs-#endif Quoted DoubleQuote xs -> "\"" <> mconcat (map go xs) <> "\"" Quoted SingleQuote xs -> "'" <> mconcat (map go xs) <> "'" Cite _ xs -> mconcat $ map go xs
src/Network/Gitit/Feed.hs view
@@ -25,11 +25,7 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Time (UTCTime, formatTime, getCurrentTime, addUTCTime)-#if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale)-#else-import System.Locale (defaultTimeLocale)-#endif import Data.Foldable as F (concatMap) import Data.List (intercalate, sortBy, nub) import Data.Maybe (fromMaybe)@@ -147,71 +143,36 @@ , entryAuthors = [authorToPerson ra], entryLinks = [ln] } where baseEntry = nullEntry (T.pack url) title (T.pack $ formatFeedTime rdt)- url = home ++ escape (extract $ head rv) ++ "?revision=" ++ rid+ url = home ++ (case rv of+ x:_ -> extract x+ _ -> "") ++ "?revision=" ++ rid ln = (nullLink (T.pack url)) {linkRel = Just (Left "alternate")} title = TextString $ T.pack $ (takeWhile ('\n' /=) rd) ++ " - " ++ (intercalate ", " $ map show rv) df = map diffFile diffs-#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0)) content = T.pack $ concat $ map showContent df-#else- content = XMLTypes.Element (XMLTypes.Name "div" Nothing Nothing) [] df-#endif -#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0)) diffFile :: (FilePath, [Diff [String]]) -> Content diffFile (fp, d) = enTag "div" $ header : text where header = enTag1 "h1" $ enText fp text = map (enTag1 "p") $ concat $ map diffLines d-#else-diffFile :: (FilePath, [Diff [String]]) -> XMLTypes.Node-diffFile (fp, d) =- enTag "div" $ header : text- where- header = enTag1 "h1" $ enText $ T.pack fp- text = map (enTag1 "p") $ concat $ map diffLines d-#endif -#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0)) diffLines :: Diff [String] -> [Content] diffLines (First x) = map (enTag1 "s" . enText) x diffLines (Second x) = map (enTag1 "b" . enText) x diffLines (Both x _) = map enText x-#else-diffLines :: Diff [String] -> [XMLTypes.Node]-diffLines (First x) = map (enTag1 "s" . enText . T.pack) x-diffLines (Second x) = map (enTag1 "b" . enText . T.pack) x-diffLines (Both x _) = map (enText . T.pack) x-#endif -#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0)) enTag :: String -> [Content] -> Content enTag tag content = Elem blank_element{ elName=blank_name{qName=tag} , elContent=content }-#else-enTag :: T.Text -> [XMLTypes.Node] -> XMLTypes.Node-enTag tag content = XMLTypes.NodeElement $- XMLTypes.Element- (XMLTypes.Name tag Nothing Nothing)- [] content-#endif -#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0)) enTag1 :: String -> Content -> Content-#else-enTag1 :: T.Text -> XMLTypes.Node -> XMLTypes.Node-#endif enTag1 tag content = enTag tag [content] -#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0)) enText :: String -> Content enText content = Text blank_cdata{cdData=content}-#else-enText :: T.Text -> XMLTypes.Node-enText content = XMLTypes.NodeContent (XMLTypes.ContentText content)-#endif -- gitit is set up not to reveal registration emails authorToPerson :: Author -> Person
src/Network/Gitit/Handlers.hs view
@@ -74,7 +74,7 @@ import Control.Monad import Control.Monad.Reader import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString as S+import qualified Data.ByteString.UTF8 as UTF8 import Network.HTTP (urlEncodeVars) import Data.Time (getCurrentTime, addUTCTime) import Data.Time.Clock (diffUTCTime, UTCTime(..))@@ -99,9 +99,7 @@ (retrieve fs path' rev :: IO B.ByteString) case res of Right contents -> ignoreFilters >> -- don't compress- (ok $ setContentType mimetype $- (toResponse (renderHtml mempty)) {rsBody = contents})- -- ugly hack+ (ok $ toResponseBS (fromString mimetype) contents) Left NotFound -> mzero Left e -> error (show e) @@ -756,7 +754,7 @@ a ! href (fromString $ base' ++ urlForPage (dropExtension file)) $ fromString $ dropExtension file let toRemoveListItem cat = li $ a ! href (fromString $ base' ++- (if null (tail pcategories)+ (if null (drop 1 pcategories) then "/_categories" else "/_category" ++ urlForPage (intercalate "," $ Data.List.delete cat pcategories))) $ fromString ("-" ++ cat)@@ -832,10 +830,9 @@ mbCached <- lookupCache file case mbCached of Just (modtime, contents) | isRecentEnough modtime -> do- let emptyResponse = setContentType "application/atom+xml; charset=utf-8" . toResponse $ ()- ok $ emptyResponse{rsBody = B.fromChunks [contents]}+ ok $ toResponseBS "application/atom+xml; charset=UTF-8" (B.fromStrict contents) _ -> do fs <- getFileStore- resp' <- liftM toResponse $ liftIO (filestoreToXmlFeed fc fs mbPath)- cacheContents file $ S.concat $ B.toChunks $ rsBody resp'- ok . setContentType "application/atom+xml; charset=UTF-8" $ resp'+ contents <- UTF8.fromString <$> liftIO (filestoreToXmlFeed fc fs mbPath)+ cacheContents file contents+ ok $ toResponseBS "application/atom+xml; charset=UTF-8" (B.fromStrict contents)
src/Network/Gitit/Initialize.hs view
@@ -27,7 +27,6 @@ , createTemplateIfMissing ) where import System.FilePath ((</>), (<.>))-import Data.Semigroup ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.FileStore@@ -136,11 +135,7 @@ RST -> writeRST defOpts <=< toPandoc Textile -> writeTextile defOpts <=< toPandoc Org -> writeOrg defOpts <=< toPandoc-#if MIN_VERSION_pandoc(3,0,0) DocBook -> writeDocBook5 defOpts <=< toPandoc-#else- DocBook -> writeDocbook5 defOpts <=< toPandoc-#endif MediaWiki -> writeMediaWiki defOpts <=< toPandoc CommonMark -> writeCommonMark defOpts <=< toPandoc
src/Network/Gitit/Page.hs view
@@ -162,7 +162,7 @@ readCategories :: FilePath -> IO [String] readCategories f = withFile f ReadMode $ \h ->- E.catch (do fl <- B.hGetLine h+ E.catch (do fl <- BC.hGetLine h if dashline fl then do -- get rest of metadata rest <- hGetLinesTill h dotOrDashline@@ -187,7 +187,7 @@ hGetLinesTill :: Handle -> (B.ByteString -> Bool) -> IO [String] hGetLinesTill h end = do- next <- B.hGetLine h+ next <- BC.hGetLine h if end next then return [toString next] else do
src/Network/Gitit/Plugins.hs view
@@ -29,6 +29,9 @@ #ifdef _PLUGINS import Data.List (isInfixOf, isPrefixOf) import GHC+import Control.Monad.IO.Class (liftIO)+import GHC.Driver.Session (PackageFlag(..), PackageArg(..), ModRenaming(..))+import GHC.Platform.Ways (Way(WayDyn), addWay, hostIsDynamic) import GHC.Paths import Unsafe.Coerce @@ -37,15 +40,25 @@ logM "gitit" WARNING ("Loading plugin '" ++ pluginName ++ "'...") runGhc (Just libdir) $ do dflags <- getSessionDynFlags- setSessionDynFlags dflags+ -- Honour package environment files (GHC_ENVIRONMENT or the default+ -- environment), which only parseDynamicFlags reads otherwise.+ logger <- getLogger+ dflags' <- liftIO $ interpretPackageEnv logger dflags+ -- Plugins always import Network.Gitit.Interface, so expose gitit even+ -- when a package environment hides packages it does not list.+ let exposeGitit = ExposePackage "-package gitit" (PackageArg "gitit")+ (ModRenaming True [])+ dflags'' = dflags' { packageFlags = exposeGitit : packageFlags dflags' }+ -- A dynamically linked gitit can only load dynamic code, so look for+ -- dynamic interface files and objects, as GHCi does.+ setSessionDynFlags $+ if hostIsDynamic+ then dflags'' { targetWays_ = addWay WayDyn (targetWays_ dflags'') }+ else dflags'' -- initDynFlags unless ("Network.Gitit.Plugin." `isPrefixOf` pluginName) $ do-#if __GLASGOW_HASKELL__ >= 904 addTarget =<< guessTarget pluginName Nothing Nothing-#else- addTarget =<< guessTarget pluginName Nothing-#endif r <- load LoadAllTargets case r of Failed -> error $ "Error loading plugin: " ++ pluginName
src/Network/Gitit/Types.hs view
@@ -74,20 +74,12 @@ 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)-#if MIN_VERSION_hoauth2(2,15,0) import Network.OAuth2-#else-import Network.OAuth.OAuth2-#endif import Text.Blaze.Html (Html) data PageType = Markdown
src/Network/Gitit/Util.hs view
@@ -42,17 +42,9 @@ import Text.Pandoc (Extension(..), Extensions, getDefaultExtensions, enableExtension) import Network.URL (encString) -#if !MIN_VERSION_pandoc(2,12,0)-import qualified Data.Text as T-#endif- -- | Read file as UTF-8 string. Encode filename as UTF-8. readFileUTF8 :: FilePath -> IO Text-#if MIN_VERSION_pandoc(2,12,0) readFileUTF8 = UTF8.readFile-#else-readFileUTF8 = fmap T.pack . UTF8.readFile-#endif -- | Perform a function a directory and return to working directory. inDir :: FilePath -> IO a -> IO a