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

DocsOnS3 table

Browse Source
This commit is contained in:
Michael Snoyman 2015-05-11 12:34:20 +03:00
parent 0992779e82
commit 06c5059392
2 changed files with 9 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Handler/Haddock.hs
View File

@ -68,6 +68,11 @@ putUploadHaddockR = getUploadHaddockR
getHaddockR :: SnapSlug -> [Text] -> Handler () getHaddockR :: SnapSlug -> [Text] -> Handler ()
getHaddockR slug rest = do getHaddockR slug rest = do
stackageEnt <- runDB $ do stackageEnt <- runDB $ do
onS3 <- fmap isJust $ getBy $ UniqueDocsOnS3 slug
when onS3 $ redirect $ concat
$ "http://haddock.stackage.org/"
: toPathPiece slug
: map (cons '/') rest
ment <- getBy $ UniqueSnapshot slug ment <- getBy $ UniqueSnapshot slug
case ment of case ment of
Just ent -> do Just ent -> do

4
config/models
View File

@ -15,6 +15,10 @@ Verkey
email Text email Text
verkey Text verkey Text
DocsOnS3
slug SnapSlug
UniqueDocsOnS3 slug
Stackage Stackage
user UserId user UserId
ident PackageSetIdent ident PackageSetIdent