923d655 · stackage · git.iko.soy

git.iko.soy/stackage

on master help sign in

Provide options for v2 uploads

923d655Michael Snoyman12 years ago

ChangeLog.md+1−1

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−## Unreleased

1+## 0.6.0

3* Upload bundle V2 stuff

Stackage/CompleteBuild.hs+52−37

@@ -8,6 +8,7 @@ module Stackage.CompleteBuild

8 , completeBuild

9 , justCheck

10 , justUploadNightly

11+ , getStackageAuthToken

11 ) where

12 ) where

13import Control.Concurrent (threadDelay)

14import Control.Concurrent (threadDelay)

@@ -39,6 +40,7 @@ data BuildFlags = BuildFlags

39 , bfEnableExecDyn :: !Bool

40 , bfEnableExecDyn :: !Bool

40 , bfVerbose :: !Bool

41 , bfVerbose :: !Bool

41 , bfSkipCheck :: !Bool

42 , bfSkipCheck :: !Bool

43+ , bfUploadV2 :: !Bool

42 } deriving (Show)

44 } deriving (Show)

44data BuildType = Nightly | LTS BumpType

46data BuildType = Nightly | LTS BumpType

@@ -251,7 +253,7 @@ completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do

251 }

253 }

252

254

253 when (bfDoUpload buildFlags) $

255 when (bfDoUpload buildFlags) $

254− finallyUpload settings man

256+ finallyUpload (bfUploadV2 buildFlags) settings man

255

257

256justUploadNightly

258justUploadNightly

257 :: Text -- ^ nightly date

259 :: Text -- ^ nightly date

@@ -259,40 +261,62 @@ justUploadNightly

259justUploadNightly day = do

261justUploadNightly day = do

260 plan <- decodeFileEither (fpToString $ nightlyPlanFile day)

262 plan <- decodeFileEither (fpToString $ nightlyPlanFile day)

261 >>= either throwM return

263 >>= either throwM return

262− withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan

264+ withManager tlsManagerSettings $ finallyUpload False $ nightlySettings day plan

265+

266+getStackageAuthToken :: IO Text

267+getStackageAuthToken = do

268+ mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"

269+ case mtoken of

270+ Nothing -> decodeUtf8 <$> readFile "/auth-token"

271+ Just token -> return $ pack token

263

272

264-- | The final part of the complete build process: uploading a bundle,

273-- | The final part of the complete build process: uploading a bundle,

265-- docs and a distro to hackage.

274-- docs and a distro to hackage.

275+finallyUpload :: Bool -- ^ use v2 upload

266−finallyUpload :: Settings -> Manager -> IO ()

276+ -> Settings -> Manager -> IO ()

267−finallyUpload settings@Settings{..} man = do

277+finallyUpload useV2 settings@Settings{..} man = do

268 putStrLn "Uploading bundle to Stackage Server"

278 putStrLn "Uploading bundle to Stackage Server"

269

279

270− mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"

280+ token <- getStackageAuthToken

271− token <-

272− case mtoken of

273− Nothing -> decodeUtf8 <$> readFile "/auth-token"

274− Just token -> return $ pack token

275−

276− now <- epochTime

277− let ghcVer = display $ siGhcVersion $ bpSystemInfo plan

278− (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def

279− { ubContents = serverBundle now (title ghcVer) slug plan

280− , ubAuthToken = token

281− }

282− putStrLn $ "New ident: " ++ unSnapshotIdent ident

283− forM_ mloc $ \loc ->

284− putStrLn $ "Track progress at: " ++ loc

285

281

286− postBuild `catchAny` print

282+ if useV2

283+ then do

284+ res <- flip uploadBundleV2 man UploadBundleV2

285+ { ub2Server = def

286+ , ub2AuthToken = token

287+ , ub2Bundle = bundleDest

288+ }

289+ putStrLn $ "New snapshot available at: " ++ res

290+ else do

291+ now <- epochTime

292+ let ghcVer = display $ siGhcVersion $ bpSystemInfo plan

293+ (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def

294+ { ubContents = serverBundle now (title ghcVer) slug plan

295+ , ubAuthToken = token

296+ }

297+ putStrLn $ "New ident: " ++ unSnapshotIdent ident

298+ forM_ mloc $ \loc ->

299+ putStrLn $ "Track progress at: " ++ loc

300+

301+ putStrLn "Uploading docs to Stackage Server"

302+ res1 <- tryAny $ uploadDocs UploadDocs

303+ { udServer = def

304+ , udAuthToken = token

305+ , udDocs = pbDocDir pb

306+ , udSnapshot = ident

307+ } man

308+ putStrLn $ "Doc upload response: " ++ tshow res1

309+

310+ putStrLn "Uploading doc map"

311+ tryAny (uploadDocMap UploadDocMap

312+ { udmServer = def

313+ , udmAuthToken = token

314+ , udmSnapshot = ident

315+ , udmDocDir = pbDocDir pb

316+ , udmPlan = plan

317+ } man) >>= print

287

318

288− putStrLn "Uploading docs to Stackage Server"

319+ postBuild `catchAny` print

289− res1 <- uploadDocs UploadDocs

290− { udServer = def

291− , udAuthToken = token

292− , udDocs = pbDocDir pb

293− , udSnapshot = ident

294− } man

295− putStrLn $ "Doc upload response: " ++ tshow res1

296

320

297 ecreds <- tryIO $ readFile "/hackage-creds"

321 ecreds <- tryIO $ readFile "/hackage-creds"

298 case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of

322 case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of

@@ -301,14 +325,5 @@ finallyUpload settings@Settings{..} man = do

301 res2 <- uploadHackageDistroNamed distroName plan username password man

325 res2 <- uploadHackageDistroNamed distroName plan username password man

302 putStrLn $ "Distro upload response: " ++ tshow res2

326 putStrLn $ "Distro upload response: " ++ tshow res2

303 _ -> putStrLn "No creds found, skipping Hackage distro upload"

327 _ -> putStrLn "No creds found, skipping Hackage distro upload"

304−

305− putStrLn "Uploading doc map"

306− uploadDocMap UploadDocMap

307− { udmServer = def

308− , udmAuthToken = token

309− , udmSnapshot = ident

310− , udmDocDir = pbDocDir pb

311− , udmPlan = plan

312− } man >>= print

313 where

328 where

314 pb = getPerformBuild (error "finallyUpload.buildFlags") settings

329 pb = getPerformBuild (error "finallyUpload.buildFlags") settings

Stackage/Upload.hs+3

@@ -16,6 +16,8 @@ module Stackage.Upload

16 , uploadDocMap

17 , uploadBundleV2

18 , UploadBundleV2 (..)

19+ , def

20+ , unStackageServer

19 ) where

21 ) where

21import Control.Monad.Writer.Strict (execWriter, tell)

23import Control.Monad.Writer.Strict (execWriter, tell)

@@ -224,6 +226,7 @@ data UploadBundleV2 = UploadBundleV2

224uploadBundleV2 :: UploadBundleV2 -> Manager -> IO Text

226uploadBundleV2 :: UploadBundleV2 -> Manager -> IO Text

225uploadBundleV2 UploadBundleV2 {..} man = IO.withBinaryFile (fpToString ub2Bundle) IO.ReadMode $ \h -> do

227uploadBundleV2 UploadBundleV2 {..} man = IO.withBinaryFile (fpToString ub2Bundle) IO.ReadMode $ \h -> do

226 size <- IO.hFileSize h

228 size <- IO.hFileSize h

229+ putStrLn $ "Bundle size: " ++ tshow size

227 req1 <- parseUrl $ unpack $ unStackageServer ub2Server ++ "/upload2"

230 req1 <- parseUrl $ unpack $ unStackageServer ub2Server ++ "/upload2"

228 let req2 = req1

231 let req2 = req1

229 { method = "PUT"

232 { method = "PUT"

app/stackage.hs+34−2

@@ -10,7 +10,11 @@ import Options.Applicative

10import Filesystem.Path.CurrentOS (decodeString)

11import Paths_stackage (version)

12import Stackage.CompleteBuild

13+import Stackage.Upload

13import Stackage.InstallBuild

14import Stackage.InstallBuild

15+import Network.HTTP.Client (withManager)

16+import Network.HTTP.Client.TLS (tlsManagerSettings)

17+import qualified Data.Text as T

15main :: IO ()

19main :: IO ()

16main =

20main =

@@ -62,7 +66,13 @@ main =

62 installBuild

66 installBuild

63 installFlags

67 installFlags

64 "install"

68 "install"

65− "Install a snapshot from an existing build plan"]

69+ "Install a snapshot from an existing build plan"

70+ , cmnd

71+ uploadv2

72+ uploadv2Flags

73+ "upload2"

74+ "Upload a pre-existing v2 bundle"

75+ ]

67 cmnd exec parse name desc =

77 cmnd exec parse name desc =

68 command name $

78 command name $

@@ -98,7 +108,10 @@ main =

98 help "Output verbose detail about the build steps") <*>

108 help "Output verbose detail about the build steps") <*>

99 switch

109 switch

100 (long "skip-check" <>

110 (long "skip-check" <>

101− help "Skip the check phase, and pass --allow-newer to cabal configure")

111+ help "Skip the check phase, and pass --allow-newer to cabal configure") <*>

112+ switch

113+ (long "upload-v2" <>

114+ help "Use the V2 upload code")

102

115

103 nightlyUploadFlags = fromString <$> strArgument

116 nightlyUploadFlags = fromString <$> strArgument

104 (metavar "DATE" <>

117 (metavar "DATE" <>

@@ -161,3 +174,22 @@ main =

161 switch

174 switch

162 (long "skip-check" <>

175 (long "skip-check" <>

163 help "Skip the check phase, and pass --allow-newer to cabal configure")

176 help "Skip the check phase, and pass --allow-newer to cabal configure")

177+

178+ uploadv2 (path, url) = withManager tlsManagerSettings $ \man -> do

179+ token <- getStackageAuthToken

180+ res <- flip uploadBundleV2 man UploadBundleV2

181+ { ub2AuthToken = token

182+ , ub2Server = fromString url

183+ , ub2Bundle = decodeString path

184+ }

185+ putStrLn $ "New URL: " ++ T.unpack res

186+

187+ uploadv2Flags = (,)

188+ <$> (strArgument

189+ (metavar "BUNDLE-PATH" <>

190+ help "Bundle path"))

191+ <*> strOption

192+ (long "server-url" <>

193+ metavar "SERVER-URL" <>

194+ showDefault <> value (T.unpack $ unStackageServer def) <>

195+ help "Server to upload bundle to")

stackage.cabal+4−1

@@ -1,5 +1,5 @@

1name: stackage

2−version: 0.5.2

2+version: 0.6.0

3synopsis: "Stable Hackage," tools for creating a vetted set of packages from Hackage.

4description: Please see <http://www.stackage.org/package/stackage> for a description and documentation.

5homepage: https://github.com/fpco/stackage

@@ -75,6 +75,9 @@ executable stackage

75 , stackage

76 , optparse-applicative >= 0.11

77 , system-filepath

78+ , http-client

79+ , http-client-tls

80+ , text

78 ghc-options: -rtsopts -threaded -with-rtsopts=-N

81 ghc-options: -rtsopts -threaded -with-rtsopts=-N

80test-suite spec

83test-suite spec