-- | This module ties together all the hackage features that we will use. -- -- To add a feature: -- -- * Import its initialization function -- * Call its initialization function with all of its required arguments -- * Add it to the allFeatures list -- {-# LANGUAGE CPP #-} module Distribution.Server.Features where import Distribution.Server.Framework.Feature import Distribution.Server.Framework.ServerEnv (ServerEnv(..)) import Distribution.Server.Framework.Logging import Distribution.Server.Features.StaticFiles (initStaticFilesFeature) import Distribution.Server.Features.Users (initUserFeature, UserFeature) import Distribution.Server.Features.Core (initCoreFeature, coreResource, queryGetPackageIndex) import Distribution.Server.Features.Upload (initUploadFeature) import Distribution.Server.Features.Mirror (initMirrorFeature) #ifndef MINIMAL import Distribution.Server.Features.TarIndexCache (initTarIndexCacheFeature) import Distribution.Server.Features.Html (initHtmlFeature) import Distribution.Server.Features.PackageCandidates (initPackageCandidatesFeature, candidatesCoreResource, queryGetCandidateIndex) import Distribution.Server.Features.RecentPackages (initRecentPackagesFeature) import Distribution.Server.Features.Distro (initDistroFeature) import Distribution.Server.Features.PackageContents (initPackageContentsFeature) import Distribution.Server.Features.Documentation (initDocumentationFeature) import Distribution.Server.Features.BuildReports (initBuildReportsFeature) import Distribution.Server.Features.LegacyRedirects (legacyRedirectsFeature) import Distribution.Server.Features.PreferredVersions (initVersionsFeature) -- [reverse index disabled] import Distribution.Server.Features.ReverseDependencies (initReverseFeature) import Distribution.Server.Features.DownloadCount (initDownloadFeature) import Distribution.Server.Features.Tags (initTagsFeature) import Distribution.Server.Features.Search (initSearchFeature) import Distribution.Server.Features.PackageList (initListFeature) import Distribution.Server.Features.HaskellPlatform (initPlatformFeature) import Distribution.Server.Features.UserDetails (initUserDetailsFeature) import Distribution.Server.Features.UserSignup (initUserSignupFeature) import Distribution.Server.Features.LegacyPasswds (initLegacyPasswdsFeature) import Distribution.Server.Features.EditCabalFiles (initEditCabalFilesFeature) import Distribution.Server.Features.AdminFrontend (initAdminFrontendFeature) import Distribution.Server.Features.HoogleData (initHoogleDataFeature) #endif import Distribution.Server.Features.ServerIntrospect (serverIntrospectFeature) #ifdef DEBUG import Distribution.Server.Features.Crash #endif import Control.Applicative ((<$>)) import Distribution.Server.Packages.PackageIndex (allPackages) import Distribution.Package (packageId) -- TODO: -- * PackageServe: serving from tarballs (most of the work is setting it up on import) -- * Snippet: code samples, pastebin for 'getting started' code -- * LibraryRank: http://hackage.haskell.org/trac/hackage/ticket/183 -- * HaskellPlatform: mark off packages in the haskell platform. -- * Anonymous build reports should work, as well as candidate build reports -- * alter Users to be more in line with the current way registering is handled, -- with email addresses available to maintainers, etc. -- * UserNotify: email users and let them email each other -- * Backup: would need a [HackageFeature] to backup, though a HackageFeature itself. -- best approach is probably to write backup tarball to disk and transfer -- it away through non-HTTP means (somewhat more secure) -- | Initialize all features and run post-initialization hooks. initHackageFeatures :: ServerEnv -> IO ([HackageFeature], UserFeature) initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do -- We have a three phase initialisation procedure... -- 1. in phase 1 all features can start independently (could be parallel) -- they load the data they need, but before having access to the other -- features they depend on -- 2. in phase 2 they have access to the other features they depend on -- this is serialised according to the dependencies of the features -- 3. in phase 3 we run all post-init actions. This could also be parallel. loginfo verbosity "Initialising features, part 1" mkStaticFilesFeature <- logStartup "static files" $ initStaticFilesFeature env mkUserFeature <- logStartup "user" $ initUserFeature env mkCoreFeature <- logStartup "core" $ initCoreFeature env mkMirrorFeature <- logStartup "mirror" $ initMirrorFeature env mkUploadFeature <- logStartup "upload" $ initUploadFeature env #ifndef MINIMAL mkTarIndexCacheFeature <- logStartup "tar index" $ initTarIndexCacheFeature env mkPackageContentsFeature <- logStartup "package contents" $ initPackageContentsFeature env mkRecentPackagesFeature <- logStartup "recent packages" $ initRecentPackagesFeature env mkUserDetailsFeature <- logStartup "user details" $ initUserDetailsFeature env mkUserSignupFeature <- logStartup "user signup" $ initUserSignupFeature env mkLegacyPasswdsFeature <- logStartup "legacy passwords" $ initLegacyPasswdsFeature env mkDistroFeature <- logStartup "distro" $ initDistroFeature env mkPackageCandidatesFeature <- logStartup "package candidates" $ initPackageCandidatesFeature env mkBuildReportsCoreFeature <- logStartup "reports (core)" $ initBuildReportsFeature "reports-core" env mkBuildReportsCandidatesFeature <- logStartup "reports (candidates)" $ initBuildReportsFeature "reports-candidates" env mkDocumentationCoreFeature <- logStartup "documentation (core)" $ initDocumentationFeature "documentation-core" env mkDocumentationCandidatesFeature <- logStartup "documentation (candidates)" $ initDocumentationFeature "documentation-candidates" env mkDownloadFeature <- logStartup "download counts" $ initDownloadFeature env mkTagsFeature <- logStartup "tags" $ initTagsFeature env mkVersionsFeature <- logStartup "versions" $ initVersionsFeature env -- mkReverseFeature <- logStartup "reverse deps" $ -- initReverseFeature env mkListFeature <- logStartup "list" $ initListFeature env mkSearchFeature <- logStartup "search" $ initSearchFeature env mkPlatformFeature <- logStartup "platform" $ initPlatformFeature env mkHtmlFeature <- logStartup "html" $ initHtmlFeature env mkEditCabalFilesFeature <- logStartup "edit cabal files" $ initEditCabalFilesFeature env mkAdminFrontendFeature <- logStartup "admn frontend" $ initAdminFrontendFeature env mkHoogleDataFeature <- logStartup "hoogle" $ initHoogleDataFeature env #endif loginfo verbosity "Initialising features, part 2" -- Arguments denote feature dependencies. -- What follows is a topological sort along those lines staticFilesFeature <- mkStaticFilesFeature usersFeature <- mkUserFeature coreFeature <- mkCoreFeature usersFeature mirrorFeature <- mkMirrorFeature coreFeature usersFeature uploadFeature <- mkUploadFeature usersFeature coreFeature #ifndef MINIMAL tarIndexCacheFeature <- mkTarIndexCacheFeature usersFeature packageContentsFeature <- mkPackageContentsFeature coreFeature tarIndexCacheFeature packagesFeature <- mkRecentPackagesFeature usersFeature coreFeature packageContentsFeature userDetailsFeature <- mkUserDetailsFeature usersFeature coreFeature userSignupFeature <- mkUserSignupFeature usersFeature userDetailsFeature uploadFeature legacyPasswdsFeature <- mkLegacyPasswdsFeature usersFeature distroFeature <- mkDistroFeature usersFeature coreFeature candidatesFeature <- mkPackageCandidatesFeature usersFeature coreFeature uploadFeature tarIndexCacheFeature reportsCoreFeature <- mkBuildReportsCoreFeature usersFeature uploadFeature (coreResource coreFeature) reportsCandidatesFeature <- mkBuildReportsCandidatesFeature usersFeature uploadFeature (candidatesCoreResource candidatesFeature) documentationCoreFeature <- mkDocumentationCoreFeature (coreResource coreFeature) (map packageId . allPackages <$> queryGetPackageIndex coreFeature) uploadFeature tarIndexCacheFeature documentationCandidatesFeature <- mkDocumentationCandidatesFeature (candidatesCoreResource candidatesFeature) (map packageId . allPackages <$> queryGetCandidateIndex candidatesFeature) uploadFeature tarIndexCacheFeature downloadFeature <- mkDownloadFeature coreFeature usersFeature tagsFeature <- mkTagsFeature coreFeature uploadFeature versionsFeature <- mkVersionsFeature coreFeature uploadFeature tagsFeature {- [reverse index disabled] reverseFeature <- mkReverseFeature coreFeature versionsFeature -} listFeature <- mkListFeature coreFeature -- [reverse index disabled] reverseFeature downloadFeature tagsFeature versionsFeature searchFeature <- mkSearchFeature coreFeature listFeature platformFeature <- mkPlatformFeature htmlFeature <- mkHtmlFeature usersFeature coreFeature packagesFeature uploadFeature candidatesFeature versionsFeature -- [reverse index disabled] reverseFeature tagsFeature downloadFeature listFeature searchFeature mirrorFeature distroFeature documentationCoreFeature documentationCandidatesFeature reportsCoreFeature userDetailsFeature editCabalFeature <- mkEditCabalFilesFeature usersFeature coreFeature uploadFeature adminFrontendFeature <- mkAdminFrontendFeature usersFeature userDetailsFeature userSignupFeature legacyPasswdsFeature hoogleDataFeature <- mkHoogleDataFeature coreFeature documentationCoreFeature tarIndexCacheFeature #endif -- The order of initialization above should be the same as -- the order of this list. let allFeatures :: [HackageFeature] allFeatures = [ getFeatureInterface usersFeature , getFeatureInterface coreFeature , getFeatureInterface mirrorFeature , getFeatureInterface uploadFeature #ifndef MINIMAL , getFeatureInterface tarIndexCacheFeature , getFeatureInterface packageContentsFeature , getFeatureInterface packagesFeature , getFeatureInterface userDetailsFeature , getFeatureInterface userSignupFeature , getFeatureInterface legacyPasswdsFeature , getFeatureInterface distroFeature , getFeatureInterface candidatesFeature , getFeatureInterface reportsCoreFeature , getFeatureInterface reportsCandidatesFeature , getFeatureInterface documentationCoreFeature , getFeatureInterface documentationCandidatesFeature , getFeatureInterface downloadFeature , getFeatureInterface tagsFeature , getFeatureInterface versionsFeature -- [reverse index disabled] , getFeatureInterface reverseFeature , getFeatureInterface searchFeature , getFeatureInterface listFeature , getFeatureInterface platformFeature , getFeatureInterface htmlFeature , legacyRedirectsFeature uploadFeature , editCabalFeature , adminFrontendFeature , getFeatureInterface hoogleDataFeature #endif , staticFilesFeature , serverIntrospectFeature allFeatures #ifdef DEBUG , serverCrashFeature #endif ] -- Run all post init hooks, now that everyone's gotten a chance to register -- for them. This solution is iffy for initial feature hooks that rely on -- other features It also happens even in the backup/restore modes. sequence_ [ logStartup ("post-init for " ++ name ++ "feature") $ featurePostInit feature | feature@HackageFeature { featureName = name } <- allFeatures ] loginfo verbosity "Initialising features done" return (allFeatures, usersFeature) where logStartup feature action = do loginfo verbosity ("Initialising " ++ feature ++ " feature") logTiming verbosity ("Initialising " ++ feature ++ " feature done") action -- | Checkpoint a feature's persistent state to disk. featureCheckpoint :: HackageFeature -> IO () featureCheckpoint = mapM_ abstractStateCheckpoint . featureState -- | Checkpoint all features' persistent state. checkpointAllFeatures :: [HackageFeature] -> IO () checkpointAllFeatures = mapM_ featureCheckpoint -- | Cleanly shut down a feature's state components. featureShutdown :: HackageFeature -> IO () featureShutdown = mapM_ abstractStateClose . featureState -- | Cleanly shut down all features' state components. shutdownAllFeatures :: [HackageFeature] -> IO () shutdownAllFeatures = mapM_ featureShutdown . reverse