diff --git a/log-elasticsearch.cabal b/log-elasticsearch.cabal --- a/log-elasticsearch.cabal +++ b/log-elasticsearch.cabal @@ -1,5 +1,5 @@ name: log-elasticsearch -version: 0.7 +version: 0.8 synopsis: Structured logging solution (Elasticsearch back end) description: Elasticsearch back end for the 'log' library. @@ -25,15 +25,18 @@ library exposed-modules: Log.Backend.ElasticSearch + Log.Backend.ElasticSearch.Internal + Log.Backend.ElasticSearch.Lens build-depends: base <5, log-base >= 0.7, aeson >=0.11.0.0, aeson-pretty >=0.8.2, bytestring, base64-bytestring, - bloodhound >= 0.11.1, + bloodhound >= 0.11.1 && < 0.13, deepseq, http-client, + http-client-tls, semigroups, text, text-show >= 2, diff --git a/src/Log/Backend/ElasticSearch.hs b/src/Log/Backend/ElasticSearch.hs --- a/src/Log/Backend/ElasticSearch.hs +++ b/src/Log/Backend/ElasticSearch.hs @@ -1,10 +1,14 @@ -- | Elasticsearch logging back-end. module Log.Backend.ElasticSearch ( - ElasticSearchConfig(..) + ElasticSearchConfig + , esServer + , esIndex + , esMapping + , esLogin + , esLoginInsecure , defaultElasticSearchConfig , withElasticSearchLogger , elasticSearchLogger - ) where import Control.Applicative @@ -17,6 +21,7 @@ import Data.Aeson.Encode.Pretty import Data.Bits import Data.IORef +import Data.Maybe (isJust) import Data.Semigroup import Data.Time import Data.Time.Clock.POSIX @@ -25,6 +30,7 @@ import Log import Log.Internal.Logger import Network.HTTP.Client +import Network.HTTP.Client.TLS (tlsManagerSettings) import Prelude import TextShow import qualified Data.ByteString as BS @@ -36,23 +42,7 @@ import qualified Data.Traversable as F import qualified Data.Vector as V --- | Configuration for the Elasticsearch 'Logger'. See --- --- for the explanation of terms. -data ElasticSearchConfig = ElasticSearchConfig { - esServer :: !T.Text -- ^ Elasticsearch server address. - , esIndex :: !T.Text -- ^ Elasticsearch index name. - , esMapping :: !T.Text -- ^ Elasticsearch mapping name. - } deriving (Eq, Show) - --- | Sensible defaults for 'ElasticSearchConfig'. -defaultElasticSearchConfig :: ElasticSearchConfig -defaultElasticSearchConfig = ElasticSearchConfig { - esServer = "http://localhost:9200", - esIndex = "logs", - esMapping = "log" - } - +import Log.Backend.ElasticSearch.Internal ---------------------------------------- -- | Create an 'elasticSearchLogger' for the duration of the given @@ -77,6 +67,7 @@ -- document IDs. -> IO Logger elasticSearchLogger ElasticSearchConfig{..} genRandomWord = do + checkElasticSearchLogin checkElasticSearchConnection indexRef <- newIORef $ IndexName T.empty mkBulkLogger "ElasticSearch" (\msgs -> do @@ -159,6 +150,15 @@ indexName <- readIORef indexRef void . runBH_ $ refreshIndex indexName + checkElasticSearchLogin :: IO () + checkElasticSearchLogin = + when (isJust esLogin + && not esLoginInsecure + && not ("https:" `T.isPrefixOf` esServer)) $ + error $ "ElasticSearch: insecure login: " + <> "Attempting to send login credentials over an insecure connection. " + <> "Set esLoginInsecure = True to disable this check." + checkElasticSearchConnection :: IO () checkElasticSearchConnection = try (void $ runBH_ listIndices) >>= \case Left (ex::HttpException) -> error $ "ElasticSearch: unexpected error: " @@ -179,7 +179,12 @@ timeToDouble = realToFrac . utcTimeToPOSIXSeconds runBH_ :: forall r. BH IO r -> IO r - runBH_ = withBH defaultManagerSettings server + runBH_ f = do + mgr <- newManager tlsManagerSettings + let hook = maybe return (uncurry basicAuthHook) esLogin + let env = (mkBHEnv server mgr) { bhRequestHook = hook } + runBH env f + jsonToBSL :: Value -> BSL.ByteString jsonToBSL = encodePretty' defConfig { confIndent = Spaces 2 } diff --git a/src/Log/Backend/ElasticSearch/Internal.hs b/src/Log/Backend/ElasticSearch/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Log/Backend/ElasticSearch/Internal.hs @@ -0,0 +1,26 @@ +module Log.Backend.ElasticSearch.Internal where + +import Database.Bloodhound hiding (Status) +import Prelude +import qualified Data.Text as T + +-- | Configuration for the Elasticsearch 'Logger'. See +-- +-- for the explanation of terms. +data ElasticSearchConfig = ElasticSearchConfig { + esServer :: !T.Text -- ^ Elasticsearch server address. + , esIndex :: !T.Text -- ^ Elasticsearch index name. + , esMapping :: !T.Text -- ^ Elasticsearch mapping name. + , esLogin :: Maybe (EsUsername, EsPassword) -- ^ Elasticsearch basic authentication username and password. + , esLoginInsecure :: !Bool -- ^ Allow basic authentication over non-TLS connections. + } deriving (Eq, Show) + +-- | Sensible defaults for 'ElasticSearchConfig'. +defaultElasticSearchConfig :: ElasticSearchConfig +defaultElasticSearchConfig = ElasticSearchConfig { + esServer = "http://localhost:9200", + esIndex = "logs", + esMapping = "log", + esLogin = Nothing, + esLoginInsecure = False + } diff --git a/src/Log/Backend/ElasticSearch/Lens.hs b/src/Log/Backend/ElasticSearch/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Log/Backend/ElasticSearch/Lens.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE RankNTypes #-} +-- | Lensified version of "Log.Backend.ElasticSearch". +module Log.Backend.ElasticSearch.Lens ( + I.ElasticSearchConfig + , esServer + , esIndex + , esMapping + , esLogin + , esLoginInsecure + , I.defaultElasticSearchConfig + , I.withElasticSearchLogger + ) where + +import Database.Bloodhound hiding (Status) +import Prelude +import qualified Data.Text as T +import qualified Log.Backend.ElasticSearch as I +import qualified Log.Backend.ElasticSearch.Internal () + +type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s + +-- | Elasticsearch server address. +esServer :: Lens' I.ElasticSearchConfig T.Text +esServer f esc = fmap (\x -> esc { I.esServer = x }) $ f (I.esServer esc) + +-- | Elasticsearch index name. +esIndex :: Lens' I.ElasticSearchConfig T.Text +esIndex f esc = fmap (\x -> esc { I.esIndex = x }) $ f (I.esIndex esc) + +-- | Elasticsearch mapping name. +esMapping :: Lens' I.ElasticSearchConfig T.Text +esMapping f esc = fmap (\x -> esc { I.esMapping = x }) $ f (I.esMapping esc) + +-- | Elasticsearch basic authentication username and password. +esLogin :: Lens' I.ElasticSearchConfig (Maybe (EsUsername, EsPassword)) +esLogin f esc = fmap (\x -> esc { I.esLogin = x }) $ f (I.esLogin esc) + +-- | Allow basic authentication over non-TLS connections. +esLoginInsecure :: Lens' I.ElasticSearchConfig Bool +esLoginInsecure f esc = fmap (\x -> esc { I.esLoginInsecure = x }) $ f (I.esLoginInsecure esc)