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