disable ekg
This commit is contained in:
parent
ec4e36c36f
commit
28ee87890e
|
@ -59,8 +59,6 @@ see `config/settings.yml` for changing default run-time parameters / environment
|
||||||
|
|
||||||
default app http port: `3000`
|
default app http port: `3000`
|
||||||
|
|
||||||
default ekg http port: `8000`
|
|
||||||
|
|
||||||
ssl: use reverse proxy
|
ssl: use reverse proxy
|
||||||
|
|
||||||
## Development
|
## Development
|
||||||
|
|
|
@ -37,7 +37,7 @@ database:
|
||||||
copyright: Insert copyright statement here
|
copyright: Insert copyright statement here
|
||||||
#analytics: UA-YOURCODE
|
#analytics: UA-YOURCODE
|
||||||
|
|
||||||
ekg-host: "_env:EKG_HOST:0.0.0.0"
|
# ekg-host: "_env:EKG_HOST:0.0.0.0"
|
||||||
ekg-port: "_env:EKG_PORT:8000"
|
# ekg-port: "_env:EKG_PORT:8000"
|
||||||
|
|
||||||
source-code-uri: "https://github.com/jonschoning/espial"
|
source-code-uri: "https://github.com/jonschoning/espial"
|
||||||
|
|
|
@ -7,7 +7,7 @@ services:
|
||||||
dockerfile: ../Dockerfile
|
dockerfile: ../Dockerfile
|
||||||
ports:
|
ports:
|
||||||
- "3000:3000"
|
- "3000:3000"
|
||||||
- "8000:8000"
|
# - "8000:8000"
|
||||||
volumes:
|
volumes:
|
||||||
- '$APPDATA:/app/data'
|
- '$APPDATA:/app/data'
|
||||||
environment:
|
environment:
|
||||||
|
|
18
espial.cabal
18
espial.cabal
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: 853ba5e7d0435fcec73b493932da0f2748f4674bbfc62ebbd54df707166f999b
|
-- hash: 1a0707be00fc3010695ab3d7f1d1d1fcb6d5039e47d101b2a6919332eb864f83
|
||||||
|
|
||||||
name: espial
|
name: espial
|
||||||
version: 0.0.8
|
version: 0.0.8
|
||||||
|
@ -139,8 +139,6 @@ library
|
||||||
, containers
|
, containers
|
||||||
, data-default
|
, data-default
|
||||||
, directory >=1.1 && <1.4
|
, directory >=1.1 && <1.4
|
||||||
, ekg
|
|
||||||
, ekg-core
|
|
||||||
, entropy
|
, entropy
|
||||||
, esqueleto
|
, esqueleto
|
||||||
, fast-logger >=2.2 && <2.5
|
, fast-logger >=2.2 && <2.5
|
||||||
|
@ -157,7 +155,6 @@ library
|
||||||
, iso8601-time >=0.1.3
|
, iso8601-time >=0.1.3
|
||||||
, microlens
|
, microlens
|
||||||
, monad-logger >=0.3 && <0.4
|
, monad-logger >=0.3 && <0.4
|
||||||
, monad-metrics
|
|
||||||
, mtl
|
, mtl
|
||||||
, parser-combinators
|
, parser-combinators
|
||||||
, persistent >=2.8 && <2.10
|
, persistent >=2.8 && <2.10
|
||||||
|
@ -175,7 +172,6 @@ library
|
||||||
, wai
|
, wai
|
||||||
, wai-extra >=3.0 && <3.1
|
, wai-extra >=3.0 && <3.1
|
||||||
, wai-logger >=2.2 && <2.4
|
, wai-logger >=2.2 && <2.4
|
||||||
, wai-middleware-metrics
|
|
||||||
, warp >=3.0 && <3.4
|
, warp >=3.0 && <3.4
|
||||||
, yaml >=0.8 && <0.12
|
, yaml >=0.8 && <0.12
|
||||||
, yesod >=1.6 && <1.7
|
, yesod >=1.6 && <1.7
|
||||||
|
@ -215,8 +211,6 @@ executable espial
|
||||||
, containers
|
, containers
|
||||||
, data-default
|
, data-default
|
||||||
, directory >=1.1 && <1.4
|
, directory >=1.1 && <1.4
|
||||||
, ekg
|
|
||||||
, ekg-core
|
|
||||||
, entropy
|
, entropy
|
||||||
, espial
|
, espial
|
||||||
, esqueleto
|
, esqueleto
|
||||||
|
@ -234,7 +228,6 @@ executable espial
|
||||||
, iso8601-time >=0.1.3
|
, iso8601-time >=0.1.3
|
||||||
, microlens
|
, microlens
|
||||||
, monad-logger >=0.3 && <0.4
|
, monad-logger >=0.3 && <0.4
|
||||||
, monad-metrics
|
|
||||||
, mtl
|
, mtl
|
||||||
, parser-combinators
|
, parser-combinators
|
||||||
, persistent >=2.8 && <2.10
|
, persistent >=2.8 && <2.10
|
||||||
|
@ -252,7 +245,6 @@ executable espial
|
||||||
, wai
|
, wai
|
||||||
, wai-extra >=3.0 && <3.1
|
, wai-extra >=3.0 && <3.1
|
||||||
, wai-logger >=2.2 && <2.4
|
, wai-logger >=2.2 && <2.4
|
||||||
, wai-middleware-metrics
|
|
||||||
, warp >=3.0 && <3.4
|
, warp >=3.0 && <3.4
|
||||||
, yaml >=0.8 && <0.12
|
, yaml >=0.8 && <0.12
|
||||||
, yesod >=1.6 && <1.7
|
, yesod >=1.6 && <1.7
|
||||||
|
@ -288,8 +280,6 @@ executable migration
|
||||||
, containers
|
, containers
|
||||||
, data-default
|
, data-default
|
||||||
, directory >=1.1 && <1.4
|
, directory >=1.1 && <1.4
|
||||||
, ekg
|
|
||||||
, ekg-core
|
|
||||||
, entropy
|
, entropy
|
||||||
, espial
|
, espial
|
||||||
, esqueleto
|
, esqueleto
|
||||||
|
@ -307,7 +297,6 @@ executable migration
|
||||||
, iso8601-time >=0.1.3
|
, iso8601-time >=0.1.3
|
||||||
, microlens
|
, microlens
|
||||||
, monad-logger >=0.3 && <0.4
|
, monad-logger >=0.3 && <0.4
|
||||||
, monad-metrics
|
|
||||||
, mtl
|
, mtl
|
||||||
, optparse-generic >=1.2.3
|
, optparse-generic >=1.2.3
|
||||||
, parser-combinators
|
, parser-combinators
|
||||||
|
@ -326,7 +315,6 @@ executable migration
|
||||||
, wai
|
, wai
|
||||||
, wai-extra >=3.0 && <3.1
|
, wai-extra >=3.0 && <3.1
|
||||||
, wai-logger >=2.2 && <2.4
|
, wai-logger >=2.2 && <2.4
|
||||||
, wai-middleware-metrics
|
|
||||||
, warp >=3.0 && <3.4
|
, warp >=3.0 && <3.4
|
||||||
, yaml >=0.8 && <0.12
|
, yaml >=0.8 && <0.12
|
||||||
, yesod >=1.6 && <1.7
|
, yesod >=1.6 && <1.7
|
||||||
|
@ -366,8 +354,6 @@ test-suite test
|
||||||
, containers
|
, containers
|
||||||
, data-default
|
, data-default
|
||||||
, directory >=1.1 && <1.4
|
, directory >=1.1 && <1.4
|
||||||
, ekg
|
|
||||||
, ekg-core
|
|
||||||
, entropy
|
, entropy
|
||||||
, espial
|
, espial
|
||||||
, esqueleto
|
, esqueleto
|
||||||
|
@ -386,7 +372,6 @@ test-suite test
|
||||||
, iso8601-time >=0.1.3
|
, iso8601-time >=0.1.3
|
||||||
, microlens
|
, microlens
|
||||||
, monad-logger >=0.3 && <0.4
|
, monad-logger >=0.3 && <0.4
|
||||||
, monad-metrics
|
|
||||||
, mtl
|
, mtl
|
||||||
, parser-combinators
|
, parser-combinators
|
||||||
, persistent >=2.8 && <2.10
|
, persistent >=2.8 && <2.10
|
||||||
|
@ -404,7 +389,6 @@ test-suite test
|
||||||
, wai
|
, wai
|
||||||
, wai-extra >=3.0 && <3.1
|
, wai-extra >=3.0 && <3.1
|
||||||
, wai-logger >=2.2 && <2.4
|
, wai-logger >=2.2 && <2.4
|
||||||
, wai-middleware-metrics
|
|
||||||
, warp >=3.0 && <3.4
|
, warp >=3.0 && <3.4
|
||||||
, yaml >=0.8 && <0.12
|
, yaml >=0.8 && <0.12
|
||||||
, yesod >=1.6 && <1.7
|
, yesod >=1.6 && <1.7
|
||||||
|
|
|
@ -126,8 +126,8 @@ dependencies:
|
||||||
- attoparsec
|
- attoparsec
|
||||||
- bcrypt >= 0.0.8
|
- bcrypt >= 0.0.8
|
||||||
- entropy
|
- entropy
|
||||||
- ekg
|
# - ekg
|
||||||
- ekg-core
|
# - ekg-core
|
||||||
- esqueleto
|
- esqueleto
|
||||||
- hscolour
|
- hscolour
|
||||||
- http-api-data >= 0.3.4
|
- http-api-data >= 0.3.4
|
||||||
|
@ -135,12 +135,12 @@ dependencies:
|
||||||
- http-types
|
- http-types
|
||||||
- iso8601-time >=0.1.3
|
- iso8601-time >=0.1.3
|
||||||
- microlens
|
- microlens
|
||||||
- monad-metrics
|
# - monad-metrics
|
||||||
- mtl
|
- mtl
|
||||||
- persistent-sqlite >=2.6.2
|
- persistent-sqlite >=2.6.2
|
||||||
- pretty-show
|
- pretty-show
|
||||||
- transformers >= 0.2.2
|
- transformers >= 0.2.2
|
||||||
- wai-middleware-metrics
|
# - wai-middleware-metrics
|
||||||
- parser-combinators
|
- parser-combinators
|
||||||
- html-entities
|
- html-entities
|
||||||
|
|
||||||
|
|
|
@ -18,7 +18,7 @@ import Control.Monad.Logger (liftLoc, runLoggingT)
|
||||||
import Database.Persist.Sqlite (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
|
import Database.Persist.Sqlite (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
|
||||||
import Import
|
import Import
|
||||||
import Language.Haskell.TH.Syntax (qLocation)
|
import Language.Haskell.TH.Syntax (qLocation)
|
||||||
import Lens.Micro
|
-- import Lens.Micro
|
||||||
import Network.HTTP.Client.TLS
|
import Network.HTTP.Client.TLS
|
||||||
import Network.Wai (Middleware)
|
import Network.Wai (Middleware)
|
||||||
import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, setOnException, setPort, getPort)
|
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 System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
|
||||||
import Yesod.Auth (getAuth)
|
import Yesod.Auth (getAuth)
|
||||||
|
|
||||||
import qualified Control.Monad.Metrics as MM
|
-- import qualified Control.Monad.Metrics as MM
|
||||||
import qualified Network.Wai.Metrics as WM
|
-- import qualified Network.Wai.Metrics as WM
|
||||||
import qualified System.Metrics as EKG
|
-- import qualified System.Metrics as EKG
|
||||||
import qualified System.Remote.Monitoring as EKG
|
-- import qualified System.Remote.Monitoring as EKG
|
||||||
|
|
||||||
-- 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!
|
||||||
|
@ -52,9 +52,9 @@ makeFoundation :: AppSettings -> IO App
|
||||||
makeFoundation appSettings = do
|
makeFoundation appSettings = do
|
||||||
appHttpManager <- getGlobalManager
|
appHttpManager <- getGlobalManager
|
||||||
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
|
appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
|
||||||
store <- EKG.newStore
|
-- store <- EKG.newStore
|
||||||
EKG.registerGcMetrics store
|
-- EKG.registerGcMetrics store
|
||||||
appMetrics <- MM.initializeWith store
|
-- appMetrics <- MM.initializeWith store
|
||||||
appStatic <-
|
appStatic <-
|
||||||
(if appMutableStatic appSettings
|
(if appMutableStatic appSettings
|
||||||
then staticDevel
|
then staticDevel
|
||||||
|
@ -77,13 +77,13 @@ makeApplication :: App -> IO Application
|
||||||
makeApplication foundation = do
|
makeApplication foundation = do
|
||||||
logWare <- makeLogWare foundation
|
logWare <- makeLogWare foundation
|
||||||
appPlain <- toWaiAppPlain foundation
|
appPlain <- toWaiAppPlain foundation
|
||||||
let store = appMetrics foundation ^. MM.metricsStore
|
-- let store = appMetrics foundation ^. MM.metricsStore
|
||||||
waiMetrics <- WM.registerWaiMetrics store
|
-- waiMetrics <- WM.registerWaiMetrics store
|
||||||
return (logWare (makeMiddleware waiMetrics appPlain))
|
return (logWare (makeMiddleware appPlain))
|
||||||
|
|
||||||
makeMiddleware :: WM.WaiMetrics -> Middleware
|
makeMiddleware :: Middleware
|
||||||
makeMiddleware waiMetrics =
|
makeMiddleware =
|
||||||
WM.metrics waiMetrics .
|
-- WM.metrics waiMetrics .
|
||||||
acceptOverride .
|
acceptOverride .
|
||||||
autohead .
|
autohead .
|
||||||
gzip def {gzipFiles = GzipPreCompressed GzipIgnore} .
|
gzip def {gzipFiles = GzipPreCompressed GzipIgnore} .
|
||||||
|
@ -127,7 +127,7 @@ getApplicationDev = do
|
||||||
foundation <- makeFoundation settings
|
foundation <- makeFoundation settings
|
||||||
wsettings <- getDevSettings (warpSettings foundation)
|
wsettings <- getDevSettings (warpSettings foundation)
|
||||||
app <- makeApplication foundation
|
app <- makeApplication foundation
|
||||||
forkEKG foundation
|
-- forkEKG foundation
|
||||||
return (wsettings, app)
|
return (wsettings, app)
|
||||||
|
|
||||||
getAppSettings :: IO AppSettings
|
getAppSettings :: IO AppSettings
|
||||||
|
@ -137,15 +137,15 @@ getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
|
||||||
develMain :: IO ()
|
develMain :: IO ()
|
||||||
develMain = develMainHelper getApplicationDev
|
develMain = develMainHelper getApplicationDev
|
||||||
|
|
||||||
forkEKG :: App -> IO ()
|
-- forkEKG :: App -> IO ()
|
||||||
forkEKG foundation =
|
-- forkEKG foundation =
|
||||||
let settings = appSettings foundation in
|
-- let settings = appSettings foundation in
|
||||||
for_ (appEkgHost settings) $ \ekgHost ->
|
-- for_ (appEkgHost settings) $ \ekgHost ->
|
||||||
for_ (appEkgPort settings) $ \ekgPort ->
|
-- for_ (appEkgPort settings) $ \ekgPort ->
|
||||||
EKG.forkServerWith
|
-- EKG.forkServerWith
|
||||||
(appMetrics foundation ^. MM.metricsStore)
|
-- (appMetrics foundation ^. MM.metricsStore)
|
||||||
(encodeUtf8 ekgHost)
|
-- (encodeUtf8 ekgHost)
|
||||||
ekgPort
|
-- ekgPort
|
||||||
|
|
||||||
-- | The @main@ function for an executable running this site.
|
-- | The @main@ function for an executable running this site.
|
||||||
appMain :: IO ()
|
appMain :: IO ()
|
||||||
|
@ -153,7 +153,7 @@ appMain = do
|
||||||
settings <- loadYamlSettingsArgs [configSettingsYmlValue] useEnv
|
settings <- loadYamlSettingsArgs [configSettingsYmlValue] useEnv
|
||||||
foundation <- makeFoundation settings
|
foundation <- makeFoundation settings
|
||||||
app <- makeApplication foundation
|
app <- makeApplication foundation
|
||||||
forkEKG foundation
|
-- forkEKG foundation
|
||||||
runSettings (warpSettings foundation) app
|
runSettings (warpSettings foundation) app
|
||||||
|
|
||||||
getApplicationRepl :: IO (Int, App, Application)
|
getApplicationRepl :: IO (Int, App, Application)
|
||||||
|
|
|
@ -15,8 +15,8 @@ import PathPiece()
|
||||||
import Yesod.Default.Util (addStaticContentExternal)
|
import Yesod.Default.Util (addStaticContentExternal)
|
||||||
import Yesod.Core.Types
|
import Yesod.Core.Types
|
||||||
import Yesod.Auth.Message
|
import Yesod.Auth.Message
|
||||||
import qualified Network.Wai as NW
|
-- import qualified Network.Wai as NW
|
||||||
import qualified Control.Monad.Metrics as MM
|
-- import qualified Control.Monad.Metrics as MM
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Text.Encoding as TE
|
import qualified Data.Text.Encoding as TE
|
||||||
import qualified Yesod.Core.Unsafe as Unsafe
|
import qualified Yesod.Core.Unsafe as Unsafe
|
||||||
|
@ -27,7 +27,7 @@ data App = App
|
||||||
, appConnPool :: ConnectionPool -- ^ Database connection pool.
|
, appConnPool :: ConnectionPool -- ^ Database connection pool.
|
||||||
, appHttpManager :: Manager
|
, appHttpManager :: Manager
|
||||||
, appLogger :: Logger
|
, appLogger :: Logger
|
||||||
, appMetrics :: !MM.Metrics
|
-- , appMetrics :: !MM.Metrics
|
||||||
} deriving (Typeable)
|
} deriving (Typeable)
|
||||||
|
|
||||||
mkYesodData "App" $(parseRoutesFile "config/routes")
|
mkYesodData "App" $(parseRoutesFile "config/routes")
|
||||||
|
@ -58,7 +58,8 @@ instance Yesod App where
|
||||||
10080 -- min (7 days)
|
10080 -- min (7 days)
|
||||||
"config/client_session_key.aes"
|
"config/client_session_key.aes"
|
||||||
|
|
||||||
yesodMiddleware = metricsMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
|
-- yesodMiddleware = metricsMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
|
||||||
|
yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
|
||||||
|
|
||||||
defaultLayout widget = do
|
defaultLayout widget = do
|
||||||
req <- getRequest
|
req <- getRequest
|
||||||
|
@ -68,7 +69,7 @@ instance Yesod App where
|
||||||
musername <- maybeAuthUsername
|
musername <- maybeAuthUsername
|
||||||
muser <- (fmap.fmap) snd maybeAuthPair
|
muser <- (fmap.fmap) snd maybeAuthPair
|
||||||
mcurrentRoute <- getCurrentRoute
|
mcurrentRoute <- getCurrentRoute
|
||||||
void $ mapM (incrementRouteEKG req) mcurrentRoute
|
-- void $ mapM (incrementRouteEKG req) mcurrentRoute
|
||||||
let msourceCodeUri = appSourceCodeUri (appSettings master)
|
let msourceCodeUri = appSourceCodeUri (appSettings master)
|
||||||
pc <- widgetToPageContent $ do
|
pc <- widgetToPageContent $ do
|
||||||
setTitle "Espial"
|
setTitle "Espial"
|
||||||
|
@ -139,17 +140,17 @@ popupLayout widget = do
|
||||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||||
|
|
||||||
|
|
||||||
metricsMiddleware :: Handler a -> Handler a
|
-- metricsMiddleware :: Handler a -> Handler a
|
||||||
metricsMiddleware handler = do
|
-- metricsMiddleware handler = do
|
||||||
req <- getRequest
|
-- req <- getRequest
|
||||||
mcurrentRoute <- getCurrentRoute
|
-- mcurrentRoute <- getCurrentRoute
|
||||||
void $ mapM (incrementRouteEKG req) mcurrentRoute
|
-- void $ mapM (incrementRouteEKG req) mcurrentRoute
|
||||||
handler
|
-- handler
|
||||||
|
|
||||||
|
|
||||||
incrementRouteEKG :: YesodRequest -> Route App -> Handler ()
|
-- incrementRouteEKG :: YesodRequest -> Route App -> Handler ()
|
||||||
incrementRouteEKG req = MM.increment . (\r -> "route." <> r <> "." <> method) . pack . constrName
|
-- incrementRouteEKG req = MM.increment . (\r -> "route." <> r <> "." <> method) . pack . constrName
|
||||||
where method = decodeUtf8 $ NW.requestMethod $ reqWaiRequest req
|
-- where method = decodeUtf8 $ NW.requestMethod $ reqWaiRequest req
|
||||||
|
|
||||||
-- YesodAuth
|
-- YesodAuth
|
||||||
|
|
||||||
|
@ -169,8 +170,8 @@ instance YesodAuth App where
|
||||||
|
|
||||||
instance YesodAuthPersist App
|
instance YesodAuthPersist App
|
||||||
|
|
||||||
instance MM.MonadMetrics Handler where
|
-- instance MM.MonadMetrics Handler where
|
||||||
getMetrics = pure . appMetrics =<< getYesod
|
-- getMetrics = pure . appMetrics =<< getYesod
|
||||||
|
|
||||||
-- session keys
|
-- session keys
|
||||||
|
|
||||||
|
|
|
@ -12,7 +12,7 @@ import qualified Network.HTTP.Client as NH
|
||||||
import qualified Network.HTTP.Client.TLS as NH
|
import qualified Network.HTTP.Client.TLS as NH
|
||||||
import qualified Network.HTTP.Types.Status as NH
|
import qualified Network.HTTP.Types.Status as NH
|
||||||
import qualified Web.FormUrlEncoded as WH
|
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 HTMLEntities.Decoder (htmlEncodedText)
|
||||||
import Data.Text.Lazy.Builder (toLazyText)
|
import Data.Text.Lazy.Builder (toLazyText)
|
||||||
|
|
||||||
|
@ -31,15 +31,15 @@ archiveBookmarkUrl :: Key Bookmark -> String -> Handler ()
|
||||||
archiveBookmarkUrl kbid url =
|
archiveBookmarkUrl kbid url =
|
||||||
(_fetchArchiveSubmitInfo >>= \case
|
(_fetchArchiveSubmitInfo >>= \case
|
||||||
Left e -> do
|
Left e -> do
|
||||||
MM.increment "archive.fetchSubmitId_noparse"
|
-- MM.increment "archive.fetchSubmitId_noparse"
|
||||||
$(logError) (pack e)
|
$(logError) (pack e)
|
||||||
Right submitInfo -> do
|
Right submitInfo -> do
|
||||||
userId <- requireAuthId
|
userId <- requireAuthId
|
||||||
let req = _buildArchiveSubmitRequest submitInfo url
|
let req = _buildArchiveSubmitRequest submitInfo url
|
||||||
MM.increment "archive.submit"
|
-- MM.increment "archive.submit"
|
||||||
res <- liftIO $ NH.httpLbs req =<< NH.getGlobalManager
|
res <- liftIO $ NH.httpLbs req =<< NH.getGlobalManager
|
||||||
let status = NH.responseStatus res
|
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
|
let updateArchiveUrl = runDB . updateBookmarkArchiveUrl userId kbid . Just
|
||||||
headers = NH.responseHeaders res
|
headers = NH.responseHeaders res
|
||||||
case status of
|
case status of
|
||||||
|
@ -87,9 +87,9 @@ _buildArchiveSubmitRequest (action, submitId) href =
|
||||||
|
|
||||||
_fetchArchiveSubmitInfo :: Handler (Either String (String , String))
|
_fetchArchiveSubmitInfo :: Handler (Either String (String , String))
|
||||||
_fetchArchiveSubmitInfo = do
|
_fetchArchiveSubmitInfo = do
|
||||||
MM.increment "archive.fetchSubmitId"
|
-- MM.increment "archive.fetchSubmitId"
|
||||||
res <- liftIO $ NH.httpLbs (buildSimpleRequest "https://archive.li/") =<< NH.getGlobalManager
|
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)
|
let body = LBS.toStrict (responseBody res)
|
||||||
action = _parseSubstring (AP8.string "action=\"") (AP8.notChar '"') body
|
action = _parseSubstring (AP8.string "action=\"") (AP8.notChar '"') body
|
||||||
submitId = _parseSubstring (AP8.string "submitid\" value=\"") (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 :: String -> Handler (Either String Text)
|
||||||
fetchPageTitle url =
|
fetchPageTitle url =
|
||||||
do MM.increment "fetchPageTitle"
|
do
|
||||||
|
-- MM.increment "fetchPageTitle"
|
||||||
res <- liftIO $ NH.httpLbs (buildSimpleRequest url) =<< NH.getGlobalManager
|
res <- liftIO $ NH.httpLbs (buildSimpleRequest url) =<< NH.getGlobalManager
|
||||||
let body = LBS.toStrict (responseBody res)
|
let body = LBS.toStrict (responseBody res)
|
||||||
pure (decodeHtmlBs <$> parseTitle body)
|
pure (decodeHtmlBs <$> parseTitle body)
|
||||||
`catch` (\(e :: SomeException) -> do
|
`catch` (\(e :: SomeException) -> do
|
||||||
MM.increment "fetchPageTitle.error"
|
-- MM.increment "fetchPageTitle.error"
|
||||||
$(logError) $ (pack . show) e
|
$(logError) $ (pack . show) e
|
||||||
pure (Left (show e)))
|
pure (Left (show e)))
|
||||||
where
|
where
|
||||||
|
|
|
@ -56,10 +56,11 @@ data AppSettings = AppSettings
|
||||||
, appAuthDummyLogin :: Bool
|
, appAuthDummyLogin :: Bool
|
||||||
-- ^ Indicate if auth dummy login should be enabled.
|
-- ^ Indicate if auth dummy login should be enabled.
|
||||||
|
|
||||||
, appEkgHost :: Maybe Text
|
-- , appEkgHost :: Maybe Text
|
||||||
-- ^ Host/interface the ekg server should bind to.
|
-- -- ^ Host/interface the ekg server should bind to.
|
||||||
, appEkgPort :: Maybe Int
|
-- , appEkgPort :: Maybe Int
|
||||||
-- ^ Port to listen on
|
-- -- ^ Port to listen on
|
||||||
|
|
||||||
, appSourceCodeUri :: Maybe Text
|
, appSourceCodeUri :: Maybe Text
|
||||||
-- ^ Uri to app source code
|
-- ^ Uri to app source code
|
||||||
}
|
}
|
||||||
|
@ -92,8 +93,8 @@ instance FromJSON AppSettings where
|
||||||
|
|
||||||
appAuthDummyLogin <- o .:? "auth-dummy-login" .!= dev
|
appAuthDummyLogin <- o .:? "auth-dummy-login" .!= dev
|
||||||
|
|
||||||
appEkgHost <- o .:? "ekg-host"
|
-- appEkgHost <- o .:? "ekg-host"
|
||||||
appEkgPort <- o .:? "ekg-port"
|
-- appEkgPort <- o .:? "ekg-port"
|
||||||
appSourceCodeUri <- o .:? "source-code-uri"
|
appSourceCodeUri <- o .:? "source-code-uri"
|
||||||
|
|
||||||
return AppSettings {..}
|
return AppSettings {..}
|
||||||
|
|
Loading…
Reference in a new issue