Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-04-04 21:59:43 +00:00
Code Issues Packages Projects Releases Wiki Activity

attempts at fixing this

Browse Source
This commit is contained in:
Keagan McClelland
2021-12-30 09:12:05 -07:00
parent e81b3b7546
commit 51851ef66c
4 changed files with 130 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files

140
src/Application.hs
View File

@@ -27,26 +27,58 @@ module Application
import Startlude import Startlude
import Control.Monad.Logger (liftLoc, runLoggingT) import Control.Monad.Logger ( liftLoc
, runLoggingT
)
import Data.Default import Data.Default
import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr, pgPoolSize, runSqlPool, runMigration) import Database.Persist.Postgresql ( createPostgresqlPool
import Language.Haskell.TH.Syntax (qLocation) , pgConnStr
, pgPoolSize
, runMigration
, runSqlPool
)
import Language.Haskell.TH.Syntax ( qLocation )
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, import Network.Wai.Handler.Warp ( Settings
getPort, setHost, setOnException, setPort, runSettings) , defaultSettings
, defaultShouldDisplayException
, getPort
, runSettings
, setHTTP2Disabled
, setHost
, setOnException
, setPort
)
import Network.Wai.Handler.WarpTLS import Network.Wai.Handler.WarpTLS
import Network.Wai.Middleware.AcceptOverride import Network.Wai.Middleware.AcceptOverride
import Network.Wai.Middleware.Autohead import Network.Wai.Middleware.Autohead
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy) import Network.Wai.Middleware.Cors ( CorsResourcePolicy(..)
, cors
, simpleCorsResourcePolicy
)
import Network.Wai.Middleware.MethodOverride import Network.Wai.Middleware.MethodOverride
import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), import Network.Wai.Middleware.RequestLogger
destination, mkRequestLogger, outputFormat) ( Destination(Logger)
import System.IO (hSetBuffering, BufferMode (..)) , IPAddrSource(..)
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr) , OutputFormat(..)
, destination
, mkRequestLogger
, outputFormat
)
import System.IO ( BufferMode(..)
, hSetBuffering
)
import System.Log.FastLogger ( defaultBufSize
, newStdoutLoggerSet
, toLogStr
)
import Yesod.Core import Yesod.Core
import Yesod.Core.Types hiding (Logger) import Yesod.Core.Types hiding ( Logger )
import Yesod.Default.Config2 import Yesod.Default.Config2
import Control.Arrow ( (***) )
import Control.Lens
import Data.List ( lookup )
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file! -- Don't forget to add new modules to your cabal file!
import Foundation import Foundation
@@ -54,14 +86,12 @@ import Handler.Apps
import Handler.Icons import Handler.Icons
import Handler.Version import Handler.Version
import Lib.Ssl import Lib.Ssl
import Model
import Network.HTTP.Types.Header ( hOrigin )
import Settings import Settings
import System.Mem ( performGC )
import System.Posix.Process import System.Posix.Process
import System.Time.Extra import System.Time.Extra
import Model
import Control.Lens
import Control.Arrow ((***))
import Network.HTTP.Types.Header ( hOrigin )
import Data.List (lookup)
-- This line actually creates our YesodDispatch instance. It is the second half -- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
@@ -76,27 +106,26 @@ makeFoundation :: AppSettings -> IO RegistryCtx
makeFoundation appSettings = do makeFoundation appSettings = do
-- Some basic initializations: HTTP connection manager, logger, and static -- Some basic initializations: HTTP connection manager, logger, and static
-- subsite. -- subsite.
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
appWebServerThreadId <- newEmptyMVar appWebServerThreadId <- newEmptyMVar
appShouldRestartWeb <- newMVar False appShouldRestartWeb <- newMVar False
-- We need a log function to create a connection pool. We need a connection -- We need a log function to create a connection pool. We need a connection
-- pool to create our foundation. And we need our foundation to get a -- pool to create our foundation. And we need our foundation to get a
-- logging function. To get out of this loop, we initially create a -- logging function. To get out of this loop, we initially create a
-- temporary foundation without a real connection pool, get a log function -- temporary foundation without a real connection pool, get a log function
-- from there, and then create the real foundation. -- from there, and then create the real foundation.
let mkFoundation appConnPool = RegistryCtx {..} let mkFoundation appConnPool = RegistryCtx { .. }
-- The RegistryCtx {..} syntax is an example of record wild cards. For more -- The RegistryCtx {..} syntax is an example of record wild cards. For more
-- information, see: -- information, see:
-- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
tempFoundation = mkFoundation $ panic "connPool forced in tempFoundation" tempFoundation = mkFoundation $ panic "connPool forced in tempFoundation"
logFunc = messageLoggerSource tempFoundation appLogger logFunc = messageLoggerSource tempFoundation appLogger
-- Create the database connection pool -- Create the database connection pool
pool <- flip runLoggingT logFunc $ createPostgresqlPool pool <- flip runLoggingT logFunc
(pgConnStr $ appDatabaseConf appSettings) $ createPostgresqlPool (pgConnStr $ appDatabaseConf appSettings) (pgPoolSize . appDatabaseConf $ appSettings)
(pgPoolSize . appDatabaseConf $ appSettings)
-- Preform database migration using application logging settings -- Preform database migration using application logging settings
runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
@@ -108,11 +137,10 @@ makeFoundation appSettings = do
-- applying some additional middlewares. -- applying some additional middlewares.
makeApplication :: RegistryCtx -> IO Application makeApplication :: RegistryCtx -> IO Application
makeApplication foundation = do makeApplication foundation = do
logWare <- makeLogWare foundation logWare <- makeLogWare foundation
let authWare = makeAuthWare foundation
-- Create the WAI application and apply middlewares -- Create the WAI application and apply middlewares
appPlain <- toWaiAppPlain foundation appPlain <- toWaiAppPlain foundation
pure . logWare . cors dynamicCorsResourcePolicy . authWare . acceptOverride . autohead . methodOverride $ appPlain pure . logWare . cors dynamicCorsResourcePolicy . acceptOverride . autohead . methodOverride $ appPlain
dynamicCorsResourcePolicy :: Request -> Maybe CorsResourcePolicy dynamicCorsResourcePolicy :: Request -> Maybe CorsResourcePolicy
dynamicCorsResourcePolicy req = Just . policy . lookup hOrigin $ requestHeaders req dynamicCorsResourcePolicy req = Just . policy . lookup hOrigin $ requestHeaders req
@@ -178,30 +206,14 @@ dynamicCorsResourcePolicy req = Just . policy . lookup hOrigin $ requestHeaders
] ]
, corsIgnoreFailures = True , corsIgnoreFailures = True
} }
-- TODO: create a middle ware which will attempt to verify an ecdsa signed transaction against one of the public keys
-- in the validDevices table.
-- makeCheckSigWare :: RegistryCtx -> IO Middleware
-- makeCheckSigWare = _
makeLogWare :: RegistryCtx -> IO Middleware makeLogWare :: RegistryCtx -> IO Middleware
makeLogWare foundation = makeLogWare foundation = mkRequestLogger def
mkRequestLogger def { outputFormat = if appDetailedRequestLogging $ appSettings foundation
{ outputFormat = then Detailed True
if appDetailedRequestLogging $ appSettings foundation else Apache (if appIpFromHeader $ appSettings foundation then FromFallback else FromSocket)
then Detailed True , destination = Logger $ loggerSet $ appLogger foundation
else Apache }
(if appIpFromHeader $ appSettings foundation
then FromFallback
else FromSocket)
, destination = Logger $ loggerSet $ appLogger foundation
}
-- TODO : what kind of auth is needed here
makeAuthWare :: RegistryCtx -> Middleware
makeAuthWare _ app req res = next
where
next :: IO ResponseReceived
next = app req res
-- | Warp settings for the given foundation value. -- | Warp settings for the given foundation value.
warpSettings :: AppPort -> RegistryCtx -> Settings warpSettings :: AppPort -> RegistryCtx -> Settings
@@ -216,6 +228,7 @@ warpSettings port foundation =
"yesod" "yesod"
LevelError LevelError
(toLogStr $ "Exception from Warp: " ++ show e)) (toLogStr $ "Exception from Warp: " ++ show e))
$ setHTTP2Disabled
defaultSettings defaultSettings
getAppSettings :: IO AppSettings getAppSettings :: IO AppSettings
@@ -228,11 +241,10 @@ appMain = do
-- Get the settings from all relevant sources -- Get the settings from all relevant sources
settings <- loadYamlSettingsArgs settings <- loadYamlSettingsArgs
-- fall back to compile-time values, set to [] to require values at runtime -- fall back to compile-time values, set to [] to require values at runtime
[configSettingsYmlValue] [configSettingsYmlValue]
-- allow environment variables to override -- allow environment variables to override
useEnv useEnv
-- Generate the foundation from the settings -- Generate the foundation from the settings
makeFoundation settings >>= startApp makeFoundation settings >>= startApp
@@ -259,17 +271,17 @@ startApp foundation = do
startWeb :: RegistryCtx -> IO () startWeb :: RegistryCtx -> IO ()
startWeb foundation = do startWeb foundation = do
app <- makeApplication foundation app <- makeApplication foundation
void $ forkIO $ forever $ sleep 10 *> putStrLn @Text "Performing GC" *> performGC
startWeb' app startWeb' app
where where
startWeb' app = do startWeb' app = do
let AppSettings{..} = appSettings foundation let AppSettings {..} = appSettings foundation
putStrLn @Text $ "Launching Tor Web Server on port " <> show torPort putStrLn @Text $ "Launching Tor Web Server on port " <> show torPort
torAction <- async $ runSettings (warpSettings torPort foundation) app torAction <- async $ runSettings (warpSettings torPort foundation) app
putStrLn @Text $ "Launching Web Server on port " <> show appPort putStrLn @Text $ "Launching Web Server on port " <> show appPort
action <- if sslAuto action <- if sslAuto
then async $ runTLS (tlsSettings sslCertLocation sslKeyLocation) then async $ runTLS (tlsSettings sslCertLocation sslKeyLocation) (warpSettings appPort foundation) app
(warpSettings appPort foundation) app else async $ runSettings (warpSettings appPort foundation) app
else async $ runSettings (warpSettings appPort foundation) app
let actions = (action, torAction) let actions = (action, torAction)
setWebProcessThreadId (join (***) asyncThreadId actions) foundation setWebProcessThreadId (join (***) asyncThreadId actions) foundation
@@ -292,7 +304,7 @@ startWeb foundation = do
restartWeb :: RegistryCtx -> IO () restartWeb :: RegistryCtx -> IO ()
restartWeb foundation = do restartWeb foundation = do
void $ swapMVar (appShouldRestartWeb foundation) True putMVar (appShouldRestartWeb foundation) True
shutdownWeb foundation shutdownWeb foundation
shutdownAll :: [ThreadId] -> IO () shutdownAll :: [ThreadId] -> IO ()
@@ -302,8 +314,8 @@ shutdownAll threadIds = do
-- Careful, you should always spawn this within forkIO so as to avoid accidentally killing the running process -- Careful, you should always spawn this within forkIO so as to avoid accidentally killing the running process
shutdownWeb :: RegistryCtx -> IO () shutdownWeb :: RegistryCtx -> IO ()
shutdownWeb RegistryCtx{..} = do shutdownWeb RegistryCtx {..} = do
threadIds <- takeMVar appWebServerThreadId threadIds <- takeMVar appWebServerThreadId
void $ both killThread threadIds void $ both killThread threadIds
-------------------------------------------------------------- --------------------------------------------------------------
@@ -313,9 +325,9 @@ shutdownWeb RegistryCtx{..} = do
getApplicationRepl :: AppPort -> IO (Int, RegistryCtx, Application) getApplicationRepl :: AppPort -> IO (Int, RegistryCtx, Application)
getApplicationRepl port = do getApplicationRepl port = do
foundation <- getAppSettings >>= makeFoundation foundation <- getAppSettings >>= makeFoundation
wsettings <- getDevSettings $ warpSettings port foundation wsettings <- getDevSettings $ warpSettings port foundation
app1 <- makeApplication foundation app1 <- makeApplication foundation
return (getPort wsettings, foundation, app1) return (getPort wsettings, foundation, app1)
shutdownApp :: RegistryCtx -> IO () shutdownApp :: RegistryCtx -> IO ()
shutdownApp _ = return () shutdownApp _ = return ()

59
src/Handler/Apps.hs
View File

@@ -6,6 +6,7 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BangPatterns #-}
module Handler.Apps where module Handler.Apps where
@@ -14,7 +15,8 @@ import Startlude
import Control.Monad.Logger import Control.Monad.Logger
import Data.Aeson import Data.Aeson
import qualified Data.Attoparsec.Text as Atto import qualified Data.Attoparsec.Text as Atto
import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Char import Data.Char
import Data.Conduit import Data.Conduit
import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.Binary as CB
@@ -34,16 +36,16 @@ import System.Posix.Files ( fileSize
import Yesod.Core import Yesod.Core
import Yesod.Persist.Core import Yesod.Persist.Core
import Database.Queries
import Foundation import Foundation
import Lib.Error
import Lib.External.AppMgr
import Lib.Registry import Lib.Registry
import Lib.Types.AppIndex import Lib.Types.AppIndex
import Lib.Types.Emver import Lib.Types.Emver
import Lib.Types.FileSystem import Lib.Types.FileSystem
import Lib.Error
import Lib.External.AppMgr
import Settings
import Database.Queries
import Network.Wai ( Request(requestHeaderUserAgent) ) import Network.Wai ( Request(requestHeaderUserAgent) )
import Settings
import Util.Shared import Util.Shared
@@ -51,7 +53,7 @@ pureLog :: Show a => a -> Handler a
pureLog = liftA2 (*>) ($logInfo . show) pure pureLog = liftA2 (*>) ($logInfo . show) pure
logRet :: ToJSON a => Handler a -> Handler a logRet :: ToJSON a => Handler a -> Handler a
logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . BS.toStrict . encode) pure) logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . LBS.toStrict . encode) pure)
data FileExtension = FileExtension FilePath (Maybe String) data FileExtension = FileExtension FilePath (Maybe String)
instance Show FileExtension where instance Show FileExtension where
@@ -71,32 +73,37 @@ getEmbassyOsVersion = userAgentOsVersion
getAppsManifestR :: Handler TypedContent getAppsManifestR :: Handler TypedContent
getAppsManifestR = do getAppsManifestR = do
osVersion <- getEmbassyOsVersion osVersion <- getEmbassyOsVersion
appsDir <- (</> "apps") . resourcesDir . appSettings <$> getYesod appsDir <- (</> "apps") . resourcesDir . appSettings <$> getYesod
let appResourceFile = appsDir </> "apps.yaml" let appResourceFile = appsDir </> "apps.yaml"
manifest <- liftIO (Yaml.decodeFileEither appResourceFile) >>= \case appResourceBytes <- liftIO $ BS.readFile appResourceFile
Left e -> do manifest <- case {-# SCC yaml_decode_either #-} Yaml.decodeEither' appResourceBytes of
Left !e -> do
$logError "COULD NOT PARSE APP INDEX! CORRECT IMMEDIATELY!" $logError "COULD NOT PARSE APP INDEX! CORRECT IMMEDIATELY!"
$logError (show e) $logError (show e)
sendResponseStatus status500 ("Internal Server Error" :: Text) sendResponseStatus status500 ("Internal Server Error" :: Text)
Right a -> pure a Right !a -> pure a
m <- mapM (addFileTimestamp' appsDir) (HM.toList $ unAppManifest manifest)
let withServiceTimestamps = AppManifest $ HM.fromList m
let pruned = case osVersion of let pruned = case osVersion of
Nothing -> withServiceTimestamps Nothing -> manifest
Just av -> AppManifest $ HM.mapMaybe (filterOsRecommended av) $ unAppManifest withServiceTimestamps Just av -> AppManifest . HM.mapMaybe (filterOsRecommended av) . unAppManifest $ manifest
pure $ TypedContent "application/x-yaml" (toContent $ Yaml.encode pruned) withServiceTimestamps <-
fmap AppManifest
. HM.traverseWithKey (const pure {-addFileTimestamp' appsDir-}
)
. unAppManifest
$ pruned
pure . TypedContent "application/x-yaml" . toContent . Yaml.encode $! withServiceTimestamps
where where
addFileTimestamp' :: (MonadHandler m, MonadIO m) => FilePath -> (AppIdentifier, StoreApp) -> m (AppIdentifier, StoreApp) addFileTimestamp' :: (MonadHandler m, MonadIO m) => FilePath -> AppIdentifier -> StoreApp -> m StoreApp
addFileTimestamp' dir (appId, service) = do addFileTimestamp' dir appId service = do
let ext = (Extension (toS appId) :: Extension "s9pk") let ext = (Extension (toS appId) :: Extension "s9pk")
mostRecentVersion <- liftIO $ getMostRecentAppVersion dir ext mostRecentVersion <- liftIO $ getMostRecentAppVersion dir ext
(v, _) <- case mostRecentVersion of (v, _) <- case mostRecentVersion of
Nothing -> notFound Nothing -> notFound
Just a -> pure $ unRegisteredAppVersion a Just a -> pure $ unRegisteredAppVersion a
liftIO (addFileTimestamp dir ext service v) >>= \case liftIO (addFileTimestamp dir ext service v) >>= \case
Nothing -> notFound Nothing -> notFound
Just appWithTimestamp -> pure (appId, appWithTimestamp) Just appWithTimestamp -> pure appWithTimestamp
getSysR :: Extension "" -> Handler TypedContent getSysR :: Extension "" -> Handler TypedContent
getSysR e = do getSysR e = do
@@ -106,7 +113,7 @@ getSysR e = do
getAppManifestR :: AppIdentifier -> Handler TypedContent getAppManifestR :: AppIdentifier -> Handler TypedContent
getAppManifestR appId = do getAppManifestR appId = do
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
av <- getVersionFromQuery appsDir appExt >>= \case av <- getVersionFromQuery appsDir appExt >>= \case
Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text) Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
Just v -> pure v Just v -> pure v
let appDir = (<> "/") . (</> show av) . (</> toS appId) $ appsDir let appDir = (<> "/") . (</> show av) . (</> toS appId) $ appsDir
@@ -145,10 +152,10 @@ getApp rootDir ext@(Extension appId) = do
case best of case best of
Nothing -> notFound Nothing -> notFound
Just (RegisteredAppVersion (appVersion, filePath)) -> do Just (RegisteredAppVersion (appVersion, filePath)) -> do
exists <- liftIO $ doesFileExist filePath >>= \case existence <- liftIO $ doesFileExist filePath >>= \case
True -> pure Existent True -> pure Existent
False -> pure NonExistent False -> pure NonExistent
determineEvent exists (extension ext) filePath appVersion determineEvent existence (extension ext) filePath appVersion
where where
determineEvent :: FileExistence -> String -> FilePath -> Version -> HandlerFor RegistryCtx TypedContent determineEvent :: FileExistence -> String -> FilePath -> Version -> HandlerFor RegistryCtx TypedContent
-- for app files -- for app files

36
src/Lib/Types/AppIndex.hs
View File

@@ -10,20 +10,20 @@ import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import Lib.Registry
import Lib.Types.Emver import Lib.Types.Emver
import Orphans.Emver ( ) import Orphans.Emver ( )
import System.Directory import System.Directory
import Lib.Registry
type AppIdentifier = Text type AppIdentifier = Text
data VersionInfo = VersionInfo data VersionInfo = VersionInfo
{ versionInfoVersion :: Version { versionInfoVersion :: !Version
, versionInfoReleaseNotes :: Text , versionInfoReleaseNotes :: !Text
, versionInfoDependencies :: HM.HashMap Text VersionRange , versionInfoDependencies :: !(HM.HashMap Text VersionRange)
, versionInfoOsRequired :: VersionRange , versionInfoOsRequired :: !VersionRange
, versionInfoOsRecommended :: VersionRange , versionInfoOsRecommended :: !VersionRange
, versionInfoInstallAlert :: Maybe Text , versionInfoInstallAlert :: !(Maybe Text)
} }
deriving (Eq, Show) deriving (Eq, Show)
@@ -51,12 +51,12 @@ instance ToJSON VersionInfo where
] ]
data StoreApp = StoreApp data StoreApp = StoreApp
{ storeAppTitle :: Text { storeAppTitle :: !Text
, storeAppDescShort :: Text , storeAppDescShort :: !Text
, storeAppDescLong :: Text , storeAppDescLong :: !Text
, storeAppVersionInfo :: NonEmpty VersionInfo , storeAppVersionInfo :: !(NonEmpty VersionInfo)
, storeAppIconType :: Text , storeAppIconType :: !Text
, storeAppTimestamp :: Maybe UTCTime , storeAppTimestamp :: !(Maybe UTCTime)
} }
deriving Show deriving Show
@@ -84,7 +84,7 @@ instance FromJSON AppManifest where
storeAppVersionInfo <- config .: "version-info" >>= \case storeAppVersionInfo <- config .: "version-info" >>= \case
[] -> fail "No Valid Version Info" [] -> fail "No Valid Version Info"
(x : xs) -> pure $ x :| xs (x : xs) -> pure $ x :| xs
storeAppTimestamp <- config .:? "timestamp" storeAppTimestamp <- config .:? "timestamp"
pure (appId, StoreApp { .. }) pure (appId, StoreApp { .. })
return $ AppManifest (HM.fromList apps) return $ AppManifest (HM.fromList apps)
instance ToJSON AppManifest where instance ToJSON AppManifest where
@@ -104,7 +104,7 @@ filterOsRecommended av sa = case NE.filter ((av <||) . versionInfoOsRecommended)
addFileTimestamp :: KnownSymbol a => FilePath -> Extension a -> StoreApp -> Version -> IO (Maybe StoreApp) addFileTimestamp :: KnownSymbol a => FilePath -> Extension a -> StoreApp -> Version -> IO (Maybe StoreApp)
addFileTimestamp appDir ext service v = do addFileTimestamp appDir ext service v = do
getVersionedFileFromDir appDir ext v >>= \case getVersionedFileFromDir appDir ext v >>= \case
Nothing -> pure Nothing Nothing -> pure Nothing
Just file -> do Just file -> do
time <- getModificationTime file time <- getModificationTime file
pure $ Just service {storeAppTimestamp = Just time } pure $ Just service { storeAppTimestamp = Just time }

7
stack.yaml
View File

@@ -17,7 +17,7 @@
# #
# resolver: ./custom-snapshot.yaml # resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-18.11 resolver: lts-18.19
# User packages to be built. # User packages to be built.
# Various formats can be used as shown in the example below. # Various formats can be used as shown in the example below.
@@ -29,7 +29,7 @@ resolver: lts-18.11
# - auto-update # - auto-update
# - wai # - wai
packages: packages:
- . - .
# Dependency packages to be pulled from upstream that are not in the resolver. # Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as # These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example: # forks / in-progress versions pinned to a git hash. For example:
@@ -41,7 +41,6 @@ packages:
# #
extra-deps: extra-deps:
- protolude-0.2.4 - protolude-0.2.4
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
# flags: {} # flags: {}
@@ -66,4 +65,4 @@ extra-deps:
# Allow a newer minor version of GHC than the snapshot specifies # Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor # compiler-check: newer-minor
# docker: # docker:
# enable: true # enable: true