diff --git a/.gitignore b/.gitignore index 9f3013b..8115bfa 100644 --- a/.gitignore +++ b/.gitignore @@ -27,4 +27,5 @@ stack.yaml.lock agent_* agent.* version -hie.yaml \ No newline at end of file +hie.yaml +**/*.s9pk \ No newline at end of file diff --git a/config/compatibility.json b/config/compatibility.json index 02f9f02..af055e9 100644 --- a/config/compatibility.json +++ b/config/compatibility.json @@ -2,5 +2,6 @@ "0.1.0": "1.0.0", "0.1.1": "1.0.0", "0.1.2": "1.1.0", - "0.1.3": "1.1.0" + "0.1.3": "1.1.0", + "0.1.4": "1.1.0" } \ No newline at end of file diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index 9f556fc..d17692d 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -5,51 +5,44 @@ module Database.Queries where import Startlude -import Lib.Types.Semver import Database.Persist.Sql import Model import Settings +import Lib.Types.Semver -fetchApp :: MonadIO m => AppIdentifier -> AppVersion -> ReaderT SqlBackend m (Maybe (Entity SApp)) -fetchApp appId appVersion = selectFirst [SAppAppId ==. appId, SAppVersion ==. appVersion] [] +fetchApp :: MonadIO m => AppIdentifier -> ReaderT SqlBackend m (Maybe (Entity SApp)) +fetchApp appId = selectFirst [SAppAppId ==. appId] [] -createApp :: MonadIO m => AppIdentifier -> AppSeed -> ReaderT SqlBackend m (Maybe (Key SApp)) -createApp appId AppSeed{..} = do - time <- liftIO $ getCurrentTime - insertUnique $ SApp - time - Nothing - appSeedTitle - appId - appSeedDescShort - appSeedDescLong - appSeedVersion - appSeedReleaseNotes - appSeedIconType +fetchAppVersion :: MonadIO m => AppVersion -> Key SApp -> ReaderT SqlBackend m (Maybe (Entity Version)) +fetchAppVersion appVersion appId = selectFirst [VersionNumber ==. appVersion, VersionAppId ==. appId] [] -createMetric :: MonadIO m => Maybe (Key SApp) -> AppIdentifier -> ReaderT SqlBackend m () -createMetric appId event = do - time <- liftIO $ getCurrentTime - insert_ $ Metric - time - appId - event - -createAllAppVersions :: MonadIO m => StoreApp -> AppIdentifier -> ReaderT SqlBackend m () -createAllAppVersions app appId = do - time <- liftIO $ getCurrentTime - -- inseryt new records and replace existing records (matching any unique constraint) - putMany $ toList $ storeAppToSeed time appId app - -storeAppToSeed :: UTCTime -> AppIdentifier -> StoreApp -> NonEmpty SApp -storeAppToSeed time appId StoreApp{..} = map (\b -> SApp +createApp :: MonadIO m => AppIdentifier -> StoreApp -> ReaderT SqlBackend m (Key SApp) +createApp appId StoreApp{..} = do + time <- liftIO getCurrentTime + insert $ SApp time Nothing storeAppTitle appId storeAppDescShort storeAppDescLong - (version' b) - (releaseNotes' b) storeAppIconType - ) storeAppVersionInfo + +createAppVersion :: MonadIO m => Key SApp -> VersionInfo -> ReaderT SqlBackend m (Key Version) +createAppVersion sId VersionInfo{..} = do + time <- liftIO getCurrentTime + insert $ Version + time + Nothing + sId + versionInfoVersion + versionInfoReleaseNotes + +createMetric :: MonadIO m => Maybe (Key SApp) -> Maybe (Key Version) -> AppIdentifier -> ReaderT SqlBackend m () +createMetric appId versionId event = do + time <- liftIO $ getCurrentTime + insert_ $ Metric + time + appId + versionId + event diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index a29161c..5bbdd9e 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -11,7 +11,6 @@ import Startlude import Control.Monad.Logger import Data.Aeson import qualified Data.ByteString.Lazy as BS -import qualified Data.List.NonEmpty as NE import Data.Char import Data.Conduit import qualified Data.Conduit.Binary as CB @@ -22,7 +21,6 @@ import System.Directory import Yesod.Core import Yesod.Persist.Core - import Foundation import Lib.Registry import Lib.Semver @@ -67,6 +65,7 @@ getApp rootDir ext@(Extension appId) = do Just t -> pure t appVersions <- liftIO $ getAvailableAppVersions rootDir ext putStrLn $ "valid appversion for " <> (show ext :: String) <> ": " <> show appVersions + -- this always returns the max version, not the one specified in query param, why? case getSpecifiedAppVersion spec appVersions of Nothing -> notFound Just (RegisteredAppVersion (appVersion, filePath)) -> do @@ -74,32 +73,31 @@ getApp rootDir ext@(Extension appId) = do if exists then do let appId' = T.pack appId - ai <- runDB $ fetchApp appId' appVersion - _ <- case ai of - Nothing -> do - -- save the app if it does not yet exist in db at particular version (automatic eventual transfer from using apps.yaml to db record) - manifest <- liftIO $ getAppManifest rootDir - deets <- case HM.lookup appId' $ unAppManifest manifest of + manifest <- liftIO $ getAppManifest rootDir + (storeApp, versionInfo) <- case HM.lookup appId' $ unAppManifest manifest of Nothing -> sendResponseStatus status400 ("App not present in manifest" :: Text) - Just StoreApp{..} -> do + Just sa -> do -- look up at specfic version - VersionInfo{..} <- case NE.filter (\v -> appVersion == version' v) storeAppVersionInfo of - [] -> sendResponseStatus status400 ("App version not present in manifest" :: Text) - x : _ -> pure x - pure $ AppSeed - { appSeedTitle = storeAppTitle - , appSeedDescShort = storeAppDescShort - , appSeedDescLong = storeAppDescLong - , appSeedVersion = version' - , appSeedReleaseNotes = releaseNotes' - , appSeedIconType = storeAppIconType - } - appKey <- runDB $ createApp appId' deets - case appKey of - Nothing -> $logWarn $ "app at this version already exists in db, no need to insert" -- unreachable - -- log app download - Just k -> runDB $ createMetric (Just k) appId' - Just a -> runDB $ createMetric (Just $ entityKey a) appId' + vi <- case find ((appVersion ==) . versionInfoVersion) (storeAppVersionInfo sa) of + Nothing -> sendResponseStatus status400 ("App version not present in manifest" :: Text) + Just x -> pure x + pure (sa, vi) + -- lazy load app at requested version if it does not yet exist to automatically transfer from using apps.yaml + sa <- runDB $ fetchApp appId' + (appKey, versionKey) <- case sa of + Nothing -> do + ak <- runDB $ createApp appId' storeApp + vk <- runDB $ createAppVersion ak versionInfo + pure (ak, vk) + Just a -> do + let appKey' = entityKey a + maybeVer <- runDB $ fetchAppVersion appVersion appKey' + case maybeVer of + Nothing -> do + av <- runDB $ createAppVersion appKey' versionInfo + pure (appKey', av) + Just v -> pure (appKey', entityKey v) + runDB $ createMetric (Just appKey) (Just versionKey) appId' sz <- liftIO $ fileSize <$> getFileStatus filePath addHeader "Content-Length" (show sz) respondSource typePlain $ CB.sourceFile filePath .| awaitForever sendChunkBS diff --git a/src/Lib/Semver.hs b/src/Lib/Semver.hs index 0dd3e65..e80f721 100644 --- a/src/Lib/Semver.hs +++ b/src/Lib/Semver.hs @@ -43,4 +43,4 @@ instance HasAppVersion AppVersion where appVersionMax :: HasAppVersion a => [a] -> Maybe a appVersionMax [] = Nothing -appVersionMax as = Just $ maximumBy (\a1 a2 -> version a1 `compare` version a2) as \ No newline at end of file +appVersionMax as = Just $ maximumBy (compare `on` version) as \ No newline at end of file diff --git a/src/Lib/Types/Semver.hs b/src/Lib/Types/Semver.hs index 6aa59f5..a03c4c9 100644 --- a/src/Lib/Types/Semver.hs +++ b/src/Lib/Types/Semver.hs @@ -62,8 +62,8 @@ instance FromJSONKey AppVersion where Just x -> pure x instance PersistField AppVersion where - toPersistValue = toPersistValue @String . show - fromPersistValue = note "" . readMaybe <=< fromPersistValue + toPersistValue = toPersistValue @Text . show + fromPersistValue = note "invalid app version" . readMaybe <=< fromPersistValue instance PersistFieldSql AppVersion where sqlType _ = SqlString diff --git a/src/Model.hs b/src/Model.hs index 0610534..ed2f623 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -19,16 +19,26 @@ SApp appId Text descShort Text descLong Text - version AppVersion - releaseNotes Text iconType Text - UniqueVersion version + UniqueAppId appId deriving Eq deriving Show +Version + createdAt UTCTime + updatedAt UTCTime Maybe + appId SAppId + number AppVersion + releaseNotes Text + UniqueNumber number + deriving Eq + deriving Show + + Metric createdAt UTCTime appId SAppId Maybe default=null + version VersionId Maybe default=null event Text deriving Eq deriving Show diff --git a/src/Settings.hs b/src/Settings.hs index 8ffadb9..5dd489c 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -91,18 +91,10 @@ compileTimeAppSettings = getAppManifest :: FilePath -> IO AppManifest getAppManifest resourcesDir = do - let appFile = ( "apps.yaml") $ resourcesDir + let appFile = ( "apps.yaml") resourcesDir loadYamlSettings [appFile] [] useEnv type AppIdentifier = Text -data AppSeed = AppSeed - { appSeedTitle :: Text - , appSeedDescShort :: Text - , appSeedDescLong :: Text - , appSeedVersion :: AppVersion - , appSeedReleaseNotes :: Text - , appSeedIconType :: Text - } deriving (Show) data StoreApp = StoreApp { storeAppTitle :: Text @@ -131,12 +123,12 @@ instance FromJSON AppManifest where return $ AppManifest (HM.fromList apps) data VersionInfo = VersionInfo - { version' :: AppVersion - , releaseNotes' :: Text + { versionInfoVersion :: AppVersion + , versionInfoReleaseNotes :: Text } deriving (Eq, Ord, Show) instance FromJSON VersionInfo where parseJSON = withObject "version info" $ \o -> do - version' <- o .: "version" - releaseNotes' <- o .: "release-notes" + versionInfoVersion <- o .: "version" + versionInfoReleaseNotes <- o .: "release-notes" pure VersionInfo {..} diff --git a/test/Handler/AppSpec.hs b/test/Handler/AppSpec.hs index 7585b49..e3b6167 100644 --- a/test/Handler/AppSpec.hs +++ b/test/Handler/AppSpec.hs @@ -3,8 +3,10 @@ module Handler.AppSpec (spec) where import Startlude -import TestImport import Database.Persist.Sql +import Data.Maybe + +import TestImport import Model spec :: Spec @@ -23,6 +25,12 @@ spec = do setMethod "GET" setUrl ("/apps/bitcoind.s9pk?spec=0.18.3" :: Text) statusIs 404 + describe "GET /apps/:appId with unknown app" $ + withApp $ it "fails to get an unregistered app" $ do + request $ do + setMethod "GET" + setUrl ("/apps/tempapp.s9pk?spec=0.0.1" :: Text) + statusIs 404 describe "GET /apps/:appId with existing version spec for bitcoin" $ withApp $ it "creates app and metric records" $ do request $ do @@ -43,3 +51,6 @@ spec = do metrics <- runDBtest $ selectList [MetricEvent ==. "cups"] [] assertEq "app should exist" (length apps) 1 assertEq "metric should exist" (length metrics) 1 + let app = fromJust $ head apps + version <- runDBtest $ selectList [VersionAppId ==. entityKey app] [] + assertEq "version should exist" (length version) 1 \ No newline at end of file diff --git a/test/TestImport.hs b/test/TestImport.hs index 46bf0af..c2f958d 100644 --- a/test/TestImport.hs +++ b/test/TestImport.hs @@ -44,7 +44,7 @@ getTables = do AND table_type = 'BASE TABLE'; |] [] - return $ map unSingle tables + return $ fmap unSingle tables wipeDB :: AgentCtx -> IO () wipeDB app = runDBWithApp app $ do @@ -52,7 +52,7 @@ wipeDB app = runDBWithApp app $ do sqlBackend <- ask let escapedTables = map (T.unpack . connEscapeName sqlBackend . DBName) tables - query = "TRUNCATE TABLE " ++ (intercalate ", " $ escapedTables) + query = "TRUNCATE TABLE " ++ (intercalate ", " escapedTables) rawExecute (T.pack query) [] runDBtest :: SqlPersistM a -> YesodExample AgentCtx a @@ -63,6 +63,6 @@ runDBtest query = do runDBWithApp :: AgentCtx -> SqlPersistM a -> IO a runDBWithApp app query = runSqlPersistMPool query (appConnPool app) --- A convenient synonym for database access functions. +-- A convenient synonym for database access functions type DB a = forall (m :: * -> *). (MonadUnliftIO m) => ReaderT SqlBackend m a