diff --git a/config/routes b/config/routes index ff86c7e..02a73db 100644 --- a/config/routes +++ b/config/routes @@ -1,8 +1,11 @@ ---authed -/version VersionR GET -/apps AppsManifestR GET --get current apps listing --- /apps/#Text/#AppVersion AppR GET --install new app --- /sys/agent/#AppVersion AgentR GET --install new agent version --- /sys/appmgr/#AppVersion AppMgrR GET --install new appmgr version --- /v0/authorizedKeys AuthorizeKeyR POST + +/ AppsManifestR GET --get current apps listing +/version VersionR GET +-- /version/:appId VersionAppR GET --get most recent appId version +-- /sys/version/agent VersionAgentR GET --get most recent agent version +-- /sys/version/appmgr VersionAppMgrR GET --get most recent appmgr version + +-- /{:appId}.s9pk AppR GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?version={semver-spec} +-- /sys/agent.s9pk AgentR GET --get most recent agent at appversion -- ?version={semver-spec} +-- /sys/appmgr.s9pk AppMgrR GET --get most recent appmgr at appversion -- ?version={semver-spec} \ No newline at end of file diff --git a/src/Lib/Resource.hs b/src/Lib/Resource.hs index ae15619..453705c 100644 --- a/src/Lib/Resource.hs +++ b/src/Lib/Resource.hs @@ -2,13 +2,13 @@ module Lib.Resource where -import Startlude hiding (empty) +import Startlude hiding (empty, toList) -import Data.Aeson import Data.HashMap.Lazy hiding (mapMaybe) import System.Directory import System.FilePath +import Lib.Semver import Lib.Types.Semver @@ -26,6 +26,10 @@ s9pkFile appId = toS appId <.> "s9pk" type Registry = HashMap String (HashMap AppVersion FilePath) +newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath) +instance HasAppVersion RegisteredAppVersion where + version (RegisteredAppVersion (av, _)) = av + loadResources :: MonadIO m => m Registry loadResources = liftIO $ do appDirectories <- getSubDirectories resourcePath @@ -33,13 +37,14 @@ loadResources = liftIO $ do ( \hm appId -> do subdirs <- getSubDirectories (resourcePath appId) let validVersions = mapMaybe readMaybe subdirs - let newAppVersions = fromList $ fmap (, s9pkFile appId) validVersions + let newAppVersions = fromList $ fmap (\v -> (v, resourcePath show v s9pkFile appId)) validVersions pure $ insert appId newAppVersions hm ) empty appDirectories where getSubDirectories path = listDirectory path >>= filterM (fmap not . doesFileExist) getAppFile :: Registry -> String -> AppVersion -> Maybe FilePath -getAppFile r appId av = do - s9pk <- lookup av <=< lookup appId $ r - pure $ resourcePath appId show av s9pk +getAppFile r appId av = lookup av <=< lookup appId $ r + +registeredAppVersions :: Registry -> String -> [RegisteredAppVersion] +registeredAppVersions r appId = fromMaybe [] $ fmap RegisteredAppVersion . toList <$> lookup appId r diff --git a/src/Lib/Types/Semver.hs b/src/Lib/Types/Semver.hs index 1c3faa1..560ff46 100644 --- a/src/Lib/Types/Semver.hs +++ b/src/Lib/Types/Semver.hs @@ -14,6 +14,10 @@ import Data.String.Interpolate import Data.Text import Yesod.Core +------------------------------------------------------------------------------------------------------------------------ +-- Semver AppVersion +------------------------------------------------------------------------------------------------------------------------ + newtype AppVersion = AppVersion { unAppVersion :: (Word16, Word16, Word16) } deriving (Eq, Ord) @@ -55,11 +59,27 @@ instance ToContent AppVersion where where d `diffy` d1 = fromIntegral . abs $ (fromIntegral d :: Integer) - (fromIntegral d1 :: Integer) +------------------------------------------------------------------------------------------------------------------------ +-- Semver AppVersionSpecification +------------------------------------------------------------------------------------------------------------------------ + data AppVersionSpecification = AppVersionSpecification { requestModifier :: SemverRequestModifier , baseVersion :: AppVersion } +instance Read AppVersionSpecification where + readsPrec _ s = + case (readMaybe . toS $ svMod, readMaybe . toS $ version) of + (Just m, Just av) -> [(AppVersionSpecification m av, "")] + _ -> [] + where + (svMod, version) = break isDigit . toS $ s + +instance PathPiece AppVersionSpecification where + fromPathPiece = readMaybe . toS + toPathPiece = show + instance Show AppVersionSpecification where show (AppVersionSpecification r b) = show r <> show b instance ToJSON AppVersionSpecification where @@ -71,6 +91,10 @@ instance FromJSON AppVersionSpecification where requestModifier <- parseJSON . String $ svMod pure $ AppVersionSpecification {..} +------------------------------------------------------------------------------------------------------------------------ +-- Semver RequestModifier +------------------------------------------------------------------------------------------------------------------------ + data SemverRequestModifier = SVEquals | SVLessThan | SVGreaterThan | SVGreatestWithMajor | SVGreatestWithMajorMinor | SVLessThanEq | SVGreaterThanEq deriving (Eq, Bounded, Enum) instance Show SemverRequestModifier where show SVEquals = "=" @@ -82,13 +106,19 @@ instance Show SemverRequestModifier where show SVGreaterThanEq = ">=" instance FromJSON SemverRequestModifier where - parseJSON = withText "semver request modifier" $ \case - "" -> pure SVGreatestWithMajorMinor - "=" -> pure SVEquals - "<" -> pure SVLessThan - ">" -> pure SVGreaterThan - "~" -> pure SVGreatestWithMajor - "^" -> pure SVGreatestWithMajorMinor - "<=" -> pure SVLessThanEq - ">=" -> pure SVGreaterThanEq - _ -> fail "invalid semver request modifier" + parseJSON = withText "semver request modifier" $ \t -> + case readMaybe . toS $ t of + Just m -> pure m + Nothing -> fail "invalid semver request modifier" + +instance Read SemverRequestModifier where + readsPrec _ = \case + "" -> [(SVGreatestWithMajorMinor, "")] + "=" -> [(SVEquals, "")] + "<" -> [(SVLessThan, "")] + ">" -> [(SVGreaterThan, "")] + "~" -> [(SVGreatestWithMajor, "")] + "^" -> [(SVGreatestWithMajorMinor, "")] + "<=" -> [(SVLessThanEq, "")] + ">=" -> [(SVGreaterThanEq, "")] + _ -> []