Merge pull request #121 from fpco/no-database

Remove all social features

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

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

Handler/Email.hs

@@ -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

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

Handler/Profile.hs

@@ -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

Handler/ResetToken.hs

@@ -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

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

Handler/Tag.hs

@@ -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)

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

Model.hs

@@ -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")

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
+parseExtra _ _ = pure 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"

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

config/models

@@ -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

config/postgresql.yml-sample

@@ -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

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

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

templates/banned-tags.hamlet

@@ -1,6 +0,0 @@
-<div .container>
-    <h1>Banned Tags
-    <a href=@{TagListR}>List of viewable tags
-    <form method=post action=@{BannedTagsR}?_method=PUT enctype=#{enctype}>
-        ^{widget}
-        <button .btn>Update banned tags

templates/banned-tags.lucius

@@ -1,4 +0,0 @@
-textarea {
-    width: 500px;
-    height: 400px;
-}

templates/default-layout.hamlet

@@ -20,32 +20,16 @@
             $nothing
               <li>
                   <a href=@{route}>#{route}
-          $maybe Entity _ user <- muser
-              <li>
-                  <a href=@{ProfileR} .user-handle>
-                      #{userDisplay user} (#{userHandle user})
-              <li>
-                <a href=@{AuthR LogoutR}>Logout
-          $nothing
-              <li>
-                <a href=@{AuthR LoginR}>Login
 
 $maybe msg <- mmsg
     <div .container>
         <div .alert .alter-info>#{msg}
 
-$case cur
+$if insideContainer
-  $of Just (AuthR _)
+  <div .container>
-      <div .container>
+    ^{widget}
-          <h1>Authorization
+$else
-          <p>Please login with an authorization method below:
+  ^{widget}
-          ^{widget}
-  $of _
-    $if insideContainer
-      <div .container>
-        ^{widget}
-    $else
-      ^{widget}
 
 <div .footer>
   <div .container>

templates/package.hamlet

@@ -39,33 +39,6 @@ $newline never
 
     <div .row>
         <div .span12>
-            <div .social>
-                <span .likes>
-                    <span #likes>
-                        #{nLikes}
-                    <span #like-or-likes>
-                        \ #{format (plural "like" "likes") nLikes} #
-                    <i .fa :liked:.fa-thumbs-up :not liked:.fa-thumbs-o-up #like title="#{likeTitle}">
-                <span .tags>
-                    $if null tags
-                        <span .no-tags>
-                            No tags yet. #
-                    $forall (tag,count,tagged) <- tags
-                        <span .tag>
-                            <a href=@{TagR tag} .tag-name>
-                                #{tag} #
-                            <a .tag-count .tag-toggle data-slug=#{tag} :tagged:.tagged title="Add/remove vote for: #{tag}">
-                                #{count}
-                            , #
-                    <i #add-tag class="fa fa-plus-square" title="Show/hide tag form">
-                    <form #add-tag-form .hidden>
-                        <p>
-                            <strong>Add tag
-                        <div .input-append>
-                            <input type="text" id="new-tag">
-                            <input type="submit" .btn #add-form-btn value="Confirm">
-                        <p #tag-msg .alert .alert-error style="display:none">
-
             <div .authorship>
                 <span .license>
                     <a href="">

templates/package.julius

@@ -1,151 +0,0 @@
-$(function(){
-  var loggedIn = $('.user-handle').length > 0;
-  var tags = Object.create(null);
-
-  function toggleClick(){
-    if (!loggedIn) {
-      login();
-      return false;
-    }
-
-    var $this = $(this);
-    var normalized = $this.data('slug');
-    var upvote = !$this.hasClass('tagged');
-    $this.text($this.text() * 1 + (upvote? 1 : -1));
-    $this.toggleClass('tagged');
-    if (upvote)
-      $.ajax({
-        method: 'POST',
-        url: '@{PackageTagR pn}',
-        data: {slug:normalized}
-      });
-    else
-      $.ajax({
-        method: 'POST',
-        url: '@{PackageUntagR pn}',
-        data: {slug:normalized}
-      });
-  }
-
-
-  $('.tags').find('.tag').each(function(){
-    tags[$(this).find('.tag-name').text()] = true;
-  });
-  $('.expanding').each(function(){
-    var $this = $(this);
-    if ($this.height() > 300) {
-      $this.addClass('collapsed');
-      $this.find('.bottom-gradient').click(function(){
-        $this.removeClass('collapsed');
-      });
-    }
-  });
-  $('#like').click(function(){
-    var $this = $(this);
-
-    if (loggedIn) {
-      var action = 'like';
-      if ($this.hasClass('fa-thumbs-up')) {
-        action = 'unlike';
-      }
-
-      $this.toggleClass('fa-thumbs-up');
-      $this.toggleClass('fa-thumbs-o-up');
-
-      $likes = $('#likes');
-      nLikes = parseInt($likes.text(), 10);
-
-      if (action == 'like') {
-        $this.attr('title','You liked this!');
-        nLikes += 1;
-        $.post("@{PackageLikeR pn}");
-      } else {
-        $this.attr('title','You disliked this.');
-        nLikes -= 1;
-        $.post("@{PackageUnlikeR pn}");
-      }
-
-      $likes.text(nLikes);
-      $('#like-or-likes').text(nLikes == 1 ? ' like ' : ' likes ');
-
-    } else {
-      login();
-    }
-  });
-  $('.tag-toggle').click(toggleClick);
-  $('#add-tag').click(function(){
-    if (!loggedIn) login();
-    $('#add-tag-form').toggleClass('hidden');
-    $('#new-tag').focus();
-  });
-  $('#new-tag').change(function(){
-    $('#add-form-btn').val('Confirm');
-    $('#tag-msg').hide();
-  });
-  $('#new-tag').keypress(function(){
-    $('#add-form-btn').val('Confirm');
-  });
-  $('#add-tag-form').submit(function(){
-    try {
-      var candidate = $('#new-tag').val();
-      var normalized = candidate
-        .replace(/[^a-zA-Z0-9-.]/g,'-')
-        .replace(/-+/g,'-')
-        .replace(/^-/,'')
-        .replace(/-$/,'')
-        .toLowerCase();
-      if (candidate !== normalized) {
-        $('#new-tag').val(normalized);
-        $('#add-form-btn').val('Done');
-      } else {
-        $.ajax({
-          method: 'POST',
-          url: '@{PackageTagR pn}',
-          data: {slug:normalized},
-          success: function(){
-
-            $('.no-tags').remove();
-
-            $('#new-tag').val('');
-            $('#add-form-btn').val('Confirm');
-
-            if (!tags[normalized]) {
-              var tag = $('<span><a></a></span>');
-              tag.find('a').text(normalized + ' ').attr('href','/tag/' + normalized);
-              $('.tags').prepend(', ');
-              var count = $('<a>1</a>')
-                .addClass('tag-count')
-                .addClass('tag-toggle')
-                .addClass('tagged')
-                .data('slug',normalized)
-                .attr('title','Add/remove vote for: ' + normalized)
-                .click(toggleClick);
-              $('.tags').prepend(count);
-              $('.tags').prepend(tag);
-            }
-
-            tags[normalized] = true;
-          },
-          error: function(err){
-            $('#tag-msg').text("Couldn't add that tag").show();
-          }
-        });
-      }
-    } finally {
-      return false;
-    }
-  });
-});
-
-// Workaround for missing functionality in IE 8 and earlier.
-if( Object.create === undefined ) {
-  Object.create = function( o ) {
-    function F(){}
-    F.prototype = o;
-    return new F();
-  };
-}
-
-function login(){
-  window.location.href = '@{AuthR LoginR}';
-}

templates/profile.hamlet

@@ -1,33 +0,0 @@
-<div .container>
-    <h1>
-        Profile
-    <div .row>
-        <div .span12>
-            <h2>Email addresses
-            $if length emails <= 1
-                $forall Entity _ email <- emails
-                    <p>#{emailEmail email}
-            $else
-                <ul>
-                    $forall Entity eid email <- emails
-                        <li .email>
-                            #{emailEmail email}
-                            <form method=post action=@{EmailR eid}?_method=DELETE>
-                                <button .btn>Remove
-
-            <p>
-                <a href=@{AuthR LoginR}>Add another email address.
-
-            <h2>Profile
-
-            <form method=post action=@{ProfileR}?_method=PUT enctype=#{enctype} role=form>
-                <div .form-group>
-                    ^{userWidget}
-                <button .btn>Update
-
-            <h2>Security token
-
-            <p>
-                Your security token is #{userToken user}.
-                <form method=post action=@{ResetTokenR}>
-                    <button>Reset token

templates/profile.lucius

@@ -1,13 +0,0 @@
-.email > form {
-    display: inline-block;
-}
-
-#aliases {
-    display: block;
-    width: 400px;
-    height: 200px;
-}
-
-h2 {
-  font-size: 30px !important;
-}

templates/tag-list.hamlet

@@ -1,11 +0,0 @@
-$newline never
-<div .container>
-    <h1>Tags
-    <p .tags>
-        $forall (i,(tag,count)) <- tags
-            $if i /= 0
-                , #
-            <span .tag>
-                <a href=@{TagR tag}>
-                    #{tag} #
-            <span .count>(#{count})

templates/tag-list.lucius

@@ -1,16 +0,0 @@
-.tags > li {
-  list-style-type: none;
-}
-
-.tags {
-  margin: 1em 0 0 0;
-  padding: 0;
-}
-
-h1 {
-  margin-bottom: 0.5em;
-}
-
-.count {
-  color: #666;
-}

templates/tag.hamlet

@@ -1,21 +0,0 @@
-$newline never
-
-<div .container>
-    <h1>
-        Tag: #{tag} (
-        <a href=@{TagListR}>
-            all tags
-        )
-    <div .packages>
-        <table .table>
-            <thead>
-                <th>Package
-                <th>Synopsis
-            <tbody>
-                $forall (name,synopsis) <- packages
-                    <tr>
-                        <td>
-                            <a href=@{PackageR name}>
-                                #{name}
-                        <td>
-                            #{synopsis}

templates/tag.lucius

@@ -1,12 +0,0 @@
-.packages > li {
-  list-style-type: none;
-}
-
-.packages {
-  margin: 1em 0 0 0;
-  padding: 0;
-}
-
-h1 {
-  margin-bottom: 0.5em;
-}