aggregate query functions

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}

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

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
         )

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"

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"

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
+    { dependencyInfoTitle :: AppIdentifier
-    , dependencyInfoIcon :: Text -- url
+    , 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
+            let filteredServices' = sAppAppId . entityVal <$> filteredServices
-            -- (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
+            settings <- getsYesod appSettings
-            -- res <- runDB $ traverse (mapEntityToServiceAvailable appMgrDir appsDir domain) filteredServices
+            packageMetadata <- runDB $ fetchPackageMetadata filteredServices'
-            res <- traverse (getServiceDetails Nothing) filteredServices
+            $logInfo $ show packageMetadata
-            pure $ ServiceAvailableRes res
+            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"

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

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
 

src/Lib/Types/Category.hs

@@ -3,11 +3,13 @@
 
 module Lib.Types.Category where
 
-import           Startlude
+import Startlude
-import           Database.Persist.Postgresql
+import Database.Persist.Postgresql
-import           Data.Aeson
+import Data.Aeson
-import           Control.Monad
+import Control.Monad
-import           Yesod.Core
+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

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

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