From b8ce0c1b165f6360b222e32bb77952089345318f Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Thu, 27 Feb 2020 14:58:08 -0700 Subject: [PATCH] should work --- src/Handler/Apps.hs | 8 +++++++- src/Handler/Types/Status.hs | 10 ++++++---- src/Handler/Version.hs | 7 ++++++- src/Lib/Registry.hs | 2 +- src/Lib/Types/Semver.hs | 35 ++++++++++++++++++++--------------- src/Startlude.hs | 7 ++++++- 6 files changed, 46 insertions(+), 23 deletions(-) diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index edf2aea..acdeac4 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -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 diff --git a/src/Handler/Types/Status.hs b/src/Handler/Types/Status.hs index 7abbaf8..2de51ad 100644 --- a/src/Handler/Types/Status.hs +++ b/src/Handler/Types/Status.hs @@ -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 diff --git a/src/Handler/Version.hs b/src/Handler/Version.hs index 53ff70b..50a04df 100644 --- a/src/Handler/Version.hs +++ b/src/Handler/Version.hs @@ -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) diff --git a/src/Lib/Registry.hs b/src/Lib/Registry.hs index caa810b..3e3e288 100644 --- a/src/Lib/Registry.hs +++ b/src/Lib/Registry.hs @@ -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 diff --git a/src/Lib/Types/Semver.hs b/src/Lib/Types/Semver.hs index d68d729..095b0f8 100644 --- a/src/Lib/Types/Semver.hs +++ b/src/Lib/Types/Semver.hs @@ -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) diff --git a/src/Startlude.hs b/src/Startlude.hs index fff9cd5..fe88aea 100644 --- a/src/Startlude.hs +++ b/src/Startlude.hs @@ -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 #-}