{-# 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 -> Validation [Text] ValidatedConfig
validateConfig Config{Text
host :: Text
host :: Config -> Text
host, Word16
port :: Word16
port :: Config -> Word16
port, Scheme
scheme :: Scheme
scheme :: Config -> Scheme
scheme, Bool
use_tls :: Bool
use_tls :: Config -> Bool
use_tls, [Version]
versions :: [Version]
versions :: Config -> [Version]
versions, Int
timeout :: Int
timeout :: Config -> Int
timeout, UserAgent
user_agent :: UserAgent
user_agent :: Config -> UserAgent
user_agent, Routing
routing :: Routing
routing :: Config -> Routing
routing, Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger :: Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger :: Config -> Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger, Maybe (Notification -> IO ())
notificationHandler :: Maybe (Notification -> IO ())
notificationHandler :: Config -> Maybe (Notification -> IO ())
notificationHandler} = do
  Text
h <- Text -> Bool -> Text -> Validation [Text] Text
forall a. a -> Bool -> Text -> Validation [Text] a
whenInvalid Text
host (Text -> Bool
T.null Text
host) Text
"Host can not be empty"
  Scheme
s <- Scheme -> Validation [Text] Scheme
validateScheme Scheme
scheme
  [Word32]
validated_versions <- [Version] -> Validation [Text] [Word32]
boltVersionsToSpec [Version]
versions
  UserAgent
ua <- UserAgent -> Validation [Text] UserAgent
validateUserAgent UserAgent
user_agent
  pure $ ValidatedConfig {host :: Text
host = Text
h, Word16
port :: Word16
port :: Word16
port, scheme :: Scheme
scheme = Scheme
s, Bool
use_tls :: Bool
use_tls :: Bool
use_tls, versions :: [Word32]
versions = [Word32]
validated_versions, Int
timeout :: Int
timeout :: Int
timeout, user_agent :: UserAgent
user_agent = UserAgent
ua, Routing
routing :: Routing
routing :: Routing
routing, Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger :: Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger :: Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger, Maybe (Notification -> IO ())
notificationHandler :: Maybe (Notification -> IO ())
notificationHandler :: Maybe (Notification -> IO ())
notificationHandler}

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

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