diff --git a/src/Database/Marketplace.hs b/src/Database/Marketplace.hs index 67bedbb..6660dd6 100644 --- a/src/Database/Marketplace.hs +++ b/src/Database/Marketplace.hs @@ -23,7 +23,6 @@ searchServices Nothing pageItems offset' query = select $ do ( (service ^. SAppDescShort `ilike` (%) ++. val query ++. (%)) ||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%)) ||. (service ^. SAppTitle `ilike` (%) ++. val query ++. (%)) - ||. (service ^. SAppAppId `ilike` (%) ++. val query ++. (%)) ) orderBy [desc (service ^. SAppUpdatedAt)] limit pageItems diff --git a/src/Handler/Icons.hs b/src/Handler/Icons.hs index 030ba8b..138e8cf 100644 --- a/src/Handler/Icons.hs +++ b/src/Handler/Icons.hs @@ -39,7 +39,7 @@ getIconsR appId = do spec <- getVersionFromQuery appsDir ext >>= \case Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) Just v -> pure v - let appDir = (<> "/") . ( show spec) . ( toS appId) $ appsDir + let appDir = (<> "/") . ( show spec) . ( show appId) $ appsDir manifest' <- handleS9ErrT $ getManifest appMgrDir appDir ext manifest <- case eitherDecode manifest' of Left e -> do @@ -65,7 +65,7 @@ getIconsR appId = do -- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe }) -- respondSource typePlain (runConduit $ yieldMany () [iconBs]) -- respondSource typePlain $ sourceHandle hout .| awaitForever sendChunkBS - where ext = Extension (toS appId) :: Extension "s9pk" + where ext = Extension (show appId) :: Extension "s9pk" getLicenseR :: AppIdentifier -> Handler TypedContent getLicenseR appId = do diff --git a/src/Handler/Marketplace.hs b/src/Handler/Marketplace.hs index ccd3743..8b90a2a 100644 --- a/src/Handler/Marketplace.hs +++ b/src/Handler/Marketplace.hs @@ -41,7 +41,6 @@ import Startlude hiding ( Handler ) import System.FilePath.Posix import UnliftIO.Async -import Util.Shared import Yesod.Core import Yesod.Persist.Core @@ -287,7 +286,7 @@ getPackageListR = do query let filteredServices' = sAppAppId . entityVal <$> filteredServices settings <- getsYesod appSettings - packageMetadata <- time "metadata" $ runDB $ fetchPackageMetadata $ Just filteredServices' + packageMetadata <- time "metadata" $ runDB $ fetchPackageMetadata $logInfo $ show packageMetadata serviceDetailResult <- time "service details" $ liftIO $ mapConcurrently (getServiceDetails settings packageMetadata Nothing) @@ -304,7 +303,7 @@ getPackageListR = do -- for each item in list get best available from version range settings <- getsYesod appSettings -- @TODO fix _ error - packageMetadata <- time "metadata2" $ runDB $ fetchPackageMetadata Nothing + packageMetadata <- time "metadata2" $ runDB $ fetchPackageMetadata availableServicesResult <- traverse (getPackageDetails packageMetadata) packages let (_, availableServices) = partitionEithers availableServicesResult serviceDetailResult <- time "service details 2" $ liftIO $ mapConcurrently @@ -319,6 +318,21 @@ getPackageListR = do + + + + + + + + + + + + + + + @@ -326,18 +340,27 @@ getPackageListR = do where - getPackageDetails :: MonadIO m => (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) -> PackageVersion -> m (Either Text ((Maybe Version), AppIdentifier)) + getPackageDetails :: MonadIO m + => (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) + -> PackageVersion + -> m (Either Text ((Maybe Version), AppIdentifier)) getPackageDetails metadata pv = do let appId = packageVersionId pv - let spec = packageVersionVersion pv + let spec = packageVersionVersion pv pacakgeMetadata <- case HM.lookup appId metadata of - Nothing-> throwIO $ NotFoundE [i|dependency metadata for #{appId} not found.|] - Just m -> pure m + Nothing -> throwIO $ NotFoundE [i|dependency metadata for #{appId} not found.|] + Just m -> pure m -- get best version from VersionRange of dependency let satisfactory = filter (<|| spec) (fst pacakgeMetadata) - let best = getMax <$> foldMap (Just . Max) satisfactory + let best = getMax <$> foldMap (Just . Max) satisfactory case best of - Nothing -> pure $ Left $ "best version could not be found for " <> show appId <> " with spec " <> show spec + Nothing -> + pure + $ Left + $ "best version could not be found for " + <> show appId + <> " with spec " + <> show spec Just v -> do pure $ Right (Just v, appId) @@ -471,10 +494,8 @@ fetchLatestAppAtVersion appId version' = selectOne $ do where_ $ (service ^. SAppAppId ==. val appId) &&. (version ^. SVersionNumber ==. val version') pure (service, version) -fetchPackageMetadata :: MonadUnliftIO m - => Maybe [AppIdentifier] - -> ReaderT SqlBackend m (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) -fetchPackageMetadata ids = do +fetchPackageMetadata :: MonadUnliftIO m => ReaderT SqlBackend m (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) +fetchPackageMetadata = do let categoriesQuery = select $ do (service :& category) <- from @@ -485,8 +506,6 @@ fetchPackageMetadata ids = do ==. category ?. ServiceCategoryServiceId ) - -- where_ $ - -- service ^. SAppAppId `in_` valList ids Database.Esqueleto.Experimental.groupBy $ service ^. SAppAppId pure (service ^. SAppAppId, arrayAggDistinct (category ?. ServiceCategoryCategoryName)) let versionsQuery = select $ do @@ -495,8 +514,6 @@ fetchPackageMetadata ids = do $ table @SApp `innerJoin` table @SVersion `on` (\(service :& version) -> (service ^. SAppId) ==. version ^. SVersionAppId) - -- where_ $ - -- service ^. SAppAppId `in_` valList ids orderBy [desc (version ^. SVersionNumber)] Database.Esqueleto.Experimental.groupBy $ (service ^. SAppAppId, version ^. SVersionNumber) pure (service ^. SAppAppId, arrayAggDistinct (version ^. SVersionNumber)) diff --git a/src/Lib/Types/Category.hs b/src/Lib/Types/Category.hs index 13f9b47..d302ae9 100644 --- a/src/Lib/Types/Category.hs +++ b/src/Lib/Types/Category.hs @@ -3,11 +3,11 @@ module Lib.Types.Category where -import Startlude -import Database.Persist.Postgresql -import Data.Aeson -import Control.Monad -import Yesod.Core +import Startlude +import Database.Persist.Postgresql +import Data.Aeson +import Control.Monad +import Yesod.Core data CategoryTitle = FEATURED | BITCOIN @@ -45,28 +45,4 @@ instance FromJSON CategoryTitle where instance ToContent CategoryTitle where toContent = toContent . toJSON instance ToTypedContent CategoryTitle where -<<<<<<< HEAD toTypedContent = toTypedContent . toJSON -<<<<<<< HEAD -======= -instance FromField CategoryTitle where - fromField a = fromJSONField a -instance FromField [CategoryTitle] where - fromField a = fromJSONField a -instance ToField [CategoryTitle] where - toField a = toJSONField a - -parseCT :: Text -> CategoryTitle -parseCT = \case - "featured" -> FEATURED - "bitcoin" -> BITCOIN - "lightning" -> LIGHTNING - "data" -> DATA - "messaging" -> MESSAGING - "social" -> SOCIAL - "alt coin" -> ALTCOIN - -- _ -> fail "unknown category title" ->>>>>>> aggregate query functions -======= - toTypedContent = toTypedContent . toJSON ->>>>>>> clean up