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

rework package list endpoint, version latest, and release notes

Browse Source
This commit is contained in:
Lucy Cifferello
2021-07-16 12:04:56 -04:00
committed by Keagan McClelland
parent d53262e143
commit 2ee06007c7
3 changed files with 126 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
config/routes
View File

@@ -1,9 +1,9 @@
!/package/#S9PK AppR GET -- get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec} !/package/#S9PK AppR GET -- get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec}
/marketplace/data CategoriesR GET -- get all marketplace categories /data CategoriesR GET -- get all marketplace categories
/marketplace/available/list ServiceListR GET -- filter marketplace services by various query params /packages PackageListR GET -- filter marketplace services by various query params
/marketplace/available ServiceR GET -- get service information /eos EosR GET -- get eos information
/marketplace/Extension EosR GET -- get eos information /version/latest VersionLatestR GET -- get latest version of apps in query param id
-- TODO deprecate -- TODO deprecate

160
src/Handler/Marketplace.hs
View File

@@ -6,10 +6,11 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
module Handler.Marketplace where module Handler.Marketplace where
import Startlude hiding (from, Handler, on) import Startlude hiding (from, Handler, on, sortOn)
import Foundation import Foundation
import Yesod.Core import Yesod.Core
import qualified Database.Persist as P import qualified Database.Persist as P
@@ -52,7 +53,6 @@ data ServiceRes = ServiceRes
, serviceResLicense :: Text , serviceResLicense :: Text
, serviceResVersions :: [Version] , serviceResVersions :: [Version]
, serviceResDependencyInfo :: HM.HashMap AppIdentifier DependencyInfo , serviceResDependencyInfo :: HM.HashMap AppIdentifier DependencyInfo
, serviceResReleaseNotes :: ReleaseNotes
} deriving (Show, Generic) } deriving (Show, Generic)
newtype ReleaseNotes = ReleaseNotes { unReleaseNotes :: HM.HashMap Version Text } newtype ReleaseNotes = ReleaseNotes { unReleaseNotes :: HM.HashMap Version Text }
@@ -62,13 +62,12 @@ instance ToJSON ReleaseNotes where
instance ToJSON ServiceRes where instance ToJSON ServiceRes where
toJSON ServiceRes {..} = object toJSON ServiceRes {..} = object
[ "icon" .= serviceResIcon [ "icon" .= serviceResIcon
, "license" .= serviceResLicense
, "instructions" .= serviceResInstructions
, "manifest" .= serviceResManifest , "manifest" .= serviceResManifest
, "categories" .= serviceResCategories , "categories" .= serviceResCategories
, "instructions" .= serviceResInstructions
, "license" .= serviceResLicense
, "versions" .= serviceResVersions , "versions" .= serviceResVersions
, "dependency-metadata" .= serviceResDependencyInfo , "dependency-metadata" .= serviceResDependencyInfo
, "release-notes" .= serviceResReleaseNotes
] ]
instance ToContent ServiceRes where instance ToContent ServiceRes where
toContent = toContent . toJSON toContent = toContent . toJSON
@@ -118,7 +117,7 @@ instance ToContent ServiceAvailable where
instance ToTypedContent ServiceAvailable where instance ToTypedContent ServiceAvailable where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
newtype ServiceAvailableRes = ServiceAvailableRes [ServiceAvailable] newtype ServiceAvailableRes = ServiceAvailableRes [ServiceRes]
deriving (Show, Generic) deriving (Show, Generic)
instance ToJSON ServiceAvailableRes instance ToJSON ServiceAvailableRes
instance ToContent ServiceAvailableRes where instance ToContent ServiceAvailableRes where
@@ -126,6 +125,13 @@ instance ToContent ServiceAvailableRes where
instance ToTypedContent ServiceAvailableRes where instance ToTypedContent ServiceAvailableRes where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
newtype VersionLatestRes = VersionLatestRes (HM.HashMap AppIdentifier (Maybe Version))
deriving (Show, Generic)
instance ToJSON VersionLatestRes
instance ToContent VersionLatestRes where
toContent = toContent . toJSON
instance ToTypedContent VersionLatestRes where
toTypedContent = toTypedContent . toJSON
data OrderArrangement = ASC | DESC data OrderArrangement = ASC | DESC
deriving (Eq, Show, Read) deriving (Eq, Show, Read)
data ServiceListDefaults = ServiceListDefaults data ServiceListDefaults = ServiceListDefaults
@@ -136,7 +142,6 @@ data ServiceListDefaults = ServiceListDefaults
, serviceListQuery :: Text , serviceListQuery :: Text
} }
deriving (Eq, Show, Read) deriving (Eq, Show, Read)
data EosRes = EosRes data EosRes = EosRes
{ eosResVersion :: Version { eosResVersion :: Version
, eosResHeadline :: Text , eosResHeadline :: Text
@@ -148,9 +153,19 @@ instance ToContent EosRes where
instance ToTypedContent EosRes where instance ToTypedContent EosRes where
toTypedContent = toTypedContent . toJSON toTypedContent = toTypedContent . toJSON
data PackageVersion = PackageVersion
{ packageVersionId :: AppIdentifier
, packageVersionVersion :: VersionRange
} deriving (Show)
instance FromJSON PackageVersion where
parseJSON = withObject "package version" $ \o -> do
packageVersionId <- o .: "id"
packageVersionVersion <- o .: "version"
pure PackageVersion { .. }
getCategoriesR :: Handler CategoryRes getCategoriesR :: Handler CategoryRes
getCategoriesR = do getCategoriesR = do
allCategories <- runDB $ select $ do allCategories <- runDB $ select $ do
cats <- from $ table @Category cats <- from $ table @Category
orderBy [desc (cats ^. CategoryPriority)] orderBy [desc (cats ^. CategoryPriority)]
pure cats pure cats
@@ -160,55 +175,100 @@ getEosR :: Handler EosRes
getEosR = do getEosR = do
allEosVersions <- runDB $ select $ do allEosVersions <- runDB $ select $ do
vers <- from $ table @OsVersion vers <- from $ table @OsVersion
orderBy [desc (vers ^. OsVersionUpdatedAt)] orderBy [desc (vers ^. OsVersionCreatedAt)]
pure vers pure vers
let osV = entityVal <$> allEosVersions let osV = entityVal <$> allEosVersions
let latest = Data.List.head osV let latest = Data.List.head osV
let mappedVersions = ReleaseNotes $ HM.fromList $ (\v -> (osVersionNumber v, osVersionReleaseNotes v)) <$> osV let mappedVersions = ReleaseNotes $ HM.fromList $ sortOn (Down . fst) $ (\v -> (osVersionNumber v, osVersionReleaseNotes v)) <$> osV
pure $ EosRes pure $ EosRes
{ eosResVersion = osVersionNumber latest { eosResVersion = osVersionNumber latest
, eosResHeadline = osVersionHeadline latest , eosResHeadline = osVersionHeadline latest
, eosResReleaseNotes = mappedVersions , eosResReleaseNotes = mappedVersions
} }
getServiceListR :: Handler ServiceAvailableRes getReleaseNotesR :: Handler ReleaseNotes
getServiceListR = do getReleaseNotesR = do
getParameters <- reqGetParams <$> getRequest getParameters <- reqGetParams <$> getRequest
let defaults = ServiceListDefaults { case lookup "id" getParameters of
serviceListOrder = DESC Nothing -> sendResponseStatus status400 ("expected query param \"id\" to exist" :: Text)
Just package -> do
(service, _) <- runDB $ fetchLatestApp package >>= errOnNothing status404 "package not found"
(_, mappedVersions) <- fetchAllAppVersions (entityKey service)
pure mappedVersions
getVersionLatestR :: Handler VersionLatestRes
getVersionLatestR = do
getParameters <- reqGetParams <$> getRequest
case lookup "ids" getParameters of
Nothing -> sendResponseStatus status400 ("expected query param \"ids\" to exist" :: Text)
Just packages -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packages of
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 :: AppIdentifier, Just $ sVersionNumber $ entityVal $ snd v)) <$> catMaybes found) $ HM.fromList packageList
getPackageListR :: Handler ServiceAvailableRes
getPackageListR = do
getParameters <- reqGetParams <$> getRequest
let defaults = ServiceListDefaults
{ serviceListOrder = DESC
, serviceListPageLimit = 20 , serviceListPageLimit = 20
, serviceListPageNumber = 1 , serviceListPageNumber = 1
, serviceListCategory = ANY , serviceListCategory = ANY
, serviceListQuery = "" , serviceListQuery = ""
} }
category <- case lookup "category" getParameters of case lookup "ids" getParameters of
Nothing -> pure $ serviceListCategory defaults Nothing -> do
Just c -> case readMaybe $ T.toUpper c of -- query for all
Nothing -> do category <- case lookup "category" getParameters of
$logInfo c Nothing -> pure $ serviceListCategory defaults
sendResponseStatus status400 ("could not read category" :: Text) Just c -> case readMaybe $ T.toUpper c of
Just t -> pure t Nothing -> do
page <- case lookup "page" getParameters of $logInfo c
Nothing -> pure $ serviceListPageNumber defaults sendResponseStatus status400 ("could not read category" :: Text)
Just p -> case readMaybe p of Just t -> pure t
Nothing -> do page <- case lookup "page" getParameters of
$logInfo p Nothing -> pure $ serviceListPageNumber defaults
sendResponseStatus status400 ("could not read page" :: Text) Just p -> case readMaybe p of
Just t -> pure $ case t of Nothing -> do
0 -> 1 -- disallow page 0 so offset is not negative $logInfo p
_ -> t sendResponseStatus status400 ("could not read page" :: Text)
limit' <- case lookup "per-page" getParameters of Just t -> pure $ case t of
Nothing -> pure $ serviceListPageLimit defaults 0 -> 1 -- disallow page 0 so offset is not negative
Just c -> case readMaybe $ toS c of _ -> t
Nothing -> sendResponseStatus status400 ("could not read per-page" :: Text) limit' <- case lookup "per-page" getParameters of
Just l -> pure l Nothing -> pure $ serviceListPageLimit defaults
query <- T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query" Just c -> case readMaybe $ toS c of
$logInfo $ show category Nothing -> sendResponseStatus status400 ("could not read per-page" :: Text)
filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query Just l -> pure l
domain <- getsYesod $ registryHostname . appSettings query <- T.filter (not . isSpace) . fromMaybe (serviceListQuery defaults) <$> lookupGetParam "query"
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings filteredServices <- runDB $ searchServices category limit' ((page - 1) * limit') query
res <- runDB $ traverse (mapEntityToServiceAvailable appMgrDir appsDir domain) filteredServices -- domain <- getsYesod $ registryHostname . appSettings
pure $ ServiceAvailableRes res -- (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
-- res <- runDB $ traverse (mapEntityToServiceAvailable appMgrDir appsDir domain) filteredServices
res <- traverse (getServiceDetails Nothing) filteredServices
pure $ ServiceAvailableRes res
Just packageVersionList -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packageVersionList of
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
availableServices <- traverse getPackageDetails packages
services <- traverse (uncurry getServiceDetails) availableServices
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 :: Handler ServiceRes
getServiceR = do getServiceR = do
@@ -223,11 +283,20 @@ getServiceR = do
case readMaybe v of case readMaybe v of
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text) Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
Just vv -> runDB $ fetchLatestAppAtVersion appId' vv >>= errOnNothing status404 ("service at version " <> show v <> " not found") 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, mappedVersions) <- fetchAllAppVersions (entityKey service) (versions, mappedVersions) <- fetchAllAppVersions (entityKey service)
categories <- runDB $ fetchAppCategories (entityKey service) categories <- runDB $ fetchAppCategories (entityKey service)
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
domain <- getsYesod $ registryHostname . appSettings domain <- getsYesod $ registryHostname . appSettings
let appId = sAppAppId $ entityVal service let appId = sAppAppId $ entityVal service
version <- case maybeVersion of
Nothing -> do
(_, version) <- runDB $ fetchLatestApp appId >>= errOnNothing status404 "service not found"
pure version
Just v -> pure v
let appDir = (<> "/") . (</> show (sVersionNumber $ entityVal version)) . (</> toS appId) $ appsDir let appDir = (<> "/") . (</> show (sVersionNumber $ entityVal version)) . (</> toS appId) $ appsDir
let appExt = Extension (toS appId) :: Extension "s9pk" let appExt = Extension (toS appId) :: Extension "s9pk"
manifest' <- handleS9ErrT $ getManifest appMgrDir appDir appExt manifest' <- handleS9ErrT $ getManifest appMgrDir appDir appExt
@@ -244,7 +313,6 @@ getServiceR = do
let icon = [i|https://#{domain}/icons/#{appId}.png|] let icon = [i|https://#{domain}/icons/#{appId}.png|]
instructions <- decodeInstructions appMgrDir depPath appExt instructions <- decodeInstructions appMgrDir depPath appExt
license <- decodeLicense appMgrDir depPath appExt license <- decodeLicense appMgrDir depPath appExt
addPackageHeader appMgrDir appDir appExt
pure $ ServiceRes pure $ ServiceRes
{ serviceResIcon = icon { serviceResIcon = icon
, serviceResManifest = manifest -- TypedContent "application/json" (toContent manifest) , serviceResManifest = manifest -- TypedContent "application/json" (toContent manifest)
@@ -253,7 +321,6 @@ getServiceR = do
, serviceResLicense = license , serviceResLicense = license
, serviceResVersions = versionInfoVersion <$> versions , serviceResVersions = versionInfoVersion <$> versions
, serviceResDependencyInfo = HM.fromList d , serviceResDependencyInfo = HM.fromList d
, serviceResReleaseNotes = mappedVersions
} }
type URL = Text type URL = Text
@@ -261,8 +328,9 @@ mapDependencyMetadata :: (MonadIO m, MonadHandler m) => FilePath -> FilePath ->
mapDependencyMetadata appsDir appmgrPath domain (appId, depInfo) = do mapDependencyMetadata appsDir appmgrPath domain (appId, depInfo) = do
let ext = (Extension (toS appId) :: Extension "s9pk") let ext = (Extension (toS appId) :: Extension "s9pk")
-- get best version from VersionRange of dependency -- get best version from VersionRange of dependency
$logInfo $ show appsDir
version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case
Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text) Nothing -> sendResponseStatus status404 ("best version not found for dependent package " <> appId :: Text)
Just v -> pure v Just v -> pure v
let depPath = appsDir </> toS appId </> show version let depPath = appsDir </> toS appId </> show version
-- @TODO uncomment when sdk icon working -- @TODO uncomment when sdk icon working

8
src/Util/Shared.hs
View File

@@ -1,3 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
module Util.Shared where module Util.Shared where
import Startlude hiding (Handler) import Startlude hiding (Handler)
@@ -23,9 +25,15 @@ getVersionFromQuery rootDir ext = do
getBestVersion :: (MonadIO m, KnownSymbol a, MonadLogger m) => FilePath -> Extension a -> VersionRange -> m (Maybe Version) getBestVersion :: (MonadIO m, KnownSymbol a, MonadLogger m) => FilePath -> Extension a -> VersionRange -> m (Maybe Version)
getBestVersion rootDir ext spec = do getBestVersion rootDir ext spec = do
-- @TODO change to db query?
appVersions <- liftIO $ getAvailableAppVersions rootDir ext appVersions <- liftIO $ getAvailableAppVersions rootDir ext
$logInfo $ show appVersions
$logInfo $ show spec
$logInfo $ show ext
let satisfactory = filter ((<|| spec) . fst . unRegisteredAppVersion) appVersions let satisfactory = filter ((<|| spec) . fst . unRegisteredAppVersion) appVersions
let best = getMax <$> foldMap (Just . Max . fst . unRegisteredAppVersion) satisfactory let best = getMax <$> foldMap (Just . Max . fst . unRegisteredAppVersion) satisfactory
$logInfo $ show satisfactory
$logInfo $ show best
pure best pure best
addPackageHeader :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m () addPackageHeader :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m ()