From 87a6b9bb9b4514c1d9cead582c8f700670a417f4 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Mon, 8 Jun 2020 15:18:57 -0600 Subject: [PATCH] handle proper version info parsing --- config/compatibility.json | 6 +++++ config/settings.yml | 4 +-- src/Application.hs | 6 ++++- src/Database/Queries.hs | 33 ++++++++++++++++++----- src/Handler/Apps.hs | 28 ++++++++++++++----- src/Model.hs | 1 + src/Settings.hs | 57 +++++++++++++++++++-------------------- test/Handler/AppSpec.hs | 15 ++++++++++- 8 files changed, 102 insertions(+), 48 deletions(-) create mode 100644 config/compatibility.json diff --git a/config/compatibility.json b/config/compatibility.json new file mode 100644 index 0000000..02f9f02 --- /dev/null +++ b/config/compatibility.json @@ -0,0 +1,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" + } \ No newline at end of file diff --git a/config/settings.yml b/config/settings.yml index 926b295..6780d74 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -36,7 +36,7 @@ registry-hostname: "_env:REGISTRY_HOSTNAME:registry.start9labs.com" database: database: "_env:PG_DATABASE:start9_registry" poolsize: "_env:PG_POOL_SIZE:2" - user: "_env:PG_USER:" - password: "_env:PG_PASSWORD:" + user: "_env:PG_USER:user" + password: "_env:PG_PASSWORD:password" host: "_env:PG_HOST:localhost" port: "_env:PG_PORT:5432" \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index ff6ddec..ac27d77 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -31,7 +31,7 @@ import Control.Monad.Logger (liftLoc, runLoggingT) import Data.Aeson import Data.Default import Data.IORef -import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr, pgPoolSize) +import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr, pgPoolSize, runSqlPool, runMigration) import Language.Haskell.TH.Syntax (qLocation) import Network.Wai import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, @@ -56,6 +56,7 @@ import Handler.Icons import Handler.Version import Lib.Ssl import Settings +import Model import System.Posix.Process -- This line actually creates our YesodDispatch instance. It is the second half @@ -96,6 +97,9 @@ makeFoundation appSettings = do (pgConnStr $ appDatabaseConf appSettings) (pgPoolSize . appDatabaseConf $ appSettings) + -- Preform database migration using application logging settings + runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc + -- Return the foundation return $ mkFoundation pool diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index fdf6c51..a49eb32 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -13,24 +13,43 @@ import Settings fetchApp :: MonadIO m => AppIdentifier -> AppVersion -> ReaderT SqlBackend m (Maybe (Entity App)) fetchApp appId appVersion = selectFirst [AppAppId ==. appId, AppSemver ==. appVersion] [] -createApp :: MonadIO m => AppIdentifier -> AppSeed -> ReaderT SqlBackend m (Key App) +createApp :: MonadIO m => AppIdentifier -> AppSeed -> ReaderT SqlBackend m (Maybe (Key App)) createApp appId AppSeed{..} = do time <- liftIO $ getCurrentTime - insert $ App + insertUnique $ App time Nothing title appId descShort descLong - semver - releaseNotes + appVersion + releaseNotes' iconType -createMetric :: MonadIO m => Maybe (Key App) -> AppIdentifier -> ReaderT SqlBackend m (Key Metric) +createMetric :: MonadIO m => Maybe (Key App) -> AppIdentifier -> ReaderT SqlBackend m () createMetric appId event = do time <- liftIO $ getCurrentTime - insert $ Metric + insert_ $ Metric time appId - event \ No newline at end of file + 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 App +storeAppToSeed time appId StoreApp{..} = map (\b -> App + time + Nothing + storeAppTitle + appId + storeAppDescShort + storeAppDescLong + (semver b) + (releaseNotes b) + storeAppIconType + ) storeAppSemver diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 672eea8..5d02a44 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -11,6 +11,7 @@ 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 @@ -55,7 +56,7 @@ getSysR e = do getAppR :: Extension "s9pk" -> Handler TypedContent getAppR e = do - appResourceDir <- ( "apps" "apps.yaml") . resourcesDir . appSettings <$> getYesod + appResourceDir <- ( "apps") . resourcesDir . appSettings <$> getYesod getApp appResourceDir e getApp :: KnownSymbol a => FilePath -> Extension a -> Handler TypedContent @@ -76,15 +77,28 @@ getApp rootDir ext@(Extension appId) = do 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 app.yaml to db record) - rd <- resourcesDir . appSettings <$> getYesod - manifest <- liftIO $ getAppManifest rd + -- 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 Nothing -> sendResponseStatus status400 ("App not present in manifest" :: Text) - Just x -> pure x + Just StoreApp{..} -> do + -- look up at specfic version + VersionInfo{..} <- case NE.filter (\v -> appVersion == semver v) storeAppSemver of + [] -> sendResponseStatus status400 ("App version not present in manifest" :: Text) + x : _ -> pure x + pure $ AppSeed + { title = storeAppTitle + , descShort = storeAppDescShort + , descLong = storeAppDescLong + , appVersion = semver + , releaseNotes' = releaseNotes + , iconType = storeAppIconType + } + -- create metric based off these app details appKey <- runDB $ createApp appId' deets - -- log app download - runDB $ createMetric (Just appKey) appId' + case appKey of + Nothing -> $logWarn $ "app at this version already exists in db, no need to insert" + Just k -> runDB $ createMetric (Just k) appId' -- log app download Just a -> runDB $ createMetric (Just $ entityKey a) appId' sz <- liftIO $ fileSize <$> getFileStatus filePath addHeader "Content-Length" (show sz) diff --git a/src/Model.hs b/src/Model.hs index 2291369..bd2b52c 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -22,6 +22,7 @@ App semver AppVersion releaseNotes Text iconType Text + UniqueSemver semver deriving Eq deriving Show diff --git a/src/Settings.hs b/src/Settings.hs index 49188a7..61d1bf2 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -10,6 +10,7 @@ module Settings where import Startlude import qualified Control.Exception as Exception +import Control.Monad.Fail (fail) import Data.Maybe import Data.Aeson import Data.Aeson.Types @@ -90,20 +91,28 @@ compileTimeAppSettings = getAppManifest :: FilePath -> IO AppManifest getAppManifest resourcesDir = do - let appResourceDir = ( "apps" "apps.yaml") $ resourcesDir - loadYamlSettings [appResourceDir] [] useEnv + let appFile = ( "apps.yaml") $ resourcesDir + loadYamlSettings [appFile] [] useEnv type AppIdentifier = Text data AppSeed = AppSeed { title :: Text , descShort :: Text , descLong :: Text - , semver :: AppVersion - , releaseNotes :: Text + , appVersion :: AppVersion + , releaseNotes' :: Text , iconType :: Text } deriving (Show) + +data StoreApp = StoreApp + { storeAppTitle :: Text + , storeAppDescShort :: Text + , storeAppDescLong :: Text + , storeAppSemver :: NonEmpty VersionInfo -- TODO rename + , storeAppIconType :: Text + } deriving (Show) -newtype AppManifest = AppManifest { unAppManifest :: HM.HashMap AppIdentifier AppSeed} +newtype AppManifest = AppManifest { unAppManifest :: HM.HashMap AppIdentifier StoreApp} deriving (Show) instance FromJSON AppManifest where @@ -111,35 +120,23 @@ instance FromJSON AppManifest where apps <- for (HM.toList o) $ \(appId', c) -> do appId <- parseJSON $ String appId' config <- parseJSON c - title <- config .: "title" - iconType <- config .: "icon-type" - desc <- config .: "description" - ver <- config .: "version-info" - let descShort = short desc - let descLong = long desc - let semver = version' ver - let releaseNotes = notes ver - return $ (appId, AppSeed {..}) + storeAppTitle <- config .: "title" + storeAppIconType <- config .: "icon-type" + storeAppDescShort <- config .: "description" >>= (.: "short") + storeAppDescLong <- config .: "description" >>= (.: "long") + storeAppSemver <- config .: "version-info" >>= \case + [] -> fail "No Valid Version Info" + (x:xs) -> pure $ x :| xs + return $ (appId, StoreApp {..}) return $ AppManifest (HM.fromList apps) data VersionInfo = VersionInfo - { version' :: AppVersion - , notes :: Text - } deriving (Show) + { semver :: AppVersion + , releaseNotes :: Text + } deriving (Eq, Ord, Show) instance FromJSON VersionInfo where parseJSON = withObject "version info" $ \o -> do - version' <- o .: "version" - notes <- o .: "release-notes" + semver <- o .: "version" + releaseNotes <- o .: "release-notes" pure VersionInfo {..} - -data AppDescription = AppDescription - { short :: Text - , long :: Text - } deriving (Show) - -instance FromJSON AppDescription where - parseJSON = withObject "app desc" $ \o -> do - short <- o .: "short" - long <- o .: "long" - pure AppDescription {..} \ No newline at end of file diff --git a/test/Handler/AppSpec.hs b/test/Handler/AppSpec.hs index 83ac4c7..6daa11a 100644 --- a/test/Handler/AppSpec.hs +++ b/test/Handler/AppSpec.hs @@ -6,11 +6,24 @@ import Startlude import TestImport spec :: Spec -spec = describe "GET /apps" $ +spec = do + describe "GET /apps" $ withApp $ it "returns list of apps" $ do request $ do setMethod "GET" setUrl ("/apps" :: Text) bodyContains "bitcoind" bodyContains "version: 0.18.1" + statusIs 200 + describe "GET /apps/:appId" $ + withApp $ it "fails to get unknown app" $ do + request $ do + setMethod "GET" + setUrl ("/apps/bitcoind.s9pk?spec=0.18.2" :: Text) + statusIs 404 + describe "GET /apps/:appId" $ + withApp $ it "makes da records" $ do + request $ do + setMethod "GET" + setUrl ("/apps/bitcoind.s9pk?spec=0.18.1" :: Text) statusIs 200 \ No newline at end of file