{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} module Database.Queries where import Database.Persist.Sql ( PersistStoreRead (get), PersistStoreWrite (insertKey, insert_, repsert), SqlBackend, ) import Lib.Types.Core ( PkgId, ) import Lib.Types.Emver (Version) import Model ( Key (PkgRecordKey, VersionRecordKey), Metric (Metric), PkgDependency (..), PkgRecord (PkgRecord), VersionRecord (VersionRecord), ) import Orphans.Emver () import Startlude ( ConvertText (toS), Maybe (..), MonadIO (..), ReaderT, SomeException, getCurrentTime, maybe, ($), (.), ) import System.FilePath (takeExtension) import UnliftIO ( MonadUnliftIO, try, ) import Conduit ( ConduitT, MonadResource, awaitForever, leftover, yield, ) import Control.Monad.Loops (unfoldM) import Data.Conduit (await) import Database.Esqueleto.Experimental ( PersistEntity, SqlExpr, Value, asc, desc, from, groupBy, ilike, in_, innerJoin, on, orderBy, select, selectSource, table, val, valList, where_, (%), (&&.), (++.), (:&) (..), (==.), (^.), (||.), ) import Database.Persist qualified as P import Database.Persist.Postgresql ( ConnectionPool, Entity (entityVal), runSqlPool, ) import Lib.Types.Manifest (PackageManifest (..)) import Model ( Category, EntityField ( CategoryId, CategoryName, PkgCategoryCategoryId, PkgCategoryPkgId, PkgDependencyPkgId, PkgDependencyPkgVersion, PkgRecordId, VersionRecordDescLong, VersionRecordDescShort, VersionRecordNumber, VersionRecordPkgId, VersionRecordTitle, VersionRecordUpdatedAt ), Key (unPkgRecordKey), PkgCategory, VersionRecord (versionRecordNumber, versionRecordPkgId), ) import Startlude ( Applicative (pure), Bool, Down (Down), Eq ((==)), Functor (fmap), Monad, Text, headMay, snd, sortOn, ($>), (<$>), ) serviceQuerySource :: (MonadResource m, MonadIO m) => Maybe Text -> Text -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) () serviceQuerySource mCat query = selectSource $ do service <- case mCat of Nothing -> do service <- from $ table @VersionRecord where_ $ queryInMetadata query service pure service Just category -> do (service :& _ :& cat) <- from $ table @VersionRecord `innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId) `innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b)) -- 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 pure service groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber) orderBy [ asc (service ^. VersionRecordPkgId) , desc (service ^. VersionRecordNumber) , desc (service ^. VersionRecordUpdatedAt) ] pure service queryInMetadata :: Text -> SqlExpr (Entity VersionRecord) -> (SqlExpr (Value Bool)) queryInMetadata query service = (service ^. VersionRecordDescShort `ilike` (%) ++. val query ++. (%)) ||. (service ^. VersionRecordDescLong `ilike` (%) ++. val query ++. (%)) ||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%)) getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) () getPkgDataSource pkgs = selectSource $ do pkgData <- from $ table @VersionRecord where_ (pkgData ^. VersionRecordPkgId `in_` valList (PkgRecordKey <$> pkgs)) pure pkgData getPkgDependencyData :: MonadIO m => PkgId -> Version -> ReaderT SqlBackend m [PkgDependency] getPkgDependencyData pkgId pkgVersion = fmap (fmap entityVal) $ select $ from $ do pkgDepRecord <- from $ table @PkgDependency where_ (pkgDepRecord ^. PkgDependencyPkgId ==. val (PkgRecordKey pkgId)) where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion) pure pkgDepRecord (===) :: (PersistEntity val1, PersistEntity val2, P.PersistField typ) => EntityField val1 typ -> EntityField val2 typ -> (SqlExpr (Entity val1) :& SqlExpr (Entity val2)) -> SqlExpr (Value Bool) (===) a' b' (a :& b) = a ^. a' ==. b ^. b' getCategoriesFor :: MonadUnliftIO m => PkgId -> ReaderT SqlBackend m [Category] getCategoriesFor pkg = fmap (fmap entityVal) $ select $ do (sc :& cat) <- from $ table @PkgCategory `innerJoin` table @Category `on` (PkgCategoryCategoryId === CategoryId) where_ (sc ^. PkgCategoryPkgId ==. val (PkgRecordKey pkg)) pure cat collateVersions :: MonadUnliftIO m => ConduitT (Entity VersionRecord) (PkgId, [VersionRecord]) (ReaderT SqlBackend m) () collateVersions = awaitForever $ \v0 -> do let pkg = unPkgRecordKey . versionRecordPkgId $ entityVal v0 let pull = do mvn <- await case mvn of Nothing -> pure Nothing Just vn -> do let pkg' = unPkgRecordKey . versionRecordPkgId $ entityVal vn if pkg == pkg' then pure (Just vn) else leftover vn $> Nothing ls <- unfoldM pull yield (pkg, fmap entityVal $ v0 : ls) getDependencyVersions :: (Monad m, MonadIO m) => PkgDependency -> ReaderT SqlBackend m [VersionRecord] getDependencyVersions pkgDepRecord = do let pkgDbId = pkgDependencyDepId pkgDepRecord depVers <- select $ do v <- from $ table @VersionRecord where_ $ v ^. VersionRecordPkgId ==. val pkgDbId pure v pure $ entityVal <$> depVers fetchAllPkgVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m [VersionRecord] fetchAllPkgVersions appConnPool appId = do entityAppVersions <- runSqlPool (P.selectList [VersionRecordPkgId P.==. PkgRecordKey appId] []) appConnPool pure $ entityVal <$> entityAppVersions fetchAppVersion :: MonadIO m => PkgId -> Version -> ReaderT SqlBackend m (Maybe VersionRecord) fetchAppVersion pkgId version = get (VersionRecordKey (PkgRecordKey pkgId) version) fetchLatestApp :: MonadIO m => PkgId -> ReaderT SqlBackend m (Maybe (P.Entity PkgRecord, P.Entity VersionRecord)) fetchLatestApp appId = fmap headMay . sortResults . select $ do (service :& version) <- from $ table @PkgRecord `innerJoin` table @VersionRecord `on` (\(service :& version) -> service ^. PkgRecordId ==. version ^. VersionRecordPkgId) where_ (service ^. PkgRecordId ==. val (PkgRecordKey appId)) pure (service, version) where sortResults = fmap $ sortOn (Down . versionRecordNumber . entityVal . snd) createMetric :: MonadIO m => PkgId -> Version -> ReaderT SqlBackend m () createMetric appId version = do time <- liftIO getCurrentTime insert_ $ Metric time (PkgRecordKey appId) version upsertPackageVersion :: (MonadUnliftIO m) => PackageManifest -> ReaderT SqlBackend m () upsertPackageVersion PackageManifest{..} = do now <- liftIO getCurrentTime let iconType = maybe "png" (toS . takeExtension . toS) packageManifestIcon let pkgId = PkgRecordKey packageManifestId let ins = VersionRecord now (Just now) pkgId packageManifestVersion packageManifestTitle packageManifestDescriptionShort packageManifestDescriptionLong iconType packageManifestReleaseNotes packageManifestEosVersion Nothing _res <- try @_ @SomeException $ insertKey pkgId (PkgRecord now (Just now)) repsert (VersionRecordKey pkgId packageManifestVersion) ins