From 2cf1e1705714e3f9510e0fedcd6c92ba2354523c Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Tue, 24 May 2022 18:06:02 -0600 Subject: [PATCH] Implements uploads, index, and deindex --- package.yaml | 4 + src/Application.hs | 16 +-- src/Cli/Cli.hs | 230 ++++++++++++++++++++++++++++++++----- src/Foundation.hs | 4 +- src/Handler/Admin.hs | 36 ++++-- src/Lib/External/AppMgr.hs | 2 +- src/Lib/PkgRepository.hs | 46 +++----- src/Util/Shared.hs | 2 +- stack.yaml | 1 + 9 files changed, 265 insertions(+), 76 deletions(-) diff --git a/package.yaml b/package.yaml index 8967fc6..7ee95a3 100644 --- a/package.yaml +++ b/package.yaml @@ -38,6 +38,8 @@ dependencies: - foreign-store - fsnotify - http-api-data + - http-client-tls + - http-conduit - http-types - interpolate - lens @@ -52,11 +54,13 @@ dependencies: - persistent-migration - persistent-postgresql - persistent-template + - postgresql-simple - process - protolude - rainbow - shakespeare - template-haskell + - terminal-progress-bar - text - time - transformers diff --git a/src/Application.hs b/src/Application.hs index 6260ba4..55d1995 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -93,9 +93,7 @@ import Handler.ErrorLogs import Handler.Icons import Handler.Marketplace import Handler.Version -import Lib.PkgRepository ( watchEosRepoRoot - , watchPkgRepoRoot - ) +import Lib.PkgRepository ( watchEosRepoRoot ) import Lib.Ssl import Migration ( manualMigration ) import Model @@ -136,13 +134,12 @@ makeFoundation appSettings = do -- logging function. To get out of this loop, we initially create a -- temporary foundation without a real connection pool, get a log function -- from there, and then create the real foundation. - let mkFoundation appConnPool appStopFsNotifyPkg appStopFsNotifyEos = RegistryCtx { .. } + let mkFoundation appConnPool appStopFsNotifyEos = RegistryCtx { .. } -- The RegistryCtx {..} syntax is an example of record wild cards. For more -- information, see: -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html - tempFoundation = mkFoundation (panic "connPool forced in tempFoundation") - (panic "stopFsNotify forced in tempFoundation") - (panic "stopFsNotify forced in tempFoundation") + tempFoundation = + mkFoundation (panic "connPool forced in tempFoundation") (panic "stopFsNotify forced in tempFoundation") logFunc = messageLoggerSource tempFoundation appLogger createDirectoryIfMissing True (errorLogRoot appSettings) @@ -151,7 +148,6 @@ makeFoundation appSettings = do pool <- flip runLoggingT logFunc $ createPostgresqlPool (pgConnStr $ appDatabaseConf appSettings) (pgPoolSize . appDatabaseConf $ appSettings) - stopPkgWatch <- runLoggingT (runReaderT (watchPkgRepoRoot pool) appSettings) logFunc stopEosWatch <- runLoggingT (runReaderT (watchEosRepoRoot pool) appSettings) logFunc -- Preform database migration using application logging settings @@ -168,7 +164,7 @@ makeFoundation appSettings = do ) -- Return the foundation - return $ mkFoundation pool stopPkgWatch stopEosWatch + return $ mkFoundation pool stopEosWatch -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and -- applying some additional middlewares. @@ -334,7 +330,7 @@ startWeb foundation = do app <- makeApplication foundation startWeb' app where - startWeb' app = (`onException` (appStopFsNotifyPkg foundation *> appStopFsNotifyEos foundation)) $ do + startWeb' app = (`onException` appStopFsNotifyEos foundation) $ do let AppSettings {..} = appSettings foundation runLog $ $logInfo [i|Launching Tor Web Server on port #{torPort}|] torAction <- async $ runSettings (warpSettings torPort foundation) app diff --git a/src/Cli/Cli.hs b/src/Cli/Cli.hs index 39087da..4a27440 100644 --- a/src/Cli/Cli.hs +++ b/src/Cli/Cli.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE RecordWildCards #-} @@ -8,62 +9,124 @@ module Cli.Cli ( cliMain ) where +import Conduit ( (.|) + , foldC + , runConduit + ) +import Control.Monad.Logger ( LogLevel(..) + , MonadLogger(monadLoggerLog) + , MonadLoggerIO(askLoggerIO) + , ToLogStr + , fromLogStr + , toLogStr + ) +import Data.Aeson ( eitherDecodeStrict ) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as LB import Data.Default import Data.Functor.Contravariant ( contramap ) import Data.HashMap.Internal.Strict ( HashMap , delete , empty , insert + , lookup , traverseWithKey ) -import Data.String ( IsString(fromString) ) import Dhall hiding ( void ) import Dhall.Core ( pretty ) +import Handler.Admin ( IndexPkgReq(IndexPkgReq) ) +import Lib.External.AppMgr ( sourceManifest ) +import Lib.Types.AppIndex ( PackageManifest + ( PackageManifest + , packageManifestId + , packageManifestVersion + ) + , PkgId(..) + ) +import Lib.Types.Emver ( Version(..) ) +import Network.HTTP.Client.Conduit ( StreamFileStatus(StreamFileStatus, fileSize, readSoFar) + , applyBasicAuth + , httpLbs + , observedStreamFile + , parseRequest + ) +import Network.HTTP.Client.TLS ( newTlsManager ) +import Network.HTTP.Simple ( getResponseBody + , httpLBS + , setRequestBody + , setRequestBodyJSON + , setRequestHeaders + ) import Network.URI ( URI , parseURI ) import Options.Applicative hiding ( auto , empty ) -import Rainbow ( fore +import Rainbow ( Chunk + , Radiant + , blue + , chunk + , fore + , green , magenta , putChunk , putChunkLn + , red + , white , yellow ) import Startlude ( ($) , ($>) , (&) , (.) - , (<$>) , (<&>) - , (>>=) , Bool(..) + , ConvertText(toS) + , Either(..) + , Eq(..) + , ExitCode(..) , FilePath , IO - , IsString - , Maybe - , Monad(return) + , IsString(..) + , Maybe(..) + , Monad((>>=)) + , ReaderT(runReaderT) , Semigroup((<>)) , Show , String + , const + , decodeUtf8 + , exitWith + , filter + , for_ + , fromIntegral , fromMaybe , panic - , print - , pure , show , unlessM , void + , when , writeFile ) -import System.Directory ( createDirectory - , createDirectoryIfMissing +import System.Directory ( createDirectoryIfMissing , doesPathExist + , getCurrentDirectory + , getFileSize , getHomeDirectory + , listDirectory ) import System.FilePath ( () - , takeBaseName , takeDirectory + , takeExtension + ) +import System.ProgressBar ( Progress(..) + , defStyle + , newProgressBar + , updateProgress + ) +import Yesod ( logError + , logWarn ) data Upload = Upload @@ -73,7 +136,7 @@ data Upload = Upload } deriving Show -data PublishCfg = PublishCfg +newtype PublishCfg = PublishCfg { publishCfgRepos :: HashMap String PublishCfgRepo } deriving Generic @@ -101,17 +164,13 @@ instance ToDhall URI where instance IsString URI where fromString = fromMaybe (panic "Invalid URI for publish target") . parseURI -data RegAdd = RegAdd - deriving Show -data RegDel = RegDel - deriving Show - data Command = CmdInit | CmdRegAdd String PublishCfgRepo | CmdRegDel String | CmdRegList | CmdUpload Upload + | CmdIndex String String Version Bool deriving Show cfgLocation :: IO FilePath @@ -163,9 +222,33 @@ parseRepoDel = subparser $ command "rm" (info go $ progDesc "Remove a registry f parseRepoList :: Parser () parseRepoList = subparser $ command "ls" (info (pure ()) $ progDesc "List registries in your config") <> metavar "ls" +parseIndex :: Parser Command +parseIndex = + subparser + $ command "index" (info (parseIndexHelper True) $ progDesc "Indexes an existing package version") + <> metavar "index" + +parseDeindex :: Parser Command +parseDeindex = + subparser + $ command "deindex" (info (parseIndexHelper False) $ progDesc "Indexes an existing package version") + <> metavar "deindex" + +parseIndexHelper :: Bool -> Parser Command +parseIndexHelper b = + CmdIndex + <$> strOption (short 't' <> long "target" <> metavar "REGISTRY_NAME") + <*> strArgument (metavar "PKG") + <*> strArgument (metavar "VERSION") + <*> pure b + parseCommand :: Parser Command -parseCommand = (parseInit $> CmdInit) <|> (CmdUpload <$> parsePublish) <|> subparser - (command "reg" (info reg $ progDesc "Manage configured registries")) +parseCommand = + (parseInit $> CmdInit) + <|> (CmdUpload <$> parsePublish) + <|> subparser (command "reg" (info reg $ progDesc "Manage configured registries")) + <|> parseIndex + <|> parseDeindex where reg = parseRepoAdd <|> (CmdRegDel <$> parseRepoDel) <|> (parseRepoList $> CmdRegList) opts :: ParserInfo Command @@ -175,11 +258,12 @@ cliMain :: IO () cliMain = execParser opts >>= (\case - CmdInit -> init - CmdRegAdd s pcr -> regAdd s pcr - CmdRegDel s -> regRm s - CmdRegList -> regLs - CmdUpload up -> regUpload up + CmdInit -> init + CmdRegAdd s pcr -> regAdd s pcr + CmdRegDel s -> regRm s + CmdRegList -> regLs + CmdUpload up -> upload up + CmdIndex name pkg v shouldIndex -> if shouldIndex then index name pkg v else deindex name pkg v ) init :: IO () @@ -212,5 +296,97 @@ regLs = do putChunk $ fromString (k <> ": ") & fore yellow putChunkLn $ fromString (show $ publishCfgRepoLocation v) & fore magenta -regUpload :: Upload -> IO () -regUpload = panic "unimplemented" +upload :: Upload -> IO () +upload (Upload name mpkg shouldIndex) = do + PublishCfgRepo {..} <- findNameInCfg name + pkg <- case mpkg of + Nothing -> do + cwd <- getCurrentDirectory + files <- listDirectory cwd + let pkgs = filter (\n -> takeExtension n == "s9pk") files + case pkgs of + [] -> do + $logError "No package specified, and could not find one in this directory" + exitWith $ ExitFailure 1 + [p ] -> pure (cwd p) + (_ : _ : _) -> do + $logWarn "Ambiguous package upload request, found multiple candidates:" + for_ pkgs $ \f -> $logWarn (fromString f) + exitWith $ ExitFailure 1 + Just s -> pure s + noBody <- + parseRequest ("POST " <> show publishCfgRepoLocation <> "/admin/v0/upload") + <&> setRequestHeaders [("accept", "text/plain")] + <&> applyBasicAuth (B8.pack publishCfgRepoUser) (B8.pack publishCfgRepoPass) + size <- getFileSize pkg + bar <- newProgressBar defStyle 30 (Progress 0 (fromIntegral size) ()) + body <- observedStreamFile (updateProgress bar . const . sfs2prog) pkg + let withBody = setRequestBody body noBody + manager <- newTlsManager + res <- getResponseBody <$> runReaderT (httpLbs withBody) manager + if LB.null res + then pure () + else do + $logError (decodeUtf8 $ LB.toStrict res) + exitWith $ ExitFailure 1 + putChunkLn $ fromString ("Successfully uploaded " <> pkg) & fore green + when shouldIndex $ do + home <- getHomeDirectory + manifestBytes <- sourceManifest (home ".cargo/bin") pkg $ \c -> runConduit (c .| foldC) + PackageManifest { packageManifestId, packageManifestVersion } <- case eitherDecodeStrict manifestBytes of + Left s -> do + $logError $ "Could not parse the manifest of the package: " <> toS s + exitWith $ ExitFailure 1 + Right a -> pure a + let pkgId = toS $ unPkgId packageManifestId + index name pkgId packageManifestVersion + putChunkLn $ fromString ("Successfully indexed " <> pkgId <> "@" <> show packageManifestVersion) & fore green + + where + sfs2prog :: StreamFileStatus -> Progress () + sfs2prog StreamFileStatus {..} = Progress (fromIntegral readSoFar) (fromIntegral fileSize) () + +index :: String -> String -> Version -> IO () +index name pkg v = do + PublishCfgRepo {..} <- findNameInCfg name + noBody <- + parseRequest ("POST " <> show publishCfgRepoLocation <> "/admin/v0/index") + <&> setRequestHeaders [("accept", "text/plain")] + <&> applyBasicAuth (B8.pack publishCfgRepoUser) (B8.pack publishCfgRepoPass) + let withBody = setRequestBodyJSON (IndexPkgReq (PkgId $ toS pkg) v) noBody + res <- getResponseBody <$> httpLBS withBody + if LB.null res then pure () else $logError (decodeUtf8 $ LB.toStrict res) *> exitWith (ExitFailure 1) + + +deindex :: String -> String -> Version -> IO () +deindex name pkg v = do + PublishCfgRepo {..} <- findNameInCfg name + noBody <- + parseRequest ("POST " <> show publishCfgRepoLocation <> "/admin/v0/deindex") + <&> setRequestHeaders [("accept", "text/plain")] + <&> applyBasicAuth (B8.pack publishCfgRepoUser) (B8.pack publishCfgRepoPass) + let withBody = setRequestBodyJSON (IndexPkgReq (PkgId $ toS pkg) v) noBody + res <- getResponseBody <$> httpLBS withBody + if LB.null res then pure () else $logError (decodeUtf8 $ LB.toStrict res) *> exitWith (ExitFailure 1) + +findNameInCfg :: String -> IO PublishCfgRepo +findNameInCfg name = do + loc <- cfgLocation + PublishCfg cfg <- inputFile auto loc + case lookup name cfg of + Nothing -> do + $logError "Registry name not found!" + exitWith $ ExitFailure 1 + Just pcr -> pure pcr + +instance MonadLogger IO where + monadLoggerLog _ _ LevelDebug = putChunkLn . colorLog white + monadLoggerLog _ _ LevelInfo = putChunkLn . colorLog blue + monadLoggerLog _ _ LevelWarn = putChunkLn . colorLog yellow + monadLoggerLog _ _ LevelError = putChunkLn . colorLog red + monadLoggerLog _ _ (LevelOther _) = putChunkLn . colorLog magenta + +colorLog :: ToLogStr msg => Radiant -> msg -> Chunk +colorLog c m = fore c $ chunk . decodeUtf8 . fromLogStr . toLogStr $ m +instance MonadLoggerIO IO where + askLoggerIO = pure monadLoggerLog diff --git a/src/Foundation.hs b/src/Foundation.hs index deb1bbd..6af5531 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -85,7 +85,6 @@ data RegistryCtx = RegistryCtx , appWebServerThreadId :: MVar (ThreadId, ThreadId) , appShouldRestartWeb :: MVar Bool , appConnPool :: ConnectionPool - , appStopFsNotifyPkg :: IO Bool , appStopFsNotifyEos :: IO Bool } instance Has PkgRepo RegistryCtx where @@ -196,6 +195,9 @@ instance Yesod RegistryCtx where pure $ if hasAuthId then Authorized else Unauthorized "This feature is for admins only" | otherwise = pure Authorized + maximumContentLengthIO :: RegistryCtx -> Maybe (Route RegistryCtx) -> IO (Maybe Word64) + maximumContentLengthIO _ (Just PkgUploadR) = pure Nothing + maximumContentLengthIO _ _ = pure $ Just 2097152 -- the original default -- How to run database actions. instance YesodPersist RegistryCtx where diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 67e59d2..c324945 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -11,12 +11,16 @@ import Conduit ( (.|) import Control.Monad.Reader.Has ( ask ) import Control.Monad.Trans.Maybe ( MaybeT(..) ) import Data.Aeson ( (.:) + , (.=) , FromJSON(parseJSON) + , ToJSON , decodeFileStrict + , object , withObject ) import Data.String.Interpolate.IsString ( i ) +import Database.Persist.Postgresql ( runSqlPoolNoTransaction ) import Database.Queries ( upsertPackageVersion ) import Foundation import Lib.PkgRepository ( PkgRepo(PkgRepo, pkgRepoFileRoot) @@ -24,7 +28,7 @@ import Lib.PkgRepository ( PkgRepo(PkgRepo, pkgRepoFileRo , getManifestLocation ) import Lib.Types.AppIndex ( PackageManifest(..) - , PkgId + , PkgId(unPkgId) ) import Lib.Types.Emver ( Version(..) ) import Model ( Key(PkgRecordKey, VersionRecordKey) ) @@ -35,7 +39,9 @@ import Startlude ( ($) , (.) , (<$>) , Applicative(pure) + , Bool(..) , Eq + , Maybe(..) , Show , SomeException(..) , asum @@ -44,6 +50,7 @@ import Startlude ( ($) , liftIO , replicate , show + , toS , when ) import System.FilePath ( (<.>) @@ -52,11 +59,16 @@ import System.FilePath ( (<.>) import UnliftIO ( try , withSystemTempDirectory ) -import UnliftIO.Directory ( renameDirectory ) +import UnliftIO.Directory ( createDirectoryIfMissing + , removePathForcibly + , renameDirectory + , renameFile + ) import Util.Shared ( orThrow , sendResponseText ) -import Yesod ( delete +import Yesod ( ToJSON(..) + , delete , getsYesod , logError , rawRequestBody @@ -66,17 +78,22 @@ import Yesod ( delete postPkgUploadR :: Handler () postPkgUploadR = do - withSystemTempDirectory "newpkg" $ \path -> do - runConduit $ rawRequestBody .| sinkFile (path "temp" <.> "s9pk") + withSystemTempDirectory "newpkg" $ \dir -> do + let path = dir "temp" <.> "s9pk" + runConduit $ rawRequestBody .| sinkFile path pool <- getsYesod appConnPool PkgRepo {..} <- ask res <- retry $ extractPkg pool path when (isNothing res) $ do $logError "Failed to extract package" sendResponseText status500 "Failed to extract package" - PackageManifest {..} <- liftIO (decodeFileStrict (path "manifest.json")) + PackageManifest {..} <- liftIO (decodeFileStrict (dir "manifest.json")) `orThrow` sendResponseText status500 "Failed to parse manifest.json" - renameDirectory path (pkgRepoFileRoot show packageManifestId show packageManifestVersion) + renameFile path (dir (toS . unPkgId) packageManifestId <.> "s9pk") + let targetPath = pkgRepoFileRoot show packageManifestId show packageManifestVersion + removePathForcibly targetPath + createDirectoryIfMissing True targetPath + renameDirectory dir targetPath where retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m) @@ -90,6 +107,8 @@ instance FromJSON IndexPkgReq where indexPkgReqId <- o .: "id" indexPkgReqVersion <- o .: "version" pure IndexPkgReq { .. } +instance ToJSON IndexPkgReq where + toJSON IndexPkgReq {..} = object ["id" .= indexPkgReqId, "version" .= indexPkgReqVersion] postPkgIndexR :: Handler () postPkgIndexR = do @@ -98,7 +117,8 @@ postPkgIndexR = do man <- liftIO (decodeFileStrict manifest) `orThrow` sendResponseText status404 [i|Could not locate manifest for #{indexPkgReqId}@#{indexPkgReqVersion}|] - runDB $ upsertPackageVersion man + pool <- getsYesod appConnPool + runSqlPoolNoTransaction (upsertPackageVersion man) pool Nothing postPkgDeindexR :: Handler () postPkgDeindexR = do diff --git a/src/Lib/External/AppMgr.hs b/src/Lib/External/AppMgr.hs index 0db98bc..b21d49e 100644 --- a/src/Lib/External/AppMgr.hs +++ b/src/Lib/External/AppMgr.hs @@ -36,9 +36,9 @@ import GHC.IO.Exception ( IOErrorType(NoSuchThing) import Lib.Error import System.FilePath ( () ) import UnliftIO ( MonadUnliftIO + , bracket , catch ) -import UnliftIO ( bracket ) readProcessWithExitCode' :: MonadIO m => String -> [String] -> ByteString -> m (ExitCode, ByteString, ByteString) readProcessWithExitCode' a b c = liftIO $ do diff --git a/src/Lib/PkgRepository.hs b/src/Lib/PkgRepository.hs index d913cf7..2880bf8 100644 --- a/src/Lib/PkgRepository.hs +++ b/src/Lib/PkgRepository.hs @@ -49,8 +49,15 @@ import Database.Esqueleto.Experimental , insertUnique , runSqlPool ) -import Database.Persist ( (=.) ) -import Database.Persist.Class ( upsert ) +import Database.Persist ( (=.) + , insertKey + , update + , upsert + ) +import Database.Persist.Sql ( SqlPersistT + , runSqlPoolNoTransaction + ) +import Database.PostgreSQL.Simple ( SqlError(sqlState) ) import Lib.Error ( S9Error(NotFoundE) ) import qualified Lib.External.AppMgr as AppMgr import Lib.Types.AppIndex ( PackageManifest(..) @@ -118,6 +125,7 @@ import System.FilePath ( (<.>) import UnliftIO ( MonadUnliftIO , askRunInIO , async + , catch , mapConcurrently_ , newEmptyMVar , takeMVar @@ -184,15 +192,18 @@ loadPkgDependencies appConnPool manifest = do let pkgVersion = packageManifestVersion manifest let deps = packageManifestDependencies manifest time <- liftIO getCurrentTime + _ <- runWith appConnPool $ insertKey (PkgRecordKey pkgId) (PkgRecord time Nothing) `catch` \(e :: SqlError) -> + if sqlState e == "23505" then update (PkgRecordKey pkgId) [PkgRecordUpdatedAt =. Just time] else throwIO e let deps' = first PkgRecordKey <$> HM.toList deps for_ deps' - (\d -> runSqlPool - ( insertUnique - $ PkgDependency time (PkgRecordKey pkgId) pkgVersion (fst d) (packageDependencyVersion . snd $ d) - ) - appConnPool + (\d -> flip runSqlPool appConnPool $ do + insertUnique + $ PkgDependency time (PkgRecordKey pkgId) pkgVersion (fst d) (packageDependencyVersion . snd $ d) ) + where + runWith :: MonadUnliftIO m => ConnectionPool -> SqlPersistT m a -> m a + runWith pool action = runSqlPoolNoTransaction action pool Nothing -- extract all package assets into their own respective files extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => ConnectionPool -> FilePath -> m () @@ -235,27 +246,6 @@ extractPkg pool fp = handle @_ @SomeException cleanup $ do mapConcurrently_ (removeFile . (pkgRoot )) toRemove throwIO e -watchPkgRepoRoot :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => ConnectionPool -> m (IO Bool) -watchPkgRepoRoot pool = do - $logInfo "Starting FSNotify Watch Manager: PKG" - root <- asks pkgRepoFileRoot - runInIO <- askRunInIO - box <- newEmptyMVar @_ @() - _ <- forkIO $ liftIO $ withManager $ \watchManager -> do - stop <- watchTree watchManager root onlyAdded $ \evt -> do - let pkg = eventPath evt - -- TODO: validate that package path is an actual s9pk and is in a correctly conforming path. - void . forkIO $ runInIO $ do - extractPkg pool pkg - takeMVar box - stop - pure $ tryPutMVar box () - where - onlyAdded :: ActionPredicate - onlyAdded (Added path _ isDir) = not isDir && takeExtension path == ".s9pk" - onlyAdded (Modified path _ isDir) = not isDir && takeExtension path == ".s9pk" - onlyAdded _ = False - watchEosRepoRoot :: (MonadUnliftIO m, MonadReader r m, Has EosRepo r, MonadLoggerIO m) => ConnectionPool -> m (IO Bool) watchEosRepoRoot pool = do $logInfo "Starting FSNotify Watch Manager: EOS" diff --git a/src/Util/Shared.hs b/src/Util/Shared.hs index 95bc6a4..d859d3e 100644 --- a/src/Util/Shared.hs +++ b/src/Util/Shared.hs @@ -148,7 +148,7 @@ filterDependencyBestVersion PackageDependencyMetadata { packageDependencyMetadat pure Nothing sendResponseText :: MonadHandler m => Status -> Text -> m a -sendResponseText = sendResponseStatus @_ @Text +sendResponseText s = sendResponseStatus s . TypedContent typePlain . toContent maximumOn :: forall a b t . (Ord b, Foldable t) => (a -> b) -> t a -> Maybe a maximumOn f = foldr (\x y -> maxOn f x <$> y <|> Just x) Nothing diff --git a/stack.yaml b/stack.yaml index 4481b7a..683ab98 100644 --- a/stack.yaml +++ b/stack.yaml @@ -45,6 +45,7 @@ extra-deps: - monad-logger-extras-0.1.1.1 - persistent-migration-0.3.0 - rainbow-0.34.2.2 + - terminal-progress-bar-0.4.1 - wai-request-spec-0.10.2.4 - warp-3.3.19 - yesod-auth-basic-0.1.0.3