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

rework to normalize version in db and small cleanups

Browse Source
This commit is contained in:
Lucy Cifferello
2020-06-22 12:47:28 -06:00
parent 57627163ff
commit 25b1786808
10 changed files with 92 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored
View File

@@ -27,4 +27,5 @@ stack.yaml.lock
agent_*
agent.*
version
hie.yaml
hie.yaml
**/*.s9pk

3
config/compatibility.json
View File

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

63
src/Database/Queries.hs
View File

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

50
src/Handler/Apps.hs
View File

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

2
src/Lib/Semver.hs
View File

@@ -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
appVersionMax as = Just $ maximumBy (compare `on` version) as

4
src/Lib/Types/Semver.hs
View File

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

16
src/Model.hs
View File

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

18
src/Settings.hs
View File

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

13
test/Handler/AppSpec.hs
View File

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

6
test/TestImport.hs
View File

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