From b93126935443cdffa967e12b6b6db9f41a7990f6 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Mon, 6 Jul 2020 15:56:10 -0600 Subject: [PATCH 1/7] rework getApp to handle sys files appropriately --- .gitignore | 3 ++- src/Handler/Apps.hs | 65 +++++++++++++++++++++++++-------------------- 2 files changed, 38 insertions(+), 30 deletions(-) diff --git a/.gitignore b/.gitignore index e5150ad..ff484f5 100644 --- a/.gitignore +++ b/.gitignore @@ -27,4 +27,5 @@ stack.yaml.lock agent_* agent.* version -**/*.s9pk \ No newline at end of file +**/*.s9pk +startup.sh \ No newline at end of file diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 2a111e4..20a7ff0 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 @@ -15,6 +16,7 @@ import Data.Char import Data.Conduit import qualified Data.Conduit.Binary as CB import qualified Data.Text as T +import Data.List import qualified GHC.Show (Show (..)) import Network.HTTP.Types import System.Directory @@ -24,6 +26,7 @@ import Yesod.Persist.Core import Foundation import Lib.Registry import Lib.Semver +import Lib.Types.Semver import System.FilePath ((<.>), ()) import System.Posix.Files (fileSize, getFileStatus) import Settings @@ -65,39 +68,14 @@ 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 + let isApp = isInfixOf "apps" rootDir + if isApp then toTypedContent <$> recordMetrics appId rootDir appVersion + else 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 @@ -106,4 +84,33 @@ getApp rootDir ext@(Extension appId) = do 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 + Just a -> pure a + +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 From 90b24d989b0d5d10bc79fcf76377b1197cfe8eb9 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Mon, 6 Jul 2020 16:41:45 -0600 Subject: [PATCH 2/7] clean up logic for recording metrics --- src/Handler/Apps.hs | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 20a7ff0..e799c8b 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -71,15 +71,22 @@ getApp rootDir ext@(Extension appId) = do case getSpecifiedAppVersion spec appVersions of Nothing -> notFound Just (RegisteredAppVersion (appVersion, filePath)) -> do - exists <- liftIO $ doesFileExist filePath let isApp = isInfixOf "apps" rootDir - if isApp then toTypedContent <$> recordMetrics appId rootDir appVersion - else if exists - then do - sz <- liftIO $ fileSize <$> getFileStatus filePath - addHeader "Content-Length" (show sz) - respondSource typePlain $ CB.sourceFile filePath .| awaitForever sendChunkBS - else notFound + exists <- liftIO $ doesFileExist filePath + determineEvent exists isApp filePath appVersion + where + determineEvent True False fp _ = do + sz <- liftIO $ fileSize <$> getFileStatus fp + addHeader "Content-Length" (show sz) + respondSource typePlain $ CB.sourceFile fp .| awaitForever sendChunkBS + determineEvent True True fp av = do + _ <- recordMetrics appId rootDir av + sz <- liftIO $ fileSize <$> getFileStatus fp + addHeader "Content-Length" (show sz) + respondSource typePlain $ CB.sourceFile fp .| awaitForever sendChunkBS + determineEvent False _ _ _ = notFound + + errOnNothing :: MonadHandler m => Status -> Text -> Maybe a -> m a errOnNothing status res entity = case entity of From bce11215d3379427564cf45f344f892cf56a26c0 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Mon, 6 Jul 2020 17:16:21 -0600 Subject: [PATCH 3/7] test getting sys files --- resources/sys/proxy.pac/0.1.0/proxy.pac | 0 test/Handler/AppSpec.hs | 19 ++++++++++++++++++- 2 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 resources/sys/proxy.pac/0.1.0/proxy.pac 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/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 From 7232c482924ebd29a8b64b9497c0a4454e1a5cf5 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Tue, 7 Jul 2020 17:38:17 -0600 Subject: [PATCH 4/7] refactor for boolean blindness --- src/Handler/Apps.hs | 28 ++++++++++++++-------------- src/Lib/Error.hs | 5 +++++ src/Lib/Registry.hs | 6 ++++++ src/Lib/Types/FileSystem.hs | 6 ++++++ src/Orphans/Yesod.hs | 1 + 5 files changed, 32 insertions(+), 14 deletions(-) create mode 100644 src/Lib/Types/FileSystem.hs diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index e799c8b..2f3160d 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -16,7 +16,6 @@ import Data.Char import Data.Conduit import qualified Data.Conduit.Binary as CB import qualified Data.Text as T -import Data.List import qualified GHC.Show (Show (..)) import Network.HTTP.Types import System.Directory @@ -27,6 +26,8 @@ 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 @@ -71,27 +72,26 @@ getApp rootDir ext@(Extension appId) = do case getSpecifiedAppVersion spec appVersions of Nothing -> notFound Just (RegisteredAppVersion (appVersion, filePath)) -> do - let isApp = isInfixOf "apps" rootDir - exists <- liftIO $ doesFileExist filePath - determineEvent exists isApp filePath appVersion + exists <- liftIO $ doesFileExist filePath >>= \case + True -> pure Existent + False -> pure NonExistent + determineEvent exists (extension ext) filePath appVersion where - determineEvent True False fp _ = do + determineEvent :: FileExistence -> String -> FilePath -> AppVersion -> HandlerFor AgentCtx TypedContent + -- for system files + determineEvent Existent "" fp _ = do sz <- liftIO $ fileSize <$> getFileStatus fp addHeader "Content-Length" (show sz) respondSource typePlain $ CB.sourceFile fp .| awaitForever sendChunkBS - determineEvent True True fp av = do + -- for app files + determineEvent Existent "s9pk" fp av = do _ <- recordMetrics appId rootDir av sz <- liftIO $ fileSize <$> getFileStatus fp addHeader "Content-Length" (show sz) respondSource typePlain $ CB.sourceFile fp .| awaitForever sendChunkBS - determineEvent False _ _ _ = 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 + -- for png files + determineEvent Existent _ _ _ = notFound + determineEvent NonExistent _ _ _ = notFound recordMetrics :: String -> FilePath -> AppVersion -> HandlerFor AgentCtx () recordMetrics appId rootDir appVersion = do 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/Registry.hs b/src/Lib/Registry.hs index 0db0957..fb7901e 100644 --- a/src/Lib/Registry.hs +++ b/src/Lib/Registry.hs @@ -16,6 +16,7 @@ import Yesod.Core import Lib.Semver import Lib.Types.Semver +import Data.Char type Registry = HashMap String (HashMap AppVersion FilePath) @@ -50,6 +51,11 @@ type S9PK = Extension "s9pk" type SYS_EXTENSIONLESS = Extension "" type PNG = Extension "png" +data Extensions = S9PK | PNG | EMPTY + deriving (Read) +instance Show Extensions where + show a = fmap toLower $ show a + instance IsString (Extension a) where fromString = Extension 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 From 84034bb510dc433fc1fb43b25cef63f2886636d7 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Tue, 7 Jul 2020 18:10:45 -0600 Subject: [PATCH 5/7] more dynamic flow --- src/Handler/Apps.hs | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 2f3160d..74ad59e 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -78,21 +78,20 @@ getApp rootDir ext@(Extension appId) = do determineEvent exists (extension ext) filePath appVersion where determineEvent :: FileExistence -> String -> FilePath -> AppVersion -> HandlerFor AgentCtx TypedContent - -- for system files - determineEvent Existent "" fp _ = do - sz <- liftIO $ fileSize <$> getFileStatus fp - addHeader "Content-Length" (show sz) - respondSource typePlain $ CB.sourceFile fp .| awaitForever sendChunkBS -- for app files determineEvent Existent "s9pk" fp av = do _ <- recordMetrics appId rootDir av - sz <- liftIO $ fileSize <$> getFileStatus fp - addHeader "Content-Length" (show sz) - respondSource typePlain $ CB.sourceFile fp .| awaitForever sendChunkBS - -- for png files - determineEvent Existent _ _ _ = notFound + chunkIt fp + -- for png, system, etc + determineEvent Existent _ fp _ = chunkIt fp determineEvent NonExistent _ _ _ = notFound +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 From 67aa26519c4593f760dfbc7888ae5cb6836c9471 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Mon, 27 Jul 2020 15:31:08 -0600 Subject: [PATCH 6/7] remove relic data --- src/Lib/Registry.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Lib/Registry.hs b/src/Lib/Registry.hs index fb7901e..0db0957 100644 --- a/src/Lib/Registry.hs +++ b/src/Lib/Registry.hs @@ -16,7 +16,6 @@ import Yesod.Core import Lib.Semver import Lib.Types.Semver -import Data.Char type Registry = HashMap String (HashMap AppVersion FilePath) @@ -51,11 +50,6 @@ type S9PK = Extension "s9pk" type SYS_EXTENSIONLESS = Extension "" type PNG = Extension "png" -data Extensions = S9PK | PNG | EMPTY - deriving (Read) -instance Show Extensions where - show a = fmap toLower $ show a - instance IsString (Extension a) where fromString = Extension From 7ce81ad9a42841ecb9e0b32c6a93533982a7012c Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Mon, 27 Jul 2020 15:32:33 -0600 Subject: [PATCH 7/7] update gitignore --- .gitignore | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index ff484f5..e5150ad 100644 --- a/.gitignore +++ b/.gitignore @@ -27,5 +27,4 @@ stack.yaml.lock agent_* agent.* version -**/*.s9pk -startup.sh \ No newline at end of file +**/*.s9pk \ No newline at end of file