haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-02-11 02:27:28 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Fix upload-haddock to work with old-style PackageSetIdents

Browse Source
This commit is contained in:
Michael Snoyman 2014-11-25 10:36:12 +02:00
parent e7e009e79c
commit d111115b9c
4 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Handler/Haddock.hs
View File

@ -23,15 +23,17 @@ form = renderDivs $ areq fileField "tarball containing docs"
{ fsName = Just "tarball" { fsName = Just "tarball"
} Nothing } Nothing
getUploadHaddockR, putUploadHaddockR :: SnapSlug -> Handler Html getUploadHaddockR, putUploadHaddockR :: Text -> Handler Html
getUploadHaddockR slug0 = do getUploadHaddockR slug0 = do
uid <- requireAuthIdOrToken uid <- requireAuthIdOrToken
Entity sid Stackage {..} <- runDB $ do Entity sid Stackage {..} <- runDB $ do
-- Provide fallback for old URLs -- Provide fallback for old URLs
ment <- getBy $ UniqueSnapshot slug0 ment <- getBy $ UniqueStackage $ PackageSetIdent slug0
case ment of case ment of
Just ent -> return ent Just ent -> return ent
Nothing -> getBy404 $ UniqueStackage $ PackageSetIdent $ toPathPiece slug0 Nothing -> do
slug <- maybe notFound return $ fromPathPiece slug0
getBy404 $ UniqueSnapshot slug
let ident = stackageIdent let ident = stackageIdent
slug = stackageSlug slug = stackageSlug
unless (uid == stackageUser) $ permissionDenied "You do not control this snapshot" unless (uid == stackageUser) $ permissionDenied "You do not control this snapshot"

2
config/routes
View File

@ -10,7 +10,7 @@
/email/#EmailId EmailR DELETE /email/#EmailId EmailR DELETE
/reset-token ResetTokenR POST /reset-token ResetTokenR POST
/upload UploadStackageR GET PUT /upload UploadStackageR GET PUT
/upload-haddock/#SnapSlug UploadHaddockR GET PUT /upload-haddock/#Text UploadHaddockR GET PUT
/stackage/#PackageSetIdent/*Texts OldStackageR GET /stackage/#PackageSetIdent/*Texts OldStackageR GET

2
templates/stackage-home.hamlet
View File

@ -24,7 +24,7 @@ $newline never
$if isOwner $if isOwner
<p> <p>
You are the owner of this snapshot. You can # You are the owner of this snapshot. You can #
<a href=@{UploadHaddockR slug}>upload haddocks# <a href=@{UploadHaddockR $ toPathPiece slug}>upload haddocks#
. .
<p> <p>
<pre> <pre>

2
templates/upload-haddock.hamlet
View File

@ -7,7 +7,7 @@
$if stackageHasHaddocks $if stackageHasHaddocks
<div .alert .alert-warning>You have already uploaded Haddocks. Uploading against will delete the old contents. <div .alert .alert-warning>You have already uploaded Haddocks. Uploading against will delete the old contents.
<form method=POST action=@{UploadHaddockR slug}?_method=PUT enctype=#{enctype}> <form method=POST action=@{UploadHaddockR $ toPathPiece slug}?_method=PUT enctype=#{enctype}>
^{widget} ^{widget}
<div> <div>
<button .btn>Upload <button .btn>Upload