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

more robust testing

Browse Source
This commit is contained in:
Lucy Cifferello
2020-06-09 12:48:28 -06:00
parent 87a6b9bb9b
commit 57627163ff
9 changed files with 118 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
apps.yaml
View File

@@ -1,9 +0,0 @@
bitcoind:
title: "Bitcoin Core"
description:
short: "A Bitcoin Full Node"
long: "The bitcoin full node implementation by Bitcoin Core."
version-info:
- version: 0.18.1
release-notes: "Some stuff"
icon-type: png

1
package.yaml
View File

@@ -62,6 +62,7 @@ dependencies:
- yesod-core >=1.6 && <1.7
- yesod-static
- yesod-persistent >= 1.6 && < 1.7
- shakespeare >=2.0 && <2.1
library:
source-dirs: src

13
resources/apps/apps.yaml
View File

@@ -6,4 +6,17 @@ bitcoind:
version-info:
- version: 0.18.1
release-notes: "Some stuff"
- version: 0.18.2
release-notes: "Some more stuff"
icon-type: png
cups:
title: "Cups Messenger"
description:
short: "P2P Encrypted messaging"
long: "Peer-to-peer encrypted messaging platform that operates over tor."
version-info:
- version: 0.2.1
release-notes: "Some stuff"
- version: 0.2.2
release-notes: "Some more stuff"
icon-type: png

32
src/Database/Queries.hs
View File

@@ -10,24 +10,24 @@ import Database.Persist.Sql
import Model
import Settings
fetchApp :: MonadIO m => AppIdentifier -> AppVersion -> ReaderT SqlBackend m (Maybe (Entity App))
fetchApp appId appVersion = selectFirst [AppAppId ==. appId, AppSemver ==. appVersion] []
fetchApp :: MonadIO m => AppIdentifier -> AppVersion -> ReaderT SqlBackend m (Maybe (Entity SApp))
fetchApp appId appVersion = selectFirst [SAppAppId ==. appId, SAppVersion ==. appVersion] []
createApp :: MonadIO m => AppIdentifier -> AppSeed -> ReaderT SqlBackend m (Maybe (Key App))
createApp :: MonadIO m => AppIdentifier -> AppSeed -> ReaderT SqlBackend m (Maybe (Key SApp))
createApp appId AppSeed{..} = do
time <- liftIO $ getCurrentTime
insertUnique $ App
insertUnique $ SApp
time
Nothing
title
appSeedTitle
appId
descShort
descLong
appVersion
releaseNotes'
iconType
appSeedDescShort
appSeedDescLong
appSeedVersion
appSeedReleaseNotes
appSeedIconType
createMetric :: MonadIO m => Maybe (Key App) -> AppIdentifier -> ReaderT SqlBackend m ()
createMetric :: MonadIO m => Maybe (Key SApp) -> AppIdentifier -> ReaderT SqlBackend m ()
createMetric appId event = do
time <- liftIO $ getCurrentTime
insert_ $ Metric
@@ -41,15 +41,15 @@ createAllAppVersions app appId = do
-- 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
storeAppToSeed :: UTCTime -> AppIdentifier -> StoreApp -> NonEmpty SApp
storeAppToSeed time appId StoreApp{..} = map (\b -> SApp
time
Nothing
storeAppTitle
appId
storeAppDescShort
storeAppDescLong
(semver b)
(releaseNotes b)
(version' b)
(releaseNotes' b)
storeAppIconType
) storeAppSemver
) storeAppVersionInfo

20
src/Handler/Apps.hs
View File

@@ -83,22 +83,22 @@ getApp rootDir ext@(Extension appId) = do
Nothing -> sendResponseStatus status400 ("App not present in manifest" :: Text)
Just StoreApp{..} -> do
-- look up at specfic version
VersionInfo{..} <- case NE.filter (\v -> appVersion == semver v) storeAppSemver of
VersionInfo{..} <- case NE.filter (\v -> appVersion == version' v) storeAppVersionInfo 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
{ appSeedTitle = storeAppTitle
, appSeedDescShort = storeAppDescShort
, appSeedDescLong = storeAppDescLong
, appSeedVersion = version'
, appSeedReleaseNotes = releaseNotes'
, appSeedIconType = storeAppIconType
}
-- create metric based off these app details
appKey <- runDB $ createApp appId' deets
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
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'
sz <- liftIO $ fileSize <$> getFileStatus filePath
addHeader "Content-Length" (show sz)

8
src/Model.hs
View File

@@ -12,23 +12,23 @@ import Lib.Types.Semver
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
App
SApp
createdAt UTCTime
updatedAt UTCTime Maybe
title Text
appId Text
descShort Text
descLong Text
semver AppVersion
version AppVersion
releaseNotes Text
iconType Text
UniqueSemver semver
UniqueVersion version
deriving Eq
deriving Show
Metric
createdAt UTCTime
appId AppId Maybe default=null
appId SAppId Maybe default=null
event Text
deriving Eq
deriving Show

24
src/Settings.hs
View File

@@ -96,19 +96,19 @@ getAppManifest resourcesDir = do
type AppIdentifier = Text
data AppSeed = AppSeed
{ title :: Text
, descShort :: Text
, descLong :: Text
, appVersion :: AppVersion
, releaseNotes' :: Text
, iconType :: Text
{ appSeedTitle :: Text
, appSeedDescShort :: Text
, appSeedDescLong :: Text
, appSeedVersion :: AppVersion
, appSeedReleaseNotes :: Text
, appSeedIconType :: Text
} deriving (Show)
data StoreApp = StoreApp
{ storeAppTitle :: Text
, storeAppDescShort :: Text
, storeAppDescLong :: Text
, storeAppSemver :: NonEmpty VersionInfo -- TODO rename
, storeAppVersionInfo :: NonEmpty VersionInfo
, storeAppIconType :: Text
} deriving (Show)
@@ -124,19 +124,19 @@ instance FromJSON AppManifest where
storeAppIconType <- config .: "icon-type"
storeAppDescShort <- config .: "description" >>= (.: "short")
storeAppDescLong <- config .: "description" >>= (.: "long")
storeAppSemver <- config .: "version-info" >>= \case
storeAppVersionInfo <- 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
{ semver :: AppVersion
, releaseNotes :: Text
{ version' :: AppVersion
, releaseNotes' :: Text
} deriving (Eq, Ord, Show)
instance FromJSON VersionInfo where
parseJSON = withObject "version info" $ \o -> do
semver <- o .: "version"
releaseNotes <- o .: "release-notes"
version' <- o .: "version"
releaseNotes' <- o .: "release-notes"
pure VersionInfo {..}

24
test/Handler/AppSpec.hs
View File

@@ -4,6 +4,8 @@ module Handler.AppSpec (spec) where
import Startlude
import TestImport
import Database.Persist.Sql
import Model
spec :: Spec
spec = do
@@ -15,15 +17,29 @@ spec = do
bodyContains "bitcoind"
bodyContains "version: 0.18.1"
statusIs 200
describe "GET /apps/:appId" $
describe "GET /apps/:appId with unknown version spec for bitcoin" $
withApp $ it "fails to get unknown app" $ do
request $ do
setMethod "GET"
setUrl ("/apps/bitcoind.s9pk?spec=0.18.2" :: Text)
setUrl ("/apps/bitcoind.s9pk?spec=0.18.3" :: Text)
statusIs 404
describe "GET /apps/:appId" $
withApp $ it "makes da records" $ do
describe "GET /apps/:appId with existing version spec for bitcoin" $
withApp $ it "creates app and metric records" $ do
request $ do
setMethod "GET"
setUrl ("/apps/bitcoind.s9pk?spec=0.18.1" :: Text)
statusIs 200
apps <- runDBtest $ selectList [SAppAppId ==. "bitcoind"] []
metrics <- runDBtest $ selectList [MetricEvent ==. "bitcoind"] []
assertEq "app should exist" (length apps) 1
assertEq "metric should exist" (length metrics) 1
describe "GET /apps/:appId with existing version spec for cups" $
withApp $ it "creates app and metric records" $ do
request $ do
setMethod "GET"
setUrl ("/apps/cups.s9pk?spec=0.2.1" :: Text)
statusIs 200
apps <- runDBtest $ selectList [SAppAppId ==. "cups"] []
metrics <- runDBtest $ selectList [MetricEvent ==. "cups"] []
assertEq "app should exist" (length apps) 1
assertEq "metric should exist" (length metrics) 1

39
test/TestImport.hs
View File

@@ -1,4 +1,6 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
module TestImport
( module TestImport
@@ -12,6 +14,10 @@ import Test.Hspec as X
import Yesod.Default.Config2 (useEnv, loadYamlSettings)
import Yesod.Test as X
import Yesod.Core.Unsafe (fakeHandlerGetLogger)
import Database.Persist.Sql
import Text.Shakespeare.Text (st)
import Yesod.Core
import qualified Data.Text as T
runHandler :: Handler a -> YesodExample AgentCtx a
runHandler handler = do
@@ -25,5 +31,38 @@ withApp = before $ do
[]
useEnv
foundation <- makeFoundation settings
wipeDB foundation
logWare <- liftIO $ makeLogWare foundation
return (foundation, logWare)
getTables :: DB [Text]
getTables = do
tables <- rawSql [st|
SELECT table_name
FROM information_schema.tables
WHERE table_schema = 'public'
AND table_type = 'BASE TABLE';
|] []
return $ map unSingle tables
wipeDB :: AgentCtx -> IO ()
wipeDB app = runDBWithApp app $ do
tables <- getTables
sqlBackend <- ask
let escapedTables = map (T.unpack . connEscapeName sqlBackend . DBName) tables
query = "TRUNCATE TABLE " ++ (intercalate ", " $ escapedTables)
rawExecute (T.pack query) []
runDBtest :: SqlPersistM a -> YesodExample AgentCtx a
runDBtest query = do
app <- getTestYesod
liftIO $ runDBWithApp app query
runDBWithApp :: AgentCtx -> SqlPersistM a -> IO a
runDBWithApp app query = runSqlPersistMPool query (appConnPool app)
-- A convenient synonym for database access functions.
type DB a = forall (m :: * -> *).
(MonadUnliftIO m) => ReaderT SqlBackend m a