From 768eaec573001b044ea7ccfc6848329682d22220 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Fri, 25 Sep 2015 17:43:50 +0300 Subject: [PATCH] Remove all social features Motivation: these were the last things requiring a database. Once this is gone, it simplifies deployment dramatically. I'm also not sure that the social features were really worth keeping. --- Application.hs | 37 -------- Foundation.hs | 116 +----------------------- Handler/Email.hs | 14 --- Handler/Package.hs | 86 ------------------ Handler/Profile.hs | 30 ------- Handler/ResetToken.hs | 12 --- Handler/Sitemap.hs | 9 +- Handler/Tag.hs | 39 --------- Import.hs | 15 ---- Model.hs | 13 --- Settings.hs | 46 +--------- Types.hs | 8 -- config/models | 35 -------- config/postgresql.yml-sample | 24 ----- config/routes | 11 --- stackage-server.cabal | 7 -- templates/banned-tags.hamlet | 6 -- templates/banned-tags.lucius | 4 - templates/default-layout.hamlet | 26 ++---- templates/package.hamlet | 27 ------ templates/package.julius | 151 -------------------------------- templates/profile.hamlet | 33 ------- templates/profile.lucius | 13 --- templates/tag-list.hamlet | 11 --- templates/tag-list.lucius | 16 ---- templates/tag.hamlet | 21 ----- templates/tag.lucius | 12 --- 27 files changed, 9 insertions(+), 813 deletions(-) delete mode 100644 Handler/Email.hs delete mode 100644 Handler/Profile.hs delete mode 100644 Handler/ResetToken.hs delete mode 100644 Handler/Tag.hs delete mode 100644 Model.hs delete mode 100644 config/models delete mode 100644 config/postgresql.yml-sample delete mode 100644 templates/banned-tags.hamlet delete mode 100644 templates/banned-tags.lucius delete mode 100644 templates/package.julius delete mode 100644 templates/profile.hamlet delete mode 100644 templates/profile.lucius delete mode 100644 templates/tag-list.hamlet delete mode 100644 templates/tag-list.lucius delete mode 100644 templates/tag.hamlet delete mode 100644 templates/tag.lucius diff --git a/Application.hs b/Application.hs index 9dacc34..0d44a02 100644 --- a/Application.hs +++ b/Application.hs @@ -36,9 +36,6 @@ import qualified Echo -- Don't forget to add new modules to your cabal file! import Handler.Home import Handler.Snapshots -import Handler.Profile -import Handler.Email -import Handler.ResetToken import Handler.StackageHome import Handler.StackageIndex import Handler.StackageSdist @@ -46,8 +43,6 @@ import Handler.System import Handler.Haddock import Handler.Package import Handler.PackageList -import Handler.Tag -import Handler.BannedTags import Handler.Hoogle import Handler.BuildVersion import Handler.Sitemap @@ -100,20 +95,12 @@ nicerExceptions app req send = catch (app req send) $ \e -> do send $ responseLBS status500 [("Content-Type", "text/plain")] $ fromStrict $ encodeUtf8 text -getDbConf :: AppConfig DefaultEnv Extra -> IO Settings.PersistConf -getDbConf conf = - withYamlEnvironment "config/postgresql.yml" (appEnv conf) - Database.Persist.loadConfig >>= - Database.Persist.applyEnv - -- | Loads up any necessary settings, creates your foundation datatype, and -- performs some initialization. makeFoundation :: Bool -> AppConfig DefaultEnv Extra -> IO App makeFoundation useEcho conf = do manager <- newManager s <- staticSite - dbconf <- getDbConf conf - p <- Database.Persist.createPoolConfig dbconf loggerSet' <- if useEcho then newFileLoggerSet defaultBufSize "/dev/null" @@ -149,27 +136,13 @@ makeFoundation useEcho conf = do foundation = App { settings = conf , getStatic = s - , connPool = p , httpManager = manager - , persistConfig = dbconf , appLogger = logger , genIO = gen , websiteContent = websiteContent' , stackageDatabase = stackageDatabase' } - -- Perform database migration using our application's logging settings. - when (lookup "STACKAGE_SKIP_MIGRATION" env /= Just "1") $ - runResourceT $ - flip runReaderT gen $ - flip runLoggingT (messageLoggerSource foundation logger) $ - flip (Database.Persist.runPool dbconf) p $ do - runMigration migrateAll - {- - checkMigration 1 fixSnapSlugs - checkMigration 2 setCorePackages - -} - return foundation -- for yesod devel @@ -180,13 +153,3 @@ getApplicationDev useEcho = loader = Yesod.Default.Config.loadConfig (configSettings Development) { csParseExtra = parseExtra } - -_checkMigration :: MonadIO m - => Int - -> ReaderT SqlBackend m () - -> ReaderT SqlBackend m () -_checkMigration num f = do - eres <- insertBy $ Migration num - case eres of - Left _ -> return () - Right _ -> f diff --git a/Foundation.hs b/Foundation.hs index e6eec85..b2a1334 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -1,13 +1,12 @@ module Foundation where import ClassyPrelude.Yesod -import Data.Slug (safeMakeSlug, HasGenIO (getGenIO), randomSlug, Slug) +import Data.Slug (HasGenIO (getGenIO), randomSlug, Slug) import Data.WebsiteContent import qualified Database.Persist import Database.Persist.Sql (PersistentSqlException (Couldn'tGetSQLConnection)) -import Model import qualified Settings -import Settings (widgetFile, Extra (..), GoogleAuth (..)) +import Settings (widgetFile, Extra (..)) import Settings.Development (development) import Settings.StaticFiles import qualified System.Random.MWC as MWC @@ -29,9 +28,7 @@ import Stackage.Database data App = App { settings :: AppConfig DefaultEnv Extra , getStatic :: Static -- ^ Settings for static file serving. - , connPool :: Database.Persist.PersistConfigPool Settings.PersistConf -- ^ Database connection pool. , httpManager :: Manager - , persistConfig :: Settings.PersistConf , appLogger :: Logger , genIO :: MWC.GenIO , websiteContent :: GitRepo WebsiteContent @@ -44,9 +41,6 @@ instance HasGenIO App where instance HasHttpManager App where getHttpManager = httpManager -instance HasHackageRoot App where - getHackageRoot = hackageRoot . appExtra . settings - -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: -- http://www.yesodweb.com/book/routing-and-handlers @@ -64,9 +58,6 @@ defaultLayoutNoContainer = defaultLayoutWithContainer False defaultLayoutWithContainer :: Bool -> Widget -> Handler Html defaultLayoutWithContainer insideContainer widget = do mmsg <- getMessage - muser <- catch maybeAuth $ \e -> case e of - Couldn'tGetSQLConnection -> return Nothing - _ -> throwM e -- We break up the default layout into two components: -- default-layout is the contents of the body tag, and @@ -118,9 +109,6 @@ instance Yesod App where Just $ uncurry (joinPath y "") $ renderRoute route urlRenderOverride _ _ = Nothing - -- The page to be redirected to when authentication is required. - authRoute _ = Just $ AuthR LoginR - {- Temporarily disable to allow for horizontal scaling -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows @@ -152,108 +140,8 @@ instance ToMarkup (Route App) where toMarkup c = case c of AllSnapshotsR{} -> "Snapshots" - AuthR (LoginR{}) -> "Login" _ -> "" --- How to run database actions. -instance YesodPersist App where - type YesodPersistBackend App = SqlBackend - runDB = defaultRunDB persistConfig connPool -instance YesodPersistRunner App where - getDBRunner = defaultGetDBRunner connPool - -instance YesodAuth App where - type AuthId App = UserId - - -- Where to send a user after successful login - loginDest _ = HomeR - -- Where to send a user after logout - logoutDest _ = HomeR - - redirectToReferer _ = True - - getAuthId creds = do - muid <- maybeAuthId - join $ runDB $ case muid of - Nothing -> do - x <- getBy $ UniqueEmail $ credsIdent creds - case x of - Just (Entity _ email) -> return $ return $ Just $ emailUser email - Nothing -> do - handle' <- getHandle (0 :: Int) - token <- getToken - userid <- insert User - { userHandle = handle' - , userDisplay = credsIdent creds - , userToken = token - } - insert_ Email - { emailEmail = credsIdent creds - , emailUser = userid - } - return $ return $ Just userid - Just uid -> do - memail <- getBy $ UniqueEmail $ credsIdent creds - case memail of - Nothing -> do - insert_ Email - { emailEmail = credsIdent creds - , emailUser = uid - } - return $ do - setMessage $ toHtml $ concat - [ "Email address " - , credsIdent creds - , " added to your account." - ] - redirect ProfileR - Just (Entity _ email) - | emailUser email == uid -> return $ do - setMessage $ toHtml $ concat - [ "The email address " - , credsIdent creds - , " is already part of your account" - ] - redirect ProfileR - | otherwise -> invalidArgs $ return $ concat - [ "The email address " - , credsIdent creds - , " is already associated with a different account." - ] - where - handleBase = takeWhile (/= '@') (credsIdent creds) - getHandle cnt | cnt > 50 = error "Could not get a unique slug" - getHandle cnt = do - slug <- lift $ safeMakeSlug handleBase (cnt > 0) - muser <- getBy $ UniqueHandle slug - case muser of - Nothing -> return slug - Just _ -> getHandle (cnt + 1) - - -- You can add other plugins like BrowserID, email or OAuth here - authPlugins app = - authBrowserId def : google - where - google = - case googleAuth $ appExtra $ settings app of - Nothing -> [] - Just GoogleAuth {..} -> [authGoogleEmail gaClientId gaClientSecret] - - authHttpManager = httpManager -instance YesodAuthPersist App - -getToken :: YesodDB App Slug -getToken = - go (0 :: Int) - where - go cnt | cnt > 50 = error "Could not get a unique token" - go cnt = do - slug <- lift $ randomSlug 25 - muser <- getBy $ UniqueToken slug - case muser of - Nothing -> return slug - Just _ -> go (cnt + 1) - -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. instance RenderMessage App FormMessage where diff --git a/Handler/Email.hs b/Handler/Email.hs deleted file mode 100644 index f2dc73c..0000000 --- a/Handler/Email.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Handler.Email where - -import Import -import Database.Persist.Sql (deleteWhereCount) - -deleteEmailR :: EmailId -> Handler () -deleteEmailR eid = do - Entity uid _ <- requireAuth - cnt <- runDB $ deleteWhereCount [EmailUser ==. uid, EmailId ==. eid] - setMessage $ - if cnt > 0 - then "Email address deleted" - else "No matching email address found" - redirect ProfileR diff --git a/Handler/Package.hs b/Handler/Package.hs index 02b3d2d..547d9b2 100644 --- a/Handler/Package.hs +++ b/Handler/Package.hs @@ -5,10 +5,6 @@ module Handler.Package ( getPackageR , getPackageSnapshotsR - , postPackageLikeR - , postPackageUnlikeR - , postPackageTagR - , postPackageUntagR , packagePage ) where @@ -39,13 +35,6 @@ packagePage mversion pname = do let pname' = toPathPiece pname (deprecated, inFavourOf) <- getDeprecated pname' latests <- getLatests pname' - muid <- maybeAuthId - (nLikes, liked) <- runDB $ do - nLikes <- count [LikePackage ==. pname] - let getLiked uid = (>0) <$> count [LikePackage ==. pname, LikeVoter ==. uid] - liked <- maybe (return False) getLiked muid - - return (nLikes, liked) deps' <- getDeps pname' revdeps' <- getRevDeps pname' Entity _ package <- getPackage pname' >>= maybe notFound return @@ -65,14 +54,6 @@ packagePage mversion pname = do let ixInFavourOf = zip [0::Int ..] inFavourOf displayedVersion = maybe (packageLatest package) (toPathPiece . snd) mversion - myTags <- maybe (return []) (runDB . user'sTagsOf pname) muid - tags <- fmap (map (\(v,count') -> (v,count',any (==v) myTags))) - (runDB (packageTags pname)) - - let likeTitle = if liked - then "You liked this!" - else "I like this!" :: Text - let homepage = case T.strip (packageHomepage package) of x | null x -> Nothing | otherwise -> Just x @@ -94,32 +75,6 @@ packagePage mversion pname = do $(widgetFile "package") where enumerate = zip [0::Int ..] --- | Get tags of the given package. -packageTags :: PackageName -> YesodDB App [(Slug,Int)] -packageTags pn = - fmap (map boilerplate) - (E.select - (E.from (\(t `E.LeftOuterJoin` bt) -> do - E.on $ t E.^. TagTag E.==. bt E.^. BannedTagTag - E.where_ - $ (t ^. TagPackage E.==. E.val pn) E.&&. - (E.isNothing $ E.just $ bt E.^. BannedTagTag) - E.groupBy (t ^. TagTag) - E.orderBy [E.asc (t ^. TagTag)] - return (t ^. TagTag,E.count (t ^. TagTag))))) - where boilerplate (E.Value a,E.Value b) = (a,b) - --- | Get tags of the package by the user. -user'sTagsOf :: PackageName -> UserId -> YesodDB App [Slug] -user'sTagsOf pn uid = - fmap (map (\(E.Value v) -> v)) - (E.select - (E.from (\t -> - do E.where_ (t ^. TagPackage E.==. E.val pn E.&&. - t ^. TagVoter E.==. E.val uid) - E.orderBy [E.asc (t ^. TagTag)] - return (t ^. TagTag)))) - -- | An identifier specified in a package. Because this field has -- quite liberal requirements, we often encounter various forms. A -- name, a name and email, just an email, or maybe nothing at all. @@ -211,47 +166,6 @@ parseChunk chunk = renderEmail :: EmailAddress -> Text renderEmail = T.decodeUtf8 . toByteString -postPackageLikeR :: PackageName -> Handler () -postPackageLikeR packageName = maybeAuthId >>= \muid -> case muid of - Nothing -> return () - Just uid -> runDB $ P.insert_ $ Like packageName uid - -postPackageUnlikeR :: PackageName -> Handler () -postPackageUnlikeR name = maybeAuthId >>= \muid -> case muid of - Nothing -> return () - Just uid -> runDB $ P.deleteWhere [LikePackage ==. name, LikeVoter ==. uid] - -postPackageTagR :: PackageName -> Handler () -postPackageTagR packageName = - maybeAuthId >>= - \muid -> - case muid of - Nothing -> return () - Just uid -> - do mtag <- lookupPostParam "slug" - case mtag of - Just tag -> - do slug <- mkTag tag - void (runDB (P.insert (Tag packageName slug uid))) - Nothing -> error "Need a slug" - -postPackageUntagR :: PackageName -> Handler () -postPackageUntagR packageName = - maybeAuthId >>= - \muid -> - case muid of - Nothing -> return () - Just uid -> - do mtag <- lookupPostParam "slug" - case mtag of - Just tag -> - do slug <- mkTag tag - void (runDB (P.deleteWhere - [TagPackage ==. packageName - ,TagTag ==. slug - ,TagVoter ==. uid])) - Nothing -> error "Need a slug" - getPackageSnapshotsR :: PackageName -> Handler Html getPackageSnapshotsR pn = do snapshots <- getSnapshotsForPackage $ toPathPiece pn diff --git a/Handler/Profile.hs b/Handler/Profile.hs deleted file mode 100644 index c8b8860..0000000 --- a/Handler/Profile.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Handler.Profile where - -import Import -import Data.Slug (slugField) - -userForm :: User -> Form User -userForm user = renderBootstrap2 $ User - <$> areq slugField "User handle" - { fsTooltip = Just "Used for URLs" - } (Just $ userHandle user) - <*> areq textField "Display name" (Just $ userDisplay user) - <*> pure (userToken user) - -getProfileR :: Handler Html -getProfileR = do - Entity uid user <- requireAuth - ((result, userWidget), enctype) <- runFormPost $ userForm user - case result of - FormSuccess user' -> do - runDB $ replace uid user' - setMessage "Profile updated" - redirect ProfileR - _ -> return () - emails <- runDB $ selectList [EmailUser ==. uid] [Asc EmailEmail] - defaultLayout $ do - setTitle "Your Profile" - $(widgetFile "profile") - -putProfileR :: Handler Html -putProfileR = getProfileR diff --git a/Handler/ResetToken.hs b/Handler/ResetToken.hs deleted file mode 100644 index babaf99..0000000 --- a/Handler/ResetToken.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Handler.ResetToken where - -import Import - -postResetTokenR :: Handler () -postResetTokenR = do - Entity uid _ <- requireAuth - runDB $ do - token <- getToken - update uid [UserToken =. token] - setMessage "Token updated" - redirect ProfileR diff --git a/Handler/Sitemap.hs b/Handler/Sitemap.hs index 9cba7ca..f0bc020 100644 --- a/Handler/Sitemap.hs +++ b/Handler/Sitemap.hs @@ -20,23 +20,21 @@ getSitemapR = sitemap $ do priority 0.7 $ AllSnapshotsR priority 0.7 $ PackageListR - priority 0.6 $ TagListR priority 0.6 $ AuthorsR priority 0.6 $ InstallR priority 0.6 $ OlderReleasesR +{- FIXME runDBSource $ do --selectAll $= ltsSitemaps return () $= snapshotSitemaps -- FIXME return () $= packageMetadataSitemaps -- FIXME - selectAll $= tagSitemaps selectAll :: (PersistEntity val, PersistEntityBackend val ~ YesodPersistBackend App) => Source (YesodDB App) val selectAll = selectSource [] [] $= CL.map entityVal -{- FIXME clNub :: (Monad m, Eq a) => Conduit a m a clNub = evalStateC [] $ awaitForever $ \a -> do seen <- State.get @@ -83,11 +81,6 @@ packageMetadataSitemaps = awaitForever go where url' floc = url $ floc $ PackageName $ packageName m -tagSitemaps :: SitemapFor Tag -tagSitemaps = awaitForever go - where - go t = url $ TagR $ tagTag t - priority :: Double -> Route App -> Sitemap priority p loc = yield $ SitemapUrl diff --git a/Handler/Tag.hs b/Handler/Tag.hs deleted file mode 100644 index 30446df..0000000 --- a/Handler/Tag.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Handler.Tag where - -import qualified Database.Esqueleto as E -import Data.Slug (Slug, unSlug) -import Import -import Stackage.Database - -getTagListR :: Handler Html -getTagListR = do - tags <- fmap (zip [0::Int ..] . (map (\(E.Value v,E.Value i) -> (v,i::Int)))) $ runDB $ - E.select $ E.from $ \(tag `E.LeftOuterJoin` bt) -> do - E.groupBy (tag E.^. TagTag) - E.orderBy [E.desc (E.count (tag E.^. TagTag) :: E.SqlExpr (E.Value Int))] - E.on $ tag E.^. TagTag E.==. bt E.^. BannedTagTag - E.where_ $ E.isNothing $ E.just $ bt E.^. BannedTagTag - return (tag E.^. TagTag, E.count (tag E.^. TagTag)) - defaultLayout $ do - setTitle "Stackage tags" - $(widgetFile "tag-list") - -getTagR :: Slug -> Handler Html -getTagR tagSlug = do - -- FIXME arguably: check if this tag is banned. Leaving it as displayed for - -- now, since someone needs to go out of their way to find it. - packages' <- runDB $ E.select $ E.from $ \tag -> do - E.groupBy (tag E.^. TagPackage) - E.where_ $ tag E.^. TagTag E.==. E.val tagSlug - E.orderBy [E.asc $ tag E.^. TagPackage] - return $ tag E.^. TagPackage - packages <- fmap catMaybes $ forM packages' $ \(E.Value pname) -> do - mp <- getPackage $ toPathPiece pname - return $ case mp of - Nothing -> Nothing - Just (Entity _ p) -> Just (pname, strip $ packageSynopsis p) - let tag = unSlug tagSlug - defaultLayout $ do - setTitle $ "Stackage tag" - $(widgetFile "tag") - where strip x = fromMaybe x (stripSuffix "." x) diff --git a/Import.hs b/Import.hs index db9fcdd..22a8e1a 100644 --- a/Import.hs +++ b/Import.hs @@ -4,7 +4,6 @@ module Import import ClassyPrelude.Yesod as Import import Foundation as Import -import Model as Import import Settings as Import import Settings.Development as Import import Settings.StaticFiles as Import @@ -15,20 +14,6 @@ import Data.WebsiteContent as Import (WebsiteContent (..)) import Data.Text.Read (decimal) import Stackage.Database (SnapName) -requireAuthIdOrToken :: Handler UserId -requireAuthIdOrToken = do - mtoken <- lookupHeader "authorization" - case decodeUtf8 <$> mtoken of - Nothing -> requireAuthId - Just token -> do - case mkSlug token of - Nothing -> invalidArgs ["Invalid token: " ++ token] - Just token' -> do - muser <- runDB $ getBy $ UniqueToken token' - case muser of - Nothing -> invalidArgs ["Unknown token: " ++ token] - Just (Entity uid _) -> return uid - parseLtsPair :: Text -> Maybe (Int, Int) parseLtsPair t1 = do (x, t2) <- either (const Nothing) Just $ decimal t1 diff --git a/Model.hs b/Model.hs deleted file mode 100644 index 778f791..0000000 --- a/Model.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Model where - -import ClassyPrelude.Yesod -import Database.Persist.Quasi -import Data.Slug (Slug) -import Types - --- You can define all of your database entities in the entities file. --- You can find more information on persistent and how to declare entities --- at: --- http://www.yesodweb.com/book/persistent/ -share [mkPersist sqlSettings, mkMigrate "migrateAll"] - $(persistFileWith lowerCaseSettings "config/models") diff --git a/Settings.hs b/Settings.hs index 8d3b83e..f5e89e3 100644 --- a/Settings.hs +++ b/Settings.hs @@ -8,17 +8,11 @@ module Settings where import ClassyPrelude.Yesod import Text.Shakespeare.Text (st) import Language.Haskell.TH.Syntax -import Database.Persist.Postgresql (PostgresConf) import Yesod.Default.Config import Yesod.Default.Util import Data.Yaml import Settings.Development import Text.Hamlet -import Data.Aeson (withText, withObject) -import Types - --- | Which Persistent backend this site is using. -type PersistConf = PostgresConf -- Static setting below. Changing these requires a recompile @@ -65,45 +59,7 @@ widgetFile = (if development then widgetFileReload widgetFileSettings data Extra = Extra - { storeConfig :: !BlobStoreConfig - , hackageRoot :: !HackageRoot - , adminUsers :: !(HashSet Text) - , googleAuth :: !(Maybe GoogleAuth) - } deriving Show parseExtra :: DefaultEnv -> Object -> Parser Extra -parseExtra _ o = Extra - <$> o .: "blob-store" - <*> (HackageRoot <$> o .: "hackage-root") - <*> o .:? "admin-users" .!= mempty - <*> o .:? "google-auth" - -data BlobStoreConfig = BSCFile !FilePath - | BSCAWS !FilePath !Text !Text !Text !Text - deriving Show - -instance FromJSON BlobStoreConfig where - parseJSON v = file v <|> aws v - where - file = withText "BlobStoreConfig" $ \t -> - case () of - () - | Just root <- stripPrefix "file:" t -> return $ BSCFile $ fpFromText root - | otherwise -> fail $ "Invalid BlobStoreConfig: " ++ show t - aws = withObject "BlobStoreConfig" $ \o -> BSCAWS - <$> (fpFromText <$> (o .: "local")) - <*> o .: "access" - <*> o .: "secret" - <*> o .: "bucket" - <*> o .:? "prefix" .!= "" - -data GoogleAuth = GoogleAuth - { gaClientId :: !Text - , gaClientSecret :: !Text - } - deriving Show -instance FromJSON GoogleAuth where - parseJSON = withObject "GoogleAuth" $ \o -> GoogleAuth - <$> o .: "client-id" - <*> o .: "client-secret" +parseExtra _ _ = pure Extra diff --git a/Types.hs b/Types.hs index f770c56..f166a5b 100644 --- a/Types.hs +++ b/Types.hs @@ -64,14 +64,6 @@ newtype HoogleVersion = HoogleVersion Text currentHoogleVersion :: HoogleVersion currentHoogleVersion = HoogleVersion VERSION_hoogle -newtype HackageRoot = HackageRoot { unHackageRoot :: Text } - deriving (Show, Read, Typeable, Eq, Ord, Hashable, PathPiece, ToMarkup) - -class HasHackageRoot a where - getHackageRoot :: a -> HackageRoot -instance HasHackageRoot HackageRoot where - getHackageRoot = id - data UnpackStatus = USReady | USBusy | USFailed !Text diff --git a/config/models b/config/models deleted file mode 100644 index 206c1f6..0000000 --- a/config/models +++ /dev/null @@ -1,35 +0,0 @@ -User - handle Slug - display Text - token Slug - UniqueHandle handle - UniqueToken token - deriving Typeable - -Email - email Text - user UserId - UniqueEmail email - -Verkey - email Text - verkey Text - -Tag - package PackageName - tag Slug - voter UserId - UniqueTagPackageVoter package tag voter - -Like - package PackageName - voter UserId - UniqueLikePackageVoter package voter - -BannedTag - tag Slug - UniqueBannedTag tag - -Migration - num Int - UniqueMigration num diff --git a/config/postgresql.yml-sample b/config/postgresql.yml-sample deleted file mode 100644 index 7b009ed..0000000 --- a/config/postgresql.yml-sample +++ /dev/null @@ -1,24 +0,0 @@ -Default: &defaults - user: stackage_server - password: stackage-server - host: localhost - port: 5432 - database: stackage_server - poolsize: 10 - -Development: - <<: *defaults - -Testing: - database: stackage_server_test - <<: *defaults - -Staging: - database: stackage_server_staging - poolsize: 100 - <<: *defaults - -Production: - database: stackage_server_production - poolsize: 100 - <<: *defaults diff --git a/config/routes b/config/routes index ba04e4a..65fd9b5 100644 --- a/config/routes +++ b/config/routes @@ -1,7 +1,6 @@ !/#LtsMajor/*Texts OldLtsMajorR GET /static StaticR Static getStatic -/auth AuthR Auth getAuth /reload WebsiteContentR GitRepo-WebsiteContent websiteContent /favicon.ico FaviconR GET @@ -10,9 +9,6 @@ / HomeR GET /snapshots AllSnapshotsR GET -/profile ProfileR GET PUT -/email/#EmailId EmailR DELETE -/reset-token ResetTokenR POST /snapshot/#Text/*Texts OldSnapshotR GET @@ -33,13 +29,6 @@ /package/#PackageName PackageR GET /package/#PackageName/snapshots PackageSnapshotsR GET /package PackageListR GET -/package/#PackageName/like PackageLikeR POST -/package/#PackageName/unlike PackageUnlikeR POST -/package/#PackageName/tag PackageTagR POST -/package/#PackageName/untag PackageUntagR POST -/tags TagListR GET -/tag/#Slug TagR GET -/banned-tags BannedTagsR GET PUT /lts/*Texts OldLtsR GET /nightly/*Texts OldNightlyR GET diff --git a/stackage-server.cabal b/stackage-server.cabal index 656c7a1..3df2634 100644 --- a/stackage-server.cabal +++ b/stackage-server.cabal @@ -15,7 +15,6 @@ library exposed-modules: Application Foundation Import - Model Echo Settings Settings.StaticFiles @@ -34,9 +33,6 @@ library Handler.Home Handler.Snapshots - Handler.Profile - Handler.Email - Handler.ResetToken Handler.StackageHome Handler.StackageIndex Handler.StackageSdist @@ -45,8 +41,6 @@ library Handler.Hoogle Handler.Package Handler.PackageList - Handler.Tag - Handler.BannedTags Handler.BuildVersion Handler.Sitemap Handler.BuildPlan @@ -119,7 +113,6 @@ library , mtl >= 2.1 , mwc-random >= 0.13 , persistent >= 1.3.1 - , persistent-postgresql >= 1.3 , persistent-template >= 1.3 , resourcet >= 1.1.2 , shakespeare >= 2.0 diff --git a/templates/banned-tags.hamlet b/templates/banned-tags.hamlet deleted file mode 100644 index e16c72e..0000000 --- a/templates/banned-tags.hamlet +++ /dev/null @@ -1,6 +0,0 @@ -
-

Banned Tags - List of viewable tags -
- ^{widget} -