more cleanup

src/Application.hs

@@ -29,7 +29,8 @@ module Application
 
 import           Startlude               hiding ( Handler )
 
-import           Control.Monad.Logger           ( liftLoc
+import           Control.Monad.Logger           ( LoggingT
+                                                , liftLoc
                                                 , runLoggingT
                                                 )
 import           Data.Default
@@ -80,6 +81,8 @@ import           Yesod.Default.Config2
 import           Control.Arrow                  ( (***) )
 import           Control.Lens
 import           Data.List                      ( lookup )
+import           Data.String.Interpolate.IsString
+                                                ( i )
 import           Database.Persist.Sql           ( SqlBackend )
 import           Foundation
 import           Handler.Apps
@@ -268,21 +271,24 @@ startApp :: RegistryCtx -> IO ()
 startApp foundation = do
     when (sslAuto . appSettings $ foundation) $ do
         -- set up ssl certificates
-        putStrLn @Text "Setting up SSL"
+        runLog $ $logInfo "Setting up SSL"
         _ <- setupSsl $ appSettings foundation
-        putStrLn @Text "SSL Setup Complete"
+        runLog $ $logInfo "SSL Setup Complete"
 
         -- certbot renew loop
         void . forkIO $ forever $ flip runReaderT foundation $ do
             shouldRenew <- doesSslNeedRenew
-            putStrLn @Text $ "Checking if SSL Certs should be renewed: " <> show shouldRenew
+            runLog $ $logInfo $ [i|Checking if SSL Certs should be renewed: #{shouldRenew}|]
             when shouldRenew $ do
-                putStrLn @Text "Renewing SSL Certs."
+                runLog $ $logInfo "Renewing SSL Certs."
                 renewSslCerts
                 liftIO $ restartWeb foundation
             liftIO $ sleep 86_400
 
     startWeb foundation
+    where
+        runLog :: MonadIO m => LoggingT m a -> m a
+        runLog a = runLoggingT a (messageLoggerSource foundation (appLogger foundation))
 
 startWeb :: RegistryCtx -> IO ()
 startWeb foundation = do
@@ -291,9 +297,9 @@ startWeb foundation = do
     where
         startWeb' app = (`onException` (appStopFsNotify foundation)) $ do
             let AppSettings {..} = appSettings foundation
-            runLog $ $logInfo $ "Launching Tor Web Server on port " <> show torPort
+            runLog $ $logInfo $ [i|Launching Tor Web Server on port #{torPort}|]
             torAction <- async $ runSettings (warpSettings torPort foundation) app
-            runLog $ $logInfo $ "Launching Web Server on port " <> show appPort
+            runLog $ $logInfo $ [i|Launching Web Server on port #{appPort}|]
             action <- if sslAuto
                 then async $ runTLS (tlsSettings sslCertLocation sslKeyLocation) (warpSettings appPort foundation) app
                 else async $ runSettings (warpSettings appPort foundation) app
@@ -314,7 +320,7 @@ startWeb foundation = do
             shouldRestart <- takeMVar (appShouldRestartWeb foundation)
             when shouldRestart $ do
                 putMVar (appShouldRestartWeb foundation) False
-                putStrLn @Text "Restarting Web Server"
+                runLog $ $logInfo "Restarting Web Server"
                 startWeb' app
         runLog a = runLoggingT a (messageLoggerSource foundation (appLogger foundation))
 

src/Handler/Apps.hs

@@ -114,14 +114,14 @@ recordMetrics pkg appVersion = do
     sa <- runDB $ fetchApp $ pkg
     case sa of
         Nothing -> do
-            $logError $ show pkg <> " not found in database"
+            $logError $ [i|#{pkg} not found in database|]
             notFound
         Just a -> do
             let appKey' = entityKey a
             existingVersion <- runDB $ fetchAppVersion appVersion appKey'
             case existingVersion of
                 Nothing -> do
-                    $logError $ "Version: " <> show appVersion <> " not found in database"
+                    $logError $ [i|#{pkg}@#{appVersion} not found in database|]
                     notFound
                 Just v -> runDB $ createMetric (entityKey a) (entityKey v)
 

src/Handler/Marketplace.hs

@@ -19,7 +19,9 @@ import           Startlude               hiding ( Handler
                                                 )
 
 import           Conduit                        ( (.|)
+                                                , awaitForever
                                                 , runConduit
+                                                , sourceFile
                                                 )
 import           Control.Monad.Except.CoHas     ( liftEither )
 import           Control.Parallel.Strategies    ( parMap
@@ -36,6 +38,7 @@ import           Data.Aeson                     ( (.:)
                                                 , object
                                                 , withObject
                                                 )
+import qualified Data.Attoparsec.Text          as Atto
 import qualified Data.ByteString.Lazy          as BS
 import qualified Data.Conduit.List             as CL
 import qualified Data.HashMap.Strict           as HM
@@ -78,9 +81,7 @@ import qualified Database.Persist              as P
 import           Foundation                     ( Handler
                                                 , RegistryCtx(appSettings)
                                                 )
-import           Lib.Error                      ( S9Error(AssetParseE, InvalidParamsE, NotFoundE)
+import           Lib.Error                      ( S9Error(..) )
-                                                , errOnNothing
-                                                )
 import           Lib.PkgRepository              ( getManifest )
 import           Lib.Types.AppIndex             ( PkgId(PkgId)
                                                 , ServiceDependencyInfo(serviceDependencyInfoVersion)
@@ -92,6 +93,8 @@ import           Lib.Types.Category             ( CategoryTitle(FEATURED) )
 import           Lib.Types.Emver                ( (<||)
                                                 , Version
                                                 , VersionRange
+                                                , parseVersion
+                                                , satisfies
                                                 )
 import           Model                          ( Category(..)
                                                 , EntityField(..)
@@ -104,22 +107,31 @@ import           Network.HTTP.Types             ( status400
                                                 , status404
                                                 )
 import           Protolude.Unsafe               ( unsafeFromJust )
-import           Settings                       ( AppSettings(registryHostname) )
+import           Settings                       ( AppSettings(registryHostname, resourcesDir) )
+import           System.FilePath                ( (</>) )
 import           UnliftIO.Async                 ( concurrently
                                                 , mapConcurrently
                                                 )
+import           UnliftIO.Directory             ( listDirectory )
+import           Util.Shared                    ( getVersionSpecFromQuery
+                                                , orThrow
+                                                )
 import           Yesod.Core                     ( HandlerFor
                                                 , MonadLogger
                                                 , MonadResource
                                                 , MonadUnliftIO
                                                 , ToContent(..)
                                                 , ToTypedContent(..)
+                                                , TypedContent
                                                 , YesodRequest(..)
                                                 , getRequest
                                                 , getsYesod
                                                 , logWarn
                                                 , lookupGetParam
+                                                , respondSource
+                                                , sendChunkBS
                                                 , sendResponseStatus
+                                                , typeOctet
                                                 )
 import           Yesod.Persist.Core             ( YesodPersist(runDB) )
 
@@ -266,8 +278,8 @@ getCategoriesR = do
         pure cats
     pure $ CategoryRes $ categoryName . entityVal <$> allCategories
 
-getEosR :: Handler EosRes
+getEosVersionR :: Handler EosRes
-getEosR = do
+getEosVersionR = do
     allEosVersions <- runDB $ select $ do
         vers <- from $ table @OsVersion
         orderBy [desc (vers ^. OsVersionCreatedAt)]
@@ -289,19 +301,35 @@ getReleaseNotesR :: Handler ReleaseNotes
 getReleaseNotesR = do
     getParameters <- reqGetParams <$> getRequest
     case lookup "id" getParameters of
-        Nothing      -> sendResponseStatus status400 ("expected query param \"id\" to exist" :: Text)
+        Nothing      -> sendResponseStatus status400 (InvalidParamsE "get:id" "<MISSING>")
         Just package -> do
-            (service, _) <- runDB $ fetchLatestApp (PkgId package) >>= errOnNothing status404 "package not found"
+            (service, _) <- runDB $ fetchLatestApp (PkgId package) `orThrow` sendResponseStatus
+                status404
+                (NotFoundE $ show package)
             (_, mappedVersions) <- fetchAllAppVersions (entityKey service)
             pure mappedVersions
 
+getEosR :: Handler TypedContent
+getEosR = do
+    spec    <- getVersionSpecFromQuery
+    root    <- getsYesod $ (</> "eos") . resourcesDir . appSettings
+    subdirs <- listDirectory root
+    let (failures, successes) = partitionEithers $ (Atto.parseOnly parseVersion . T.pack) <$> subdirs
+    for_ failures $ \f -> $logWarn [i|Emver Parse Failure for EOS: #{f}|]
+    let res = headMay . sortOn Down . filter (`satisfies` spec) $ successes
+    case res of
+        Nothing -> sendResponseStatus status404 (NotFoundE [i|EOS version satisfying #{spec}|])
+        Just r  -> do
+            let imgPath = root </> show r </> "eos.img"
+            respondSource typeOctet (sourceFile imgPath .| awaitForever sendChunkBS)
+
 getVersionLatestR :: Handler VersionLatestRes
 getVersionLatestR = do
     getParameters <- reqGetParams <$> getRequest
     case lookup "ids" getParameters of
-        Nothing       -> sendResponseStatus status400 ("expected query param \"ids\" to exist" :: Text)
+        Nothing       -> sendResponseStatus status400 (InvalidParamsE "get:ids" "<MISSING>")
         Just packages -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packages of
-            Left e -> sendResponseStatus status400 ("could not parse query param \"ids\"" <> show e :: Text)
+            Left  _              -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages)
             Right (p :: [PkgId]) -> do
                 let packageList :: [(PkgId, Maybe Version)] = (, Nothing) <$> p
                 found <- runDB $ traverse fetchLatestApp $ fst <$> packageList
@@ -404,9 +432,8 @@ getPackageListR = do
             let satisfactory = filter (<|| spec) (fst pacakgeMetadata)
             let best         = getMax <$> foldMap (Just . Max) satisfactory
             case best of
-                Nothing ->
+                Nothing -> pure $ Left $ [i|Best version could not be found for #{appId} with spec #{spec}|]
-                    pure $ Left $ "best version could not be found for " <> show appId <> " with spec " <> show spec
+                Just v  -> do
-                Just v -> do
                     pure $ Right (Just v, appId)
 
 getServiceDetails :: (MonadIO m, MonadResource m)
@@ -424,7 +451,7 @@ getServiceDetails settings metadata maybeVersion pkg = runExceptT $ do
         Nothing -> do
             -- grab first value, which will be the latest version
             case fst packageMetadata of
-                []    -> liftEither . Left $ NotFoundE $ "no latest version found for " <> show pkg
+                []    -> liftEither . Left $ NotFoundE $ [i|No latest version found for #{pkg}|]
                 x : _ -> pure x
         Just v -> pure v
     manifest <- flip runReaderT settings $ (snd <$> getManifest pkg version) >>= \bs ->
@@ -455,7 +482,7 @@ mapDependencyMetadata domain metadata (appId, depInfo) = do
     let satisfactory = filter (<|| serviceDependencyInfoVersion depInfo) (fst depMetadata)
     let best         = getMax <$> foldMap (Just . Max) satisfactory
     version <- case best of
-        Nothing -> Left $ NotFoundE $ "best version not found for dependent package " <> show appId
+        Nothing -> Left $ NotFoundE $ [i|No satisfactory version for dependent package #{appId}|]
         Just v  -> pure v
     pure
         ( appId

src/Handler/Version.hs

@@ -11,25 +11,15 @@ import           Startlude               hiding ( Handler )
 
 import           Yesod.Core
 
-import qualified Data.Attoparsec.Text          as Atto
 import           Data.String.Interpolate.IsString
                                                 ( i )
-import qualified Data.Text                     as T
-import qualified Data.Text.IO                  as T
 import           Foundation
 import           Handler.Types.Status
 import           Lib.Error                      ( S9Error(NotFoundE) )
 import           Lib.PkgRepository              ( getBestVersion )
 import           Lib.Types.AppIndex             ( PkgId )
-import           Lib.Types.Emver                ( Version(..)
-                                                , parseVersion
-                                                , satisfies
-                                                )
 import           Network.HTTP.Types.Status      ( status404 )
 import           Settings
-import           System.FilePath                ( (</>) )
-import           System.IO.Error                ( isDoesNotExistError )
-import           UnliftIO.Directory             ( listDirectory )
 import           Util.Shared                    ( getVersionSpecFromQuery
                                                 , orThrow
                                                 )
@@ -43,25 +33,3 @@ getPkgVersionR pkg = do
     AppVersionRes <$> getBestVersion pkg spec `orThrow` sendResponseStatus
         status404
         (NotFoundE [i|Version for #{pkg} satisfying #{spec}|])
-
-
-data EosVersionRes = EosVersionRes
-    { eosVersionVersion      :: Version
-    , eosVersionReleaseNotes :: Text
-    }
-
-getEosVersionR :: Handler EosVersionRes
-getEosVersionR = do
-    spec    <- getVersionSpecFromQuery
-    root    <- getsYesod $ (</> "eos") . resourcesDir . appSettings
-    subdirs <- listDirectory root
-    let (failures, successes) = partitionEithers $ (Atto.parseOnly parseVersion . T.pack) <$> subdirs
-    for_ failures $ \f -> $logWarn [i|Emver Parse Failure for EOS: #{f}|]
-    let res = headMay . sortOn Down . filter (`satisfies` spec) $ successes
-    case res of
-        Nothing -> sendResponseStatus status404 (NotFoundE [i|EOS version satisfying #{spec}|])
-        Just r  -> do
-            let notesPath = root </> show r </> "release-notes.md"
-            notes <- liftIO $ T.readFile notesPath `catch` \e ->
-                if isDoesNotExistError e then pure [i|# Release Notes Missing for #{r}|] else throwIO e
-            pure $ EosVersionRes r notes

src/Lib/PkgRepository.hs

@@ -48,7 +48,6 @@ import           Startlude                      ( ($)
                                                 , (&&)
                                                 , (.)
                                                 , (<$>)
-                                                , (<>)
                                                 , Bool(..)
                                                 , ByteString
                                                 , Down(..)
@@ -234,7 +233,7 @@ getIcon pkg version = do
     let pkgRoot = root </> show pkg </> show version
     mIconFile <- find ((== "icon") . takeBaseName) <$> listDirectory pkgRoot
     case mIconFile of
-        Nothing -> throwIO $ NotFoundE $ show pkg <> ": Icon"
+        Nothing -> throwIO $ NotFoundE $ [i|#{pkg}: Icon|]
         Just x  -> do
             let ct = case takeExtension x of
                     ".png"  -> typePng

src/Lib/Types/AppIndex.hs

@@ -49,7 +49,7 @@ instance ToJSONKey PkgId where
 instance PersistField PkgId where
     toPersistValue = PersistText . show
     fromPersistValue (PersistText t) = Right . PkgId $ toS t
-    fromPersistValue other           = Left $ "Invalid AppId: " <> show other
+    fromPersistValue other           = Left $ [i|Invalid AppId: #{other}|]
 instance PersistFieldSql PkgId where
     sqlType _ = SqlString
 instance PathPiece PkgId where