diff --git a/Handler/Alias.hs b/Handler/Alias.hs index 67ac7c2..d3ba778 100644 --- a/Handler/Alias.hs +++ b/Handler/Alias.hs @@ -6,7 +6,6 @@ module Handler.Alias import Import import Data.Slug (Slug) -import Data.Text.Read (decimal) import Handler.StackageHome (getStackageHomeR, getStackageMetadataR, getStackageCabalConfigR) import Handler.StackageIndex (getStackageIndexR, getStackageBundleR) import Handler.StackageSdist (getStackageSdistR) @@ -22,13 +21,6 @@ handleAliasR user name pieces = do Nothing -> notFound Just route -> redirect (route :: Route App) -parseLtsPair :: Text -> Maybe (Int, Int) -parseLtsPair t1 = do - (x, t2) <- either (const Nothing) Just $ decimal t1 - t3 <- stripPrefix "." t2 - (y, "") <- either (const Nothing) Just $ decimal t3 - Just (x, y) - getLtsR :: [Text] -> Handler () getLtsR pieces0 = case pieces0 of diff --git a/Handler/UploadStackage.hs b/Handler/UploadStackage.hs index 26ef97d..0d0180f 100644 --- a/Handler/UploadStackage.hs +++ b/Handler/UploadStackage.hs @@ -1,6 +1,7 @@ module Handler.UploadStackage where import Import hiding (catch, get, update) +import qualified Import import System.IO.Temp (withSystemTempFile, withSystemTempDirectory, openBinaryTempFile) import Crypto.Hash.Conduit (sinkHash) import Crypto.Hash (Digest, SHA1) @@ -18,7 +19,7 @@ import Control.Monad.Trans.Resource (allocate) import System.Directory (removeFile, getTemporaryDirectory) import System.Process (runProcess, waitForProcess) import System.Exit (ExitCode (ExitSuccess)) -import Data.Slug (mkSlug, SnapSlug (..), safeMakeSlug) +import Data.Slug (mkSlug, SnapSlug (..), safeMakeSlug, unSlug) fileKey :: Text fileKey = "stackage" @@ -42,6 +43,9 @@ putUploadStackageR = do Nothing -> invalidArgs ["Upload missing"] Just file -> do malias <- lookupPostParam "alias" + extra <- getExtra + mlts <- lookupPostParam "lts" + mnightly <- lookupPostParam "nightly" tempDir <- liftIO getTemporaryDirectory (_releaseKey, (fp, handleOut)) <- allocate @@ -67,13 +71,32 @@ putUploadStackageR = do done msg url = updateHelper (ProgressDone msg url) onExc e = done ("Exception occurred: " ++ tshow e) ProfileR setAlias = do - forM_ (malias >>= mkSlug) $ \alias -> runDB $ do + forM_ (malias >>= mkSlug) $ \alias -> do deleteWhere [AliasUser ==. uid, AliasName ==. alias] insert_ Alias { aliasUser = uid , aliasName = alias , aliasTarget = ident } + whenAdmin inner = do + muser <- Import.get uid + forM_ muser $ \user -> + when (unSlug (userHandle user) `member` adminUsers extra) + inner + setLts sid = forM_ mlts + $ \lts -> whenAdmin + $ forM_ (parseLtsPair lts) $ \(major, minor) -> do + mx <- getBy $ UniqueLts major minor + when (isNothing mx) $ insert_ $ Lts major minor sid + setNightly sid = forM_ mnightly $ \nightly -> whenAdmin $ do + now <- liftIO getCurrentTime + let day = utctDay now + mx <- getBy $ UniqueNightly day + when (isNothing mx) $ insert_ Nightly + { nightlyDay = day + , nightlyGhcVersion = nightly + , nightlyStackage = sid + } update "Starting" @@ -121,9 +144,12 @@ putUploadStackageR = do , packageVersion = version , packageOverwrite = overwrite } - return slug - setAlias + setAlias + setLts sid + setNightly sid + + return slug done "Stackage created" $ SnapshotR slug StackageHomeR else do diff --git a/Import.hs b/Import.hs index d796420..9a53b4d 100644 --- a/Import.hs +++ b/Import.hs @@ -12,6 +12,7 @@ import Types as Import import Yesod.Auth as Import import Data.Slug (mkSlug) import Data.WebsiteContent as Import (WebsiteContent (..)) +import Data.Text.Read (decimal) requireAuthIdOrToken :: Handler UserId requireAuthIdOrToken = do @@ -26,3 +27,10 @@ requireAuthIdOrToken = do case muser of Nothing -> invalidArgs ["Unknown token: " ++ token] Just (Entity uid _) -> return uid + +parseLtsPair :: Text -> Maybe (Int, Int) +parseLtsPair t1 = do + (x, t2) <- either (const Nothing) Just $ decimal t1 + t3 <- stripPrefix "." t2 + (y, "") <- either (const Nothing) Just $ decimal t3 + Just (x, y)