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

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

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)
+    

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

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

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)

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

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

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

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