handle proper version info parsing

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"
+  }

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:"
+  user: "_env:PG_USER:user"
-  password: "_env:PG_PASSWORD:"
+  password: "_env:PG_PASSWORD:password"
   host: "_env:PG_HOST:localhost"
   port: "_env:PG_PORT:5432"

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
 

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
+        appVersion
-        releaseNotes
+        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
+        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

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)
+                            -- save the app if it does not yet exist in db at particular version (automatic eventual transfer from using apps.yaml to db record)
-                            rd <- resourcesDir . appSettings <$> getYesod
+                            manifest <- liftIO $ getAppManifest rootDir
-                            manifest <- liftIO $ getAppManifest rd
                             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
+                            case appKey of
-                            runDB $ createMetric (Just appKey) appId'
+                                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)

src/Model.hs

@@ -22,6 +22,7 @@ App
     semver AppVersion
     releaseNotes Text
     iconType Text
+    UniqueSemver semver
     deriving Eq
     deriving Show
 

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
+    let appFile = (</> "apps.yaml") $ resourcesDir
-    loadYamlSettings [appResourceDir] [] useEnv
+    loadYamlSettings [appFile] [] useEnv
 
 type AppIdentifier = Text
 data AppSeed = AppSeed 
     { title :: Text
     , descShort :: Text
     , descLong :: Text
-    , semver :: AppVersion
+    , appVersion :: AppVersion
-    , releaseNotes :: Text
+    , 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"
+            storeAppTitle <- config .: "title"
-            iconType <- config .: "icon-type"
+            storeAppIconType <- config .: "icon-type"
-            desc <- config .: "description"
+            storeAppDescShort <- config .: "description" >>= (.: "short")
-            ver <- config .: "version-info"
+            storeAppDescLong <- config .: "description" >>= (.: "long")
-            let descShort = short desc
+            storeAppSemver <- config .: "version-info" >>= \case
-            let descLong = long desc
+                [] -> fail "No Valid Version Info"
-            let semver = version' ver
+                (x:xs) -> pure $ x :| xs
-            let releaseNotes = notes ver
+            return $ (appId, StoreApp {..})
-            return $ (appId, AppSeed {..})
         return $ AppManifest (HM.fromList apps)
 
 data VersionInfo = VersionInfo 
-    { version' :: AppVersion
+    { semver :: AppVersion
-    , notes :: Text
+    , releaseNotes :: Text
-    } deriving (Show)
+    } deriving (Eq, Ord, Show)
 
 instance FromJSON VersionInfo where
     parseJSON = withObject "version info" $ \o -> do
-        version' <- o .: "version"
+        semver <- o .: "version"
-        notes <- o .: "release-notes"
+        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 {..}

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