From 3ee2110602f4ff8c188f2ea68cf58773b89d54eb Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 18 Dec 2014 10:24:19 +0200
Subject: [PATCH] More sanity in docmap uploading

---
 Handler/Haddock.hs | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/Handler/Haddock.hs b/Handler/Haddock.hs
index f1e52f4..0eaa82d 100644
--- a/Handler/Haddock.hs
+++ b/Handler/Haddock.hs
@@ -314,8 +314,15 @@ getUploadDocMapR = do
         <*> areq textField "Stackage ID" { fsName = Just "snapshot" } Nothing
     case res of
         FormSuccess (fi, snapshot) -> do
-            Entity _sid stackage <-
-                runDB $ getBy404 $ UniqueStackage $ PackageSetIdent snapshot
+            Entity _sid stackage <- runDB $ do
+                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
             case Y.decodeEither bs of
                 Left e -> invalidArgs [pack e]