adds icons endpoint

config/routes

@@ -8,6 +8,7 @@
 /sys/version/appmgr                     VersionAppMgrR     GET --get most recent appmgr version
 /sys/version/torrc                      VersionTorrcR      GET --get most recent torrc version
 
+/icons/#PNG                             IconsR             GET -- get icons
 !/apps/#S9PK                            AppR               GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec}
 /sys/agent                              AgentR             GET --get most recent agent at appversion -- ?spec={semver-spec}
 /sys/appmgr                             AppMgrR            GET --get most recent appmgr at appversion -- ?spec={semver-spec}

package.yaml

@@ -68,6 +68,7 @@ dependencies:
 - process
 - protolude
 - safe
+- singletons
 - split
 - template-haskell
 - text >=0.11 && <2.0

src/Application.hs

@@ -51,6 +51,7 @@ import           Yesod.Persist.Core
 -- Don't forget to add new modules to your cabal file!
 import           Foundation
 import           Handler.Apps
+import           Handler.Icons
 import           Handler.Version
 import           Lib.Ssl
 import           Model

src/Constants.hs

@@ -12,7 +12,7 @@ sslPath :: FilePath
 sslPath = "/var/ssl"
 
 resourcesPath :: FilePath
-resourcesPath = "/var/www/html/resources"
+resourcesPath = "./resources" -- "/var/www/html/resources"
 
 registryVersion :: AppVersion
 registryVersion = fromJust . parseMaybe parseJSON . String . toS . showVersion $ version

src/Foundation.hs

@@ -24,6 +24,7 @@ import           Settings
 -- starts running, such as database connections. Every handler will have
 -- access to the data present here.
 
+
 data AgentCtx = AgentCtx
     { appSettings          :: AppSettings
     , appConnPool          :: ConnectionPool -- ^ Database connection pool.

src/Handler/Apps.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds        #-}
 {-# LANGUAGE QuasiQuotes      #-}
 {-# LANGUAGE RecordWildCards  #-}
 {-# LANGUAGE TemplateHaskell  #-}
@@ -34,31 +35,29 @@ instance Show FileExtension where
     show (FileExtension f Nothing)  = f
     show (FileExtension f (Just e)) = f <.> e
 
-getImageR :: Handler TypedContent
-getImageR = getApp sysResourceDir "image"
-
 getAppsManifestR :: Handler TypedContent
 getAppsManifestR = respondSource typePlain $ CB.sourceFile appManifestPath .| awaitForever sendChunkBS
 
+getImageR :: Handler TypedContent
+getImageR = getApp sysResourceDir ("image" :: Extension "")
+
 getAgentR :: Handler TypedContent
-getAgentR = getApp sysResourceDir "agent"
+getAgentR = getApp sysResourceDir ("agent" :: Extension "")
 
 getAppMgrR :: Handler TypedContent
-getAppMgrR = getApp sysResourceDir "appmgr"
+getAppMgrR = getApp sysResourceDir ("appmgr" :: Extension "")
 
 getTorrcR :: Handler TypedContent
-getTorrcR = getApp sysResourceDir "torrc"
+getTorrcR = getApp sysResourceDir ("torrc" :: Extension "")
 
-getAppR :: S9PK -> Handler TypedContent
-getAppR (S9PK appId) = getApp appResourceDir appId
+getAppR :: Extension "s9pk" -> Handler TypedContent
+getAppR = getApp appResourceDir
 
-getApp :: FilePath -> FilePath -> Handler TypedContent
-getApp rootDir appId = do
+getApp :: KnownSymbol a => FilePath -> Extension a -> Handler TypedContent
+getApp rootDir ext = do
     spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec"
-    reg <- loadRegistry rootDir
-    putStrLn ("got registry" :: String)
-    let appVersions = registeredAppVersions appId reg
-    putStrLn $ "valid appversion for " <> appId <> ": " <> show (fmap version appVersions)
+    appVersions <- liftIO $ getAvailableAppVersions rootDir ext
+    putStrLn $ "valid appversion for " <> (show ext :: String) <> ": " <> show appVersions
     case getSpecifiedAppVersion spec appVersions of
         Nothing -> notFound
         Just (RegisteredAppVersion (_, filePath)) -> do

src/Handler/Icons.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE DataKinds        #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Handler.Icons where
+
+import           Startlude
+
+import           Data.Conduit
+import qualified Data.Conduit.Binary as CB
+import           System.Directory
+import           Yesod.Core
+
+import           Foundation
+import           Lib.Registry
+
+getIconsR :: Extension "png" -> Handler TypedContent
+getIconsR ext = do
+    mPng <- liftIO $ getUnversionedFileFromDir iconsResourceDir ext
+    case mPng of
+        Nothing -> notFound
+        Just pngPath -> do
+            putStrLn @Text $ show pngPath
+            exists <- liftIO $ doesFileExist pngPath
+            if exists
+                then respondSource typePlain $ CB.sourceFile pngPath .| awaitForever sendChunkBS
+                else notFound

src/Handler/Version.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Handler.Version where
 
@@ -16,19 +17,21 @@ getVersionR :: Handler AppVersionRes
 getVersionR = pure . AppVersionRes $ registryVersion
 
 getVersionAppR :: Text -> Handler (Maybe AppVersionRes)
-getVersionAppR = getVersionWSpec appResourceDir
+getVersionAppR appId = getVersionWSpec appResourceDir appExt
+    where
+        appExt = Extension (toS appId) :: Extension "s9pk"
 
 getVersionAgentR :: Handler (Maybe AppVersionRes)
-getVersionAgentR = getVersionWSpec sysResourceDir "agent"
+getVersionAgentR = getVersionWSpec sysResourceDir ("agent" :: Extension "")
 
 getVersionAppMgrR :: Handler (Maybe AppVersionRes)
-getVersionAppMgrR = getVersionWSpec sysResourceDir "appmgr"
+getVersionAppMgrR = getVersionWSpec sysResourceDir ("appmgr" :: Extension "")
 
 getVersionTorrcR :: Handler (Maybe AppVersionRes)
-getVersionTorrcR = getVersionWSpec sysResourceDir "torrc"
+getVersionTorrcR = getVersionWSpec sysResourceDir ("torrc" :: Extension "")
 
-getVersionWSpec :: FilePath -> Text -> Handler (Maybe AppVersionRes)
-getVersionWSpec rootDir appId = do
+getVersionWSpec :: KnownSymbol a => FilePath -> Extension a -> Handler (Maybe AppVersionRes)
+getVersionWSpec rootDir ext = do
     spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec"
-    appVersions <- registeredAppVersions (toS appId) <$> loadRegistry rootDir
+    appVersions <- liftIO $ getAvailableAppVersions rootDir ext
     pure . fmap (AppVersionRes . version) $ getSpecifiedAppVersion spec appVersions

src/Lib/Registry.hs

@@ -1,6 +1,11 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
 module Lib.Registry where
 
-import           Startlude         hiding (empty, toList)
+import           Startlude
 
 import           Data.HashMap.Lazy hiding (mapMaybe)
 import qualified GHC.Read          (Read (..))
@@ -14,22 +19,6 @@ import           Data.Text         (isSuffixOf)
 import           Constants
 import           Lib.Semver
 import           Lib.Types.Semver
-import           Util.Function
-
-newtype S9PK = S9PK String deriving (Eq)
-instance Show S9PK where
-    show (S9PK t) = t <.> "s9pk"
-
-instance Read S9PK where
-    readsPrec _ s = [(S9PK . take (m - n) $ s, "") | toS s9pk `isSuffixOf` toS s]
-        where
-            m = length s
-            s9pk = ".s9pk" :: String
-            n = length s9pk
-
-instance PathPiece S9PK where
-    fromPathPiece = readMaybe . toS
-    toPathPiece = show
 
 appResourceDir :: FilePath
 appResourceDir = resourcesPath </> "apps"
@@ -37,57 +26,65 @@ appResourceDir = resourcesPath </> "apps"
 sysResourceDir :: FilePath
 sysResourceDir = resourcesPath </> "sys"
 
+iconsResourceDir :: FilePath
+iconsResourceDir = resourcesPath </> "icons"
+
 appManifestPath :: FilePath
 appManifestPath = appResourceDir </> appManifestFile
 
 appManifestFile :: FilePath
 appManifestFile = "apps.yaml"
 
-s9pkExt :: String -> FilePath
-s9pkExt = show . S9PK
-
 type Registry = HashMap String (HashMap AppVersion FilePath)
 
-newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath)
+newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath) deriving (Eq, Show)
 instance HasAppVersion RegisteredAppVersion where
     version (RegisteredAppVersion (av, _)) = av
 
-loadAppRegistry :: MonadIO m => m Registry
-loadAppRegistry = loadRegistry appResourceDir
-
-loadSysRegistry :: MonadIO m => m Registry
-loadSysRegistry = loadRegistry sysResourceDir
-
-loadRegistry :: MonadIO m => FilePath -> m Registry
-loadRegistry rootDirectory = liftIO $ do
-    appDirectories <- getSubDirectories rootDirectory
-    putStrLn $ "got appDirectories for " <> rootDirectory <> ": " <> show appDirectories
-    foldM
-        ( \registry appId -> do
-            subdirs <- getSubDirectories (rootDirectory </> appId)
-            putStrLn $ "got appDirectories for " <> (rootDirectory </> appId) <> ": " <> show subdirs
-            let validVersions = mapMaybe readMaybe subdirs
-            versionApps <- for validVersions $ \v ->
-                getAppFileFromDir rootDirectory appId v
-                    >>= \case
-                        Nothing      -> pure Nothing
-                        Just appFile -> pure . Just $ (v, rootDirectory </> appId </> show v </> appFile)
-            pure $ insert appId (fromList . catMaybes $ versionApps) registry
-        ) empty appDirectories
+getAvailableAppVersions :: KnownSymbol a => FilePath -> Extension a -> IO [RegisteredAppVersion]
+getAvailableAppVersions rootDirectory ext@(Extension appId) = do
+    versions <- mapMaybe readMaybe <$> getSubDirectories (rootDirectory </> appId)
+    fmap catMaybes . for versions $ \v ->
+        getVersionedFileFromDir rootDirectory ext v
+            >>= \case
+                Nothing      -> pure Nothing
+                Just appFile -> pure . Just $ RegisteredAppVersion (v, appFile)
     where
-        getSubDirectories path = listDirectory path >>= filterM (doesDirectoryExist . (path </>))
+        getSubDirectories path = (fmap (fromRight []) . try @SomeException $ listDirectory path) >>= filterM (doesDirectoryExist . (path </>))
 
+-- /root/appId/version/appId.ext
+getVersionedFileFromDir :: KnownSymbol a => FilePath -> Extension a -> AppVersion -> IO (Maybe FilePath)
+getVersionedFileFromDir rootDirectory ext@(Extension appId) v = getUnversionedFileFromDir (rootDirectory </> appId </> show v) ext
 
-getAppFileFromDir :: String -> String -> AppVersion -> IO (Maybe FilePath)
-getAppFileFromDir rootDirectory appId v = do
-    dirContents <- listDirectory (rootDirectory </> appId </> show v)
-    pure $ find (isPrefixOf appId) dirContents
+-- /root/appId.ext
+getUnversionedFileFromDir :: KnownSymbol a => FilePath -> Extension a -> IO (Maybe FilePath)
+getUnversionedFileFromDir rootDirectory appExt = fmap (join . hush) . try @SomeException $ do
+    dirContents <- listDirectory rootDirectory
+    pure . fmap (rootDirectory </>) $ find (== show appExt) dirContents
 
-getAppFile :: String -> Registry -> AppVersion -> Maybe FilePath
-getAppFile appId r av = lookup av <=< lookup appId $ r
+newtype Extension (a :: Symbol) = Extension String deriving (Eq)
+type S9PK = Extension "s9pk"
+type PNG = Extension "png"
 
-registeredAppVersions :: String -> Registry -> [RegisteredAppVersion]
-registeredAppVersions appId r = maybe [] (fmap RegisteredAppVersion . toList) (lookup appId r)
+instance IsString (Extension a) where
+    fromString = Extension
 
-findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
-findM = fmap headMay .* filterM
+def :: Extension a
+def = Extension ""
+
+extension :: KnownSymbol a => Extension a -> String
+extension = symbolVal
+
+instance KnownSymbol a => Show (Extension a) where
+    show e@(Extension file) = file <.> extension e
+
+instance KnownSymbol a => Read (Extension a) where
+    readsPrec _ s = [(Extension . take (m - n - 1) $ s, "") | toS ext' `isSuffixOf` toS s]
+        where
+            m = length s
+            ext' = extension (def :: Extension a)
+            n = length ext'
+
+instance KnownSymbol a => PathPiece (Extension a) where
+    fromPathPiece = readMaybe . toS
+    toPathPiece = show