From 5a590f0f4dfd004819797770804c2a4697196692 Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Mon, 20 Jun 2022 10:44:21 -0600 Subject: [PATCH] Feature/data url images (#107) * changes serialization scheme for v1 api * removes dependent types --- src/Handler/Package.hs | 13 +- src/Handler/Package/Api.hs | 81 +++++++++ src/Handler/Package/V0/Index.hs | 301 +------------------------------- src/Handler/Package/V1/Index.hs | 261 +++++++++++++++++++++++++++ src/Handler/Types/Api.hs | 11 ++ 5 files changed, 367 insertions(+), 300 deletions(-) create mode 100644 src/Handler/Package/Api.hs create mode 100644 src/Handler/Package/V1/Index.hs diff --git a/src/Handler/Package.hs b/src/Handler/Package.hs index 294d48c..af8007e 100644 --- a/src/Handler/Package.hs +++ b/src/Handler/Package.hs @@ -2,7 +2,7 @@ module Handler.Package where import Foundation (Handler) import Handler.Package.V0.Icon qualified -import Handler.Package.V0.Index (PackageListRes, getPackageIndexR) +import Handler.Package.V0.Index qualified import Handler.Package.V0.Info (InfoRes, getInfoR) import Handler.Package.V0.Instructions qualified import Handler.Package.V0.Latest (VersionLatestRes, getVersionLatestR) @@ -11,11 +11,13 @@ import Handler.Package.V0.Manifest qualified import Handler.Package.V0.ReleaseNotes (ReleaseNotes, getReleaseNotesR) import Handler.Package.V0.S9PK qualified import Handler.Package.V0.Version (AppVersionRes, getPkgVersionR) -import Handler.Types.Api (ApiVersion (..)) +import Handler.Package.V1.Index (getPackageIndexR) +import Handler.Types.Api (ApiResponse (..), ApiVersion (..)) import Lib.Types.Core (PkgId, S9PK) +import Startlude ((.), (<$>)) +import Yesod import Yesod.Core.Types ( JSONResponse, - TypedContent, ) @@ -23,8 +25,9 @@ getInfoR :: ApiVersion -> Handler (JSONResponse InfoRes) getInfoR _ = Handler.Package.V0.Info.getInfoR -getPackageIndexR :: ApiVersion -> Handler PackageListRes -getPackageIndexR _ = Handler.Package.V0.Index.getPackageIndexR +getPackageIndexR :: ApiVersion -> Handler TypedContent +getPackageIndexR V0 = toTypedContent . apiEncode V0 <$> Handler.Package.V0.Index.getPackageIndexR +getPackageIndexR V1 = toTypedContent . apiEncode V1 <$> Handler.Package.V1.Index.getPackageIndexR getVersionLatestR :: ApiVersion -> Handler VersionLatestRes diff --git a/src/Handler/Package/Api.hs b/src/Handler/Package/Api.hs new file mode 100644 index 0000000..cb8f948 --- /dev/null +++ b/src/Handler/Package/Api.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Handler.Package.Api where + +import Data.ByteString.Base64 (encodeBase64) +import Data.HashMap.Strict +import Data.String.Interpolate.IsString (i) +import Handler.Types.Api (ApiResponse (..), ApiVersion (..)) +import Lib.Types.Core +import Lib.Types.Emver +import Startlude ( + ByteString, + Eq, + Generic, + NonEmpty, + Show, + Text, + snd, + ($), + (&), + (.), + (<$>), + ) +import Yesod + + +dataUrl :: (ContentType, ByteString) -> Text +dataUrl (ct, payload) = [i|data:#{ct};base64,#{encodeBase64 payload}|] + + +newtype PackageListRes = PackageListRes [PackageRes] + deriving (Generic) +instance ApiResponse PackageListRes where + apiEncode V0 (PackageListRes pkgs) = toJSON $ apiEncode V0 <$> pkgs + apiEncode V1 (PackageListRes pkgs) = toJSON $ apiEncode V1 <$> pkgs + + +data PackageRes = PackageRes + { packageResIcon :: !(ContentType, ByteString) + , packageResManifest :: !Value -- PackageManifest + , packageResCategories :: ![Text] + , packageResInstructions :: !Text + , packageResLicense :: !Text + , packageResVersions :: !(NonEmpty Version) + , packageResDependencies :: !(HashMap PkgId DependencyRes) + } + deriving (Show, Generic) + + +instance ApiResponse PackageRes where + apiEncode v PackageRes{..} = + object + [ "icon" + .= ( packageResIcon & case v of + V0 -> encodeBase64 . snd + V1 -> dataUrl + ) + , "license" .= packageResLicense + , "instructions" .= packageResInstructions + , "manifest" .= packageResManifest + , "categories" .= packageResCategories + , "versions" .= packageResVersions + , "dependency-metadata" .= (apiEncode v <$> packageResDependencies) + ] + + +data DependencyRes = DependencyRes + { dependencyResTitle :: !Text + , dependencyResIcon :: !(ContentType, ByteString) + } + deriving (Eq, Show) + + +instance ApiResponse DependencyRes where + apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle] + apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle] diff --git a/src/Handler/Package/V0/Index.hs b/src/Handler/Package/V0/Index.hs index 5df0991..eb5dff7 100644 --- a/src/Handler/Package/V0/Index.hs +++ b/src/Handler/Package/V0/Index.hs @@ -1,302 +1,13 @@ -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} module Handler.Package.V0.Index where -import Conduit (concatMapC, dropC, mapC, mapMC, runConduit, sinkList, takeC, (.|)) -import Control.Monad.Reader.Has (Functor (fmap), Has, Monad ((>>=)), MonadReader, ReaderT (runReaderT), ask, lift) -import Data.Aeson (FromJSON (..), ToJSON (..), Value, decode, eitherDecodeStrict, object, withObject, (.:), (.=)) -import Data.Attoparsec.Text qualified as Atto -import Data.ByteString.Base64 (encodeBase64) -import Data.ByteString.Lazy qualified as LBS -import Data.Conduit.List qualified as CL -import Data.HashMap.Internal.Strict (HashMap) -import Data.HashMap.Strict qualified as HM -import Data.List (lookup) -import Data.List.NonEmpty qualified as NE -import Data.Text qualified as T -import Database.Persist.Sql (SqlBackend) -import Database.Queries ( - collateVersions, - getCategoriesFor, - getDependencyVersions, - getPkgDataSource, - getPkgDependencyData, - serviceQuerySource, - ) -import Foundation (Handler, Route (InstructionsR, LicenseR)) -import Handler.Types.Api (ApiVersion (..)) -import Handler.Util (basicRender) -import Lib.Error (S9Error (..)) -import Lib.PkgRepository (PkgRepo, getIcon, getManifest) -import Lib.Types.Core (PkgId) -import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||)) -import Model (Category (..), Key (..), PkgDependency (..), VersionRecord (..)) -import Network.HTTP.Types (status400) -import Protolude.Unsafe (unsafeFromJust) -import Settings (AppSettings) -import Startlude ( - Applicative ((*>)), - Bifunctor (..), - Bool (..), - ByteString, - ConvertText (toS), - Down (..), - Either (..), - Eq (..), - Generic, - Int, - Maybe (..), - MonadIO, - NonEmpty, - Num ((*), (-)), - Show, - Text, - Traversable (traverse), - catMaybes, - const, - encodeUtf8, - filter, - flip, - for, - fromMaybe, - headMay, - id, - mappend, - maximumOn, - nonEmpty, - note, - pure, - readMaybe, - snd, - sortOn, - zipWith, - zipWithM, - ($), - (&&&), - (.), - (.*), - (<$>), - (<&>), - (<>), - (=<<), - ) -import UnliftIO (Concurrently (..), mapConcurrently) -import Yesod ( - MonadLogger, - MonadResource, - ToContent (..), - ToTypedContent (..), - YesodPersist (runDB), - lookupGetParam, - sendResponseStatus, - ) -import Yesod.Core (logWarn) - - -data PackageReq = PackageReq - { packageReqId :: !PkgId - , packageReqVersion :: !VersionRange - } - deriving (Show) -instance FromJSON PackageReq where - parseJSON = withObject "package version" $ \o -> do - packageReqId <- o .: "id" - packageReqVersion <- o .: "version" - pure PackageReq{..} - - -data PackageRes = PackageRes - { packageResIcon :: !Text - , packageResManifest :: !Value -- PackageManifest - , packageResCategories :: ![Text] - , packageResInstructions :: !Text - , packageResLicense :: !Text - , packageResVersions :: !(NonEmpty Version) - , packageResDependencies :: !(HashMap PkgId DependencyRes) - } - deriving (Show, Generic) -instance ToJSON PackageRes where - toJSON PackageRes{..} = - object - [ "icon" .= packageResIcon - , "license" .= packageResLicense - , "instructions" .= packageResInstructions - , "manifest" .= packageResManifest - , "categories" .= packageResCategories - , "versions" .= packageResVersions - , "dependency-metadata" .= packageResDependencies - ] - - -newtype PackageListRes = PackageListRes [PackageRes] - deriving (Generic) -instance ToJSON PackageListRes -instance ToContent PackageListRes where - toContent = toContent . toJSON -instance ToTypedContent PackageListRes where - toTypedContent = toTypedContent . toJSON - - -data DependencyRes = DependencyRes - { dependencyResTitle :: !Text - , dependencyResIcon :: !Text - } - deriving (Eq, Show) -instance ToJSON DependencyRes where - toJSON DependencyRes{..} = object ["icon" .= dependencyResIcon, "title" .= dependencyResTitle] - - -data PackageMetadata = PackageMetadata - { packageMetadataPkgId :: !PkgId - , packageMetadataPkgVersionRecords :: !(NonEmpty VersionRecord) - , packageMetadataPkgVersion :: !Version - , packageMetadataPkgCategories :: ![Category] - } - deriving (Eq, Show) +import Foundation (Handler) +import Handler.Package.Api (PackageListRes) +import Handler.Package.V1.Index qualified +-- implementation is the same but we will encode different payloads on the way out getPackageIndexR :: Handler PackageListRes -getPackageIndexR = do - osPredicate <- - getOsVersionQuery <&> \case - Nothing -> const True - Just v -> flip satisfies v - pkgIds <- getPkgIdsQuery - category <- getCategoryQuery - page <- fromMaybe 1 <$> getPageQuery - limit' <- fromMaybe 20 <$> getLimitQuery - query <- T.strip . fromMaybe "" <$> lookupGetParam "query" - let (source, packageRanges) = case pkgIds of - Nothing -> (serviceQuerySource category query, const Any) - Just packages -> - let s = getPkgDataSource (packageReqId <$> packages) - r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages) - in (s, r) - filteredPackages <- - runDB $ - runConduit $ - source - -- group conduit pipeline by pkg id - .| collateVersions - -- filter out versions of apps that are incompatible with the OS predicate - .| mapC (second (filter (osPredicate . versionRecordOsVersion))) - -- prune empty version sets - .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) - -- grab the latest matching version if it exists - .| concatMapC (\(a, b) -> (a,b,) <$> (selectLatestVersionFromSpec packageRanges b)) - -- construct - .| mapMC (\(a, b, c) -> PackageMetadata a b (versionRecordNumber c) <$> getCategoriesFor a) - -- pages start at 1 for some reason. TODO: make pages start at 0 - .| (dropC (limit' * (page - 1)) *> takeC limit') - .| sinkList - - -- NOTE: if a package's dependencies do not meet the system requirements, it is currently omitted from the list - pkgsWithDependencies <- runDB $ mapConcurrently (getPackageDependencies osPredicate) filteredPackages - PackageListRes <$> runConcurrently (zipWithM (Concurrently .* constructPackageListApiRes) filteredPackages pkgsWithDependencies) - - -parseQueryParam :: Text -> (Text -> Either Text a) -> Handler (Maybe a) -parseQueryParam param parser = do - lookupGetParam param >>= \case - Nothing -> pure Nothing - Just x -> case parser x of - Left e -> do - let err = InvalidParamsE ("get:" <> param) x - $logWarn e - sendResponseStatus status400 err - Right a -> pure (Just a) - - -getPkgIdsQuery :: Handler (Maybe [PackageReq]) -getPkgIdsQuery = parseQueryParam "ids" (first toS . eitherDecodeStrict . encodeUtf8) - - -getCategoryQuery :: Handler (Maybe Text) -getCategoryQuery = parseQueryParam "category" ((flip $ note . mappend "Invalid 'category': ") =<< (readMaybe . T.toUpper)) - - -getPageQuery :: Handler (Maybe Int) -getPageQuery = parseQueryParam "page" ((flip $ note . mappend "Invalid 'page': ") =<< readMaybe) - - -getLimitQuery :: Handler (Maybe Int) -getLimitQuery = parseQueryParam "per-page" ((flip $ note . mappend "Invalid 'per-page': ") =<< readMaybe) - - -getOsVersionQuery :: Handler (Maybe VersionRange) -getOsVersionQuery = parseQueryParam "eos-version-compat" (first toS . Atto.parseOnly parseRange) - - -getPackageDependencies :: - (MonadIO m, MonadLogger m, MonadResource m, Has PkgRepo r, MonadReader r m) => - (Version -> Bool) -> - PackageMetadata -> - ReaderT SqlBackend m (HashMap PkgId DependencyRes) -getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} = - do - pkgDepInfo <- getPkgDependencyData pkg pkgVersion - pkgDepInfoWithVersions <- traverse getDependencyVersions pkgDepInfo - let compatiblePkgDepInfo = fmap (filter (osPredicate . versionRecordOsVersion)) pkgDepInfoWithVersions - let depMetadata = catMaybes $ zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo - lift $ - fmap HM.fromList $ - for depMetadata $ \(depId, title, v) -> do - icon <- encodeBase64 <$> loadIcon depId v - pure $ (depId, DependencyRes title icon) - - -constructPackageListApiRes :: - (MonadResource m, MonadReader r m, Has AppSettings r, Has PkgRepo r) => - PackageMetadata -> - HashMap PkgId DependencyRes -> - m PackageRes -constructPackageListApiRes PackageMetadata{..} dependencies = do - settings <- ask @_ @_ @AppSettings - let pkgId = packageMetadataPkgId - let pkgCategories = packageMetadataPkgCategories - let pkgVersions = packageMetadataPkgVersionRecords - let pkgVersion = packageMetadataPkgVersion - manifest <- - flip runReaderT settings $ - (snd <$> getManifest pkgId pkgVersion) >>= \bs -> - runConduit $ bs .| CL.foldMap LBS.fromStrict - icon <- loadIcon pkgId pkgVersion - pure $ - PackageRes - { packageResIcon = encodeBase64 icon -- pass through raw JSON Value, we have checked its correct parsing above - , packageResManifest = unsafeFromJust . decode $ manifest - , packageResCategories = categoryName <$> pkgCategories - , packageResInstructions = basicRender $ InstructionsR V0 pkgId - , packageResLicense = basicRender $ LicenseR V0 pkgId - , packageResVersions = versionRecordNumber <$> pkgVersions - , packageResDependencies = dependencies - } - - -loadIcon :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m ByteString -loadIcon pkg version = do - (_, _, src) <- getIcon pkg version - runConduit $ src .| CL.foldMap id - - -selectLatestVersionFromSpec :: - (PkgId -> VersionRange) -> - NonEmpty VersionRecord -> - Maybe VersionRecord -selectLatestVersionFromSpec pkgRanges vs = - let pkgId = NE.head $ versionRecordPkgId <$> vs - spec = pkgRanges (unPkgRecordKey pkgId) - in headMay . sortOn (Down . versionRecordNumber) $ NE.filter ((`satisfies` spec) . versionRecordNumber) vs - - --- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package) -selectDependencyBestVersion :: PkgDependency -> [VersionRecord] -> Maybe (PkgId, Text, Version) -selectDependencyBestVersion pkgDepRecord depVersions = do - let depId = pkgDependencyDepId pkgDepRecord - let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord - let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) depVersions - case maximumOn versionRecordNumber satisfactory of - Just bestVersion -> Just (unPkgRecordKey depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion) - Nothing -> Nothing +getPackageIndexR = Handler.Package.V1.Index.getPackageIndexR \ No newline at end of file diff --git a/src/Handler/Package/V1/Index.hs b/src/Handler/Package/V1/Index.hs new file mode 100644 index 0000000..ef42c8c --- /dev/null +++ b/src/Handler/Package/V1/Index.hs @@ -0,0 +1,261 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module Handler.Package.V1.Index where + +import Conduit (concatMapC, dropC, mapC, mapMC, runConduit, sinkList, takeC, (.|)) +import Control.Monad.Reader.Has (Functor (fmap), Has, Monad ((>>=)), MonadReader, ReaderT (runReaderT), ask, lift) +import Data.Aeson (FromJSON (..), decode, eitherDecodeStrict, withObject, (.:)) +import Data.Attoparsec.Text qualified as Atto +import Data.ByteString.Lazy qualified as LBS +import Data.Conduit.List qualified as CL +import Data.HashMap.Internal.Strict (HashMap) +import Data.HashMap.Strict qualified as HM +import Data.List (lookup) +import Data.List.NonEmpty qualified as NE +import Data.Text qualified as T +import Database.Persist.Sql (SqlBackend) +import Database.Queries ( + collateVersions, + getCategoriesFor, + getDependencyVersions, + getPkgDataSource, + getPkgDependencyData, + serviceQuerySource, + ) +import Foundation (Handler, Route (InstructionsR, LicenseR)) +import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..)) +import Handler.Types.Api (ApiVersion (..)) +import Handler.Util (basicRender) +import Lib.Error (S9Error (..)) +import Lib.PkgRepository (PkgRepo, getIcon, getManifest) +import Lib.Types.Core (PkgId) +import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||)) +import Model (Category (..), Key (..), PkgDependency (..), VersionRecord (..)) +import Network.HTTP.Types (status400) +import Protolude.Unsafe (unsafeFromJust) +import Settings (AppSettings) +import Startlude ( + Applicative ((*>)), + Bifunctor (..), + Bool (..), + ByteString, + ConvertText (toS), + Down (..), + Either (..), + Eq (..), + Int, + Maybe (..), + MonadIO, + NonEmpty, + Num ((*), (-)), + Show, + Text, + Traversable (traverse), + catMaybes, + const, + encodeUtf8, + filter, + flip, + for, + fromMaybe, + headMay, + id, + mappend, + maximumOn, + nonEmpty, + note, + pure, + readMaybe, + snd, + sortOn, + zipWith, + zipWithM, + ($), + (&&&), + (.), + (.*), + (<$>), + (<&>), + (<>), + (=<<), + ) +import UnliftIO (Concurrently (..), mapConcurrently) +import Yesod ( + ContentType, + MonadLogger, + MonadResource, + YesodPersist (runDB), + lookupGetParam, + sendResponseStatus, + ) +import Yesod.Core (logWarn) + + +data PackageReq = PackageReq + { packageReqId :: !PkgId + , packageReqVersion :: !VersionRange + } + deriving (Show) +instance FromJSON PackageReq where + parseJSON = withObject "package version" $ \o -> do + packageReqId <- o .: "id" + packageReqVersion <- o .: "version" + pure PackageReq{..} + + +data PackageMetadata = PackageMetadata + { packageMetadataPkgId :: !PkgId + , packageMetadataPkgVersionRecords :: !(NonEmpty VersionRecord) + , packageMetadataPkgVersion :: !Version + , packageMetadataPkgCategories :: ![Category] + } + deriving (Eq, Show) + + +getPackageIndexR :: Handler PackageListRes +getPackageIndexR = do + osPredicate <- + getOsVersionQuery <&> \case + Nothing -> const True + Just v -> flip satisfies v + pkgIds <- getPkgIdsQuery + category <- getCategoryQuery + page <- fromMaybe 1 <$> getPageQuery + limit' <- fromMaybe 20 <$> getLimitQuery + query <- T.strip . fromMaybe "" <$> lookupGetParam "query" + let (source, packageRanges) = case pkgIds of + Nothing -> (serviceQuerySource category query, const Any) + Just packages -> + let s = getPkgDataSource (packageReqId <$> packages) + r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages) + in (s, r) + filteredPackages <- + runDB $ + runConduit $ + source + -- group conduit pipeline by pkg id + .| collateVersions + -- filter out versions of apps that are incompatible with the OS predicate + .| mapC (second (filter (osPredicate . versionRecordOsVersion))) + -- prune empty version sets + .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) + -- grab the latest matching version if it exists + .| concatMapC (\(a, b) -> (a,b,) <$> (selectLatestVersionFromSpec packageRanges b)) + -- construct + .| mapMC (\(a, b, c) -> PackageMetadata a b (versionRecordNumber c) <$> getCategoriesFor a) + -- pages start at 1 for some reason. TODO: make pages start at 0 + .| (dropC (limit' * (page - 1)) *> takeC limit') + .| sinkList + + -- NOTE: if a package's dependencies do not meet the system requirements, it is currently omitted from the list + pkgsWithDependencies <- runDB $ mapConcurrently (getPackageDependencies osPredicate) filteredPackages + PackageListRes <$> runConcurrently (zipWithM (Concurrently .* constructPackageListApiRes) filteredPackages pkgsWithDependencies) + + +parseQueryParam :: Text -> (Text -> Either Text a) -> Handler (Maybe a) +parseQueryParam param parser = do + lookupGetParam param >>= \case + Nothing -> pure Nothing + Just x -> case parser x of + Left e -> do + let err = InvalidParamsE ("get:" <> param) x + $logWarn e + sendResponseStatus status400 err + Right a -> pure (Just a) + + +getPkgIdsQuery :: Handler (Maybe [PackageReq]) +getPkgIdsQuery = parseQueryParam "ids" (first toS . eitherDecodeStrict . encodeUtf8) + + +getCategoryQuery :: Handler (Maybe Text) +getCategoryQuery = parseQueryParam "category" ((flip $ note . mappend "Invalid 'category': ") =<< (readMaybe . T.toUpper)) + + +getPageQuery :: Handler (Maybe Int) +getPageQuery = parseQueryParam "page" ((flip $ note . mappend "Invalid 'page': ") =<< readMaybe) + + +getLimitQuery :: Handler (Maybe Int) +getLimitQuery = parseQueryParam "per-page" ((flip $ note . mappend "Invalid 'per-page': ") =<< readMaybe) + + +getOsVersionQuery :: Handler (Maybe VersionRange) +getOsVersionQuery = parseQueryParam "eos-version-compat" (first toS . Atto.parseOnly parseRange) + + +getPackageDependencies :: + (MonadIO m, MonadLogger m, MonadResource m, Has PkgRepo r, MonadReader r m) => + (Version -> Bool) -> + PackageMetadata -> + ReaderT SqlBackend m (HashMap PkgId DependencyRes) +getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} = + do + pkgDepInfo <- getPkgDependencyData pkg pkgVersion + pkgDepInfoWithVersions <- traverse getDependencyVersions pkgDepInfo + let compatiblePkgDepInfo = fmap (filter (osPredicate . versionRecordOsVersion)) pkgDepInfoWithVersions + let depMetadata = catMaybes $ zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo + lift $ + fmap HM.fromList $ + for depMetadata $ \(depId, title, v) -> do + icon <- loadIcon depId v + pure $ (depId, DependencyRes title icon) + + +constructPackageListApiRes :: + (MonadResource m, MonadReader r m, Has AppSettings r, Has PkgRepo r) => + PackageMetadata -> + HashMap PkgId DependencyRes -> + m PackageRes +constructPackageListApiRes PackageMetadata{..} dependencies = do + settings <- ask @_ @_ @AppSettings + let pkgId = packageMetadataPkgId + let pkgCategories = packageMetadataPkgCategories + let pkgVersions = packageMetadataPkgVersionRecords + let pkgVersion = packageMetadataPkgVersion + manifest <- + flip runReaderT settings $ + (snd <$> getManifest pkgId pkgVersion) >>= \bs -> + runConduit $ bs .| CL.foldMap LBS.fromStrict + icon <- loadIcon pkgId pkgVersion + pure $ + PackageRes + { packageResIcon = icon + , packageResManifest = unsafeFromJust . decode $ manifest + , packageResCategories = categoryName <$> pkgCategories + , packageResInstructions = basicRender $ InstructionsR V0 pkgId + , packageResLicense = basicRender $ LicenseR V0 pkgId + , packageResVersions = versionRecordNumber <$> pkgVersions + , packageResDependencies = dependencies + } + + +loadIcon :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m (ContentType, ByteString) +loadIcon pkg version = do + (ct, _, src) <- getIcon pkg version + buffered <- runConduit $ src .| CL.foldMap id + pure (ct, buffered) + + +selectLatestVersionFromSpec :: + (PkgId -> VersionRange) -> + NonEmpty VersionRecord -> + Maybe VersionRecord +selectLatestVersionFromSpec pkgRanges vs = + let pkgId = NE.head $ versionRecordPkgId <$> vs + spec = pkgRanges (unPkgRecordKey pkgId) + in headMay . sortOn (Down . versionRecordNumber) $ NE.filter ((`satisfies` spec) . versionRecordNumber) vs + + +-- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package) +selectDependencyBestVersion :: PkgDependency -> [VersionRecord] -> Maybe (PkgId, Text, Version) +selectDependencyBestVersion pkgDepRecord depVersions = do + let depId = pkgDependencyDepId pkgDepRecord + let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord + let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) depVersions + case maximumOn versionRecordNumber satisfactory of + Just bestVersion -> Just (unPkgRecordKey depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion) + Nothing -> Nothing diff --git a/src/Handler/Types/Api.hs b/src/Handler/Types/Api.hs index e04d67e..c9a74ff 100644 --- a/src/Handler/Types/Api.hs +++ b/src/Handler/Types/Api.hs @@ -1,5 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + module Handler.Types.Api where +import Data.Aeson (Value) import GHC.Read (Read (..)) import GHC.Show (show) import Startlude ( @@ -34,3 +41,7 @@ instance PathPiece ApiVersion where fromPathPiece "v0" = Just V0 fromPathPiece "v1" = Just V1 fromPathPiece _ = Nothing + + +class ApiResponse a where + apiEncode :: ApiVersion -> a -> Value \ No newline at end of file