mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 10:21:51 +00:00
should work
This commit is contained in:
@@ -11,9 +11,12 @@ import Startlude
|
||||
import Control.Monad.Logger
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
import Data.Char
|
||||
import Data.Conduit
|
||||
import qualified Data.Conduit.Binary as CB
|
||||
import qualified Data.Text as T
|
||||
import qualified GHC.Show (Show (..))
|
||||
import Network.HTTP.Types
|
||||
import System.Directory
|
||||
import Yesod.Core
|
||||
|
||||
@@ -47,7 +50,10 @@ getAppR = getApp appResourceDir
|
||||
|
||||
getApp :: KnownSymbol a => FilePath -> Extension a -> Handler TypedContent
|
||||
getApp rootDir ext = do
|
||||
spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec"
|
||||
specString <- T.filter (not . isSpace) . fromMaybe "*" <$> lookupGetParam "spec"
|
||||
spec <- case readMaybe specString of
|
||||
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
|
||||
Just t -> pure t
|
||||
appVersions <- liftIO $ getAvailableAppVersions rootDir ext
|
||||
putStrLn $ "valid appversion for " <> (show ext :: String) <> ": " <> show appVersions
|
||||
case getSpecifiedAppVersion spec appVersions of
|
||||
|
||||
@@ -5,6 +5,8 @@ module Handler.Types.Status where
|
||||
import Startlude
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Char
|
||||
import qualified Data.Text as T
|
||||
import Yesod.Core.Content
|
||||
|
||||
import Lib.Types.Semver
|
||||
@@ -30,8 +32,8 @@ instance ToContent (Maybe AppVersionRes) where
|
||||
instance ToTypedContent (Maybe AppVersionRes) where
|
||||
toTypedContent = toTypedContent . toJSON
|
||||
|
||||
querySpec :: Maybe Text -> Maybe AppVersionSpecification
|
||||
querySpec = (readMaybe . toS =<<)
|
||||
-- querySpec :: Text -> Maybe AppVersionSpecification
|
||||
-- querySpec = readMaybe . toS . T.filter (not . isSpace)
|
||||
|
||||
querySpecD :: AppVersionSpecification -> Maybe Text -> AppVersionSpecification
|
||||
querySpecD defaultSpec = fromMaybe defaultSpec . querySpec
|
||||
-- querySpecD :: AppVersionSpecification -> Maybe Text -> AppVersionSpecification
|
||||
-- querySpecD defaultSpec = fromMaybe defaultSpec . querySpec
|
||||
|
||||
@@ -7,7 +7,9 @@ module Handler.Version where
|
||||
import Startlude
|
||||
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Char
|
||||
import Data.String.Interpolate.IsString
|
||||
import qualified Data.Text as T
|
||||
import Network.HTTP.Types
|
||||
import Yesod.Core
|
||||
|
||||
@@ -38,7 +40,10 @@ getVersionSysR sysAppId = runMaybeT $ do
|
||||
|
||||
getVersionWSpec :: KnownSymbol a => FilePath -> Extension a -> Handler (Maybe AppVersionRes)
|
||||
getVersionWSpec rootDir ext = do
|
||||
spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec"
|
||||
specString <- T.filter (not . isSpace) . fromMaybe "*" <$> lookupGetParam "spec"
|
||||
spec <- case readMaybe specString of
|
||||
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
|
||||
Just t -> pure t
|
||||
appVersions <- liftIO $ getAvailableAppVersions rootDir ext
|
||||
let av = version <$> getSpecifiedAppVersion spec appVersions
|
||||
pure $ liftA2 AppVersionRes av (pure Nothing)
|
||||
|
||||
@@ -42,7 +42,7 @@ instance HasAppVersion RegisteredAppVersion where
|
||||
-- retrieve all valid semver folder names with queried for file: rootDirectory/appId/[0.0.0 ...]/appId.extension
|
||||
getAvailableAppVersions :: KnownSymbol a => FilePath -> Extension a -> IO [RegisteredAppVersion]
|
||||
getAvailableAppVersions rootDirectory ext@(Extension appId) = do
|
||||
versions <- mapMaybe readMaybe <$> getSubDirectories (rootDirectory </> appId)
|
||||
versions <- mapMaybe (readMaybe . toS) <$> getSubDirectories (rootDirectory </> appId)
|
||||
fmap catMaybes . for versions $ \v ->
|
||||
getVersionedFileFromDir rootDirectory ext v
|
||||
>>= \case
|
||||
|
||||
@@ -38,8 +38,8 @@ instance Show AppVersion where
|
||||
instance IsString AppVersion where
|
||||
fromString s = case traverse (readMaybe . toS) $ splitOn "+" <=< splitOn "." $ (toS s) of
|
||||
Just [major, minor, patch, build] -> AppVersion (major, minor, patch, build)
|
||||
Just [major, minor, patch] -> AppVersion (major, minor, patch, 0)
|
||||
_ -> panic . toS $ "Invalid App Version: " <> s
|
||||
Just [major, minor, patch] -> AppVersion (major, minor, patch, 0)
|
||||
_ -> panic . toS $ "Invalid App Version: " <> s
|
||||
instance ToJSON AppVersion where
|
||||
toJSON = String . show
|
||||
instance FromJSON AppVersion where
|
||||
@@ -47,7 +47,7 @@ instance FromJSON AppVersion where
|
||||
case traverse (decode . toS) $ splitOn "+" <=< splitOn "." $ t of
|
||||
Just [a, b, c, d] -> pure $ AppVersion (a, b, c, d)
|
||||
Just [a, b, c] -> pure $ AppVersion (a, b, c, 0)
|
||||
_ -> fail "unknown versioning"
|
||||
_ -> fail "unknown versioning"
|
||||
instance ToTypedContent AppVersion where
|
||||
toTypedContent = toTypedContent . toJSON
|
||||
instance ToContent AppVersion where
|
||||
@@ -57,16 +57,17 @@ instance ToContent AppVersion where
|
||||
-- Semver AppVersionSpecification
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
data AppVersionSpecification = AppVersionSpecification
|
||||
{ requestModifier :: SemverRequestModifier
|
||||
, baseVersion :: AppVersion
|
||||
}
|
||||
data AppVersionSpecification =
|
||||
AppVersionAny
|
||||
| AppVersionSpecification SemverRequestModifier AppVersion
|
||||
|
||||
instance Read AppVersionSpecification where
|
||||
readsPrec _ s =
|
||||
case (readMaybe . toS $ svMod, readMaybe . toS $ version) of
|
||||
(Just m, Just av) -> [(AppVersionSpecification m av, "")]
|
||||
_ -> []
|
||||
if s == "*"
|
||||
then [(AppVersionAny, "")]
|
||||
else case (readMaybe . toS $ svMod, readMaybe . toS $ version) of
|
||||
(Just m, Just av) -> [(AppVersionSpecification m av, "")]
|
||||
_ -> []
|
||||
where
|
||||
(svMod, version) = break isDigit . toS $ s
|
||||
|
||||
@@ -75,15 +76,19 @@ instance PathPiece AppVersionSpecification where
|
||||
toPathPiece = show
|
||||
|
||||
instance Show AppVersionSpecification where
|
||||
show AppVersionAny = "*"
|
||||
show (AppVersionSpecification r b) = show r <> show b
|
||||
instance ToJSON AppVersionSpecification where
|
||||
toJSON = String . show
|
||||
instance FromJSON AppVersionSpecification where
|
||||
parseJSON = withText "app version spec" $ \t -> do
|
||||
let (svMod, version) = break isDigit t
|
||||
baseVersion <- parseJSON . String $ version
|
||||
requestModifier <- parseJSON . String $ svMod
|
||||
pure $ AppVersionSpecification {..}
|
||||
parseJSON = withText "app version spec" $ \t ->
|
||||
if t == "*"
|
||||
then pure AppVersionAny
|
||||
else do
|
||||
let (svMod, version) = break isDigit t
|
||||
baseVersion <- parseJSON . String $ version
|
||||
requestModifier <- parseJSON . String $ svMod
|
||||
pure $ AppVersionSpecification requestModifier baseVersion
|
||||
|
||||
mostRecentVersion :: AppVersionSpecification
|
||||
mostRecentVersion = AppVersionSpecification SVGreaterThanEq $ AppVersion (0,0,0,0)
|
||||
|
||||
@@ -10,7 +10,12 @@ import Control.Error.Util as X
|
||||
import Data.Coerce as X
|
||||
import Data.String as X (String, fromString)
|
||||
import Data.Time.Clock as X
|
||||
import Protolude as X hiding (bool, hush, isLeft, isRight, note, tryIO, (<.>))
|
||||
import Protolude as X hiding (bool, hush, isLeft, isRight, note, readMaybe, tryIO, (<.>))
|
||||
import qualified Protolude as P (readMaybe)
|
||||
|
||||
id :: a -> a
|
||||
id = identity
|
||||
|
||||
readMaybe :: Read a => Text -> Maybe a
|
||||
readMaybe = P.readMaybe . toS
|
||||
{-# INLINE readMaybe #-}
|
||||
|
||||
Reference in New Issue
Block a user