Give a bit more information on upload progress

This commit is contained in:
Michael Snoyman 2014-12-24 09:14:59 +02:00
parent ff41a4f8d5
commit 3982eee037

View File

@ -67,7 +67,10 @@ uploadBundle UploadBundle {..} man = do
}
res <- httpLbs req3 man
case lookup "x-stackage-ident" $ responseHeaders res of
Just snapid -> return $ SnapshotIdent $ decodeUtf8 snapid
Just snapid -> do
forM_ (lookup "location" $ responseHeaders res) $ \loc ->
putStrLn $ "Check upload progress at: " ++ decodeUtf8 loc
return $ SnapshotIdent $ decodeUtf8 snapid
Nothing -> error $ "An error occurred: " ++ show res
where
params = mapMaybe (\(x, y) -> (x, ) <$> y)