git.iko.soy/stackage
on master help sign in
More correct progress tracking
be3221fMichael Snoyman
ChangeLog.md+4
compare with master
unifiedsplit
@@ -1,3 +1,7 @@
1+## 0.3.0.0
2+
3+* Return progress URL from uploadBundle
4+
1## 0.2.1.4
5## 0.2.1.4
2
6
3Generate a `core` file in bundles.
7Generate a `core` file in bundles.
Stackage/CompleteBuild.hs+3−1
@@ -157,11 +157,13 @@ completeBuild buildType = withManager tlsManagerSettings $ \man -> do
157 token <- readFile "/auth-token"
157 token <- readFile "/auth-token"
158 now <- epochTime
158 now <- epochTime
159 let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
159 let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
160− ident <- flip uploadBundle man $ setArgs ghcVer def
160+ (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def
161 { ubContents = serverBundle now (title ghcVer) slug plan
161 { ubContents = serverBundle now (title ghcVer) slug plan
162 , ubAuthToken = decodeUtf8 token
162 , ubAuthToken = decodeUtf8 token
163 }
163 }
164 putStrLn $ "New ident: " ++ unSnapshotIdent ident
164 putStrLn $ "New ident: " ++ unSnapshotIdent ident
165+ forM_ mloc $ \loc ->
166+ putStrLn $ "Track progress at: " ++ loc
165
167
166 postBuild `catchAny` print
168 postBuild `catchAny` print
167
169
Stackage/Upload.hs+5−5
@@ -51,7 +51,7 @@ instance Default UploadBundle where
51newtype SnapshotIdent = SnapshotIdent { unSnapshotIdent :: Text }
51newtype SnapshotIdent = SnapshotIdent { unSnapshotIdent :: Text }
52 deriving (Show, Eq, Ord, Hashable, IsString)
52 deriving (Show, Eq, Ord, Hashable, IsString)
53
53
54−uploadBundle :: UploadBundle -> Manager -> IO SnapshotIdent
54+uploadBundle :: UploadBundle -> Manager -> IO (SnapshotIdent, Maybe Text)
55uploadBundle UploadBundle {..} man = do
55uploadBundle UploadBundle {..} man = do
56 req1 <- parseUrl $ unpack $ unStackageServer ubServer ++ "/upload"
56 req1 <- parseUrl $ unpack $ unStackageServer ubServer ++ "/upload"
57 req2 <- formDataBody formData req1
57 req2 <- formDataBody formData req1
@@ -67,10 +67,10 @@ uploadBundle UploadBundle {..} man = do
67 }
67 }
68 res <- httpLbs req3 man
68 res <- httpLbs req3 man
69 case lookup "x-stackage-ident" $ responseHeaders res of
69 case lookup "x-stackage-ident" $ responseHeaders res of
70− Just snapid -> do
70+ Just snapid -> return
71+ ( SnapshotIdent $ decodeUtf8 snapid
71− forM_ (lookup "location" $ responseHeaders res) $ \loc ->
72+ , decodeUtf8 <$> lookup "location" (responseHeaders res)
72− putStrLn $ "Check upload progress at: " ++ decodeUtf8 loc
73+ )
73− return $ SnapshotIdent $ decodeUtf8 snapid
74 Nothing -> error $ "An error occurred: " ++ show res
74 Nothing -> error $ "An error occurred: " ++ show res
75 where
75 where
76 params = mapMaybe (\(x, y) -> (x, ) <$> y)
76 params = mapMaybe (\(x, y) -> (x, ) <$> y)