diff --git a/apps.yaml b/apps.yaml deleted file mode 100644 index 645eadd..0000000 --- a/apps.yaml +++ /dev/null @@ -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 \ No newline at end of file diff --git a/package.yaml b/package.yaml index f41deb9..78850a9 100644 --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/resources/apps/apps.yaml b/resources/apps/apps.yaml index 645eadd..0023250 100644 --- a/resources/apps/apps.yaml +++ b/resources/apps/apps.yaml @@ -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 \ No newline at end of file diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index a49eb32..9f556fc 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -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 + time <- liftIO $ getCurrentTime + 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 diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 5d02a44..a29161c 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -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) diff --git a/src/Model.hs b/src/Model.hs index bd2b52c..0610534 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -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 diff --git a/src/Settings.hs b/src/Settings.hs index 61d1bf2..8ffadb9 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -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 {..} diff --git a/test/Handler/AppSpec.hs b/test/Handler/AppSpec.hs index 6daa11a..7585b49 100644 --- a/test/Handler/AppSpec.hs +++ b/test/Handler/AppSpec.hs @@ -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 \ No newline at end of file + 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 diff --git a/test/TestImport.hs b/test/TestImport.hs index d0b6752..46bf0af 100644 --- a/test/TestImport.hs +++ b/test/TestImport.hs @@ -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) \ No newline at end of file + 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