git.iko.soy/stackage
on master help sign in
STACKAGE_AUTH_TOKEN environment variable
fd56370Michael Snoyman
ChangeLog.md+5
compare with master
unifiedsplit
@@ -1,3 +1,8 @@
1+## 0.5.1
2+
3+* `loadBuildConstraints`
4+* More command line options
5+
1## 0.5.0
6## 0.5.0
2
7
3* Print "Still Alive" while checking, to avoid Travis timeouts
8* Print "Still Alive" while checking, to avoid Travis timeouts
Stackage/BuildConstraints.hs+28−9
@@ -11,6 +11,8 @@ module Stackage.BuildConstraints
11 , getSystemInfo
11 , getSystemInfo
12 , defaultBuildConstraints
12 , defaultBuildConstraints
13 , toBC
13 , toBC
14+ , BuildConstraintsSource (..)
15+ , loadBuildConstraints
14 ) where
16 ) where
15
17
16import Control.Monad.Writer.Strict (execWriter, tell)
18import Control.Monad.Writer.Strict (execWriter, tell)
@@ -22,7 +24,7 @@ import Distribution.System (Arch, OS)
22import qualified Distribution.System
24import qualified Distribution.System
23import Distribution.Version (anyVersion)
25import Distribution.Version (anyVersion)
24import Filesystem (isFile)
26import Filesystem (isFile)
25−import Network.HTTP.Client (Manager, httpLbs, responseBody)
27+import Network.HTTP.Client (Manager, httpLbs, responseBody, Request)
26import Stackage.CorePackages
28import Stackage.CorePackages
27import Stackage.Prelude
29import Stackage.Prelude
28
30
@@ -126,15 +128,32 @@ instance FromJSON PackageConstraints where
126-- Checks the current directory for a build-constraints.yaml file and uses it
128-- Checks the current directory for a build-constraints.yaml file and uses it
127-- if present. If not, downloads from Github.
129-- if present. If not, downloads from Github.
128defaultBuildConstraints :: Manager -> IO BuildConstraints
130defaultBuildConstraints :: Manager -> IO BuildConstraints
129−defaultBuildConstraints man = do
131+defaultBuildConstraints = loadBuildConstraints BCSDefault
132+
133+data BuildConstraintsSource
134+ = BCSDefault
135+ | BCSFile FilePath
136+ | BCSWeb Request
137+ deriving (Show)
138+
139+loadBuildConstraints :: BuildConstraintsSource -> Manager -> IO BuildConstraints
140+loadBuildConstraints bcs man = do
141+ case bcs of
142+ BCSDefault -> do
130− e <- isFile fp
143+ e <- isFile fp0
131− if e
144+ if e
132− then decodeFileEither (fpToString fp) >>= either throwIO toBC
145+ then loadFile fp0
133− else httpLbs req man >>=
146+ else loadReq req0
134− either throwIO toBC . decodeEither' . toStrict . responseBody
147+ BCSFile fp -> loadFile fp
148+ BCSWeb req -> loadReq req
135 where
149 where
136− fp = "build-constraints.yaml"
150+ fp0 = "build-constraints.yaml"
137− req = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"
151+ req0 = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"
152+
153+ loadFile fp = decodeFileEither (fpToString fp) >>= either throwIO toBC
154+ loadReq req = httpLbs req man >>=
155+ either throwIO toBC . decodeEither' . toStrict . responseBody
156+
138
157
139getSystemInfo :: IO SystemInfo
158getSystemInfo :: IO SystemInfo
140getSystemInfo = do
159getSystemInfo = do
Stackage/CompleteBuild.hs+11−4
@@ -27,6 +27,7 @@ import Stackage.Prelude
27import Stackage.ServerBundle
27import Stackage.ServerBundle
28import Stackage.UpdateBuildPlan
28import Stackage.UpdateBuildPlan
29import Stackage.Upload
29import Stackage.Upload
30+import System.Environment (lookupEnv)
30import System.IO (BufferMode (LineBuffering), hSetBuffering)
31import System.IO (BufferMode (LineBuffering), hSetBuffering)
31
32
32-- | Flags passed in from the command line.
33-- | Flags passed in from the command line.
@@ -241,12 +242,18 @@ justUploadNightly day = do
241finallyUpload :: Settings -> Manager -> IO ()
242finallyUpload :: Settings -> Manager -> IO ()
242finallyUpload settings@Settings{..} man = do
243finallyUpload settings@Settings{..} man = do
243 putStrLn "Uploading bundle to Stackage Server"
244 putStrLn "Uploading bundle to Stackage Server"
245+
246+ mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"
247+ token <-
248+ case mtoken of
244− token <- readFile "/auth-token"
249+ Nothing -> decodeUtf8 <$> readFile "/auth-token"
250+ Just token -> return $ pack token
251+
245 now <- epochTime
252 now <- epochTime
246 let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
253 let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
247 (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def
254 (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def
248 { ubContents = serverBundle now (title ghcVer) slug plan
255 { ubContents = serverBundle now (title ghcVer) slug plan
249− , ubAuthToken = decodeUtf8 token
256+ , ubAuthToken = token
250 }
257 }
251 putStrLn $ "New ident: " ++ unSnapshotIdent ident
258 putStrLn $ "New ident: " ++ unSnapshotIdent ident
252 forM_ mloc $ \loc ->
259 forM_ mloc $ \loc ->
@@ -257,7 +264,7 @@ finallyUpload settings@Settings{..} man = do
257 putStrLn "Uploading docs to Stackage Server"
264 putStrLn "Uploading docs to Stackage Server"
258 res1 <- uploadDocs UploadDocs
265 res1 <- uploadDocs UploadDocs
259 { udServer = def
266 { udServer = def
260− , udAuthToken = decodeUtf8 token
267+ , udAuthToken = token
261 , udDocs = pbDocDir pb
268 , udDocs = pbDocDir pb
262 , udSnapshot = ident
269 , udSnapshot = ident
263 } man
270 } man
@@ -274,7 +281,7 @@ finallyUpload settings@Settings{..} man = do
274 putStrLn "Uploading doc map"
281 putStrLn "Uploading doc map"
275 uploadDocMap UploadDocMap
282 uploadDocMap UploadDocMap
276 { udmServer = def
283 { udmServer = def
277− , udmAuthToken = decodeUtf8 token
284+ , udmAuthToken = token
278 , udmSnapshot = ident
285 , udmSnapshot = ident
279 , udmDocDir = pbDocDir pb
286 , udmDocDir = pbDocDir pb
280 , udmPlan = plan
287 , udmPlan = plan
Stackage/PerformBuild.hs+9−1
@@ -197,7 +197,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
197 id
197 id
198 (\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):))
198 (\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):))
199 (pbDatabase pb)
199 (pbDatabase pb)
200− (map fixEnv env)
200+ (filter allowedEnv $ map fixEnv env)
201 , sbHaddockFiles = haddockFiles
201 , sbHaddockFiles = haddockFiles
202 }
202 }
203
203
@@ -215,6 +215,8 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
215 | toUpper p == "PATH" = (p, fpToString (pbBinDir pb) ++ pathSep : x)
215 | toUpper p == "PATH" = (p, fpToString (pbBinDir pb) ++ pathSep : x)
216 | otherwise = (p, x)
216 | otherwise = (p, x)
217
217
218+ allowedEnv (k, _) = k `notMember` bannedEnvs
219+
218 -- | Separate for the PATH environment variable
220 -- | Separate for the PATH environment variable
219 pathSep :: Char
221 pathSep :: Char
220#ifdef mingw32_HOST_OS
222#ifdef mingw32_HOST_OS
@@ -223,6 +225,12 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
223 pathSep = ':'
225 pathSep = ':'
224#endif
226#endif
225
227
228+-- | Environment variables we don't allow to be passed on to child processes.
229+bannedEnvs :: Set String
230+bannedEnvs = setFromList
231+ [ "STACKAGE_AUTH_TOKEN"
232+ ]
233+
226data SingleBuild = SingleBuild
234data SingleBuild = SingleBuild
227 { sbSem :: TSem
235 { sbSem :: TSem
228 , sbErrsVar :: TVar (Map PackageName BuildFailure)
236 , sbErrsVar :: TVar (Map PackageName BuildFailure)