Working!

Application.hs

@@ -33,8 +33,10 @@ import Handler.Home
 import Handler.Profile
 import Handler.Email
 import Handler.ResetToken
-import Handler.HackageSdist
 import Handler.UploadStackage
+import Handler.StackageHome
+import Handler.StackageIndex
+import Handler.StackageSdist
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

Handler/Home.hs

@@ -2,6 +2,7 @@
 module Handler.Home where
 
 import Import
+import qualified Database.Esqueleto as E
 
 -- This is a handler function for the GET request method on the HomeR
 -- resource pattern. All of your resource patterns are defined in
@@ -12,6 +13,16 @@ import Import
 -- inclined, or create a single monolithic file.
 getHomeR :: Handler Html
 getHomeR = do
+    stackages <- runDB $ E.select $ E.from $ \(stackage `E.InnerJoin` user) -> do
+        E.on (stackage E.^. StackageUser E.==. user E.^. UserId)
+        E.orderBy [E.desc $ stackage E.^. StackageUploaded]
+        return
+            ( stackage E.^. StackageIdent
+            , stackage E.^. StackageTitle
+            , stackage E.^. StackageUploaded
+            , user E.^. UserDisplay
+            , user E.^. UserHandle
+            )
     defaultLayout $ do
         setTitle "Stackage Server"
         $(widgetFile "homepage")

Handler/StackageHome.hs

@@ -0,0 +1,13 @@
+module Handler.StackageHome where
+
+import Import
+
+getStackageHomeR :: PackageSetIdent -> Handler Html
+getStackageHomeR ident = do
+    (stackage, user) <- runDB $ do
+        Entity _ stackage <- getBy404 $ UniqueStackage ident
+        user <- get404 $ stackageUser stackage
+        return (stackage, user)
+    defaultLayout $ do
+        setTitle $ toHtml $ stackageTitle stackage
+        $(widgetFile "stackage-home")

Handler/StackageIndex.hs

@@ -0,0 +1,13 @@
+module Handler.StackageIndex where
+
+import Import
+import Data.BlobStore
+
+getStackageIndexR :: PackageSetIdent -> Handler TypedContent
+getStackageIndexR ident = do
+    msrc <- storeRead $ CabalIndex ident
+    case msrc of
+        Nothing -> notFound
+        Just src -> do
+            addHeader "content-disposition" "attachment; filename=\"00-index.tar.gz\""
+            respondSource "application/x-gzip" $ mapOutput (Chunk . toBuilder) src

Handler/StackageSdist.hs

@@ -1,11 +1,15 @@
-module Handler.HackageSdist where
+module Handler.StackageSdist where
 
 import Import
-import Data.Hackage
+import Data.BlobStore
 
-getHackageSdistR :: PackageName -> Version -> Handler TypedContent
+getStackageSdistR :: PackageSetIdent -> PackageNameVersion -> Handler TypedContent
-getHackageSdistR name version = do
+getStackageSdistR ident (PackageNameVersion name version) = do
-    msrc <- sourceHackageSdist name version
+    msrc1 <- storeRead (CustomSdist ident name version)
+    msrc <-
+        case msrc1 of
+            Just src -> return $ Just src
+            Nothing -> storeRead $ HackageSdist name version
     case msrc of
         Nothing -> notFound
         Just src -> do

Handler/UploadStackage.hs

@@ -66,7 +66,8 @@ putUploadStackageR = do
                 let indexLBS = GZip.compress $ Tar.write entries
                 sourceLazy indexLBS $$ storeWrite (CabalIndex ident)
                 runDB $ insert stackage
-                sendResponseCreated HomeR -- FIXME $ StackageR ident
+                setMessage "Stackage created"
+                redirect $ StackageHomeR ident
   where
     loop Tar.Done = return ()
     loop (Tar.Fail e) = throwM e

Types.hs

@@ -4,6 +4,7 @@ import ClassyPrelude.Yesod
 import Data.BlobStore (ToPath (..))
 import Text.Blaze (ToMarkup)
 import Database.Persist.Sql (PersistFieldSql)
+import qualified Data.Text as T
 
 newtype PackageName = PackageName { unPackageName :: Text }
     deriving (Show, Read, Typeable, Eq, Ord, Hashable, PathPiece, ToMarkup)
@@ -12,6 +13,18 @@ newtype Version = Version { unVersion :: Text }
 newtype PackageSetIdent = PackageSetIdent { unPackageSetIdent :: Text }
     deriving (Show, Read, Typeable, Eq, Ord, Hashable, PathPiece, ToMarkup, PersistField, PersistFieldSql)
 
+data PackageNameVersion = PackageNameVersion !PackageName !Version
+    deriving (Show, Read, Typeable, Eq, Ord)
+
+instance PathPiece PackageNameVersion where
+    toPathPiece (PackageNameVersion x y) = concat [toPathPiece x, "-", toPathPiece y]
+    fromPathPiece t' | Just t <- stripSuffix ".tar.gz" t' =
+        case T.breakOnEnd "-" t of
+            ("", _) -> Nothing
+            (_, "") -> Nothing
+            (T.init -> name, version) -> Just $ PackageNameVersion (PackageName name) (Version version)
+    fromPathPiece _ = Nothing
+
 data StoreKey = HackageCabal !PackageName !Version
               | HackageSdist !PackageName !Version
               | CabalIndex !PackageSetIdent

config/routes

@@ -8,5 +8,7 @@
 /profile ProfileR GET PUT
 /email/#EmailId EmailR DELETE
 /reset-token ResetTokenR POST
-/hackage/#PackageName/#Version HackageSdistR GET
 /upload UploadStackageR GET PUT
+/stackage/#PackageSetIdent StackageHomeR GET
+/stackage/#PackageSetIdent/00-index.tar.gz StackageIndexR GET
+/stackage/#PackageSetIdent/package/#PackageNameVersion StackageSdistR GET

stackage-server.cabal

@@ -27,8 +27,10 @@ library
                      Handler.Profile
                      Handler.Email
                      Handler.ResetToken
-                     Handler.HackageSdist
                      Handler.UploadStackage
+                     Handler.StackageHome
+                     Handler.StackageIndex
+                     Handler.StackageSdist
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT
@@ -101,6 +103,7 @@ library
                  , cryptohash
                  , base64-bytestring
                  , zlib
+                 , esqueleto
 
 executable         stackage-server
     if flag(library-only)

templates/homepage.hamlet

@@ -1,6 +1,11 @@
 <h2>Browse stackages
 
-FIXME!
+<ul>
+    $forall (E.Value ident, E.Value title, E.Value uploaded, E.Value display, E.Value handle) <- stackages
+        <li>
+            <a href=@{StackageHomeR ident}>
+                #{title}
+                <i>by #{display} (#{handle}) on #{show uploaded}
 
 <h2>Upload
 

templates/stackage-home.hamlet

@@ -0,0 +1,8 @@
+<hgroup>
+    <h1>#{stackageTitle stackage}
+    <h2>Uploaded by #{userDisplay user} (#{userHandle user}) on #{tshow $ stackageUploaded stackage}
+<p>#{stackageDesc stackage}
+<hr>
+<p>To use, add a line like the following to ~/.cabal/config:
+
+<pre>remote-repo: stackage:@{StackageHomeR ident}