ethereum-analyzer-webui (empty) → 1.0.0
raw patch · 13 files changed
+798/−0 lines, 13 filesdep +aesondep +basedep +bimapsetup-changed
Dependencies added: aeson, base, bimap, bytestring, conduit-combinators, conduit-extra, containers, ethereum-analyzer, ethereum-analyzer-deps, ethereum-analyzer-webui, exceptions, extra, fgl, graphviz, hexstring, hflags, hoopl, http-conduit, http-media, http-types, json-rpc, logging-effect, monad-logger, mtl, neat-interpolation, network, optparse-applicative, prometheus-client, prometheus-metrics-ghc, protolude, servant, servant-server, text, time, unordered-containers, vector, wai, wai-extra, wai-middleware-prometheus, warp, wl-pprint-text
Files
- ChangeLog.md +5/−0
- LICENSE +202/−0
- README.md +1/−0
- Setup.hs +3/−0
- ethereum-analyzer-webui.cabal +95/−0
- exec_src/Main.hs +9/−0
- src/Ethereum/Analyzer/Web.hs +5/−0
- src/Ethereum/Analyzer/Web/API.hs +93/−0
- src/Ethereum/Analyzer/Web/API/Internal.hs +14/−0
- src/Ethereum/Analyzer/Web/Server.hs +120/−0
- src/Ethereum/Analyzer/Web/Server/Handlers.hs +63/−0
- src/Ethereum/Analyzer/Web/Server/Instrument.hs +104/−0
- src/Ethereum/Analyzer/Web/Server/Logging.hs +84/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for ethereum-analyzer-webui++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright 2017 Kevin Chen++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,1 @@+# ethereum-analyzer
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ ethereum-analyzer-webui.cabal view
@@ -0,0 +1,95 @@+name: ethereum-analyzer-webui+version: 1.0.0+synopsis: A web frontend for ethereum-analyzer+homepage: https://github.com/ethereumK/ethereum-analyzer+license: Apache-2.0+license-file: LICENSE+author: Kevin Chen+maintainer: k_@berkeley.edu+category: Web, Ethereum, Static Analysis+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >=1.10+description: A web frontend for ethereum-analyzer.++source-repository head+ type: git+ location: https://github.com/zchn/ethereum-analyzer+ branch: master+ subdir: ethereum-analyzer-webui+ +source-repository this+ type: git+ location: https://github.com/zchn/ethereum-analyzer+ tag: v1.0.0+ subdir: ethereum-analyzer-webui++library+ build-depends: base >= 4 && < 5,+ aeson,+ bimap,+ bytestring,+ conduit-combinators,+ conduit-extra,+ containers,+ ethereum-analyzer,+ ethereum-analyzer-deps,+ exceptions,+ extra,+ fgl,+ graphviz,+ hexstring,+ hflags,+ hoopl >= 3.10.2.1,+ http-conduit,+ http-media,+ http-types,+ json-rpc,+ logging-effect,+ monad-logger,+ mtl,+ neat-interpolation,+ network,+ optparse-applicative,+ prometheus-client,+ prometheus-metrics-ghc,+ protolude,+ servant,+ servant-server,+ text,+ time,+ unordered-containers,+ vector,+ wai,+ wai-extra,+ wai-middleware-prometheus,+ warp,+ wl-pprint-text+ + exposed-modules: Ethereum.Analyzer.Web+ other-modules: Ethereum.Analyzer.Web.API+ , Ethereum.Analyzer.Web.API.Internal+ , Ethereum.Analyzer.Web.Server+ , Ethereum.Analyzer.Web.Server.Handlers+ , Ethereum.Analyzer.Web.Server.Instrument+ , Ethereum.Analyzer.Web.Server.Logging+ + ghc-options: -Wall+ hs-source-dirs: src+ buildable: True+ default-language: Haskell98+ default-extensions: OverloadedStrings+ +executable ethereum-analyzer-webui+ main-is: Main.hs+ build-depends: base >= 4 && < 5,+ ethereum-analyzer,+ ethereum-analyzer-deps,+ ethereum-analyzer-webui,+ hflags,+ monad-logger+ + ghc-options: -Wall+ hs-source-dirs: exec_src+ buildable: True+ default-language: Haskell98
+ exec_src/Main.hs view
@@ -0,0 +1,9 @@+-- | Launch ethereum-analyzer server.+module Main+ ( main+ ) where++import Ethereum.Analyzer.Web (startApp)++main :: IO ()+main = startApp
+ src/Ethereum/Analyzer/Web.hs view
@@ -0,0 +1,5 @@+module Ethereum.Analyzer.Web+ ( startApp+ ) where++import Ethereum.Analyzer.Web.Server (startApp)
+ src/Ethereum/Analyzer/Web/API.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeOperators #-}++-- | API definition for ethereum-analyzer.+module Ethereum.Analyzer.Web.API+ ( API+ , apiraw+ , RootPage(..)+ , User(User)+ , Users(..)+ , DotCfgResp(..)+ ) where++import Protolude++import Data.Aeson+ (FromJSON(..), ToJSON(..), Value(..), object, (.=), (.:))+import Data.Aeson.Types (typeMismatch)+import qualified NeatInterpolation as NI+import Servant.API+ ((:>), (:<|>)(..), Get, JSON, MimeRender(..), QueryParam, Raw)++import Ethereum.Analyzer.Web.API.Internal (HTML)++-- | ethereum-analyzer API definition.+type API = Get '[HTML] RootPage :<|> "users" :> Get '[JSON] Users :<|> "ea" :> "dotcfg" :> QueryParam "code" Text :> Get '[JSON] DotCfgResp :<|> "ea" :> "dotcfg2" :> QueryParam "code" Text :> Get '[JSON] DotCfgResp++-- | Value-level representation of API.+apiraw :: Proxy (API :<|> "web" :> Raw)+apiraw = Proxy++-- | Example object. Replace this with something relevant to your app.+data User = User+ { _userId :: Int+ , _userFirstName :: Text+ , _userLastName :: Text+ } deriving (Eq, Show, Generic)++instance FromJSON User++instance ToJSON User++data DotCfgResp = DotCfgResp+ { _ctorDot :: Text+ , _dispatcherDot :: Text+ } deriving (Eq, Show, Generic)++instance FromJSON DotCfgResp++instance ToJSON DotCfgResp++-- | Represents a list of users.+--+-- We have a newtype so we can be sure to return a JSON object.+newtype Users =+ Users [User]+ deriving (Eq, Show, Generic)++instance FromJSON Users where+ parseJSON (Object v) = Users <$> v .: "users"+ parseJSON x = typeMismatch "Users" x++instance ToJSON Users where+ toJSON (Users users) = object ["users" .= toJSON users]++-- | Represents the root page of the service.+data RootPage =+ RootPage++-- | Very simple root HTML page.+instance MimeRender HTML RootPage where+ mimeRender _ _ =+ toS+ [NI.text|+ <!doctype html>+ <html>+ <head><title>ethereum-analyzer</title></head>+ <body>+ <h1>ethereum-analyzer</h1>+ <ul>+ <li><a href="/users">users</a></li>+ <li><a href="/ea/dotcfg">/ea/dotcfg</a></li>+ <li><a href="/metrics"><code>/metrics</code></a></li>+ </ul>+ <p>+ Source code at <a href="https://github.com/ethereumK/ethereum-analyzer">https://github.com/ethereumK/ethereum-analyzer/</a>+ </p>+ </body>+ <html>+ |]
+ src/Ethereum/Analyzer/Web/API/Internal.hs view
@@ -0,0 +1,14 @@+-- | Definition of HTML content type.+module Ethereum.Analyzer.Web.API.Internal+ ( HTML+ ) where++import Network.HTTP.Media ((//), (/:))+import Servant.API (Accept(..))++-- | HTML content type.+data HTML =+ HTML++instance Accept HTML where+ contentType _ = "text" // "html" /: ("charset", "utf-8")
+ src/Ethereum/Analyzer/Web/Server.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards+ #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DataKinds #-}++-- | Serve the API as an HTTP server.+module Ethereum.Analyzer.Web.Server+ ( server+ , startApp+ ) where++import Protolude++import Control.Monad.Log (Severity(..))+import qualified Data.List as List+import GHC.Stats (getGCStatsEnabled)+import Network.Wai.Handler.Warp+ (Port, Settings, defaultSettings, runSettings, setBeforeMainLoop,+ setPort)+import qualified Network.Wai.Middleware.RequestLogger as RL+import Options.Applicative+ (ParserInfo, auto, eitherReader, execParser, fullDesc, header,+ help, helper, info, long, metavar, option, progDesc, switch, value)+import qualified Prometheus as Prom+import qualified Prometheus.Metric.GHC as Prom+import Servant (serve)+import Text.PrettyPrint.Leijen.Text (int, text)++import Ethereum.Analyzer.Web.API (apiraw)+import Ethereum.Analyzer.Web.Server.Handlers (server)+import Ethereum.Analyzer.Web.Server.Instrument+ (defaultPrometheusSettings, prometheus, requestDuration)+import qualified Ethereum.Analyzer.Web.Server.Logging as Log++-- | Configuration for the application.+data Config = Config+ { port :: Port+ , accessLogs :: AccessLogs+ , logLevel :: Severity+ , enableGhcMetrics :: Bool+ } deriving (Show)++-- | What level of access logs to show.+data AccessLogs+ = Disabled -- ^ Don't show access logs.+ | Enabled -- ^ Show Apache-style access logs.+ | DevMode -- ^ Show detailed, colorful access logs. Not suitable in production.+ deriving (Eq, Show)++-- | Run the service.+startApp :: IO ()+startApp = runApp =<< execParser options++options :: ParserInfo Config+options = info (helper <*> parser) description+ where+ parser =+ Config <$>+ option auto (fold [long "port", metavar "PORT", help "Port to listen on"]) <*>+ option+ (eitherReader parseAccessLogs)+ (fold+ [long "access-logs", help "How to log HTTP access", value Disabled]) <*>+ option+ (eitherReader+ (maybe (throwError (toS invalidLogLevel)) pure . Log.fromKeyword . toS))+ (fold+ [ long "log-level"+ , help "Minimum severity for log messages"+ , value Informational+ ]) <*>+ switch+ (fold+ [ long "ghc-metrics"+ , help "Export GHC metrics. Requires running with +RTS."+ ])+ invalidLogLevel = "Log level must be one of: " <> allLogLevels+ allLogLevels =+ fold . List.intersperse "," . List.map Log.toKeyword $ enumFrom minBound+ parseAccessLogs "none" = pure Disabled+ parseAccessLogs "basic" = pure Enabled+ parseAccessLogs "dev" = pure DevMode+ parseAccessLogs _ = throwError "One of 'none', 'basic', or 'dev'"+ description =+ fold [fullDesc, progDesc "Ethereum Analyzer", header "ethereum-analyzer"]++runApp :: Config -> IO ()+runApp config@Config {..} = do+ requests <- Prom.registerIO requestDuration+ when enableGhcMetrics $+ do statsEnabled <- getGCStatsEnabled+ unless statsEnabled $+ Log.withLogging logLevel $+ Log.log+ Warning+ (text+ "Exporting GHC metrics but GC stats not enabled. Re-run with +RTS -T.")+ void $ Prom.register Prom.ghcMetrics+ runSettings settings (middleware requests)+ where+ settings = warpSettings config+ middleware r =+ logging . prometheus defaultPrometheusSettings r "ethereum_analyzer" $ app+ logging =+ case accessLogs of+ Disabled -> identity+ Enabled -> RL.logStdout+ DevMode -> RL.logStdoutDev+ app = serve apiraw (server logLevel)++-- | Generate warp settings from config+--+-- Serve from a port and print out where we're serving from.+warpSettings :: Config -> Settings+warpSettings Config {..} =+ setBeforeMainLoop+ (Log.withLogging logLevel printPort)+ (setPort port defaultSettings)+ where+ printPort = Log.log Informational (text "Listening on :" `mappend` int port)
+ src/Ethereum/Analyzer/Web/Server/Handlers.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}++-- | Implementation of the ethereum-analyzer API.+module Ethereum.Analyzer.Web.Server.Handlers+ ( server+ ) where++-- XXX: jml doesn't like the name "Handlers" for this, and isn't sure that it+-- should be in a submodule of Project.Server. Perhaps the code in+-- Project.Server (which is command-line processing, setting up logs &+-- monitoring, starting the HTTP server) should be in a different module.+import Protolude hiding (Handler)++import Ethereum.Analyzer.Util+import Ethereum.Analyzer.Web.API+ (API, RootPage(..), User(..), Users(..), DotCfgResp(..))+import qualified Ethereum.Analyzer.Web.Server.Logging as Log+import Control.Monad.Except (ExceptT(..))+import Control.Monad.Log (Severity, logInfo)+import qualified Data.Text.Lazy as DTL+import Servant+ (ServantErr, Server, (:<|>)(..), (:>), (:~>)(..), enter, Raw)+import Servant.Utils.StaticFiles (serveDirectory)+import Text.PrettyPrint.Leijen.Text (Doc, Pretty, text)++-- | ethereum-analyzer API implementation.+server :: Severity -> Server (API :<|> "web" :> Raw)+server logLevel = enter (toHandler logLevel) handlers :<|> serveDirectory "web"+ where+ handlers = pure RootPage :<|> users :<|> dotcfg :<|> dotcfg2++-- | Our custom handler type.+type Handler msg = ExceptT ServantErr (Log.LogM msg IO)++-- | Translate our custom monad into a Servant handler.+--+-- See http://haskell-servant.readthedocs.io/en/stable/tutorial/Server.html#using-another-monad-for-your-handlers+-- for the details.+toHandler+ :: Pretty msg+ => Severity -> (Handler msg :~> ExceptT ServantErr IO)+toHandler logLevel = Nat toHandler'+ where+ toHandler'+ :: Pretty msg+ => Handler msg a -> ExceptT ServantErr IO a+ toHandler' = ExceptT . Log.withLogging logLevel . runExceptT++-- | Example endpoint.+users :: Handler Doc Users+users = do+ logInfo (text "Example of logging")+ pure (Users [User 1 "Isaac" "Newton", User 2 "Albert" "Einstein"])++dotcfg :: Maybe Text -> Handler Doc DotCfgResp+dotcfg (Just t) = pure (DotCfgResp (decompileToDotText t) "")+dotcfg _ = pure (DotCfgResp "" "")++dotcfg2 :: Maybe Text -> Handler Doc DotCfgResp+dotcfg2 (Just t) = pure (uncurry DotCfgResp $ decompileToDotText2 t)+dotcfg2 _ = pure (DotCfgResp "" "")
+ src/Ethereum/Analyzer/Web/Server/Instrument.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards+ #-}++-- | Prometheus instrumentation for ethereum-analyzer.+module Ethereum.Analyzer.Web.Server.Instrument+ ( metrics+ , requestDuration+ , instrumentApp+ , prometheus+ , PrometheusSettings(..)+ , defaultPrometheusSettings+ ) where++import Protolude++import Data.ByteString.Builder (byteString)+import Data.Time.Clock (diffUTCTime, getCurrentTime)+import qualified Network.HTTP.Types as HTTP+import qualified Network.Wai as Wai+import qualified Prometheus as Prom++-- | Settings that control the behavior of the Prometheus middleware.+data PrometheusSettings = PrometheusSettings+ { prometheusEndPoint :: [Text]+ -- ^ The path that will be used for exporting metrics. The default value+ -- is ["metrics"] which corresponds to the path /metrics.+ , prometheusHandlerName :: Maybe Text+ -- ^ The name of the handler used to record metrics about the Prometheus+ -- endpoint. If Nothing, then we won't record any.+ }++-- | Default settings for Prometheus. Serve metrics at /metrics and record+-- latency information for that endpoint with 'handler="metrics"'.+defaultPrometheusSettings :: PrometheusSettings+defaultPrometheusSettings = PrometheusSettings ["metrics"] (Just "metrics")++-- | Core information about HTTP requests:+--+-- Labels:+-- * handler: the name of the application+-- * method: the HTTP method requested+-- * status_code: the HTTP response code+--+-- Actual metric is the latency of the request.+type RequestDuration = Prom.Metric (Prom.Vector Prom.Label3 Prom.Summary)++requestDuration :: IO RequestDuration+requestDuration =+ Prom.vector ("handler", "method", "status_code") $ Prom.summary info Prom.defaultQuantiles+ where+ info =+ Prom.Info+ "http_request_duration_seconds"+ "The HTTP request latencies in microseconds."++-- | Instrument a WAI app with the default WAI metrics.+instrumentApp+ :: RequestDuration -- ^ The metric to instrument+ -> Text -- ^ The label used to identify this app+ -> Wai.Application -- ^ The app to instrument+ -> Wai.Application -- ^ The instrumented app+instrumentApp metric handler app req respond = do+ start <- getCurrentTime+ app+ req+ (\res -> do+ recordResult start (HTTP.statusCode (Wai.responseStatus res))+ respond res) `onException`+ recordResult start (500 :: Integer)+ where+ recordResult start statusCode = do+ end <- getCurrentTime+ let latency = fromRational $ toRational (end `diffUTCTime` start)+ Prom.withLabel (toS handler, method, status) (Prom.observe latency) metric+ where+ method = toS (Wai.requestMethod req)+ status = show statusCode++-- | Instrument an app with Prometheus and export metrics from the configured+-- handler.+prometheus+ :: PrometheusSettings -- ^ How we're going to use Prometheus+ -> RequestDuration -- ^ A metric to instrument with request information+ -> Text -- ^ The label used to identify the app+ -> Wai.Middleware+prometheus PrometheusSettings {..} duration appName app req respond =+ if Wai.requestMethod req == HTTP.methodGet && Wai.pathInfo req == prometheusEndPoint+ then case prometheusHandlerName of+ Nothing -> respondWithMetrics respond+ Just name ->+ instrumentApp duration name (const respondWithMetrics) req respond+ else instrumentApp duration appName app req respond++-- | Application that serves the Prometheus /metrics page regardless of what+-- was requested.+metrics :: Wai.Application+metrics = const respondWithMetrics++respondWithMetrics :: (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived+respondWithMetrics respond = do+ content <- Prom.exportMetricsAsText+ respond $ Wai.responseBuilder HTTP.status200 headers $ byteString content+ where+ headers = [(HTTP.hContentType, "text/plain; version=0.0.4")]
+ src/Ethereum/Analyzer/Web/Server/Logging.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards,+ FlexibleContexts #-}++-- | Logging helpers for ethereum-analyzer.+module Ethereum.Analyzer.Web.Server.Logging+ ( LogM+ , withLogging+ , log+ , fromKeyword+ , toKeyword+ ) where++import Protolude hiding (log)++import Control.Monad.Catch (MonadMask)+import Control.Monad.Log+ (Handler, LoggingT, MonadLog, Severity(..), WithTimestamp(..),+ WithSeverity(..), defaultBatchingOptions, logMessage,+ mapLogMessageM, renderWithSeverity, renderWithTimestamp,+ runLoggingT, timestamp, withFDHandler)+import Data.Time.Format+ (defaultTimeLocale, formatTime, iso8601DateFormat)+import Text.PrettyPrint.Leijen.Text (Doc, Pretty(..))++type LogM msg m = LoggingT (WithSeverity msg) (LoggingT (WithTimestamp (WithSeverity msg)) m)++-- | Take a bunch of logs with severity and print them to stdout with timestamps.+withLogging+ :: (MonadMask m, MonadIO m, Pretty msg)+ => Severity -> LogM msg m a -> m a+withLogging severityThreshold body =+ withFDHandler defaultBatchingOptions stdout 0.4 80 $+ \stdoutHandler ->+ runLoggingT+ (withTimestamps body)+ (printLogs severityThreshold stdoutHandler)++withTimestamps+ :: (MonadIO m, MonadLog (WithTimestamp msg) m)+ => LoggingT msg m a -> m a+withTimestamps = mapLogMessageM timestamp++type Keyword = Text++fromKeyword+ :: Alternative m+ => Keyword -> m Severity+fromKeyword "emerg" = pure Emergency+fromKeyword "alert" = pure Alert+fromKeyword "crit" = pure Critical+fromKeyword "err" = pure Error+fromKeyword "error" = pure Error+fromKeyword "warning" = pure Warning -- A friend in need's a friend indeed.+fromKeyword "warn" = pure Warning+fromKeyword "notice" = pure Notice+fromKeyword "info" = pure Informational+fromKeyword "debug" = pure Debug+fromKeyword _ = empty++toKeyword :: Severity -> Keyword+toKeyword Emergency = "emerg"+toKeyword Alert = "alert"+toKeyword Critical = "crit"+toKeyword Error = "err"+toKeyword Warning = "warning"+toKeyword Notice = "notice"+toKeyword Informational = "info"+toKeyword Debug = "debug"++printLogs+ :: (Pretty a, MonadIO m)+ => Severity -> Handler m Doc -> WithTimestamp (WithSeverity a) -> m ()+printLogs severityThreshold handler message =+ when (severityThreshold >= msgSeverity (discardTimestamp message)) $+ handler . renderWithTimestamp timeFormatter (renderWithSeverity pretty) $ message+ where+ timeFormatter = formatTime defaultTimeLocale timeFormat+ timeFormat = iso8601DateFormat (Just "%H:%M:%S.%q")++-- | Convenience method to log with severity.+log+ :: MonadLog (WithSeverity a) m+ => Severity -> a -> m ()+log severity msg = logMessage (WithSeverity severity msg)