diff --git a/config/routes b/config/routes index fed18af..b92c314 100644 --- a/config/routes +++ b/config/routes @@ -6,6 +6,8 @@ /sys/version/agent VersionAgentR GET --get most recent agent version /sys/version/appmgr VersionAppMgrR GET --get most recent appmgr version -/sys/agent.s9pk AgentR GET --get most recent agent at appversion -- ?spec={semver-spec} -/sys/appmgr.s9pk AppMgrR GET --get most recent appmgr at appversion -- ?spec={semver-spec} -!/#S9PK AppR GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec} \ No newline at end of file +/sys/agent AgentR GET --get most recent agent at appversion -- ?spec={semver-spec} +/sys/appmgr AppMgrR GET --get most recent appmgr at appversion -- ?spec={semver-spec} +!/#S9PK AppR GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec} + +/sys.tar.gz ImageR GET --get most recent iso image, ?spec={semver-spec} \ No newline at end of file diff --git a/resources/sys/appmgr/0.0.0/appmgr.deleteme b/resources/sys/appmgr/0.0.0/appmgr.deleteme new file mode 100644 index 0000000..bfad61c --- /dev/null +++ b/resources/sys/appmgr/0.0.0/appmgr.deleteme @@ -0,0 +1 @@ +appmgr downloaded \ No newline at end of file diff --git a/resources/sys/appmgr/0.0.0/appmgr.s9pk b/resources/sys/appmgr/0.0.0/appmgr.s9pk deleted file mode 100644 index 158db5b..0000000 --- a/resources/sys/appmgr/0.0.0/appmgr.s9pk +++ /dev/null @@ -1 +0,0 @@ -some appmgr code \ No newline at end of file diff --git a/resources/sys/image/0.0.0/image.img.deleteme b/resources/sys/image/0.0.0/image.img.deleteme new file mode 100644 index 0000000..478ae3e --- /dev/null +++ b/resources/sys/image/0.0.0/image.img.deleteme @@ -0,0 +1 @@ +image downloaded \ No newline at end of file diff --git a/src/Foundation.hs b/src/Foundation.hs index c350c95..819441f 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -38,6 +38,7 @@ setWebProcessThreadId tid a = writeIORef (appWebServerThreadId a) . Just $ tid -- explanation of the syntax, please see: -- http://www.yesodweb.com/book/routing-and-handlers -- + -- Note that this is really half the story; in Application.hs, mkYesodDispatch -- generates the rest of the code. Please see the following documentation -- for an explanation for this split: diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 373dfd2..47790b7 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -12,6 +12,7 @@ import Data.Aeson import qualified Data.ByteString.Lazy as BS import Data.Conduit import qualified Data.Conduit.Binary as CB +import qualified GHC.Show (Show (..)) import System.Directory import Yesod.Core @@ -20,6 +21,7 @@ import Handler.Types.Status import Lib.Registry import Lib.Semver import Lib.Types.Semver +import System.FilePath ((<.>)) pureLog :: Show a => a -> Handler a pureLog = liftA2 (*>) ($logInfo . show) pure @@ -27,20 +29,28 @@ pureLog = liftA2 (*>) ($logInfo . show) pure logRet :: ToJSON a => Handler a -> Handler a logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . BS.toStrict . encode) pure) +data FileExtension = FileExtension FilePath (Maybe String) +instance Show FileExtension where + show (FileExtension f Nothing) = f + show (FileExtension f (Just e)) = f <.> e + +getImageR :: Handler TypedContent +getImageR = getApp sysResourceDir "image" + getAppsManifestR :: Handler TypedContent getAppsManifestR = respondSource typePlain $ CB.sourceFile appManifestPath .| awaitForever sendChunkBS getAgentR :: Handler TypedContent -getAgentR = getApp sysResourceDir $ S9PK "agent" +getAgentR = getApp sysResourceDir "agent" getAppMgrR :: Handler TypedContent -getAppMgrR = getApp sysResourceDir $ S9PK "appmgr" +getAppMgrR = getApp sysResourceDir "appmgr" getAppR :: S9PK -> Handler TypedContent -getAppR = getApp appResourceDir +getAppR (S9PK appId) = getApp appResourceDir appId -getApp :: FilePath -> S9PK -> Handler TypedContent -getApp rootDir (S9PK appId) = do +getApp :: FilePath -> FilePath -> Handler TypedContent +getApp rootDir appId = do spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec" appVersions <- registeredAppVersions appId <$> loadRegistry rootDir case getSpecifiedAppVersion spec appVersions of diff --git a/src/Lib/Registry.hs b/src/Lib/Registry.hs index 6d77595..dd0b851 100644 --- a/src/Lib/Registry.hs +++ b/src/Lib/Registry.hs @@ -13,6 +13,7 @@ import Data.Text (isSuffixOf) import Lib.Semver import Lib.Types.Semver +import Util.Function newtype S9PK = S9PK String deriving (Eq) instance Show S9PK where @@ -63,15 +64,27 @@ loadRegistry rootDirectory = liftIO $ do ( \registry appId -> do subdirs <- getSubDirectories (rootDirectory appId) let validVersions = mapMaybe readMaybe subdirs - let versionedApps = fromList . fmap (id &&& fullS9pk rootDirectory appId) $ validVersions - pure $ insert appId versionedApps registry + versionApps <- for validVersions $ \v -> + getAppFileFromDir rootDirectory appId v + >>= \case + Nothing -> pure Nothing + Just appFile -> pure . Just $ (v, rootDirectory appId show v appFile) + pure $ insert appId (fromList . catMaybes $ versionApps) registry ) empty appDirectories where getSubDirectories path = listDirectory path >>= filterM (fmap not . doesFileExist) - fullS9pk root appId' appVersion = root appId' show appVersion s9pkExt appId' + + +getAppFileFromDir :: String -> String -> AppVersion -> IO (Maybe FilePath) +getAppFileFromDir rootDirectory appId v = do + dirContents <- listDirectory (rootDirectory appId show v) + pure $ find (isPrefixOf appId) dirContents getAppFile :: String -> Registry -> AppVersion -> Maybe FilePath getAppFile appId r av = lookup av <=< lookup appId $ r registeredAppVersions :: String -> Registry -> [RegisteredAppVersion] registeredAppVersions appId r = maybe [] (fmap RegisteredAppVersion . toList) (lookup appId r) + +findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) +findM = fmap headMay .* filterM