From d2f8db82cf71f2434bd4e2dcb8d0cd8954d46cc3 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello <12953208+elvece@users.noreply.github.com> Date: Fri, 2 Jul 2021 17:35:20 -0400 Subject: [PATCH] add architecture to version table; refactor to remove dependency on apps.yaml --- config/routes | 7 ++-- src/Database/Queries.hs | 5 +-- src/Handler/Apps.hs | 67 +++++++------------------------------- src/Handler/Marketplace.hs | 8 ----- src/Handler/Version.hs | 1 + src/Lib/Registry.hs | 2 +- src/Lib/Types/Category.hs | 1 - src/Model.hs | 1 + src/Settings.hs | 6 ---- src/Util/Shared.hs | 1 - 10 files changed, 19 insertions(+), 80 deletions(-) diff --git a/config/routes b/config/routes index 2bd895e..0db7157 100644 --- a/config/routes +++ b/config/routes @@ -1,8 +1,5 @@ - - -/apps AppsManifestR GET -- get current apps listing -/package/manifest/#AppIdentifier AppManifestR GET -- get app manifest from appmgr -- ?spec={semver-spec} -/package/config/#AppIdentifier AppConfigR GET -- get app config from appmgr -- ?spec={semver-spec} +/package/manifest/#AppIdentifier AppManifestR GET -- get app manifest from appmgr -- ?spec={semver-spec} +/package/config/#AppIdentifier AppConfigR GET -- get app config from appmgr -- ?spec={semver-spec} /version VersionR GET diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index 8eeed7b..555af78 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -22,8 +22,8 @@ createApp appId StoreApp {..} = do time <- liftIO getCurrentTime insertUnique $ SApp time Nothing storeAppTitle appId storeAppDescShort storeAppDescLong storeAppIconType -createAppVersion :: MonadIO m => Key SApp -> VersionInfo -> ReaderT SqlBackend m (Maybe (Key SVersion)) -createAppVersion sId VersionInfo {..} = do +createAppVersion :: MonadIO m => Key SApp -> VersionInfo -> Text -> ReaderT SqlBackend m (Maybe (Key SVersion)) +createAppVersion sId VersionInfo {..} arch = do time <- liftIO getCurrentTime insertUnique $ SVersion time Nothing @@ -32,6 +32,7 @@ createAppVersion sId VersionInfo {..} = do versionInfoReleaseNotes versionInfoOsRequired versionInfoOsRecommended + arch createMetric :: MonadIO m => Key SApp -> Key SVersion -> ReaderT SqlBackend m () createMetric appId versionId = do diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 5274c43..10da8d6 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -45,7 +45,6 @@ import Database.Queries import Network.Wai ( Request(requestHeaderUserAgent) ) import Util.Shared - pureLog :: Show a => a -> Handler a pureLog = liftA2 (*>) ($logInfo . show) pure @@ -68,35 +67,6 @@ getEmbassyOsVersion = userAgentOsVersion userAgentOsVersion = (hush . Atto.parseOnly userAgentOsVersionParser . decodeUtf8 <=< requestHeaderUserAgent) <$> waiRequest -getAppsManifestR :: Handler TypedContent -getAppsManifestR = do - osVersion <- getEmbassyOsVersion - appsDir <- ( "apps") . resourcesDir . appSettings <$> getYesod - let appResourceFile = appsDir "apps.yaml" - manifest <- liftIO (Yaml.decodeFileEither appResourceFile) >>= \case - Left e -> do - $logError "COULD NOT PARSE APP INDEX! CORRECT IMMEDIATELY!" - $logError (show e) - sendResponseStatus status500 ("Internal Server Error" :: Text) - Right a -> pure a - m <- mapM (addFileTimestamp' appsDir) (HM.toList $ unAppManifest manifest) - let withServiceTimestamps = AppManifest $ HM.fromList m - let pruned = case osVersion of - Nothing -> withServiceTimestamps - Just av -> AppManifest $ HM.mapMaybe (filterOsRecommended av) $ unAppManifest withServiceTimestamps - pure $ TypedContent "application/x-yaml" (toContent $ Yaml.encode pruned) - where - addFileTimestamp' :: (MonadHandler m, MonadIO m) => FilePath -> (AppIdentifier, StoreApp) -> m (AppIdentifier, StoreApp) - addFileTimestamp' dir (appId, service) = do - let ext = (Extension (toS appId) :: Extension "s9pk") - mostRecentVersion <- liftIO $ getMostRecentAppVersion dir ext - (v, _) <- case mostRecentVersion of - Nothing -> notFound - Just a -> pure $ unRegisteredAppVersion a - liftIO (addFileTimestamp dir ext service v) >>= \case - Nothing -> notFound - Just appWithTimestamp -> pure (appId, appWithTimestamp) - getSysR :: Extension "" -> Handler TypedContent getSysR e = do sysResourceDir <- ( "sys") . resourcesDir . appSettings <$> getYesod @@ -155,7 +125,7 @@ getApp rootDir ext@(Extension appId) = do determineEvent :: FileExistence -> String -> FilePath -> Version -> HandlerFor RegistryCtx TypedContent -- for app files determineEvent Existent "s9pk" fp av = do - _ <- recordMetrics appId rootDir av + _ <- recordMetrics appId av chunkIt fp -- for png, system, etc determineEvent Existent _ fp _ = chunkIt fp @@ -167,35 +137,20 @@ chunkIt fp = do addHeader "Content-Length" (show sz) respondSource typeOctet $ CB.sourceFile fp .| awaitForever sendChunkBS -recordMetrics :: String -> FilePath -> Version -> HandlerFor RegistryCtx () -recordMetrics appId rootDir appVersion = do +recordMetrics :: String -> Version -> HandlerFor RegistryCtx () +recordMetrics appId appVersion = do let appId' = T.pack appId - manifest <- liftIO $ getAppManifest rootDir - (storeApp, versionInfo) <- case HM.lookup appId' $ unAppManifest manifest of - Nothing -> sendResponseStatus status400 ("App not present in manifest" :: Text) - Just sa -> do - -- look up at specfic version - vi <- case find ((appVersion ==) . versionInfoVersion) (storeAppVersionInfo sa) of - Nothing -> sendResponseStatus status400 ("App version not present in manifest" :: Text) - Just x -> pure x - pure (sa, vi) - -- lazy load app at requested version if it does not yet exist to automatically transfer from using apps.yaml - sa <- runDB $ fetchApp appId' - (appKey, versionKey) <- case sa of + sa <- runDB $ fetchApp appId' + case sa of Nothing -> do - appKey' <- runDB $ createApp appId' storeApp >>= errOnNothing status500 "duplicate app created" - versionKey' <- runDB $ createAppVersion appKey' versionInfo >>= errOnNothing - status500 - "duplicate app version created" - pure (appKey', versionKey') + $logError $ appId' <> " not found in database" + notFound Just a -> do let appKey' = entityKey a existingVersion <- runDB $ fetchAppVersion appVersion appKey' case existingVersion of Nothing -> do - appVersion' <- runDB $ createAppVersion appKey' versionInfo >>= errOnNothing - status500 - "duplicate app version created" - pure (appKey', appVersion') - Just v -> pure (appKey', entityKey v) - runDB $ createMetric appKey versionKey + $logError $ "Version: " <> show appVersion <> " not found in database" + notFound + Just v -> runDB $ createMetric (entityKey a) (entityKey v) + diff --git a/src/Handler/Marketplace.hs b/src/Handler/Marketplace.hs index e54be51..286fe48 100644 --- a/src/Handler/Marketplace.hs +++ b/src/Handler/Marketplace.hs @@ -188,7 +188,6 @@ getServiceR = do categories <- runDB $ fetchAppCategories (entityKey service) (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings let appId = sAppAppId $ entityVal service - let appVersion = sVersionNumber (entityVal version) let appDir = (<> "/") . ( show version) . ( toS appId) $ appsDir let appExt = Extension (toS appId) :: Extension "s9pk" manifest' <- handleS9ErrT $ getManifest appMgrDir appDir appExt @@ -198,13 +197,6 @@ getServiceR = do $logError (show e) sendResponseStatus status500 ("Internal Server Error" :: Text) Right (a :: ServiceManifest) -> pure a - -- @TODO uncomment when new apps.yaml - -- let storeApp = fromMaybe - -- _ - -- (HM.lookup (sAppAppId $ entityVal service) - -- $ unAppManifest manifest) - -- let versionInfo = filter (\v -> versionInfoVersion v == appVersion) $ NE.toList $ storeAppVersionInfo storeApp - -- let deps = HM.toList (versionInfoDependencies $ Data.List.head versionInfo) d <- traverse (mapDependencyMetadata appsDir appMgrDir) (HM.toList $ serviceManifestDependencies manifest) icon <- decodeIcon appMgrDir appsDir appExt addPackageHeader appMgrDir appDir appExt diff --git a/src/Handler/Version.hs b/src/Handler/Version.hs index 1abbcd1..774bbc9 100644 --- a/src/Handler/Version.hs +++ b/src/Handler/Version.hs @@ -31,6 +31,7 @@ getVersionAppR appId = do getVersionWSpec appsDir appExt where appExt = Extension (toS appId) :: Extension "s9pk" +-- @TODO update to using db record getVersionSysR :: Text -> Handler (Maybe AppVersionRes) getVersionSysR sysAppId = runMaybeT $ do sysDir <- ( "sys") . resourcesDir . appSettings <$> getYesod diff --git a/src/Lib/Registry.hs b/src/Lib/Registry.hs index cb993d4..3dac235 100644 --- a/src/Lib/Registry.hs +++ b/src/Lib/Registry.hs @@ -27,7 +27,7 @@ instance Semigroup (MaxVersion a) where (MaxVersion (a, f)) <> (MaxVersion (b, g)) = if f a > g b then MaxVersion (a, f) else MaxVersion (b, g) -- retrieve all valid semver folder names with queried for file: rootDirectory/appId/[0.0.0 ...]/appId.extension --- TODO move to db query after all appversions are seeded qith post 0.3.0 migration script +-- @TODO move to db query after all appversions are seeded qith post 0.3.0 migration script getAvailableAppVersions :: KnownSymbol a => FilePath -> Extension a -> IO [RegisteredAppVersion] getAvailableAppVersions rootDirectory ext@(Extension appId) = do versions <- mapMaybe (hush . Atto.parseOnly parseVersion . toS) <$> getSubDirectories (rootDirectory appId) diff --git a/src/Lib/Types/Category.hs b/src/Lib/Types/Category.hs index df0e080..4710ff0 100644 --- a/src/Lib/Types/Category.hs +++ b/src/Lib/Types/Category.hs @@ -7,7 +7,6 @@ module Lib.Types.Category where import Startlude import Database.Persist.Postgresql import Data.Aeson -import qualified Data.Text as T import Control.Monad import Yesod.Core import Data.String.Interpolate.IsString diff --git a/src/Model.hs b/src/Model.hs index 58f4c54..15d9d39 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -37,6 +37,7 @@ SVersion sql=version releaseNotes Text osVersionRequired VersionRange default='*' osVersionRecommended VersionRange default='*' + arch Text UniqueBin appId number deriving Eq deriving Show diff --git a/src/Settings.hs b/src/Settings.hs index a6910db..2c40086 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -24,7 +24,6 @@ import System.FilePath ( () ) import Yesod.Default.Config2 ( configSettingsYml ) import Lib.Types.Emver -import Lib.Types.AppIndex import Orphans.Emver ( ) -- | Runtime settings to configure this application. These settings can be -- loaded from various sources: defaults, environment variables, config files, @@ -90,8 +89,3 @@ compileTimeAppSettings :: AppSettings compileTimeAppSettings = case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of Error e -> panic $ toS e Success settings -> settings - -getAppManifest :: FilePath -> IO AppManifest -getAppManifest resourcesDir = do - let appFile = ( "apps.yaml") resourcesDir - loadYamlSettings [appFile] [] useEnv diff --git a/src/Util/Shared.hs b/src/Util/Shared.hs index 6878b78..dff3626 100644 --- a/src/Util/Shared.hs +++ b/src/Util/Shared.hs @@ -3,7 +3,6 @@ module Util.Shared where import Startlude hiding (Handler) import qualified Data.Text as T -import Data.Text.Encoding import Network.HTTP.Types import Yesod.Core