From 7a99562b169ade2512b3a0402d5e7f7660f931bd Mon Sep 17 00:00:00 2001 From: Lucy Cifferello <12953208+elvece@users.noreply.github.com> Date: Tue, 12 Jan 2021 20:42:33 -0700 Subject: [PATCH] add timestamp from most recent service file to app manifest --- src/Handler/Apps.hs | 30 +++++++++++++++++++++++------- src/Lib/Registry.hs | 5 +++++ src/Lib/Types/AppIndex.hs | 16 +++++++++++++++- 3 files changed, 43 insertions(+), 8 deletions(-) diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 15bb4f8..b8b2738 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -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 diff --git a/src/Lib/Registry.hs b/src/Lib/Registry.hs index 7889ecb..9e7e87b 100644 --- a/src/Lib/Registry.hs +++ b/src/Lib/Registry.hs @@ -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 = diff --git a/src/Lib/Types/AppIndex.hs b/src/Lib/Types/AppIndex.hs index 2d9e0fb..bf7a575 100644 --- a/src/Lib/Types/AppIndex.hs +++ b/src/Lib/Types/AppIndex.hs @@ -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 } \ No newline at end of file