Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

handle proper version info parsing

Browse Source
This commit is contained in:
Lucy Cifferello
2020-06-08 15:18:57 -06:00
parent 138011f392
commit db59e3b7ed
8 changed files with 102 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
config/compatibility.json Normal file
View File

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

4
config/settings.yml
View File

@@ -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"

6
src/Application.hs
View File

@@ -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

33
src/Database/Queries.hs
View File

@@ -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
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

28
src/Handler/Apps.hs
View File

@@ -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)

1
src/Model.hs
View File

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

57
src/Settings.hs
View File

@@ -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 {..}

15
test/Handler/AppSpec.hs
View File

@@ -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