diff --git a/src/Handler/Package/V0/S9PK.hs b/src/Handler/Package/V0/S9PK.hs index 0f00048..4ed12d5 100644 --- a/src/Handler/Package/V0/S9PK.hs +++ b/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,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 ()