yogsototh/espial
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

disable ekg

Browse source
This commit is contained in:
Jon Schoning 2020-03-29 18:49:28 -05:00
parent ec4e36c36f
commit 28ee87890e
9 changed files with 66 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
README.md
View file

@ -59,8 +59,6 @@ see `config/settings.yml` for changing default run-time parameters / environment
default app http port: `3000`
default ekg http port: `8000`
ssl: use reverse proxy
## Development

4
config/settings.yml
View file

@ -37,7 +37,7 @@ database:
copyright: Insert copyright statement here
#analytics: UA-YOURCODE
ekg-host: "_env:EKG_HOST:0.0.0.0"
ekg-port: "_env:EKG_PORT:8000"
# ekg-host: "_env:EKG_HOST:0.0.0.0"
# ekg-port: "_env:EKG_PORT:8000"
source-code-uri: "https://github.com/jonschoning/espial"

2
docker-compose.yml
View file

@ -7,7 +7,7 @@ services:
dockerfile: ../Dockerfile
ports:
- "3000:3000"
- "8000:8000"
# - "8000:8000"
volumes:
- '$APPDATA:/app/data'
environment:

18
espial.cabal
View file

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: 853ba5e7d0435fcec73b493932da0f2748f4674bbfc62ebbd54df707166f999b
-- hash: 1a0707be00fc3010695ab3d7f1d1d1fcb6d5039e47d101b2a6919332eb864f83
name: espial
version: 0.0.8
@ -139,8 +139,6 @@ library
, containers
, data-default
, directory >=1.1 && <1.4
, ekg
, ekg-core
, entropy
, esqueleto
, fast-logger >=2.2 && <2.5
@ -157,7 +155,6 @@ library
, iso8601-time >=0.1.3
, microlens
, monad-logger >=0.3 && <0.4
, monad-metrics
, mtl
, parser-combinators
, persistent >=2.8 && <2.10
@ -175,7 +172,6 @@ library
, wai
, wai-extra >=3.0 && <3.1
, wai-logger >=2.2 && <2.4
, wai-middleware-metrics
, warp >=3.0 && <3.4
, yaml >=0.8 && <0.12
, yesod >=1.6 && <1.7
@ -215,8 +211,6 @@ executable espial
, containers
, data-default
, directory >=1.1 && <1.4
, ekg
, ekg-core
, entropy
, espial
, esqueleto
@ -234,7 +228,6 @@ executable espial
, iso8601-time >=0.1.3
, microlens
, monad-logger >=0.3 && <0.4
, monad-metrics
, mtl
, parser-combinators
, persistent >=2.8 && <2.10
@ -252,7 +245,6 @@ executable espial
, wai
, wai-extra >=3.0 && <3.1
, wai-logger >=2.2 && <2.4
, wai-middleware-metrics
, warp >=3.0 && <3.4
, yaml >=0.8 && <0.12
, yesod >=1.6 && <1.7
@ -288,8 +280,6 @@ executable migration
, containers
, data-default
, directory >=1.1 && <1.4
, ekg
, ekg-core
, entropy
, espial
, esqueleto
@ -307,7 +297,6 @@ executable migration
, iso8601-time >=0.1.3
, microlens
, monad-logger >=0.3 && <0.4
, monad-metrics
, mtl
, optparse-generic >=1.2.3
, parser-combinators
@ -326,7 +315,6 @@ executable migration
, wai
, wai-extra >=3.0 && <3.1
, wai-logger >=2.2 && <2.4
, wai-middleware-metrics
, warp >=3.0 && <3.4
, yaml >=0.8 && <0.12
, yesod >=1.6 && <1.7
@ -366,8 +354,6 @@ test-suite test
, containers
, data-default
, directory >=1.1 && <1.4
, ekg
, ekg-core
, entropy
, espial
, esqueleto
@ -386,7 +372,6 @@ test-suite test
, iso8601-time >=0.1.3
, microlens
, monad-logger >=0.3 && <0.4
, monad-metrics
, mtl
, parser-combinators
, persistent >=2.8 && <2.10
@ -404,7 +389,6 @@ test-suite test
, wai
, wai-extra >=3.0 && <3.1
, wai-logger >=2.2 && <2.4
, wai-middleware-metrics
, warp >=3.0 && <3.4
, yaml >=0.8 && <0.12
, yesod >=1.6 && <1.7

8
package.yaml
View file

@ -126,8 +126,8 @@ dependencies:
- attoparsec
- bcrypt >= 0.0.8
- entropy
- ekg
- ekg-core
# - ekg
# - ekg-core
- esqueleto
- hscolour
- http-api-data >= 0.3.4
@ -135,12 +135,12 @@ dependencies:
- http-types
- iso8601-time >=0.1.3
- microlens
- monad-metrics
# - monad-metrics
- mtl
- persistent-sqlite >=2.6.2
- pretty-show
- transformers >= 0.2.2
- wai-middleware-metrics
# - wai-middleware-metrics
- parser-combinators
- html-entities

50
src/Application.hs
View file

@ -18,7 +18,7 @@ import Control.Monad.Logger (liftLoc, runLoggingT)
import Database.Persist.Sqlite (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
import Import
import Language.Haskell.TH.Syntax (qLocation)
import Lens.Micro
-- import Lens.Micro
import Network.HTTP.Client.TLS
import Network.Wai (Middleware)
import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, setOnException, setPort, getPort)
@ -30,10 +30,10 @@ import Network.Wai.Middleware.RequestLogger (Destination(Logger), IPAd
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
import Yesod.Auth (getAuth)
import qualified Control.Monad.Metrics as MM
import qualified Network.Wai.Metrics as WM
import qualified System.Metrics as EKG
import qualified System.Remote.Monitoring as EKG
-- import qualified Control.Monad.Metrics as MM
-- import qualified Network.Wai.Metrics as WM
-- import qualified System.Metrics as EKG
-- import qualified System.Remote.Monitoring as EKG
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
@ -52,9 +52,9 @@ makeFoundation :: AppSettings -> IO App
makeFoundation appSettings = do
appHttpManager <- getGlobalManager
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
store <- EKG.newStore
EKG.registerGcMetrics store
appMetrics <- MM.initializeWith store
-- store <- EKG.newStore
-- EKG.registerGcMetrics store
-- appMetrics <- MM.initializeWith store
appStatic <-
(if appMutableStatic appSettings
then staticDevel
@ -77,13 +77,13 @@ makeApplication :: App -> IO Application
makeApplication foundation = do
logWare <- makeLogWare foundation
appPlain <- toWaiAppPlain foundation
let store = appMetrics foundation ^. MM.metricsStore
waiMetrics <- WM.registerWaiMetrics store
return (logWare (makeMiddleware waiMetrics appPlain))
-- let store = appMetrics foundation ^. MM.metricsStore
-- waiMetrics <- WM.registerWaiMetrics store
return (logWare (makeMiddleware appPlain))
makeMiddleware :: WM.WaiMetrics -> Middleware
makeMiddleware waiMetrics =
WM.metrics waiMetrics .
makeMiddleware :: Middleware
makeMiddleware =
-- WM.metrics waiMetrics .
acceptOverride .
autohead .
gzip def {gzipFiles = GzipPreCompressed GzipIgnore} .
@ -127,7 +127,7 @@ getApplicationDev = do
foundation <- makeFoundation settings
wsettings <- getDevSettings (warpSettings foundation)
app <- makeApplication foundation
forkEKG foundation
-- forkEKG foundation
return (wsettings, app)
getAppSettings :: IO AppSettings
@ -137,15 +137,15 @@ getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
develMain :: IO ()
develMain = develMainHelper getApplicationDev
forkEKG :: App -> IO ()
forkEKG foundation =
let settings = appSettings foundation in
for_ (appEkgHost settings) $ \ekgHost ->
for_ (appEkgPort settings) $ \ekgPort ->
EKG.forkServerWith
(appMetrics foundation ^. MM.metricsStore)
(encodeUtf8 ekgHost)
ekgPort
-- forkEKG :: App -> IO ()
-- forkEKG foundation =
-- let settings = appSettings foundation in
-- for_ (appEkgHost settings) $ \ekgHost ->
-- for_ (appEkgPort settings) $ \ekgPort ->
-- EKG.forkServerWith
-- (appMetrics foundation ^. MM.metricsStore)
-- (encodeUtf8 ekgHost)
-- ekgPort
-- | The @main@ function for an executable running this site.
appMain :: IO ()
@ -153,7 +153,7 @@ appMain = do
settings <- loadYamlSettingsArgs [configSettingsYmlValue] useEnv
foundation <- makeFoundation settings
app <- makeApplication foundation
forkEKG foundation
-- forkEKG foundation
runSettings (warpSettings foundation) app
getApplicationRepl :: IO (Int, App, Application)

33
src/Foundation.hs
View file

@ -15,8 +15,8 @@ import PathPiece()
import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Core.Types
import Yesod.Auth.Message
import qualified Network.Wai as NW
import qualified Control.Monad.Metrics as MM
-- import qualified Network.Wai as NW
-- import qualified Control.Monad.Metrics as MM
import qualified Data.CaseInsensitive as CI
import qualified Data.Text.Encoding as TE
import qualified Yesod.Core.Unsafe as Unsafe
@ -27,7 +27,7 @@ data App = App
, appConnPool :: ConnectionPool -- ^ Database connection pool.
, appHttpManager :: Manager
, appLogger :: Logger
, appMetrics :: !MM.Metrics
-- , appMetrics :: !MM.Metrics
} deriving (Typeable)
mkYesodData "App" $(parseRoutesFile "config/routes")
@ -58,7 +58,8 @@ instance Yesod App where
10080 -- min (7 days)
"config/client_session_key.aes"
yesodMiddleware = metricsMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
-- yesodMiddleware = metricsMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
defaultLayout widget = do
req <- getRequest
@ -68,7 +69,7 @@ instance Yesod App where
musername <- maybeAuthUsername
muser <- (fmap.fmap) snd maybeAuthPair
mcurrentRoute <- getCurrentRoute
void $ mapM (incrementRouteEKG req) mcurrentRoute
-- void $ mapM (incrementRouteEKG req) mcurrentRoute
let msourceCodeUri = appSourceCodeUri (appSettings master)
pc <- widgetToPageContent $ do
setTitle "Espial"
@ -139,17 +140,17 @@ popupLayout widget = do
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
metricsMiddleware :: Handler a -> Handler a
metricsMiddleware handler = do
req <- getRequest
mcurrentRoute <- getCurrentRoute
void $ mapM (incrementRouteEKG req) mcurrentRoute
handler
-- metricsMiddleware :: Handler a -> Handler a
-- metricsMiddleware handler = do
-- req <- getRequest
-- mcurrentRoute <- getCurrentRoute
-- void $ mapM (incrementRouteEKG req) mcurrentRoute
-- handler
incrementRouteEKG :: YesodRequest -> Route App -> Handler ()
incrementRouteEKG req = MM.increment . (\r -> "route." <> r <> "." <> method) . pack . constrName
where method = decodeUtf8 $ NW.requestMethod $ reqWaiRequest req
-- incrementRouteEKG :: YesodRequest -> Route App -> Handler ()
-- incrementRouteEKG req = MM.increment . (\r -> "route." <> r <> "." <> method) . pack . constrName
-- where method = decodeUtf8 $ NW.requestMethod $ reqWaiRequest req
-- YesodAuth
@ -169,8 +170,8 @@ instance YesodAuth App where
instance YesodAuthPersist App
instance MM.MonadMetrics Handler where
getMetrics = pure . appMetrics =<< getYesod
-- instance MM.MonadMetrics Handler where
-- getMetrics = pure . appMetrics =<< getYesod
-- session keys

17
src/Handler/Archive.hs
View file

@ -12,7 +12,7 @@ import qualified Network.HTTP.Client as NH
import qualified Network.HTTP.Client.TLS as NH
import qualified Network.HTTP.Types.Status as NH
import qualified Web.FormUrlEncoded as WH
import qualified Control.Monad.Metrics as MM
-- import qualified Control.Monad.Metrics as MM
import HTMLEntities.Decoder (htmlEncodedText)
import Data.Text.Lazy.Builder (toLazyText)
@ -31,15 +31,15 @@ archiveBookmarkUrl :: Key Bookmark -> String -> Handler ()
archiveBookmarkUrl kbid url =
(_fetchArchiveSubmitInfo >>= \case
Left e -> do
MM.increment "archive.fetchSubmitId_noparse"
-- MM.increment "archive.fetchSubmitId_noparse"
$(logError) (pack e)
Right submitInfo -> do
userId <- requireAuthId
let req = _buildArchiveSubmitRequest submitInfo url
MM.increment "archive.submit"
-- MM.increment "archive.submit"
res <- liftIO $ NH.httpLbs req =<< NH.getGlobalManager
let status = NH.responseStatus res
MM.increment ("archive.submit_status_" <> (pack.show) (NH.statusCode status))
-- MM.increment ("archive.submit_status_" <> (pack.show) (NH.statusCode status))
let updateArchiveUrl = runDB . updateBookmarkArchiveUrl userId kbid . Just
headers = NH.responseHeaders res
case status of
@ -87,9 +87,9 @@ _buildArchiveSubmitRequest (action, submitId) href =
_fetchArchiveSubmitInfo :: Handler (Either String (String , String))
_fetchArchiveSubmitInfo = do
MM.increment "archive.fetchSubmitId"
-- MM.increment "archive.fetchSubmitId"
res <- liftIO $ NH.httpLbs (buildSimpleRequest "https://archive.li/") =<< NH.getGlobalManager
MM.increment ("archive.fetchSubmitId_status_" <> (pack.show) (NH.statusCode (NH.responseStatus res)))
-- MM.increment ("archive.fetchSubmitId_status_" <> (pack.show) (NH.statusCode (NH.responseStatus res)))
let body = LBS.toStrict (responseBody res)
action = _parseSubstring (AP8.string "action=\"") (AP8.notChar '"') body
submitId = _parseSubstring (AP8.string "submitid\" value=\"") (AP8.notChar '"') body
@ -107,12 +107,13 @@ _parseSubstring start inner res = do
fetchPageTitle :: String -> Handler (Either String Text)
fetchPageTitle url =
do MM.increment "fetchPageTitle"
do
-- MM.increment "fetchPageTitle"
res <- liftIO $ NH.httpLbs (buildSimpleRequest url) =<< NH.getGlobalManager
let body = LBS.toStrict (responseBody res)
pure (decodeHtmlBs <$> parseTitle body)
`catch` (\(e :: SomeException) -> do
MM.increment "fetchPageTitle.error"
-- MM.increment "fetchPageTitle.error"
$(logError) $ (pack . show) e
pure (Left (show e)))
where

13
src/Settings.hs
View file

@ -56,10 +56,11 @@ data AppSettings = AppSettings
, appAuthDummyLogin :: Bool
-- ^ Indicate if auth dummy login should be enabled.
, appEkgHost :: Maybe Text
-- ^ Host/interface the ekg server should bind to.
, appEkgPort :: Maybe Int
-- ^ Port to listen on
-- , appEkgHost :: Maybe Text
-- -- ^ Host/interface the ekg server should bind to.
-- , appEkgPort :: Maybe Int
-- -- ^ Port to listen on
, appSourceCodeUri :: Maybe Text
-- ^ Uri to app source code
}
@ -92,8 +93,8 @@ instance FromJSON AppSettings where
appAuthDummyLogin <- o .:? "auth-dummy-login" .!= dev
appEkgHost <- o .:? "ekg-host"
appEkgPort <- o .:? "ekg-port"
-- appEkgHost <- o .:? "ekg-host"
-- appEkgPort <- o .:? "ekg-port"
appSourceCodeUri <- o .:? "source-code-uri"
return AppSettings {..}