diff --git a/resources/sys/proxy.pac/0.1.0/proxy.pac b/resources/sys/proxy.pac/0.1.0/proxy.pac new file mode 100644 index 0000000..e69de29 diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 2a111e4..74ad59e 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -3,6 +3,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleInstances #-} module Handler.Apps where @@ -24,6 +25,9 @@ import Yesod.Persist.Core import Foundation import Lib.Registry import Lib.Semver +import Lib.Types.Semver +import Lib.Types.FileSystem +import Lib.Error import System.FilePath ((<.>), ()) import System.Posix.Files (fileSize, getFileStatus) import Settings @@ -65,45 +69,54 @@ 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 - exists <- liftIO $ doesFileExist filePath - if exists - then do - let appId' = T.pack appId - manifest <- liftIO $ getAppManifest rootDir - (storeApp, versionInfo) <- case HM.lookup appId' $ unAppManifest manifest of - Nothing -> sendResponseStatus status400 ("App not present in manifest" :: Text) - Just sa -> do - -- look up at specfic version - 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 - appKey' <- runDB $ createApp appId' storeApp >>= errOnNothing status500 "duplicate app created" - versionKey' <- runDB $ createAppVersion appKey' versionInfo >>= errOnNothing status500 "duplicate app version created" - pure (appKey', versionKey') - Just a -> do - let appKey' = entityKey a - existingVersion <- runDB $ fetchAppVersion appVersion appKey' - case existingVersion of - Nothing -> do - appVersion' <- runDB $ createAppVersion appKey' versionInfo >>= errOnNothing status500 "duplicate app version created" - pure (appKey', appVersion') - Just v -> pure (appKey', entityKey v) - runDB $ createMetric appKey versionKey - sz <- liftIO $ fileSize <$> getFileStatus filePath - addHeader "Content-Length" (show sz) - respondSource typePlain $ CB.sourceFile filePath .| awaitForever sendChunkBS - else notFound + exists <- liftIO $ doesFileExist filePath >>= \case + True -> pure Existent + False -> pure NonExistent + determineEvent exists (extension ext) filePath appVersion + where + determineEvent :: FileExistence -> String -> FilePath -> AppVersion -> HandlerFor AgentCtx TypedContent + -- for app files + determineEvent Existent "s9pk" fp av = do + _ <- recordMetrics appId rootDir av + chunkIt fp + -- for png, system, etc + determineEvent Existent _ fp _ = chunkIt fp + determineEvent NonExistent _ _ _ = notFound -errOnNothing :: MonadHandler m => Status -> Text -> Maybe a -> m a -errOnNothing status res entity = case entity of - Nothing -> sendResponseStatus status res - Just a -> pure a \ No newline at end of file +chunkIt :: FilePath -> HandlerFor AgentCtx TypedContent +chunkIt fp = do + sz <- liftIO $ fileSize <$> getFileStatus fp + addHeader "Content-Length" (show sz) + respondSource typePlain $ CB.sourceFile fp .| awaitForever sendChunkBS + +recordMetrics :: String -> FilePath -> AppVersion -> HandlerFor AgentCtx () +recordMetrics appId rootDir appVersion = do + let appId' = T.pack appId + manifest <- liftIO $ getAppManifest rootDir + (storeApp, versionInfo) <- case HM.lookup appId' $ unAppManifest manifest of + Nothing -> sendResponseStatus status400 ("App not present in manifest" :: Text) + Just sa -> do + -- look up at specfic version + 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 + appKey' <- runDB $ createApp appId' storeApp >>= errOnNothing status500 "duplicate app created" + versionKey' <- runDB $ createAppVersion appKey' versionInfo >>= errOnNothing status500 "duplicate app version created" + pure (appKey', versionKey') + Just a -> do + let appKey' = entityKey a + existingVersion <- runDB $ fetchAppVersion appVersion appKey' + case existingVersion of + Nothing -> do + appVersion' <- runDB $ createAppVersion appKey' versionInfo >>= errOnNothing status500 "duplicate app version created" + pure (appKey', appVersion') + Just v -> pure (appKey', entityKey v) + runDB $ createMetric appKey versionKey \ No newline at end of file diff --git a/src/Lib/Error.hs b/src/Lib/Error.hs index d3e9e54..a1af45f 100644 --- a/src/Lib/Error.hs +++ b/src/Lib/Error.hs @@ -55,3 +55,8 @@ handleS9ErrNuclear :: MonadIO m => S9ErrT m a -> m a handleS9ErrNuclear action = runExceptT action >>= \case Left e -> throwIO e Right a -> pure a + +errOnNothing :: MonadHandler m => Status -> Text -> Maybe a -> m a +errOnNothing status res entity = case entity of + Nothing -> sendResponseStatus status res + Just a -> pure a \ No newline at end of file diff --git a/src/Lib/Types/FileSystem.hs b/src/Lib/Types/FileSystem.hs new file mode 100644 index 0000000..229cc39 --- /dev/null +++ b/src/Lib/Types/FileSystem.hs @@ -0,0 +1,6 @@ +module Lib.Types.FileSystem where + + import Startlude + + data FileExistence = Existent | NonExistent + deriving (Eq, Show) \ No newline at end of file diff --git a/src/Orphans/Yesod.hs b/src/Orphans/Yesod.hs index 778c7b2..c07fc37 100644 --- a/src/Orphans/Yesod.hs +++ b/src/Orphans/Yesod.hs @@ -10,3 +10,4 @@ instance ToJSON a => ToContent [a] where toContent = toContent . toJSON . fmap toJSON instance ToJSON a => ToTypedContent [a] where toTypedContent = toTypedContent . toJSON . fmap toJSON + \ No newline at end of file diff --git a/test/Handler/AppSpec.hs b/test/Handler/AppSpec.hs index b1b1b37..135ca8c 100644 --- a/test/Handler/AppSpec.hs +++ b/test/Handler/AppSpec.hs @@ -54,4 +54,21 @@ spec = do metrics <- runDBtest $ selectList [MetricAppId ==. entityKey app] [] assertEq "metric should exist" (length metrics) 1 version <- runDBtest $ selectList [VersionAppId ==. entityKey app] [] - assertEq "version should exist" (length version) 1 \ No newline at end of file + assertEq "version should exist" (length version) 1 + describe "GET /sys/proxy.pac" $ + withApp $ it "does not record metric but request successful" $ do + request $ do + setMethod "GET" + setUrl ("/sys/proxy.pac?spec=0.1.0" :: Text) + statusIs 200 + -- select * from s_app + apps <- runDBtest $ selectList ([] :: [Filter SApp])[] + assertEq "no apps should exist" (length apps) 0 + describe "GET /sys/:sysId" $ + withApp $ it "does not record metric but request successful" $ do + request $ do + setMethod "GET" + setUrl ("/sys/agent?spec=0.0.0" :: Text) + statusIs 200 + apps <- runDBtest $ selectList ([] :: [Filter SApp])[] + assertEq "no apps should exist" (length apps) 0 \ No newline at end of file