add architecture to version table; refactor to remove dependency on apps.yaml

This commit is contained in:
Lucy Cifferello
2021-07-02 17:35:20 -04:00
committed by Keagan McClelland
parent 8f20f68c5e
commit d2f8db82cf
10 changed files with 19 additions and 80 deletions

View File

@@ -1,6 +1,3 @@
/apps AppsManifestR GET -- get current apps listing
/package/manifest/#AppIdentifier AppManifestR GET -- get app manifest 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} /package/config/#AppIdentifier AppConfigR GET -- get app config from appmgr -- ?spec={semver-spec}

View File

@@ -22,8 +22,8 @@ createApp appId StoreApp {..} = do
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
insertUnique $ SApp time Nothing storeAppTitle appId storeAppDescShort storeAppDescLong storeAppIconType insertUnique $ SApp time Nothing storeAppTitle appId storeAppDescShort storeAppDescLong storeAppIconType
createAppVersion :: MonadIO m => Key SApp -> VersionInfo -> ReaderT SqlBackend m (Maybe (Key SVersion)) createAppVersion :: MonadIO m => Key SApp -> VersionInfo -> Text -> ReaderT SqlBackend m (Maybe (Key SVersion))
createAppVersion sId VersionInfo {..} = do createAppVersion sId VersionInfo {..} arch = do
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
insertUnique $ SVersion time insertUnique $ SVersion time
Nothing Nothing
@@ -32,6 +32,7 @@ createAppVersion sId VersionInfo {..} = do
versionInfoReleaseNotes versionInfoReleaseNotes
versionInfoOsRequired versionInfoOsRequired
versionInfoOsRecommended versionInfoOsRecommended
arch
createMetric :: MonadIO m => Key SApp -> Key SVersion -> ReaderT SqlBackend m () createMetric :: MonadIO m => Key SApp -> Key SVersion -> ReaderT SqlBackend m ()
createMetric appId versionId = do createMetric appId versionId = do

View File

@@ -45,7 +45,6 @@ import Database.Queries
import Network.Wai ( Request(requestHeaderUserAgent) ) import Network.Wai ( Request(requestHeaderUserAgent) )
import Util.Shared import Util.Shared
pureLog :: Show a => a -> Handler a pureLog :: Show a => a -> Handler a
pureLog = liftA2 (*>) ($logInfo . show) pure pureLog = liftA2 (*>) ($logInfo . show) pure
@@ -68,35 +67,6 @@ getEmbassyOsVersion = userAgentOsVersion
userAgentOsVersion = userAgentOsVersion =
(hush . Atto.parseOnly userAgentOsVersionParser . decodeUtf8 <=< requestHeaderUserAgent) <$> waiRequest (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 :: Extension "" -> Handler TypedContent
getSysR e = do getSysR e = do
sysResourceDir <- (</> "sys") . resourcesDir . appSettings <$> getYesod sysResourceDir <- (</> "sys") . resourcesDir . appSettings <$> getYesod
@@ -155,7 +125,7 @@ getApp rootDir ext@(Extension appId) = do
determineEvent :: FileExistence -> String -> FilePath -> Version -> HandlerFor RegistryCtx TypedContent determineEvent :: FileExistence -> String -> FilePath -> Version -> HandlerFor RegistryCtx TypedContent
-- for app files -- for app files
determineEvent Existent "s9pk" fp av = do determineEvent Existent "s9pk" fp av = do
_ <- recordMetrics appId rootDir av _ <- recordMetrics appId av
chunkIt fp chunkIt fp
-- for png, system, etc -- for png, system, etc
determineEvent Existent _ fp _ = chunkIt fp determineEvent Existent _ fp _ = chunkIt fp
@@ -167,35 +137,20 @@ chunkIt fp = do
addHeader "Content-Length" (show sz) addHeader "Content-Length" (show sz)
respondSource typeOctet $ CB.sourceFile fp .| awaitForever sendChunkBS respondSource typeOctet $ CB.sourceFile fp .| awaitForever sendChunkBS
recordMetrics :: String -> FilePath -> Version -> HandlerFor RegistryCtx () recordMetrics :: String -> Version -> HandlerFor RegistryCtx ()
recordMetrics appId rootDir appVersion = do recordMetrics appId appVersion = do
let appId' = T.pack appId 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' sa <- runDB $ fetchApp appId'
(appKey, versionKey) <- case sa of case sa of
Nothing -> do Nothing -> do
appKey' <- runDB $ createApp appId' storeApp >>= errOnNothing status500 "duplicate app created" $logError $ appId' <> " not found in database"
versionKey' <- runDB $ createAppVersion appKey' versionInfo >>= errOnNothing notFound
status500
"duplicate app version created"
pure (appKey', versionKey')
Just a -> do Just a -> do
let appKey' = entityKey a let appKey' = entityKey a
existingVersion <- runDB $ fetchAppVersion appVersion appKey' existingVersion <- runDB $ fetchAppVersion appVersion appKey'
case existingVersion of case existingVersion of
Nothing -> do Nothing -> do
appVersion' <- runDB $ createAppVersion appKey' versionInfo >>= errOnNothing $logError $ "Version: " <> show appVersion <> " not found in database"
status500 notFound
"duplicate app version created" Just v -> runDB $ createMetric (entityKey a) (entityKey v)
pure (appKey', appVersion')
Just v -> pure (appKey', entityKey v)
runDB $ createMetric appKey versionKey

View File

@@ -188,7 +188,6 @@ getServiceR = do
categories <- runDB $ fetchAppCategories (entityKey service) categories <- runDB $ fetchAppCategories (entityKey service)
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
let appId = sAppAppId $ entityVal service let appId = sAppAppId $ entityVal service
let appVersion = sVersionNumber (entityVal version)
let appDir = (<> "/") . (</> show version) . (</> toS appId) $ appsDir let appDir = (<> "/") . (</> show 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
@@ -198,13 +197,6 @@ getServiceR = do
$logError (show e) $logError (show e)
sendResponseStatus status500 ("Internal Server Error" :: Text) sendResponseStatus status500 ("Internal Server Error" :: Text)
Right (a :: ServiceManifest) -> pure a 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) d <- traverse (mapDependencyMetadata appsDir appMgrDir) (HM.toList $ serviceManifestDependencies manifest)
icon <- decodeIcon appMgrDir appsDir appExt icon <- decodeIcon appMgrDir appsDir appExt
addPackageHeader appMgrDir appDir appExt addPackageHeader appMgrDir appDir appExt

View File

@@ -31,6 +31,7 @@ getVersionAppR appId = do
getVersionWSpec appsDir appExt getVersionWSpec appsDir appExt
where appExt = Extension (toS appId) :: Extension "s9pk" where appExt = Extension (toS appId) :: Extension "s9pk"
-- @TODO update to using db record
getVersionSysR :: Text -> Handler (Maybe AppVersionRes) getVersionSysR :: Text -> Handler (Maybe AppVersionRes)
getVersionSysR sysAppId = runMaybeT $ do getVersionSysR sysAppId = runMaybeT $ do
sysDir <- (</> "sys") . resourcesDir . appSettings <$> getYesod sysDir <- (</> "sys") . resourcesDir . appSettings <$> getYesod

View File

@@ -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) (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 -- 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 :: KnownSymbol a => FilePath -> Extension a -> IO [RegisteredAppVersion]
getAvailableAppVersions rootDirectory ext@(Extension appId) = do getAvailableAppVersions rootDirectory ext@(Extension appId) = do
versions <- mapMaybe (hush . Atto.parseOnly parseVersion . toS) <$> getSubDirectories (rootDirectory </> appId) versions <- mapMaybe (hush . Atto.parseOnly parseVersion . toS) <$> getSubDirectories (rootDirectory </> appId)

View File

@@ -7,7 +7,6 @@ module Lib.Types.Category where
import Startlude import Startlude
import Database.Persist.Postgresql import Database.Persist.Postgresql
import Data.Aeson import Data.Aeson
import qualified Data.Text as T
import Control.Monad import Control.Monad
import Yesod.Core import Yesod.Core
import Data.String.Interpolate.IsString import Data.String.Interpolate.IsString

View File

@@ -37,6 +37,7 @@ SVersion sql=version
releaseNotes Text releaseNotes Text
osVersionRequired VersionRange default='*' osVersionRequired VersionRange default='*'
osVersionRecommended VersionRange default='*' osVersionRecommended VersionRange default='*'
arch Text
UniqueBin appId number UniqueBin appId number
deriving Eq deriving Eq
deriving Show deriving Show

View File

@@ -24,7 +24,6 @@ import System.FilePath ( (</>) )
import Yesod.Default.Config2 ( configSettingsYml ) import Yesod.Default.Config2 ( configSettingsYml )
import Lib.Types.Emver import Lib.Types.Emver
import Lib.Types.AppIndex
import Orphans.Emver ( ) import Orphans.Emver ( )
-- | Runtime settings to configure this application. These settings can be -- | Runtime settings to configure this application. These settings can be
-- loaded from various sources: defaults, environment variables, config files, -- loaded from various sources: defaults, environment variables, config files,
@@ -90,8 +89,3 @@ compileTimeAppSettings :: AppSettings
compileTimeAppSettings = case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of compileTimeAppSettings = case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of
Error e -> panic $ toS e Error e -> panic $ toS e
Success settings -> settings Success settings -> settings
getAppManifest :: FilePath -> IO AppManifest
getAppManifest resourcesDir = do
let appFile = (</> "apps.yaml") resourcesDir
loadYamlSettings [appFile] [] useEnv

View File

@@ -3,7 +3,6 @@ module Util.Shared where
import Startlude hiding (Handler) import Startlude hiding (Handler)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding
import Network.HTTP.Types import Network.HTTP.Types
import Yesod.Core import Yesod.Core