cleans semver

This commit is contained in:
Aaron Greenspan
2019-12-23 19:00:03 -07:00
parent a00f4f10e3
commit b3fef3e4b3
3 changed files with 61 additions and 23 deletions

View File

@@ -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}

View File

@@ -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

View File

@@ -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, "")]
_ -> []