@@ -0,0 +1,88 @@
1+{-# LANGUAGE NoImplicitPrelude #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+module Stackage2.CompleteBuild
5+ ( BuildType (..)
6+ , completeBuild
7+ ) where
8+import Data.Default.Class (def)
9+import Data.Time
10+import Data.Yaml (encodeFile)
11+import Network.HTTP.Client
12+import Stackage2.BuildConstraints
13+import Stackage2.BuildPlan
14+import Stackage2.CheckBuildPlan
15+import Stackage2.PerformBuild
16+import Stackage2.Prelude
17+import Stackage2.ServerBundle
18+import Stackage2.UpdateBuildPlan
19+import Stackage2.Upload
20+import System.IO (BufferMode (LineBuffering), hSetBuffering)
21+
22+data BuildType = Nightly | LTS
23+
24+data Settings = Settings
25+ { plan :: BuildPlan
26+ , planFile :: FilePath
27+ , buildDir :: FilePath
28+ , title :: Text -> Text -- ^ GHC version -> title
29+ , slug :: Text
30+ , setArgs :: Text -> UploadBundle -> UploadBundle
31+ }
32+
33+getSettings :: BuildType -> IO Settings
34+getSettings Nightly = do
35+ day <- tshow . utctDay <$> getCurrentTime
36+ let slug' = "nightly-" ++ day
37+ plan' <- defaultBuildConstraints >>= newBuildPlan
38+ return Settings
39+ { planFile = fpFromText ("nightly-" ++ day) <.> "yaml"
40+ , buildDir = fpFromText $ "/tmp/stackage-nightly-" ++ day
41+ , title = \ghcVer -> concat
42+ [ "Stackage Nightly "
43+ , day
44+ , ", GHC "
45+ , ghcVer
46+ ]
47+ , slug = slug'
48+ , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
49+ , plan = plan'
50+ }
51+
52+completeBuild :: BuildType -> IO ()
53+completeBuild buildType = withManager defaultManagerSettings $ \man -> do
54+ hSetBuffering stdout LineBuffering
55+
56+ Settings {..} <- getSettings buildType
57+ encodeFile (fpToString planFile) plan
58+ checkBuildPlan plan
59+ let pb = PerformBuild
60+ { pbPlan = plan
61+ , pbInstallDest = buildDir
62+ , pbLogDir = buildDir </> "logs"
63+ , pbLog = hPut stdout
64+ , pbJobs = 8
65+ }
66+ performBuild pb
67+
68+ token <- readFile "/auth-token"
69+ now <- epochTime
70+ let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
71+ ident <- flip uploadBundle man $ setArgs ghcVer def
72+ { ubContents = serverBundle now (title ghcVer) slug plan
73+ , ubAuthToken = decodeUtf8 token
74+ , ubAlias = Just slug
75+ }
76+
77+ uploadDocs UploadDocs
78+ { udServer = def
79+ , udAuthToken = decodeUtf8 token
80+ , udDocs = pbDocDir pb
81+ , udSnapshot = ident
82+ } man >>= print
83+
84+ creds <- readFile "/hackage-creds"
85+ case map encodeUtf8 $ words $ decodeUtf8 creds of
86+ [username, password] ->
87+ uploadHackageDistro plan username password man >>= print
88+ _ -> return ()