diff --git a/config/routes b/config/routes index 827c4a5..dc4abc5 100644 --- a/config/routes +++ b/config/routes @@ -1,6 +1,7 @@ !/package/#S9PK AppR GET -- get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec} /package/data CategoriesR GET -- get all marketplace categories /package/index PackageListR GET -- filter marketplace services by various query params +-- /package/updates /eos/latest EosR GET -- get eos information /latest-version VersionLatestR GET -- get latest version of apps in query param id /package/manifest/#AppIdentifier AppManifestR GET -- get app manifest from appmgr -- ?version={semver-spec} diff --git a/package.yaml b/package.yaml index d82d6f5..2e574e3 100644 --- a/package.yaml +++ b/package.yaml @@ -16,6 +16,7 @@ dependencies: - base >=4.12 && <5 - aeson - attoparsec +- binary - bytestring - casing - conduit @@ -23,10 +24,12 @@ dependencies: - data-default - directory - errors +- esqueleto - extra - file-embed - fast-logger - filepath +- foreign-store - http-types - interpolate - lens @@ -34,14 +37,17 @@ dependencies: - persistent - persistent-postgresql - persistent-template +- postgresql-simple - process - protolude - shakespeare - template-haskell - text +- text-conversions - time - transformers - typed-process +- unliftio - unordered-containers - unix - wai @@ -53,9 +59,6 @@ dependencies: - yesod - yesod-core - yesod-persistent -- esqueleto -- text-conversions -- foreign-store library: source-dirs: src diff --git a/src/Database/Marketplace.hs b/src/Database/Marketplace.hs index 7bed768..67bedbb 100644 --- a/src/Database/Marketplace.hs +++ b/src/Database/Marketplace.hs @@ -46,7 +46,6 @@ searchServices (Just category) 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 ++. (%)) ) pure service ) diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 7f8d1ed..bbbc9bb 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -77,11 +77,11 @@ getAppManifestR appId = do av <- getVersionFromQuery appsDir appExt >>= \case Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) Just v -> pure v - let appDir = (<> "/") . ( show av) . ( toS appId) $ appsDir + let appDir = (<> "/") . ( show av) . ( show appId) $ appsDir manifest <- handleS9ErrT $ getManifest appMgrDir appDir appExt addPackageHeader appMgrDir appDir appExt pure $ TypedContent "application/json" (toContent manifest) - where appExt = Extension (toS appId) :: Extension "s9pk" + where appExt = Extension (show appId) :: Extension "s9pk" getAppConfigR :: AppIdentifier -> Handler TypedContent getAppConfigR appId = do @@ -91,11 +91,11 @@ getAppConfigR appId = do av <- getVersionFromQuery appsDir appExt >>= \case Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) Just v -> pure v - let appDir = (<> "/") . ( show av) . ( toS appId) $ appsDir + let appDir = (<> "/") . ( show av) . ( show appId) $ appsDir config <- handleS9ErrT $ getConfig appMgrDir appDir appExt addPackageHeader appMgrDir appDir appExt pure $ TypedContent "application/json" (toContent config) - where appExt = Extension (toS appId) :: Extension "s9pk" + where appExt = Extension (show appId) :: Extension "s9pk" getAppR :: Extension "s9pk" -> Handler TypedContent getAppR e = do @@ -142,7 +142,7 @@ chunkIt fp = do recordMetrics :: String -> Version -> HandlerFor RegistryCtx () recordMetrics appId appVersion = do let appId' = T.pack appId - sa <- runDB $ fetchApp appId' + sa <- runDB $ fetchApp $ AppIdentifier appId' case sa of Nothing -> do $logError $ appId' <> " not found in database" diff --git a/src/Handler/Icons.hs b/src/Handler/Icons.hs index 7dadaba..87c6925 100644 --- a/src/Handler/Icons.hs +++ b/src/Handler/Icons.hs @@ -78,7 +78,7 @@ getLicenseR appId = do Nothing -> notFound Just p -> do respondSource typePlain (sendChunkBS =<< handleS9ErrT (getLicense appMgrDir p ext)) - where ext = Extension (toS appId) :: Extension "s9pk" + where ext = Extension (show appId) :: Extension "s9pk" getInstructionsR :: AppIdentifier -> Handler TypedContent getInstructionsR appId = do @@ -91,4 +91,4 @@ getInstructionsR appId = do Nothing -> notFound Just p -> do respondSource typePlain (sendChunkBS =<< handleS9ErrT (getInstructions appMgrDir p ext)) - where ext = Extension (toS appId) :: Extension "s9pk" + where ext = Extension (show appId) :: Extension "s9pk" diff --git a/src/Handler/Marketplace.hs b/src/Handler/Marketplace.hs index 46f0968..5b022c9 100644 --- a/src/Handler/Marketplace.hs +++ b/src/Handler/Marketplace.hs @@ -7,9 +7,11 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TupleSections #-} - +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DeriveAnyClass #-} module Handler.Marketplace where +<<<<<<< HEAD import Startlude hiding ( from , Handler , on @@ -39,6 +41,40 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.Text as T import Data.String.Interpolate.IsString import Util.Shared +======= +import Startlude hiding (from, Handler, on, sortOn) +import Foundation +import Yesod.Core +import qualified Database.Persist as P +import Model +import Yesod.Persist.Core +import Database.Marketplace +import Data.List +import Lib.Types.Category +import Lib.Types.AppIndex +import qualified Data.HashMap.Strict as HM +import Lib.Types.Emver +import qualified Data.List.NonEmpty as NE +import Database.Esqueleto.Experimental +import Lib.Error +import Network.HTTP.Types +import Lib.Registry +import Settings +import System.FilePath.Posix +import Lib.External.AppMgr +import Data.Aeson +import qualified Data.ByteString.Lazy as BS +import qualified Data.Text as T +import Data.String.Interpolate.IsString +import Util.Shared +import Lib.Types.AppIndex() +import UnliftIO.Async +import qualified Database.PostgreSQL.Simple as PS +import qualified Database.Persist.Postgresql as PP +import Database.PostgreSQL.Simple (FromRow) +import Database.PostgreSQL.Simple.FromRow (FromRow(fromRow), field) +import Database.Esqueleto.PostgreSQL (arrayAggDistinct) +>>>>>>> aggregate query functions newtype CategoryRes = CategoryRes { categories :: [CategoryTitle] @@ -82,8 +118,8 @@ instance ToContent ServiceRes where instance ToTypedContent ServiceRes where toTypedContent = toTypedContent . toJSON data DependencyInfo = DependencyInfo - { dependencyInfoTitle :: Text -- title - , dependencyInfoIcon :: Text -- url + { dependencyInfoTitle :: AppIdentifier + , dependencyInfoIcon :: URL } deriving (Eq, Show) instance ToJSON DependencyInfo where toJSON DependencyInfo {..} = object ["icon" .= dependencyInfoIcon, "title" .= dependencyInfoTitle] @@ -101,7 +137,7 @@ instance ToTypedContent ServiceListRes where toTypedContent = toTypedContent . toJSON data ServiceAvailable = ServiceAvailable - { serviceAvailableId :: Text + { serviceAvailableId :: AppIdentifier , serviceAvailableTitle :: Text , serviceAvailableVersion :: Version , serviceAvailableIcon :: URL @@ -151,8 +187,16 @@ data EosRes = EosRes , eosResReleaseNotes :: ReleaseNotes } deriving (Eq, Show, Generic) instance ToJSON EosRes where +<<<<<<< HEAD toJSON EosRes {..} = object ["version" .= eosResVersion, "headline" .= eosResHeadline, "release-notes" .= eosResReleaseNotes] +======= + toJSON EosRes { .. } = object + [ "version" .= eosResVersion + , "headline" .= eosResHeadline + , "release-notes" .= eosResReleaseNotes + ] +>>>>>>> aggregate query functions instance ToContent EosRes where toContent = toContent . toJSON instance ToTypedContent EosRes where @@ -201,8 +245,13 @@ getReleaseNotesR = do case lookup "id" getParameters of Nothing -> sendResponseStatus status400 ("expected query param \"id\" to exist" :: Text) Just package -> do +<<<<<<< HEAD (service, _ ) <- runDB $ fetchLatestApp package >>= errOnNothing status404 "package not found" (_ , mappedVersions) <- fetchAllAppVersions (entityKey service) +======= + (service, _) <- runDB $ fetchLatestApp (AppIdentifier package) >>= errOnNothing status404 "package not found" + (_, mappedVersions) <- fetchAllAppVersions (entityKey service) +>>>>>>> aggregate query functions pure mappedVersions getVersionLatestR :: Handler VersionLatestRes @@ -211,6 +260,7 @@ getVersionLatestR = do case lookup "ids" getParameters of Nothing -> sendResponseStatus status400 ("expected query param \"ids\" to exist" :: Text) Just packages -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packages of +<<<<<<< HEAD Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text) Right (p :: [AppIdentifier]) -> do let packageList :: [(AppIdentifier, Maybe Version)] = (, Nothing) <$> p @@ -227,16 +277,33 @@ getVersionLatestR = do <$> catMaybes found ) $ HM.fromList packageList +======= + Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text) + Right (p :: [AppIdentifier])-> do + let packageList :: [(AppIdentifier, Maybe Version)] = (, Nothing) <$> p + found <- runDB $ traverse fetchLatestApp $ fst <$> packageList + pure $ VersionLatestRes $ HM.union (HM.fromList $ (\v -> (sAppAppId $ entityVal $ fst v, Just $ sVersionNumber $ entityVal $ snd v)) <$> catMaybes found) $ HM.fromList packageList +>>>>>>> aggregate query functions getPackageListR :: Handler ServiceAvailableRes getPackageListR = do getParameters <- reqGetParams <$> getRequest +<<<<<<< HEAD let defaults = ServiceListDefaults { serviceListOrder = DESC , serviceListPageLimit = 20 , serviceListPageNumber = 1 , serviceListCategory = Nothing , serviceListQuery = "" } +======= + let defaults = ServiceListDefaults + { serviceListOrder = DESC + , serviceListPageLimit = 20 + , serviceListPageNumber = 1 + , serviceListCategory = Nothing + , serviceListQuery = "" + } +>>>>>>> aggregate query functions case lookup "ids" getParameters of Nothing -> do -- query for all @@ -263,13 +330,19 @@ getPackageListR = do Just l -> pure l query <- T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query" filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query - -- domain <- getsYesod $ registryHostname . appSettings - -- (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings - -- res <- runDB $ traverse (mapEntityToServiceAvailable appMgrDir appsDir domain) filteredServices - res <- traverse (getServiceDetails Nothing) filteredServices - pure $ ServiceAvailableRes res + let filteredServices' = sAppAppId . entityVal <$> filteredServices + settings <- getsYesod appSettings + packageMetadata <- runDB $ fetchPackageMetadata filteredServices' + $logInfo $ show packageMetadata + serviceDetailResult <- liftIO $ mapConcurrently (getServiceDetails settings packageMetadata Nothing) filteredServices' + let (errors, services) = partitionEithers serviceDetailResult + pure $ ServiceAvailableRes services + -- if null errors + -- then pure $ ServiceAvailableRes services + -- else sendResponseStatus status500 ("Errors acquiring service details: " <> show <$> errors) Just packageVersionList -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packageVersionList of +<<<<<<< HEAD Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text) Right (packages :: [PackageVersion]) -> do -- for each item in list get best available from version range @@ -347,10 +420,70 @@ mapDependencyMetadata :: (MonadIO m, MonadHandler m) -> Text -> (AppIdentifier, ServiceDependencyInfo) -> m (AppIdentifier, DependencyInfo) +======= + Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text) + Right (packages :: [PackageVersion])-> do + -- for each item in list get best available from version range + settings <- getsYesod appSettings + availableServices <- traverse (getPackageDetails settings) packages + packageMetadata <- runDB $ fetchPackageMetadata (snd <$> availableServices) + serviceDetailResult <- liftIO $ mapConcurrently (uncurry $ getServiceDetails settings packageMetadata) availableServices + let (errors, services) = partitionEithers serviceDetailResult + pure $ ServiceAvailableRes services + -- if null errors + -- then pure $ ServiceAvailableRes services + -- else sendResponseStatus status500 ("Errors acquiring service details: " <> show <$> errors) + where + getPackageDetails :: (MonadHandler m) => AppSettings -> PackageVersion -> m (Maybe Version, AppIdentifier) + getPackageDetails settings pv = do + let appId = packageVersionId pv + let spec = packageVersionVersion pv + let appExt = Extension (show appId) :: Extension "s9pk" + getBestVersion (( "apps") . resourcesDir $ settings) appExt spec >>= \case + Nothing -> sendResponseStatus status404 ("best version could not be found for " <> show appId <> " with spec " <> show spec :: Text) + Just v -> do + pure (Just v, appId) + +getServiceDetails :: (MonadIO m, Monad m, MonadError IOException m) => AppSettings -> (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) -> Maybe Version -> AppIdentifier -> m (Either Text ServiceRes) +getServiceDetails settings metadata maybeVersion appId = do + packageMetadata <- case HM.lookup appId metadata of + Nothing-> throwIO $ NotFoundE [i|#{appId} not found.|] + Just m -> pure m + let (appsDir, appMgrDir) = (( "apps") . resourcesDir &&& staticBinDir) settings + let domain = registryHostname settings + version <- case maybeVersion of + Nothing -> do + -- grab first value, which will be the latest version + case fst packageMetadata of + [] -> throwIO $ NotFoundE $ "no latest version found for " <> show appId + x:_ -> pure x + Just v -> pure v + let appDir = (<> "/") . ( show version) . ( show appId) $ appsDir + let appExt = Extension (show appId) :: Extension "s9pk" + manifest' <- handleS9ErrNuclear $ getManifest appMgrDir appDir appExt + case eitherDecode $ BS.fromStrict manifest' of + Left e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e + Right m -> do + d <- liftIO $ mapConcurrently (mapDependencyMetadata appsDir domain) (HM.toList $ serviceManifestDependencies m) + pure $ Right $ ServiceRes + { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|] + , serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value + , serviceResCategories = snd packageMetadata + , serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|] + , serviceResLicense = [i|https://#{domain}/package/license/#{appId}|] + , serviceResVersions = fst packageMetadata + , serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d + } + + +type URL = Text +mapDependencyMetadata :: (MonadIO m) => FilePath -> Text -> (AppIdentifier, ServiceDependencyInfo) -> m (Either Text (AppIdentifier, DependencyInfo)) +>>>>>>> aggregate query functions mapDependencyMetadata appsDir domain (appId, depInfo) = do - let ext = (Extension (toS appId) :: Extension "s9pk") + let ext = (Extension (show appId) :: Extension "s9pk") -- get best version from VersionRange of dependency version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case +<<<<<<< HEAD Nothing -> sendResponseStatus status404 ("best version not found for dependent package " <> appId :: Text) Just v -> pure v pure @@ -359,6 +492,14 @@ mapDependencyMetadata appsDir domain (appId, depInfo) = do , dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|] } ) +======= + Nothing -> throwIO $ NotFoundE $ "best version not found for dependent package " <> show appId + Just v -> pure v + pure $ Right (appId, DependencyInfo + { dependencyInfoTitle = appId + , dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|] + }) +>>>>>>> aggregate query functions decodeIcon :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL decodeIcon appmgrPath depPath e@(Extension icon) = do @@ -386,6 +527,17 @@ fetchAllAppVersions appId = do let vv = mapSVersionToVersionInfo vers let mappedVersions = ReleaseNotes $ HM.fromList $ (\v -> (versionInfoVersion v, versionInfoReleaseNotes v)) <$> vv pure (vv, mappedVersions) + where + mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo] + mapSVersionToVersionInfo sv = do + (\v -> VersionInfo { + versionInfoVersion = sVersionNumber v + , versionInfoReleaseNotes = sVersionReleaseNotes v + , versionInfoDependencies = HM.empty + , versionInfoOsRequired = sVersionOsVersionRequired v + , versionInfoOsRecommended = sVersionOsVersionRecommended v + , versionInfoInstallAlert = Nothing + }) <$> sv fetchMostRecentAppVersions :: MonadIO m => Key SApp -> ReaderT SqlBackend m [Entity SVersion] fetchMostRecentAppVersions appId = select $ do @@ -395,8 +547,9 @@ fetchMostRecentAppVersions appId = select $ do limit 1 pure version -fetchLatestApp :: MonadIO m => Text -> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion)) +fetchLatestApp :: MonadIO m => AppIdentifier -> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion)) fetchLatestApp appId = selectOne $ do +<<<<<<< HEAD (service :& version) <- from $ table @SApp @@ -410,6 +563,18 @@ fetchLatestAppAtVersion :: MonadIO m => Text -> Version -> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion)) +======= + (service :& version) <- + from $ table @SApp + `innerJoin` table @SVersion + `on` (\(service :& version) -> + service ^. SAppId ==. version ^. SVersionAppId) + where_ (service ^. SAppAppId ==. val appId) + orderBy [ desc (version ^. SVersionNumber)] + pure (service, version) + +fetchLatestAppAtVersion :: MonadIO m => AppIdentifier -> Version -> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion)) +>>>>>>> aggregate query functions fetchLatestAppAtVersion appId version' = selectOne $ do (service :& version) <- from @@ -419,6 +584,92 @@ fetchLatestAppAtVersion appId version' = selectOne $ do where_ $ (service ^. SAppAppId ==. val appId) &&. (version ^. SVersionNumber ==. val version') pure (service, version) +data PackageMetadata = PackageMetadata + { packageMetadataId :: AppIdentifier + , packageMetadataVersions :: [Version] + , packageMetadataCategories :: [CategoryTitle] + } deriving (Eq, Show, Generic) +instance RawSql PackageMetadata where + rawSqlCols _ _ = (3, []) + rawSqlColCountReason _ = "because that is the number of fields in the data type" + rawSqlProcessRow pv = case pv of + [] -> Left "empty row" + _:xs -> Right $ PackageMetadata + { packageMetadataId = case fromPersistValue $ xs !! 1 of + Left _ -> "" + Right v -> v + , packageMetadataVersions = case fromPersistValue $ xs !! 2 of + Left _ -> [] + Right v -> v + , packageMetadataCategories = case fromPersistValue $ xs !! 3 of + Left _ -> [] + Right v -> v + } +-- instance FromJSON PackageMetadata where +-- parseJSON = withObject "package data" $ \o -> do +-- packageMetadataId <- o .: "app_id" +-- packageMetadataVersions <- o .: "versions" +-- packageMetadataCategories <- o .: "categories" +-- pure PackageMetadata { .. } +-- instance ToJSON PackageMetadata where +-- toJSON PackageMetadata {..} = object +-- [ "app_id" .= packageMetadataId +-- , "versions" .= packageMetadataVersions +-- , "categories" .= packageMetadataCategories +-- ] +-- instance PersistField PackageMetadata where +-- fromPersistValue = fromPersistValueJSON +-- toPersistValue = toPersistValueJSON +-- instance FromRow PackageMetadata where +-- fromRow = PackageMetadata <$> field <*> (fmap Version <$> field) <*> (fmap parseCT <$> field) + +fetchPackageMetadataX :: MonadIO m => [AppIdentifier] -> ReaderT SqlBackend m [PackageMetadata] +fetchPackageMetadataX ids = rawSql "SELECT s.app_id, json_agg(DISTINCT v.number ORDER BY v.number DESC) AS versions, json_agg(DISTINCT c.category_name) AS categories FROM s_app s LEFT JOIN service_category c on s.id = c.service_id JOIN version v on v.app_id = s.id WHERE s.app_id IN (?) GROUP BY s.app_id" [PersistList (toPersistValue <$> ids)] + +fetchPackageMetadata :: MonadUnliftIO m => [AppIdentifier] -> ReaderT SqlBackend m (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) +fetchPackageMetadata ids = do + let categoriesQuery = select $ do + (service :& category) <- from $ table @SApp + `leftJoin` table @ServiceCategory + `on` (\(service :& category) -> Database.Esqueleto.Experimental.just (service ^. SAppId) ==. category ?. ServiceCategoryServiceId) + where_ $ + service ^. SAppAppId `in_` valList ids + Database.Esqueleto.Experimental.groupBy $ service ^. SAppAppId + pure (service ^. SAppAppId, arrayAggDistinct (category ?. ServiceCategoryCategoryName)) + let versionsQuery = select $ do + (service :& version) <- from $ 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)) + (categories, versions) <- UnliftIO.Async.concurrently categoriesQuery versionsQuery + let c = foreach categories $ \(appId, categories') -> (unValue appId, catMaybes $ fromMaybe [] (unValue categories')) + let v = foreach versions $ \(appId, versions') -> (unValue appId, fromMaybe [] (unValue versions')) + pure $ HM.intersectionWith (\ vers cts -> (vers, cts)) (HM.fromList v) (HM.fromList c) + +-- fetchPackageMetadata :: MonadIO m => [AppIdentifier] -> ReaderT SqlBackend m [PackageMetadata] +fetchPackageMetadata_ :: (MonadLogger m, MonadIO m) => [AppIdentifier] -> AppSettings -> m [PackageMetadata] +fetchPackageMetadata_ ids settings = do + let connString = PP.pgConnStr $ appDatabaseConf settings + conn <- liftIO $ PS.connectPostgreSQL connString + res <- liftIO $ PS.query conn query $ PS.Only $ PS.In ids + $logInfo $ show query + $logInfo$ show res + $logInfo$ show ids + forM res $ \(appId, versions, categories) -> + pure $ PackageMetadata + { packageMetadataId = appId + , packageMetadataVersions = versions + , packageMetadataCategories = categories + } + where + query :: PS.Query + query = "SELECT s.app_id, json_agg(DISTINCT v.number ORDER BY v.number DESC) AS versions, json_agg(DISTINCT c.category_name) AS categories FROM s_app s LEFT JOIN service_category c on s.id = c.service_id JOIN version v on v.app_id = s.id WHERE s.app_id IN ? GROUP BY s.app_id" + -- query = "SELECT \"s_app\".\"app_id\", json_agg(DISTINCT \"version\".\"number\" ORDER BY \"version\".\"number\" DESC) AS \"versions\", json_agg(DISTINCT \"service_category\".\"category_name\") AS \"categories\" FROM \"s_app\" LEFT JOIN \"service_category\" on \"s_app\".\"id\" = \"service_category\".\"service_id\" JOIN \"version\" on \"version\".\"app_id\" = \"s_app\".\"id\" WHERE \"s_app\".\"app_id\" IN ? GROUP BY \"s_app\".\"app_id\"" + fetchAppCategories :: MonadIO m => Key SApp -> ReaderT SqlBackend m [P.Entity ServiceCategory] fetchAppCategories appId = select $ do (categories :& service) <- @@ -431,6 +682,7 @@ fetchAppCategories appId = select $ do mapEntityToStoreApp :: MonadIO m => Entity SApp -> ReaderT SqlBackend m StoreApp mapEntityToStoreApp serviceEntity = do +<<<<<<< HEAD let service = entityVal serviceEntity entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity let vers = entityVal <$> entityVersion @@ -447,6 +699,33 @@ mapEntityToServiceAvailable :: (MonadIO m, MonadHandler m) => Text -> Entity SApp -> ReaderT SqlBackend m ServiceAvailable +======= + let service = entityVal serviceEntity + entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity + let vers = entityVal <$> entityVersion + let vv = mapSVersionToVersionInfo vers + pure $ StoreApp { + storeAppTitle = sAppTitle service + , storeAppDescShort = sAppDescShort service + , storeAppDescLong = sAppDescLong service + , storeAppVersionInfo = NE.fromList vv + , storeAppIconType = sAppIconType service + , storeAppTimestamp = Just (sAppCreatedAt service) -- case on if updatedAt? or always use updated time? was file timestamp + } + where + mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo] + mapSVersionToVersionInfo sv = do + (\v -> VersionInfo { + versionInfoVersion = sVersionNumber v + , versionInfoReleaseNotes = sVersionReleaseNotes v + , versionInfoDependencies = HM.empty + , versionInfoOsRequired = sVersionOsVersionRequired v + , versionInfoOsRecommended = sVersionOsVersionRecommended v + , versionInfoInstallAlert = Nothing + }) <$> sv + +mapEntityToServiceAvailable :: (MonadIO m, MonadHandler m) => Text -> Entity SApp -> ReaderT SqlBackend m ServiceAvailable +>>>>>>> aggregate query functions mapEntityToServiceAvailable domain service = do let appId = sAppAppId $ entityVal service (_, v) <- fetchLatestApp appId >>= errOnNothing status404 "service not found" diff --git a/src/Lib/Error.hs b/src/Lib/Error.hs index aa67125..e9a01e7 100644 --- a/src/Lib/Error.hs +++ b/src/Lib/Error.hs @@ -14,6 +14,7 @@ type S9ErrT m = ExceptT S9Error m data S9Error = PersistentE Text | AppMgrE Text Int + | NotFoundE Text deriving (Show, Eq) instance Exception S9Error @@ -23,10 +24,12 @@ toError :: S9Error -> Error toError = \case PersistentE t -> Error DATABASE_ERROR t AppMgrE cmd code -> Error APPMGR_ERROR [i|"appmgr #{cmd}" exited with #{code}|] + NotFoundE e -> Error NOT_FOUND [i|#{e}|] data ErrorCode = DATABASE_ERROR | APPMGR_ERROR + | NOT_FOUND deriving (Eq, Show) instance ToJSON ErrorCode where @@ -53,6 +56,7 @@ toStatus :: S9Error -> Status toStatus = \case PersistentE _ -> status500 AppMgrE _ _ -> status500 + NotFoundE _ -> status404 handleS9ErrT :: MonadHandler m => S9ErrT m a -> m a diff --git a/src/Lib/Types/AppIndex.hs b/src/Lib/Types/AppIndex.hs index da8bc99..17d45c6 100644 --- a/src/Lib/Types/AppIndex.hs +++ b/src/Lib/Types/AppIndex.hs @@ -18,12 +18,57 @@ import Lib.Types.Emver import Orphans.Emver ( ) import System.Directory import Lib.Registry -import Model +-- import Model import qualified Data.Text as T import Data.String.Interpolate.IsString import qualified Data.ByteString.Lazy as BS +import Database.Persist.Postgresql +import Yesod +import Data.Functor.Contravariant ( Contravariant(contramap) ) +import qualified GHC.Read ( Read(..) ) +import qualified GHC.Show ( Show(..) ) +import Database.PostgreSQL.Simple.ToField +import Database.PostgreSQL.Simple.FromField +import Data.Binary.Builder -type AppIdentifier = Text +newtype AppIdentifier = AppIdentifier { unAppIdentifier :: Text } + deriving (Eq) +instance IsString AppIdentifier where + fromString = AppIdentifier . fromString +instance Show AppIdentifier where + show = toS . unAppIdentifier +instance Read AppIdentifier where + readsPrec _ s = [(AppIdentifier $ toS s, "")] +instance Hashable AppIdentifier where + hashWithSalt n = hashWithSalt n . unAppIdentifier +instance FromJSON AppIdentifier where + parseJSON = fmap AppIdentifier . parseJSON +instance ToJSON AppIdentifier where + toJSON = toJSON . unAppIdentifier +instance FromJSONKey AppIdentifier where + fromJSONKey = fmap AppIdentifier fromJSONKey +instance ToJSONKey AppIdentifier where + toJSONKey = contramap unAppIdentifier toJSONKey +instance PersistField AppIdentifier where + toPersistValue = PersistText . show + fromPersistValue (PersistText t) = Right . AppIdentifier $ toS t + fromPersistValue other = Left $ "Invalid AppId: " <> show other +instance PersistFieldSql AppIdentifier where + sqlType _ = SqlString +instance PathPiece AppIdentifier where + fromPathPiece = fmap AppIdentifier . fromPathPiece + toPathPiece = unAppIdentifier +instance ToContent AppIdentifier where + toContent = toContent . toJSON +instance ToTypedContent AppIdentifier where + toTypedContent = toTypedContent . toJSON +instance ToField AppIdentifier where + toField a = toJSONField a + -- Escape $ BS.toStrict $ encode a + -- Plain $ inQuotes $ putStringUtf8 $ show a + -- $ fromByteString $ BS.toStrict $ encode a +instance FromField AppIdentifier where + fromField = fromJSONField data VersionInfo = VersionInfo { versionInfoVersion :: Version @@ -35,18 +80,6 @@ data VersionInfo = VersionInfo } deriving (Eq, Show) -mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo] -mapSVersionToVersionInfo sv = do - (\v -> VersionInfo { versionInfoVersion = sVersionNumber v - , versionInfoReleaseNotes = sVersionReleaseNotes v - , versionInfoDependencies = HM.empty - , versionInfoOsRequired = sVersionOsVersionRequired v - , versionInfoOsRecommended = sVersionOsVersionRecommended v - , versionInfoInstallAlert = Nothing - } - ) - <$> sv - instance Ord VersionInfo where compare = compare `on` versionInfoVersion diff --git a/src/Lib/Types/Category.hs b/src/Lib/Types/Category.hs index d302ae9..80ee041 100644 --- a/src/Lib/Types/Category.hs +++ b/src/Lib/Types/Category.hs @@ -3,11 +3,13 @@ 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 +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.ToField data CategoryTitle = FEATURED | BITCOIN @@ -46,3 +48,23 @@ instance ToContent CategoryTitle where toContent = toContent . toJSON instance ToTypedContent CategoryTitle where 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 diff --git a/src/Model.hs b/src/Model.hs index 30373de..11de26f 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -15,13 +15,14 @@ import Database.Persist.TH import Lib.Types.Emver import Lib.Types.Category import Orphans.Emver ( ) +import Lib.Types.AppIndex share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| SApp createdAt UTCTime updatedAt UTCTime Maybe title Text - appId Text + appId AppIdentifier descShort Text descLong Text iconType Text diff --git a/src/Orphans/Emver.hs b/src/Orphans/Emver.hs index 24976a3..502595f 100644 --- a/src/Orphans/Emver.hs +++ b/src/Orphans/Emver.hs @@ -13,6 +13,8 @@ import Lib.Types.Emver import Database.Persist.Sql import qualified Data.Text as T import Control.Monad.Fail ( MonadFail(fail) ) +import Database.PostgreSQL.Simple.FromField +import Database.PostgreSQL.Simple.ToField instance FromJSON Version where parseJSON = withText "Emver Version" $ either fail pure . Atto.parseOnly parseVersion @@ -33,3 +35,9 @@ instance PersistField VersionRange where fromPersistValue = first T.pack . Atto.parseOnly parseRange <=< fromPersistValue instance PersistFieldSql VersionRange where sqlType _ = SqlString +instance FromField Version where + fromField a = fromJSONField a +instance FromField [Version] where + fromField a = fromJSONField a +instance ToField [Version] where + toField a = toJSONField a \ No newline at end of file