mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
cleans semver
This commit is contained in:
@@ -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}
|
||||
@@ -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
|
||||
|
||||
@@ -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, "")]
|
||||
_ -> []
|
||||
|
||||
Reference in New Issue
Block a user