Accept snapshot branches at /api/v1/snapshot

config/routes

@@ -13,7 +13,7 @@
 
 /snapshot/#Text/*Texts OldSnapshotR GET
 
-/api/v1/snapshot/#SnapName ApiV1SnapshotR GET
+/api/v1/snapshot/#ApiSnapshotName ApiV1SnapshotR GET
 
 !/#SnapName SnapshotR:
     / StackageHomeR GET

src/Foundation.hs

@@ -11,6 +11,7 @@ import Data.WebsiteContent
 import Settings
 import Settings.StaticFiles
 import Stackage.Database
+import Handler.StackageHome.Types (ApiSnapshotName(..))
 import Text.Hamlet (hamletFile)
 import Types
 import Yesod.AtomFeed

src/Handler/StackageHome.hs

@@ -14,14 +14,24 @@ module Handler.StackageHome
     ) where
 
 import Data.These
+import Handler.StackageHome.Types (ApiSnapshotName(..))
+import Import
 import RIO (textDisplay)
 import RIO.Time (FormatTime)
-import Import
 import Stackage.Database
 import Stackage.Snapshot.Diff
 
-getApiV1SnapshotR :: SnapName -> Handler Value
-getApiV1SnapshotR name = track "Handler.StackageHome.getApiV1SnapshotR" $ do
+-- | Return JSON representation of a snapshot.
+-- Redirect /lts, /nightly, /lts-X to the latest corresponding full snapshot.
+getApiV1SnapshotR :: ApiSnapshotName -> Handler Value
+getApiV1SnapshotR (ApiSnapshotNameBranch branch) = track "Handler.API.getApiV1SnapshotR.Branch" $ do
+    mLatestSnap <- case branch of
+        LtsBranch -> fmap (uncurry SNLts) <$> newestLTS
+        LtsMajorBranch x -> fmap (SNLts x) <$> newestLTSMajor x
+        NightlyBranch -> fmap SNNightly <$> newestNightly
+    maybe notFound (redirectWith found302 . ApiV1SnapshotR . ApiSnapshotName) mLatestSnap
+
+getApiV1SnapshotR (ApiSnapshotName name) = track "Handler.API.getApiV1SnapshotR.Name" $ do
     Entity sid snapshot <- lookupSnapshot name >>= maybe notFound return
     packages <- getPackagesForSnapshot sid
     pure $ toJSON $ SnapshotInfo snapshot packages

src/Handler/StackageHome/Types.hs

@@ -0,0 +1,21 @@
+module Handler.StackageHome.Types (
+    ApiSnapshotName(..),
+) where
+
+import ClassyPrelude.Yesod
+import Types
+
+-- | Combining SnapshotBranch and SnapName. Prevents needing overlapping routes
+-- for /api/v1/snapshot, unlike how SnapshotR and OldSnashotBranchR work.
+data ApiSnapshotName
+    = ApiSnapshotName SnapName
+    | ApiSnapshotNameBranch SnapshotBranch
+    deriving (Eq, Show, Read)
+
+instance PathPiece ApiSnapshotName where
+    fromPathPiece x =
+        ApiSnapshotName <$> fromPathPiece x
+        <|> ApiSnapshotNameBranch <$> fromPathPiece x
+
+    toPathPiece (ApiSnapshotName name) = toPathPiece name
+    toPathPiece (ApiSnapshotNameBranch branch) = toPathPiece branch