Config.hs

{-# LANGUAGE ApplicativeDo #-}

-- | Internal module. Not part of the public API.
module Database.Bolty.Connection.Config
  ( validateConfig
  ) where

import qualified Data.Text as T
import qualified Validation as V

import           Database.Bolty.Connection.Type
import           Database.Bolty.Connection.Version (boltVersionsToSpec)
import           Database.Bolty.Util               (whenInvalid)


-- | Validate a 'Config', returning either validation errors or a 'ValidatedConfig'.
validateConfig :: Config -> V.Validation [T.Text] ValidatedConfig
validateConfig Config{host, port, scheme, use_tls, versions, timeout, user_agent, routing, queryLogger, notificationHandler} = do
  h <- whenInvalid host (T.null host) "Host can not be empty"
  s <- validateScheme scheme
  validated_versions <- boltVersionsToSpec versions
  ua <- validateUserAgent user_agent
  pure $ ValidatedConfig {host = h, port, scheme = s, use_tls, versions = validated_versions, timeout, user_agent = ua, routing, queryLogger, notificationHandler}

validateScheme :: Scheme -> V.Validation [T.Text] Scheme
validateScheme s@(Basic principal credentials) = do
  _ <- whenInvalid principal (T.null principal) "Scheme basic principal (username) can not be empty"
  _ <- whenInvalid credentials (T.null credentials) "Scheme basic credentials (password) can not be empty"
  pure s
validateScheme s@(Bearer credentials) = do
  _ <- whenInvalid credentials (T.null credentials) "Scheme bearer credentials (password) can not be empty"
  pure s
validateScheme s = pure s

validateUserAgent :: UserAgent -> V.Validation [T.Text] UserAgent
validateUserAgent ua@UserAgent{name, version} = do
  _ <- whenInvalid name (T.null name) "User agent name can not be empty"
  _ <- whenInvalid version (T.null version) "User agent version can not be empty"
  pure ua