mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
aggregate query functions
This commit is contained in:
committed by
Keagan McClelland
parent
e2d2fb6afc
commit
7b2684acd5
@@ -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}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
Reference in New Issue
Block a user