Merge branch 'master' of github.com:Start9Labs/registry

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

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

src/Lib/Types/FileSystem.hs

@@ -0,0 +1,6 @@
+module Lib.Types.FileSystem where
+
+    import           Startlude
+
+    data FileExistence = Existent | NonExistent
+        deriving (Eq, Show)

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
+    

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