diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index cb5a43f..8ab1923 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -31,7 +31,7 @@ import Startlude ( getCurrentTime, maybe, ($), - (.), + (.), Bool (True), ) import System.FilePath (takeExtension) import UnliftIO ( @@ -97,7 +97,7 @@ import Model ( VersionRecordNumber, VersionRecordPkgId, VersionRecordTitle, - VersionRecordUpdatedAt + VersionRecordUpdatedAt, PkgRecordIsLocal ), Key (unPkgRecordKey), PkgCategory, @@ -105,7 +105,6 @@ import Model ( ) import Startlude ( Applicative (pure), - Bool, Down (Down), Eq ((==)), Functor (fmap), @@ -118,7 +117,6 @@ import Startlude ( (<$>), ) - serviceQuerySource :: (MonadResource m, MonadIO m) => Maybe Text -> @@ -130,24 +128,28 @@ serviceQuerySource mCat query mOsArch = selectSource $ do Just osArch -> do service <- case mCat of Nothing -> do - (service :& vp) <- from $ table @VersionRecord + (service :& vp :& pr) <- from $ table @VersionRecord `innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service)) + `innerJoin` table @PkgRecord `on` (\(v :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v)) where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber) where_ (vp ^. VersionPlatformArch ==. val osArch) + where_ (pr ^. PkgRecordIsLocal ==. val True) where_ $ queryInMetadata query service pure service Just category -> do - (service :& _ :& cat :& vp) <- + (service :& _ :& cat :& vp :& pr) <- from $ table @VersionRecord `innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId) `innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b)) `innerJoin` table @VersionPlatform `on` (\(service :& _ :& _ :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service)) + `innerJoin` table @PkgRecord `on` (\(v :& _ :& _ :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v)) -- if there is a cateogry, only search in category -- weight title, short, long (bitcoin should equal Bitcoin Core) where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber) where_ (vp ^. VersionPlatformArch ==. val osArch) + where_ (pr ^. PkgRecordIsLocal ==. val True) pure service groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber) orderBy @@ -159,18 +161,22 @@ serviceQuerySource mCat query mOsArch = selectSource $ do Nothing -> do service <- case mCat of Nothing -> do - service <- from $ table @VersionRecord + (service :& pr) <- from $ table @VersionRecord + `innerJoin` table @PkgRecord `on` (\(v :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v)) where_ $ queryInMetadata query service + where_ (pr ^. PkgRecordIsLocal ==. val True) pure service Just category -> do - (service :& _ :& cat) <- + (service :& _ :& cat :& pr) <- from $ table @VersionRecord `innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId) `innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b)) + `innerJoin` table @PkgRecord `on` (\(v :& _ :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v)) -- if there is a cateogry, only search in category -- weight title, short, long (bitcoin should equal Bitcoin Core) where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service + where_ (pr ^. PkgRecordIsLocal ==. val True) pure service groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber) orderBy @@ -207,14 +213,15 @@ getPkgDependencyData :: MonadIO m => PkgId -> Version -> - ReaderT SqlBackend m [PkgDependency] -getPkgDependencyData pkgId pkgVersion = fmap (fmap entityVal) $ + ReaderT SqlBackend m [(P.Entity PkgDependency, P.Entity PkgRecord)] +getPkgDependencyData pkgId pkgVersion = select $ from $ do - pkgDepRecord <- from $ table @PkgDependency + (pkgDepRecord :& pr) <- from $ table @PkgDependency + `innerJoin` table @PkgRecord `on` (\(v :& p) -> (PkgRecordId === PkgDependencyPkgId) (p :& v)) where_ (pkgDepRecord ^. PkgDependencyPkgId ==. val (PkgRecordKey pkgId)) where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion) - pure pkgDepRecord + pure (pkgDepRecord, pr) (===) :: @@ -315,7 +322,7 @@ upsertPackageVersion PackageManifest{..} = do iconType packageManifestReleaseNotes packageManifestEosVersion - _res <- try @_ @SomeException $ insertKey pkgId (PkgRecord now (Just now)) + _res <- try @_ @SomeException $ insertKey pkgId (PkgRecord True now (Just now)) repsert (VersionRecordKey pkgId packageManifestVersion) ins upsertPackageVersionPlatform :: (MonadUnliftIO m) => PackageManifest -> ReaderT SqlBackend m () diff --git a/src/Handler/Package/Api.hs b/src/Handler/Package/Api.hs index 7804b86..179a489 100644 --- a/src/Handler/Package/Api.hs +++ b/src/Handler/Package/Api.hs @@ -17,6 +17,7 @@ import Startlude ( ByteString, Eq, Generic, + Bool, NonEmpty, Show, Text, @@ -76,10 +77,11 @@ instance ApiResponse PackageRes where data DependencyRes = DependencyRes { dependencyResTitle :: !Text , dependencyResIcon :: !(ContentType, ByteString) + , dependencyResIsLocal :: !Bool } 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] + apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle, "is-local" .= dependencyResIsLocal] + apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle, "is-local" .= dependencyResIsLocal] diff --git a/src/Handler/Package/V1/Index.hs b/src/Handler/Package/V1/Index.hs index ce39c1c..bb872ff 100644 --- a/src/Handler/Package/V1/Index.hs +++ b/src/Handler/Package/V1/Index.hs @@ -32,7 +32,7 @@ import Handler.Util (basicRender, parseQueryParam, getArchQuery) 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 Model (Category (..), Key (..), PkgDependency (..), VersionRecord (..), PkgRecord (pkgRecordIsLocal)) import Protolude.Unsafe (unsafeFromJust) import Settings (AppSettings) import Startlude ( @@ -87,6 +87,9 @@ import Yesod ( YesodPersist (runDB), lookupGetParam, ) +import Data.Tuple (fst) +import Data.Tuple.Extra (both) +import Database.Persist.Postgresql (entityVal) data PackageReq = PackageReq { packageReqId :: !PkgId @@ -177,15 +180,16 @@ getPackageDependencies :: ReaderT SqlBackend m (HashMap PkgId DependencyRes) getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} = do - pkgDepInfo <- getPkgDependencyData pkg pkgVersion - pkgDepInfoWithVersions <- traverse getDependencyVersions pkgDepInfo + pkgDepInfo' <- getPkgDependencyData pkg pkgVersion + let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo' + pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> 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 + for depMetadata $ \(depId, title, v, isLocal) -> do icon <- loadIcon depId v - pure $ (depId, DependencyRes title icon) + pure $ (depId, DependencyRes title icon isLocal) constructPackageListApiRes :: @@ -237,11 +241,13 @@ selectLatestVersionFromSpec pkgRanges 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 +selectDependencyBestVersion :: (PkgDependency, PkgRecord) -> [VersionRecord] -> Maybe (PkgId, Text, Version, Bool) +selectDependencyBestVersion pkgDepInfo depVersions = do + let pkgDepRecord = fst pkgDepInfo + let isLocal = pkgRecordIsLocal $ snd pkgDepInfo 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) + Just bestVersion -> Just (unPkgRecordKey depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal) Nothing -> Nothing diff --git a/src/Lib/PkgRepository.hs b/src/Lib/PkgRepository.hs index ba1cdf5..71d6c06 100644 --- a/src/Lib/PkgRepository.hs +++ b/src/Lib/PkgRepository.hs @@ -206,7 +206,7 @@ loadPkgDependencies appConnPool manifest = do time <- liftIO getCurrentTime _ <- runWith appConnPool $ - insertKey (PkgRecordKey pkgId) (PkgRecord time Nothing) `catch` \(e :: SqlError) -> + insertKey (PkgRecordKey pkgId) (PkgRecord True time Nothing) `catch` \(e :: SqlError) -> -- 23505 is "already exists" if sqlState e == "23505" then update (PkgRecordKey pkgId) [PkgRecordUpdatedAt =. Just time] else throwIO e let deps' = first PkgRecordKey <$> HM.toList deps @@ -215,7 +215,7 @@ loadPkgDependencies appConnPool manifest = do ( \d -> flip runSqlPool appConnPool $ do _ <- runWith appConnPool $ - insertKey (fst d) (PkgRecord time Nothing) `catch` \(e :: SqlError) -> + insertKey (fst d) (PkgRecord True time Nothing) `catch` \(e :: SqlError) -> -- 23505 is "already exists" if sqlState e == "23505" then update (fst d) [PkgRecordUpdatedAt =. Just time] else throwIO e insertUnique $ diff --git a/src/Model.hs b/src/Model.hs index e1a8509..b9a10ff 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -36,6 +36,7 @@ import Startlude ( Text, UTCTime, Word32, + Bool ) @@ -44,6 +45,7 @@ share [persistLowerCase| PkgRecord Id PkgId sql=pkg_id + isLocal Bool default=True createdAt UTCTime updatedAt UTCTime Maybe deriving Eq