add timestamp from most recent service file to app manifest

This commit is contained in:
Lucy Cifferello
2021-01-12 20:42:33 -07:00
parent db251c1977
commit 7a99562b16
3 changed files with 43 additions and 8 deletions

View File

@@ -5,6 +5,7 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Handler.Apps where
@@ -72,16 +73,31 @@ getAppsManifestR :: Handler TypedContent
getAppsManifestR = do
osVersion <- getEmbassyOsVersion
appResourceFile <- (</> "apps" </> "apps.yaml") . resourcesDir . appSettings <$> getYesod
manifest@AppManifest { unAppManifest } <- liftIO (Yaml.decodeFileEither appResourceFile) >>= \case
appsDir <- (</> "apps") . resourcesDir . appSettings <$> getYesod
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 -> manifest
Just av -> AppManifest $ HM.mapMaybe (filterOsRecommended av) unAppManifest
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
maybeStoreApp <- liftIO $ addFileTimestamp dir ext service v
case maybeStoreApp of
Nothing -> notFound
Just appWithTimestamp -> pure (appId, appWithTimestamp)
getSysR :: Extension "" -> Handler TypedContent
getSysR e = do
@@ -90,9 +106,9 @@ getSysR e = do
getAppManifestR :: AppIdentifier -> Handler TypedContent
getAppManifestR appId = do
appSettings <- appSettings <$> getYesod
let appsDir = (</> "apps") . resourcesDir $ appSettings
let appMgrDir = staticBinDir $ appSettings
appSettings' <- appSettings <$> getYesod
let appsDir = (</> "apps") . resourcesDir $ appSettings'
let appMgrDir = staticBinDir appSettings'
av <- getVersionFromQuery appsDir appExt >>= \case
Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
Just v -> pure v
@@ -105,7 +121,7 @@ getAppConfigR :: AppIdentifier -> Handler TypedContent
getAppConfigR appId = do
appSettings <- appSettings <$> getYesod
let appsDir = (</> "apps") . resourcesDir $ appSettings
let appMgrDir = staticBinDir $ appSettings
let appMgrDir = staticBinDir appSettings
av <- getVersionFromQuery appsDir appExt >>= \case
Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
Just v -> pure v

View File

@@ -37,6 +37,11 @@ getAvailableAppVersions rootDirectory ext@(Extension appId) = do
getSubDirectories path = (fmap (fromRight []) . try @SomeException $ listDirectory path)
>>= filterM (doesDirectoryExist . (path </>))
getMostRecentAppVersion :: KnownSymbol a => FilePath -> Extension a -> IO (Maybe RegisteredAppVersion)
getMostRecentAppVersion rootDirectory ext = do
allVersions <- liftIO $ getAvailableAppVersions rootDirectory ext
pure $ head $ sortOn (fst . unRegisteredAppVersion) allVersions
-- /root/appId/version/appId.ext
getVersionedFileFromDir :: KnownSymbol a => FilePath -> Extension a -> Version -> IO (Maybe FilePath)
getVersionedFileFromDir rootDirectory ext@(Extension appId) v =

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Lib.Types.AppIndex where
@@ -11,6 +12,8 @@ import qualified Data.List.NonEmpty as NE
import Lib.Types.Emver
import Orphans.Emver ( )
import System.Directory
import Lib.Registry
type AppIdentifier = Text
@@ -50,6 +53,7 @@ data StoreApp = StoreApp
, storeAppDescLong :: Text
, storeAppVersionInfo :: NonEmpty VersionInfo
, storeAppIconType :: Text
, storeAppTimestamp :: Maybe UTCTime
}
deriving Show
@@ -59,6 +63,7 @@ instance ToJSON StoreApp where
, "icon-type" .= storeAppIconType
, "description" .= object ["short" .= storeAppDescShort, "long" .= storeAppDescLong]
, "version-info" .= storeAppVersionInfo
, "timestamp" .= storeAppTimestamp
]
newtype AppManifest = AppManifest { unAppManifest :: HM.HashMap AppIdentifier StoreApp}
@@ -76,7 +81,8 @@ instance FromJSON AppManifest where
storeAppVersionInfo <- config .: "version-info" >>= \case
[] -> fail "No Valid Version Info"
(x : xs) -> pure $ x :| xs
return $ (appId, StoreApp { .. })
storeAppTimestamp <- config .:? "timestamp"
return (appId, StoreApp { .. })
return $ AppManifest (HM.fromList apps)
instance ToJSON AppManifest where
toJSON = toJSON . unAppManifest
@@ -91,3 +97,11 @@ filterOsRecommended :: Version -> StoreApp -> Maybe StoreApp
filterOsRecommended av sa = case NE.filter ((av <||) . versionInfoOsRecommended) (storeAppVersionInfo sa) of
[] -> Nothing
(x : xs) -> Just $ sa { storeAppVersionInfo = x :| xs }
addFileTimestamp :: KnownSymbol a => FilePath -> Extension a -> StoreApp -> Version -> IO (Maybe StoreApp)
addFileTimestamp appDir ext service v = do
getVersionedFileFromDir appDir ext v >>= \case
Nothing -> pure Nothing
Just file -> do
time <- getModificationTime file
pure $ Just service {storeAppTimestamp = Just time }