Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-30 19:54:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

clean up

Browse Source
This commit is contained in:
Lucy Cifferello
2021-09-21 23:58:34 -06:00
committed by Keagan McClelland
parent 7b2684acd5
commit bce777f991
4 changed files with 111 additions and 332 deletions
Download Patch File Download Diff File Expand all files Collapse all files

421
src/Handler/Marketplace.hs
View File

@@ -11,7 +11,6 @@
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
module Handler.Marketplace where module Handler.Marketplace where
<<<<<<< HEAD
import Startlude hiding ( from import Startlude hiding ( from
, Handler , Handler
, on , on
@@ -41,40 +40,9 @@ import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T import qualified Data.Text as T
import Data.String.Interpolate.IsString import Data.String.Interpolate.IsString
import Util.Shared import Util.Shared
======= import Lib.Types.AppIndex ( )
import Startlude hiding (from, Handler, on, sortOn) import UnliftIO.Async
import Foundation import Database.Esqueleto.PostgreSQL ( arrayAggDistinct )
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 { newtype CategoryRes = CategoryRes {
categories :: [CategoryTitle] categories :: [CategoryTitle]
@@ -187,16 +155,8 @@ data EosRes = EosRes
, eosResReleaseNotes :: ReleaseNotes , eosResReleaseNotes :: ReleaseNotes
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
instance ToJSON EosRes where instance ToJSON EosRes where
<<<<<<< HEAD
toJSON EosRes {..} = toJSON EosRes {..} =
object ["version" .= eosResVersion, "headline" .= eosResHeadline, "release-notes" .= eosResReleaseNotes] 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 instance ToContent EosRes where
toContent = toContent . toJSON toContent = toContent . toJSON
instance ToTypedContent EosRes where instance ToTypedContent EosRes where
@@ -245,13 +205,8 @@ getReleaseNotesR = do
case lookup "id" getParameters of case lookup "id" getParameters of
Nothing -> sendResponseStatus status400 ("expected query param \"id\" to exist" :: Text) Nothing -> sendResponseStatus status400 ("expected query param \"id\" to exist" :: Text)
Just package -> do Just package -> do
<<<<<<< HEAD
(service, _ ) <- runDB $ fetchLatestApp package >>= errOnNothing status404 "package not found" (service, _ ) <- runDB $ fetchLatestApp package >>= errOnNothing status404 "package not found"
(_ , mappedVersions) <- fetchAllAppVersions (entityKey service) (_ , mappedVersions) <- fetchAllAppVersions (entityKey service)
=======
(service, _) <- runDB $ fetchLatestApp (AppIdentifier package) >>= errOnNothing status404 "package not found"
(_, mappedVersions) <- fetchAllAppVersions (entityKey service)
>>>>>>> aggregate query functions
pure mappedVersions pure mappedVersions
getVersionLatestR :: Handler VersionLatestRes getVersionLatestR :: Handler VersionLatestRes
@@ -260,7 +215,6 @@ getVersionLatestR = do
case lookup "ids" getParameters of case lookup "ids" getParameters of
Nothing -> sendResponseStatus status400 ("expected query param \"ids\" to exist" :: Text) Nothing -> sendResponseStatus status400 ("expected query param \"ids\" to exist" :: Text)
Just packages -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packages of Just packages -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packages of
<<<<<<< HEAD
Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text) Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text)
Right (p :: [AppIdentifier]) -> do Right (p :: [AppIdentifier]) -> do
let packageList :: [(AppIdentifier, Maybe Version)] = (, Nothing) <$> p let packageList :: [(AppIdentifier, Maybe Version)] = (, Nothing) <$> p
@@ -277,33 +231,16 @@ getVersionLatestR = do
<$> catMaybes found <$> catMaybes found
) )
$ HM.fromList packageList $ 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 :: Handler ServiceAvailableRes
getPackageListR = do getPackageListR = do
getParameters <- reqGetParams <$> getRequest getParameters <- reqGetParams <$> getRequest
<<<<<<< HEAD
let defaults = ServiceListDefaults { serviceListOrder = DESC let defaults = ServiceListDefaults { serviceListOrder = DESC
, serviceListPageLimit = 20 , serviceListPageLimit = 20
, serviceListPageNumber = 1 , serviceListPageNumber = 1
, serviceListCategory = Nothing , serviceListCategory = Nothing
, serviceListQuery = "" , serviceListQuery = ""
} }
=======
let defaults = ServiceListDefaults
{ serviceListOrder = DESC
, serviceListPageLimit = 20
, serviceListPageNumber = 1
, serviceListCategory = Nothing
, serviceListQuery = ""
}
>>>>>>> aggregate query functions
case lookup "ids" getParameters of case lookup "ids" getParameters of
Nothing -> do Nothing -> do
-- query for all -- query for all
@@ -331,175 +268,105 @@ getPackageListR = do
query <- T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query" query <- T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query"
filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query
let filteredServices' = sAppAppId . entityVal <$> filteredServices let filteredServices' = sAppAppId . entityVal <$> filteredServices
settings <- getsYesod appSettings settings <- getsYesod appSettings
packageMetadata <- runDB $ fetchPackageMetadata filteredServices' packageMetadata <- runDB $ fetchPackageMetadata filteredServices'
$logInfo $ show packageMetadata $logInfo $ show packageMetadata
serviceDetailResult <- liftIO $ mapConcurrently (getServiceDetails settings packageMetadata Nothing) filteredServices' serviceDetailResult <- liftIO
let (errors, services) = partitionEithers serviceDetailResult $ mapConcurrently (getServiceDetails settings packageMetadata Nothing) filteredServices'
let (_, services) = partitionEithers serviceDetailResult
pure $ ServiceAvailableRes services pure $ ServiceAvailableRes services
-- if null errors -- if null errors
-- then pure $ ServiceAvailableRes services -- then pure $ ServiceAvailableRes services
-- else sendResponseStatus status500 ("Errors acquiring service details: " <> show <$> errors) -- else sendResponseStatus status500 ("Errors acquiring service details: " <> show <$> errors)
Just packageVersionList -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packageVersionList of Just packageVersionList -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packageVersionList of
<<<<<<< HEAD
Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text) Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text)
Right (packages :: [PackageVersion]) -> do Right (packages :: [PackageVersion]) -> do
-- for each item in list get best available from version range -- for each item in list get best available from version range
availableServices <- traverse getPackageDetails packages settings <- getsYesod appSettings
services <- traverse (uncurry getServiceDetails) availableServices availableServices <- traverse (getPackageDetails settings) packages
packageMetadata <- runDB $ fetchPackageMetadata (snd <$> availableServices)
serviceDetailResult <- liftIO
$ mapConcurrently (uncurry $ getServiceDetails settings packageMetadata) availableServices
let (_, services) = partitionEithers serviceDetailResult
pure $ ServiceAvailableRes services pure $ ServiceAvailableRes services
where
getPackageDetails :: PackageVersion -> HandlerFor RegistryCtx (Maybe (Entity SVersion), Entity SApp)
getPackageDetails pv = do
appsDir <- getsYesod $ ((</> "apps") . resourcesDir) . appSettings
let appId = packageVersionId pv
let spec = packageVersionVersion pv
let appExt = Extension (toS appId) :: Extension "s9pk"
getBestVersion appsDir appExt spec >>= \case
Nothing -> sendResponseStatus
status404
("best version could not be found for " <> appId <> " with spec " <> show spec :: Text)
Just v -> do
(service, version) <- runDB $ fetchLatestAppAtVersion appId v >>= errOnNothing
status404
("service at version " <> show v <> " not found")
pure (Just version, service)
getServiceR :: Handler ServiceRes
getServiceR = do
getParameters <- reqGetParams <$> getRequest
(service, version) <- case lookup "id" getParameters of
Nothing -> sendResponseStatus status404 ("id param should exist" :: Text)
Just appId' -> do
case lookup "version" getParameters of
-- default to latest - @TODO need to determine best available based on OS version?
Nothing -> runDB $ fetchLatestApp appId' >>= errOnNothing status404 "service not found"
Just v -> do
case readMaybe v of
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
Just vv -> runDB $ fetchLatestAppAtVersion appId' vv >>= errOnNothing
status404
("service at version " <> show v <> " not found")
getServiceDetails (Just version) service
getServiceDetails :: Maybe (Entity SVersion) -> Entity SApp -> HandlerFor RegistryCtx ServiceRes
getServiceDetails maybeVersion service = do
(versions, _) <- fetchAllAppVersions (entityKey service)
categories <- runDB $ fetchAppCategories (entityKey service)
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
domain <- getsYesod $ registryHostname . appSettings
let appId = sAppAppId $ entityVal service
version <- case maybeVersion of
Nothing -> do
(_, version) <- runDB $ fetchLatestApp appId >>= errOnNothing status404 "service not found"
pure $ sVersionNumber $ entityVal version
Just v -> pure $ sVersionNumber $ entityVal v
let appDir = (<> "/") . (</> show version) . (</> toS appId) $ appsDir
let appExt = Extension (toS appId) :: Extension "s9pk"
manifest' <- handleS9ErrT $ getManifest appMgrDir appDir appExt
manifest <- case eitherDecode $ BS.fromStrict manifest' of
Left e -> do
$logError "could not parse service manifest!"
$logError (show e)
sendResponseStatus status500 ("Internal Server Error" :: Text)
Right a -> pure a
d <- traverse (mapDependencyMetadata appsDir domain) (HM.toList $ serviceManifestDependencies manifest)
pure $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
, serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value
, serviceResCategories = serviceCategoryCategoryName . entityVal <$> categories
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|]
, serviceResLicense = [i|https://#{domain}/package/license/#{appId}|]
, serviceResVersions = versionInfoVersion <$> versions
, serviceResDependencyInfo = HM.fromList d
}
type URL = Text
mapDependencyMetadata :: (MonadIO m, MonadHandler m)
=> FilePath
-> 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 -- if null errors
-- then pure $ ServiceAvailableRes services -- then pure $ ServiceAvailableRes services
-- else sendResponseStatus status500 ("Errors acquiring service details: " <> show <$> errors) -- else sendResponseStatus status500 ("Errors acquiring service details: " <> show <$> errors)
where where
getPackageDetails :: (MonadHandler m) => AppSettings -> PackageVersion -> m (Maybe Version, AppIdentifier) getPackageDetails :: (MonadHandler m)
=> AppSettings
-> PackageVersion
-> m (Maybe Version, AppIdentifier)
getPackageDetails settings pv = do getPackageDetails settings pv = do
let appId = packageVersionId pv let appId = packageVersionId pv
let spec = packageVersionVersion pv let spec = packageVersionVersion pv
let appExt = Extension (show appId) :: Extension "s9pk" let appExt = Extension (show appId) :: Extension "s9pk"
getBestVersion ((</> "apps") . resourcesDir $ settings) appExt spec >>= \case getBestVersion ((</> "apps") . resourcesDir $ settings) appExt spec >>= \case
Nothing -> sendResponseStatus status404 ("best version could not be found for " <> show appId <> " with spec " <> show spec :: Text) Nothing -> sendResponseStatus
status404
("best version could not be found for " <> show appId <> " with spec " <> show spec :: Text)
Just v -> do Just v -> do
pure (Just v, appId) 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 :: (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 getServiceDetails settings metadata maybeVersion appId = do
packageMetadata <- case HM.lookup appId metadata of packageMetadata <- case HM.lookup appId metadata of
Nothing-> throwIO $ NotFoundE [i|#{appId} not found.|] Nothing -> throwIO $ NotFoundE [i|#{appId} not found.|]
Just m -> pure m Just m -> pure m
let (appsDir, appMgrDir) = ((</> "apps") . resourcesDir &&& staticBinDir) settings let (appsDir, appMgrDir) = ((</> "apps") . resourcesDir &&& staticBinDir) settings
let domain = registryHostname settings let domain = registryHostname settings
version <- case maybeVersion of version <- case maybeVersion of
Nothing -> do Nothing -> do
-- grab first value, which will be the latest version -- grab first value, which will be the latest version
case fst packageMetadata of case fst packageMetadata of
[] -> throwIO $ NotFoundE $ "no latest version found for " <> show appId [] -> throwIO $ NotFoundE $ "no latest version found for " <> show appId
x:_ -> pure x x : _ -> pure x
Just v -> pure v Just v -> pure v
let appDir = (<> "/") . (</> show version) . (</> show appId) $ appsDir let appDir = (<> "/") . (</> show version) . (</> show appId) $ appsDir
let appExt = Extension (show appId) :: Extension "s9pk" let appExt = Extension (show appId) :: Extension "s9pk"
manifest' <- handleS9ErrNuclear $ getManifest appMgrDir appDir appExt manifest' <- handleS9ErrNuclear $ getManifest appMgrDir appDir appExt
case eitherDecode $ BS.fromStrict manifest' of case eitherDecode $ BS.fromStrict manifest' of
Left e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e Left e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e
Right m -> do Right m -> do
d <- liftIO $ mapConcurrently (mapDependencyMetadata appsDir domain) (HM.toList $ serviceManifestDependencies m) d <- liftIO
pure $ Right $ ServiceRes $ mapConcurrently (mapDependencyMetadata appsDir domain) (HM.toList $ serviceManifestDependencies m)
{ serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|] pure $ Right $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
, serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value , serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value
, serviceResCategories = snd packageMetadata , serviceResCategories = snd packageMetadata
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|] , serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|]
, serviceResLicense = [i|https://#{domain}/package/license/#{appId}|] , serviceResLicense = [i|https://#{domain}/package/license/#{appId}|]
, serviceResVersions = fst packageMetadata , serviceResVersions = fst packageMetadata
, serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d , serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d
} }
type URL = Text type URL = Text
mapDependencyMetadata :: (MonadIO m) => FilePath -> Text -> (AppIdentifier, ServiceDependencyInfo) -> m (Either Text (AppIdentifier, DependencyInfo)) mapDependencyMetadata :: (MonadIO m)
>>>>>>> aggregate query functions => FilePath
-> Text
-> (AppIdentifier, ServiceDependencyInfo)
-> m (Either Text (AppIdentifier, DependencyInfo))
mapDependencyMetadata appsDir domain (appId, depInfo) = do mapDependencyMetadata appsDir domain (appId, depInfo) = do
let ext = (Extension (show appId) :: Extension "s9pk") let ext = (Extension (show appId) :: Extension "s9pk")
-- get best version from VersionRange of dependency -- get best version from VersionRange of dependency
version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case
<<<<<<< HEAD Nothing -> throwIO $ NotFoundE $ "best version not found for dependent package " <> show appId
Nothing -> sendResponseStatus status404 ("best version not found for dependent package " <> appId :: Text)
Just v -> pure v Just v -> pure v
pure pure $ Right
( appId ( appId
, DependencyInfo { dependencyInfoTitle = appId , DependencyInfo { dependencyInfoTitle = appId
, dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|] , 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 :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL
decodeIcon appmgrPath depPath e@(Extension icon) = do decodeIcon appmgrPath depPath e@(Extension icon) = do
@@ -530,14 +397,15 @@ fetchAllAppVersions appId = do
where where
mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo] mapSVersionToVersionInfo :: [SVersion] -> [VersionInfo]
mapSVersionToVersionInfo sv = do mapSVersionToVersionInfo sv = do
(\v -> VersionInfo { (\v -> VersionInfo { versionInfoVersion = sVersionNumber v
versionInfoVersion = sVersionNumber v , versionInfoReleaseNotes = sVersionReleaseNotes v
, versionInfoReleaseNotes = sVersionReleaseNotes v , versionInfoDependencies = HM.empty
, versionInfoDependencies = HM.empty , versionInfoOsRequired = sVersionOsVersionRequired v
, versionInfoOsRequired = sVersionOsVersionRequired v , versionInfoOsRecommended = sVersionOsVersionRecommended v
, versionInfoOsRecommended = sVersionOsVersionRecommended v , versionInfoInstallAlert = Nothing
, versionInfoInstallAlert = Nothing }
}) <$> sv )
<$> sv
fetchMostRecentAppVersions :: MonadIO m => Key SApp -> ReaderT SqlBackend m [Entity SVersion] fetchMostRecentAppVersions :: MonadIO m => Key SApp -> ReaderT SqlBackend m [Entity SVersion]
fetchMostRecentAppVersions appId = select $ do fetchMostRecentAppVersions appId = select $ do
@@ -549,7 +417,6 @@ fetchMostRecentAppVersions appId = select $ do
fetchLatestApp :: MonadIO m => AppIdentifier -> 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 fetchLatestApp appId = selectOne $ do
<<<<<<< HEAD
(service :& version) <- (service :& version) <-
from from
$ table @SApp $ table @SApp
@@ -563,18 +430,6 @@ fetchLatestAppAtVersion :: MonadIO m
=> Text => Text
-> Version -> Version
-> ReaderT SqlBackend m (Maybe (P.Entity SApp, P.Entity SVersion)) -> 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 fetchLatestAppAtVersion appId version' = selectOne $ do
(service :& version) <- (service :& version) <-
from from
@@ -584,91 +439,39 @@ fetchLatestAppAtVersion appId version' = selectOne $ do
where_ $ (service ^. SAppAppId ==. val appId) &&. (version ^. SVersionNumber ==. val version') where_ $ (service ^. SAppAppId ==. val appId) &&. (version ^. SVersionNumber ==. val version')
pure (service, version) pure (service, version)
data PackageMetadata = PackageMetadata fetchPackageMetadata :: MonadUnliftIO m
{ packageMetadataId :: AppIdentifier => [AppIdentifier]
, packageMetadataVersions :: [Version] -> ReaderT SqlBackend m (HM.HashMap AppIdentifier ([Version], [CategoryTitle]))
, 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 fetchPackageMetadata ids = do
let categoriesQuery = select $ do let categoriesQuery = select $ do
(service :& category) <- from $ table @SApp (service :& category) <-
`leftJoin` table @ServiceCategory from
`on` (\(service :& category) -> Database.Esqueleto.Experimental.just (service ^. SAppId) ==. category ?. ServiceCategoryServiceId) $ table @SApp
where_ $ `leftJoin` table @ServiceCategory
service ^. SAppAppId `in_` valList ids `on` (\(service :& category) ->
Database.Esqueleto.Experimental.just (service ^. SAppId)
==. category
?. ServiceCategoryServiceId
)
where_ $ service ^. SAppAppId `in_` valList ids
Database.Esqueleto.Experimental.groupBy $ service ^. SAppAppId Database.Esqueleto.Experimental.groupBy $ service ^. SAppAppId
pure (service ^. SAppAppId, arrayAggDistinct (category ?. ServiceCategoryCategoryName)) pure (service ^. SAppAppId, arrayAggDistinct (category ?. ServiceCategoryCategoryName))
let versionsQuery = select $ do let versionsQuery = select $ do
(service :& version) <- from $ table @SApp (service :& version) <-
`innerJoin` table @SVersion from
`on` (\(service :& version) -> (service ^. SAppId) ==. version ^. SVersionAppId) $ table @SApp
where_ $ `innerJoin` table @SVersion
service ^. SAppAppId `in_` valList ids `on` (\(service :& version) -> (service ^. SAppId) ==. version ^. SVersionAppId)
orderBy [ desc (version ^. SVersionNumber) ] where_ $ service ^. SAppAppId `in_` valList ids
orderBy [desc (version ^. SVersionNumber)]
Database.Esqueleto.Experimental.groupBy $ (service ^. SAppAppId, version ^. SVersionNumber) Database.Esqueleto.Experimental.groupBy $ (service ^. SAppAppId, version ^. SVersionNumber)
pure (service ^. SAppAppId, arrayAggDistinct (version ^. SVersionNumber)) pure (service ^. SAppAppId, arrayAggDistinct (version ^. SVersionNumber))
(categories, versions) <- UnliftIO.Async.concurrently categoriesQuery versionsQuery (categories, versions) <- UnliftIO.Async.concurrently categoriesQuery versionsQuery
let c = foreach categories $ \(appId, categories') -> (unValue appId, catMaybes $ fromMaybe [] (unValue categories')) let
c = foreach categories
$ \(appId, categories') -> (unValue appId, catMaybes $ fromMaybe [] (unValue categories'))
let v = foreach versions $ \(appId, versions') -> (unValue appId, fromMaybe [] (unValue versions')) let v = foreach versions $ \(appId, versions') -> (unValue appId, fromMaybe [] (unValue versions'))
pure $ HM.intersectionWith (\ vers cts -> (vers, cts)) (HM.fromList v) (HM.fromList c) 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 :: MonadIO m => Key SApp -> ReaderT SqlBackend m [P.Entity ServiceCategory]
fetchAppCategories appId = select $ do fetchAppCategories appId = select $ do
@@ -682,7 +485,6 @@ fetchAppCategories appId = select $ do
mapEntityToStoreApp :: MonadIO m => Entity SApp -> ReaderT SqlBackend m StoreApp mapEntityToStoreApp :: MonadIO m => Entity SApp -> ReaderT SqlBackend m StoreApp
mapEntityToStoreApp serviceEntity = do mapEntityToStoreApp serviceEntity = do
<<<<<<< HEAD
let service = entityVal serviceEntity let service = entityVal serviceEntity
entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity entityVersion <- fetchMostRecentAppVersions $ entityKey serviceEntity
let vers = entityVal <$> entityVersion let vers = entityVal <$> entityVersion
@@ -694,38 +496,23 @@ mapEntityToStoreApp serviceEntity = do
, storeAppIconType = sAppIconType service , storeAppIconType = sAppIconType service
, storeAppTimestamp = Just (sAppCreatedAt service) -- case on if updatedAt? or always use updated time? was file timestamp , 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) mapEntityToServiceAvailable :: (MonadIO m, MonadHandler m)
=> Text => Text
-> Entity SApp -> Entity SApp
-> ReaderT SqlBackend m ServiceAvailable -> 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 mapEntityToServiceAvailable domain service = do
let appId = sAppAppId $ entityVal service let appId = sAppAppId $ entityVal service
(_, v) <- fetchLatestApp appId >>= errOnNothing status404 "service not found" (_, v) <- fetchLatestApp appId >>= errOnNothing status404 "service not found"

6
src/Lib/External/AppMgr.hs vendored
View File

@@ -59,7 +59,7 @@ getManifest appmgrPath appPath e@(Extension appId) = do
ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect manifest #{appId}|] n ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect manifest #{appId}|] n
getIcon :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString getIcon :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString
getIcon appmgrPath appPath e@(Extension icon) = do getIcon appmgrPath appPath (Extension icon) = do
(ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", appPath] "" (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", appPath] ""
case ec of case ec of
ExitSuccess -> pure bs ExitSuccess -> pure bs
@@ -73,14 +73,14 @@ getPackageHash appmgrPath appPath e@(Extension appId) = do
ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect hash #{appId}|] n ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect hash #{appId}|] n
getInstructions :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString getInstructions :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString
getInstructions appmgrPath appPath e@(Extension appId) = do getInstructions appmgrPath appPath (Extension appId) = do
(ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", appPath] "" (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", appPath] ""
case ec of case ec of
ExitSuccess -> pure bs ExitSuccess -> pure bs
ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect instructions #{appId}|] n ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect instructions #{appId}|] n
getLicense :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString getLicense :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString
getLicense appmgrPath appPath e@(Extension appId) = do getLicense appmgrPath appPath (Extension appId) = do
(ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", appPath] "" (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", appPath] ""
case ec of case ec of
ExitSuccess -> pure bs ExitSuccess -> pure bs

10
src/Lib/Types/AppIndex.hs
View File

@@ -27,9 +27,6 @@ import Yesod
import Data.Functor.Contravariant ( Contravariant(contramap) ) import Data.Functor.Contravariant ( Contravariant(contramap) )
import qualified GHC.Read ( Read(..) ) import qualified GHC.Read ( Read(..) )
import qualified GHC.Show ( Show(..) ) import qualified GHC.Show ( Show(..) )
import Database.PostgreSQL.Simple.ToField
import Database.PostgreSQL.Simple.FromField
import Data.Binary.Builder
newtype AppIdentifier = AppIdentifier { unAppIdentifier :: Text } newtype AppIdentifier = AppIdentifier { unAppIdentifier :: Text }
deriving (Eq) deriving (Eq)
@@ -62,13 +59,6 @@ instance ToContent AppIdentifier where
toContent = toContent . toJSON toContent = toContent . toJSON
instance ToTypedContent AppIdentifier where instance ToTypedContent AppIdentifier where
toTypedContent = toTypedContent . toJSON 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 data VersionInfo = VersionInfo
{ versionInfoVersion :: Version { versionInfoVersion :: Version

6
src/Lib/Types/Category.hs
View File

@@ -8,8 +8,6 @@ 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 data CategoryTitle = FEATURED
| BITCOIN | BITCOIN
@@ -47,6 +45,7 @@ instance FromJSON CategoryTitle where
instance ToContent CategoryTitle where instance ToContent CategoryTitle where
toContent = toContent . toJSON toContent = toContent . toJSON
instance ToTypedContent CategoryTitle where instance ToTypedContent CategoryTitle where
<<<<<<< HEAD
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
<<<<<<< HEAD <<<<<<< HEAD
======= =======
@@ -68,3 +67,6 @@ parseCT = \case
"alt coin" -> ALTCOIN "alt coin" -> ALTCOIN
-- _ -> fail "unknown category title" -- _ -> fail "unknown category title"
>>>>>>> aggregate query functions >>>>>>> aggregate query functions
=======
toTypedContent = toTypedContent . toJSON
>>>>>>> clean up