content ranges implemented

src/Handler/Package/V0/S9PK.hs

@@ -4,9 +4,9 @@
 
 module Handler.Package.V0.S9PK where
 
-import Data.String.Interpolate.IsString (
-    i,
- )
+import Conduit (awaitForever, (.|))
+import Data.Conduit.Binary (sourceFileRange)
+import Data.String.Interpolate.IsString (i)
 import Data.Text qualified as T
 import Database.Queries (
     createMetric,
@@ -32,30 +32,22 @@ import Lib.Types.Core (
     S9PK,
  )
 import Lib.Types.Emver (Version (..))
-import Network.HTTP.Types (status404)
-import Startlude (
-    Maybe (..),
-    pure,
-    void,
-    ($),
-    (.),
-    (>>=),
- )
+import Network.HTTP.Types (ByteRange (..), hRange, parseByteRanges, status404, status416)
+import Startlude (Applicative (..), Maybe (..), Num ((-)), Text, fmap, foldr, for, liftIO, pure, void, ($), (.), (>>=))
+import System.Directory (getFileSize)
 import System.FilePath (takeBaseName)
-import Yesod (
-    Content (..),
-    TypedContent,
-    YesodPersist (runDB),
-    notFound,
-    respond,
-    sendResponseStatus,
-    typeOctet,
- )
+import Yesod (Content (..), TypedContent, YesodPersist (runDB), lookupHeader, notFound, respond, sendChunkBS, sendResponseStatus, typeOctet)
 import Yesod.Core (logError)
 
 
 getAppR :: S9PK -> Handler TypedContent
 getAppR file = do
+    mRange <-
+        lookupHeader hRange >>= \case
+            Nothing -> pure Nothing
+            Just bs -> case parseByteRanges bs of
+                Nothing -> sendResponseStatus status416 ("Range Not Satisfiable" :: Text)
+                Just ranges -> pure $ Just ranges
     let pkg = PkgId . T.pack $ takeBaseName (show file)
     osVersion <- getOsVersionQuery
     osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
@@ -70,7 +62,17 @@ getAppR file = do
         getPackage pkg version >>= \case
             Nothing -> sendResponseStatus status404 (NotFoundE [i|#{pkg}@#{version}|])
             Just a -> pure a
-    respond typeOctet $ ContentFile pkgPath Nothing
+    case mRange of
+        Nothing -> respond typeOctet $ ContentFile pkgPath Nothing
+        Just ranges -> do
+            composite <- fmap (foldr (*>) (pure ())) $
+                for ranges $ \case
+                    ByteRangeFrom start -> pure $ sourceFileRange pkgPath (Just start) Nothing
+                    ByteRangeFromTo start end -> pure $ sourceFileRange pkgPath (Just start) (Just end)
+                    ByteRangeSuffix suffix -> do
+                        sz <- liftIO $ getFileSize pkgPath
+                        pure $ sourceFileRange pkgPath (Just $ sz - suffix) Nothing
+            respond typeOctet $ ContentSource $ composite .| awaitForever sendChunkBS
 
 
 recordMetrics :: PkgId -> Version -> Handler ()