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

More sanity in docmap uploading

Browse Source
This commit is contained in:
Michael Snoyman 2014-12-18 10:24:19 +02:00
parent bc147c85e2
commit 3ee2110602
1 changed files with 9 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Handler/Haddock.hs
View File

@ -314,8 +314,15 @@ getUploadDocMapR = do
<*> areq textField "Stackage ID" { fsName = Just "snapshot" } Nothing <*> areq textField "Stackage ID" { fsName = Just "snapshot" } Nothing
case res of case res of
FormSuccess (fi, snapshot) -> do FormSuccess (fi, snapshot) -> do
Entity _sid stackage <- Entity _sid stackage <- runDB $ do
runDB $ getBy404 $ UniqueStackage $ PackageSetIdent snapshot ment <- getBy $ UniqueStackage $ PackageSetIdent snapshot
case ment of
Just ent -> return ent
Nothing -> do
slug <- maybe notFound return $ fromPathPiece snapshot
getBy404 $ UniqueSnapshot slug
unless (stackageHasHaddocks stackage) $ invalidArgs $ return
"Cannot use a snapshot without docs for a docmap"
bs <- fileSource fi $$ foldC bs <- fileSource fi $$ foldC
case Y.decodeEither bs of case Y.decodeEither bs of
Left e -> invalidArgs [pack e] Left e -> invalidArgs [pack e]