STACKAGE_AUTH_TOKEN environment variable

ChangeLog.md

@@ -1,3 +1,8 @@
+## 0.5.1
+
+* `loadBuildConstraints`
+* More command line options
+
 ## 0.5.0
 
 * Print "Still Alive" while checking, to avoid Travis timeouts

Stackage/BuildConstraints.hs

@@ -11,6 +11,8 @@ module Stackage.BuildConstraints
     , getSystemInfo
     , defaultBuildConstraints
     , toBC
+    , BuildConstraintsSource (..)
+    , loadBuildConstraints
     ) where
 
 import           Control.Monad.Writer.Strict (execWriter, tell)
@@ -22,7 +24,7 @@ import           Distribution.System         (Arch, OS)
 import qualified Distribution.System
 import           Distribution.Version        (anyVersion)
 import           Filesystem                  (isFile)
-import           Network.HTTP.Client         (Manager, httpLbs, responseBody)
+import           Network.HTTP.Client         (Manager, httpLbs, responseBody, Request)
 import           Stackage.CorePackages
 import           Stackage.Prelude
 
@@ -126,15 +128,32 @@ instance FromJSON PackageConstraints where
 -- Checks the current directory for a build-constraints.yaml file and uses it
 -- if present. If not, downloads from Github.
 defaultBuildConstraints :: Manager -> IO BuildConstraints
-defaultBuildConstraints man = do
-    e <- isFile fp
-    if e
-        then decodeFileEither (fpToString fp) >>= either throwIO toBC
-        else httpLbs req man >>=
-             either throwIO toBC . decodeEither' . toStrict . responseBody
+defaultBuildConstraints = loadBuildConstraints BCSDefault
+
+data BuildConstraintsSource
+    = BCSDefault
+    | BCSFile FilePath
+    | BCSWeb Request
+    deriving (Show)
+
+loadBuildConstraints :: BuildConstraintsSource -> Manager -> IO BuildConstraints
+loadBuildConstraints bcs man = do
+    case bcs of
+        BCSDefault -> do
+            e <- isFile fp0
+            if e
+                then loadFile fp0
+                else loadReq req0
+        BCSFile fp -> loadFile fp
+        BCSWeb req -> loadReq req
   where
-    fp = "build-constraints.yaml"
-    req = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"
+    fp0 = "build-constraints.yaml"
+    req0 = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"
+
+    loadFile fp = decodeFileEither (fpToString fp) >>= either throwIO toBC
+    loadReq req = httpLbs req man >>=
+                  either throwIO toBC . decodeEither' . toStrict . responseBody
+
 
 getSystemInfo :: IO SystemInfo
 getSystemInfo = do

Stackage/CompleteBuild.hs

@@ -27,6 +27,7 @@ import Stackage.Prelude
 import Stackage.ServerBundle
 import Stackage.UpdateBuildPlan
 import Stackage.Upload
+import System.Environment        (lookupEnv)
 import System.IO                 (BufferMode (LineBuffering), hSetBuffering)
 
 -- | Flags passed in from the command line.
@@ -241,12 +242,18 @@ justUploadNightly day = do
 finallyUpload :: Settings -> Manager -> IO ()
 finallyUpload settings@Settings{..} man = do
     putStrLn "Uploading bundle to Stackage Server"
-    token <- readFile "/auth-token"
+
+    mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"
+    token <-
+        case mtoken of
+            Nothing -> decodeUtf8 <$> readFile "/auth-token"
+            Just token -> return $ pack token
+
     now <- epochTime
     let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
     (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def
         { ubContents = serverBundle now (title ghcVer) slug plan
-        , ubAuthToken = decodeUtf8 token
+        , ubAuthToken = token
         }
     putStrLn $ "New ident: " ++ unSnapshotIdent ident
     forM_ mloc $ \loc ->
@@ -257,7 +264,7 @@ finallyUpload settings@Settings{..} man = do
     putStrLn "Uploading docs to Stackage Server"
     res1 <- uploadDocs UploadDocs
         { udServer = def
-        , udAuthToken = decodeUtf8 token
+        , udAuthToken = token
         , udDocs = pbDocDir pb
         , udSnapshot = ident
         } man
@@ -274,7 +281,7 @@ finallyUpload settings@Settings{..} man = do
     putStrLn "Uploading doc map"
     uploadDocMap UploadDocMap
         { udmServer = def
-        , udmAuthToken = decodeUtf8 token
+        , udmAuthToken = token
         , udmSnapshot = ident
         , udmDocDir = pbDocDir pb
         , udmPlan = plan

Stackage/PerformBuild.hs

@@ -197,7 +197,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
             id
             (\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):))
             (pbDatabase pb)
-            (map fixEnv env)
+            (filter allowedEnv $ map fixEnv env)
         , sbHaddockFiles = haddockFiles
         }
 
@@ -215,6 +215,8 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
         | toUpper p == "PATH" = (p, fpToString (pbBinDir pb) ++ pathSep : x)
         | otherwise = (p, x)
 
+    allowedEnv (k, _) = k `notMember` bannedEnvs
+
     -- | Separate for the PATH environment variable
     pathSep :: Char
 #ifdef mingw32_HOST_OS
@@ -223,6 +225,12 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
     pathSep = ':'
 #endif
 
+-- | Environment variables we don't allow to be passed on to child processes.
+bannedEnvs :: Set String
+bannedEnvs = setFromList
+    [ "STACKAGE_AUTH_TOKEN"
+    ]
+
 data SingleBuild = SingleBuild
     { sbSem           :: TSem
     , sbErrsVar       :: TVar (Map PackageName BuildFailure)