content ranges implemented (#114)

* content ranges implemented

* formatting

Co-authored-by: Lucy Cifferello <12953208+elvece@users.noreply.github.com>

src/Handler/Package/V0/S9PK.hs

@@ -4,9 +4,9 @@
 
 module Handler.Package.V0.S9PK where
 
-import Data.String.Interpolate.IsString (
+import Conduit (awaitForever, (.|))
-    i,
+import Data.Conduit.Binary (sourceFileRange)
- )
+import Data.String.Interpolate.IsString (i)
 import Data.Text qualified as T
 import Database.Queries (
     createMetric,
@@ -32,22 +32,38 @@ import Lib.Types.Core (
     S9PK,
  )
 import Lib.Types.Emver (Version (..))
-import Network.HTTP.Types (status404)
+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),
+    lookupHeader,
     notFound,
     respond,
+    sendChunkBS,
     sendResponseStatus,
     typeOctet,
  )
@@ -56,6 +72,12 @@ 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 +92,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 ()