refactor for boolean blindness

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 >>= \case
-            exists <- liftIO $ doesFileExist filePath
+                        True -> pure Existent
-            determineEvent exists isApp filePath appVersion
+                        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
+        -- for png files
-
+        determineEvent Existent _ _ _ = notFound
-
+        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
 
 recordMetrics :: String -> FilePath -> AppVersion -> HandlerFor AgentCtx ()
 recordMetrics appId rootDir appVersion = do

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

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
+