diff --git a/conferer-hedis.cabal b/conferer-hedis.cabal --- a/conferer-hedis.cabal +++ b/conferer-hedis.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 1ca6d2eb45eb5c28e844e351918ffe93f8d006f0d26a03bbe39d6ea9b0316c68 +-- hash: 38ac739d423c0e28c7b8dd4d614f1092cbebb6371eef9f2dd9fa21f0c5c618a1 name: conferer-hedis -version: 0.2.0.0 +version: 0.3.0.0 synopsis: conferer's FromConfig instances for hedis settings description: Library to abstract the parsing of many haskell config values from different config sources @@ -25,7 +25,7 @@ library exposed-modules: - Conferer.FetchFromConfig.Hedis + Conferer.FromConfig.Hedis other-modules: Paths_conferer_hedis hs-source-dirs: @@ -33,23 +33,23 @@ default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables build-depends: base >=4.3 && <5 - , conferer >=0.2.0.0 && <0.3.0.0 + , conferer >=0.3.0.0 && <0.5.0.0 , hedis >=0.7.0 && <1.0.0 , text >=1.1 && <1.3 default-language: Haskell2010 -test-suite conferer-hedis-test +test-suite specs type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Conferer.FetchFromConfig.HedisSpec + Conferer.FromConfig.HedisSpec Paths_conferer_hedis hs-source-dirs: test default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables build-depends: base >=4.3 && <5 - , conferer >=0.2.0.0 && <0.3.0.0 + , conferer >=0.3.0.0 && <0.5.0.0 , conferer-hedis , hedis >=0.7.0 && <1.0.0 , hspec diff --git a/src/Conferer/FetchFromConfig/Hedis.hs b/src/Conferer/FetchFromConfig/Hedis.hs deleted file mode 100644 --- a/src/Conferer/FetchFromConfig/Hedis.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeApplications #-} -module Conferer.FetchFromConfig.Hedis - ( - -- * How to use this - -- | FetchFromConfig instance for hedis server settings - -- - -- @ - -- import Conferer - -- import Conferer.FetchFromConfig.Hedis () - -- - -- main = do - -- config <- 'defaultConfig' \"awesomeapp\" - -- hedisSettings <- 'getFromConfig' \"hedis\" config - -- @ - ) where - -import Conferer.Core -import Conferer.Types -import Conferer.FetchFromConfig.Basics -import Data.Maybe (catMaybes) -import qualified Database.Redis as Redis -import Data.String (fromString) -import Data.Text (unpack) -import Data.Maybe (fromMaybe) -import Text.Read (readMaybe) -import Data.Proxy (Proxy(..)) -import Data.Typeable (typeRep) -import Control.Exception (throwIO) - -instance FetchFromConfig Redis.PortID where - fetch = fetchFromConfigWith (\t -> do - case readMaybe $ unpack t of - Just n -> return $ Redis.PortNumber n - Nothing -> - return $ Redis.UnixSocket $ unpack t - ) - -instance DefaultConfig Redis.ConnectInfo where - configDef = Redis.defaultConnectInfo - -instance FetchFromConfig Redis.ConnectInfo where - fetch key config = do - redisConfig <- getKey key config - >>= \case - Just connectionString -> - case Redis.parseConnectInfo $ unpack connectionString of - Right con -> return $ con - Left e -> - throwIO $ ConfigParsingError key connectionString (typeRep (Proxy :: Proxy (Redis.ConnectInfo))) - Nothing -> - pure configDef - >>= findKeyAndApplyConfig config key "host" (\v c -> c { Redis.connectHost = v }) - >>= findKeyAndApplyConfig config key "port" (\v c -> c { Redis.connectPort = v }) - >>= findKeyAndApplyConfig config key "auth" (\v c -> c { Redis.connectAuth = v }) - - pure redisConfig - >>= findKeyAndApplyConfig config key "maxConnections" (\v c -> c { Redis.connectMaxConnections = v }) - >>= findKeyAndApplyConfig config key "maxIdleTime" (\v c -> c { Redis.connectMaxConnections = v }) - >>= (return . return) diff --git a/src/Conferer/FromConfig/Hedis.hs b/src/Conferer/FromConfig/Hedis.hs new file mode 100644 --- /dev/null +++ b/src/Conferer/FromConfig/Hedis.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +module Conferer.FromConfig.Hedis + ( + -- * How to use this + -- | FromConfig instance for hedis server settings + -- + -- @ + -- import Conferer + -- import Conferer.FromConfig.Hedis () + -- + -- main = do + -- config <- 'defaultConfig' \"awesomeapp\" + -- hedisSettings <- 'getFromConfig' \"hedis\" config + -- @ + ) where + +import Conferer.Core +import Conferer.Types +import Conferer.FromConfig.Basics +import Data.Maybe (catMaybes) +import qualified Database.Redis as Redis +import Data.String (fromString) +import Data.Text (unpack) +import Data.Maybe (fromMaybe) +import Text.Read (readMaybe) +import Data.Proxy (Proxy(..)) +import Data.Typeable (typeRep) +import Control.Exception (throwIO) + +instance FromConfig Redis.PortID where + updateFromConfig = updateAllAtOnceUsingFetch + fetchFromConfig = fetchFromConfigWith (\t -> do + case readMaybe $ unpack t of + Just n -> return $ Redis.PortNumber n + Nothing -> + return $ Redis.UnixSocket $ unpack t + ) + +instance DefaultConfig Redis.ConnectInfo where + configDef = Redis.defaultConnectInfo + +instance FromConfig Redis.ConnectInfo where + fetchFromConfig key config = do + return Nothing + + updateFromConfig key config connectInfo = do + redisConfig <- getKey key config + >>= \case + Just connectionString -> + case Redis.parseConnectInfo $ unpack connectionString of + Right con -> return $ con + Left e -> + throwIO $ ConfigParsingError key connectionString (typeRep (Proxy :: Proxy (Redis.ConnectInfo))) + Nothing -> + pure connectInfo + >>= findKeyAndApplyConfig config key "host" Redis.connectHost (\v c -> c { Redis.connectHost = v }) + >>= findKeyAndApplyConfig config key "port" Redis.connectPort (\v c -> c { Redis.connectPort = v }) + >>= findKeyAndApplyConfig config key "auth" Redis.connectAuth (\v c -> c { Redis.connectAuth = v }) + + pure redisConfig + >>= findKeyAndApplyConfig config key "maxConnections" Redis.connectMaxConnections (\v c -> c { Redis.connectMaxConnections = v }) + -- >>= findKeyAndApplyConfig config key "maxIdleTime" Redis.connectMaxIdleTime (\v c -> c { Redis.connectMaxIdleTime = v }) + >>= return diff --git a/test/Conferer/FetchFromConfig/HedisSpec.hs b/test/Conferer/FetchFromConfig/HedisSpec.hs deleted file mode 100644 --- a/test/Conferer/FetchFromConfig/HedisSpec.hs +++ /dev/null @@ -1,49 +0,0 @@ -module Conferer.FetchFromConfig.HedisSpec where - -import Test.Hspec -import Conferer.Types -import Data.Text -import Conferer -import Conferer.FetchFromConfig.Hedis () -import qualified Database.Redis as Redis - -configWith :: [(Key, Text)] -> IO Config -configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues) - -portAndHostShouldBe :: Maybe Redis.ConnectInfo -> (Redis.PortID, Int) -> Expectation -portAndHostShouldBe fetchedSettings (port, host) = do - Redis.connectPort <$> fetchedSettings `shouldBe` Just port - Redis.connectMaxConnections <$> fetchedSettings `shouldBe` Just host - -spec :: Spec -spec = do - let defaultPort = Redis.connectPort configDef - defaultHost = Redis.connectMaxConnections configDef - describe "fetching a hedis configuration without overriding anything" $ do - it "returns hedis default config" $ do - let config = emptyConfig - fetchedValue <- fetch "." config - fetchedValue `portAndHostShouldBe` (defaultPort, defaultHost) - describe "fetching a hedis configuration overriding its port" $ do - it "returns a hedis config with its port set to the overriden one" $ do - config <- configWith [("hedis.port", "9999")] - fetchedValue <- fetch "hedis" config - fetchedValue `portAndHostShouldBe` (Redis.PortNumber 9999, defaultHost) - describe "fetching a hedis configuration overriding its host" $ do - it "returns a hedis config with its host set to the overriden one" $ do - config <- configWith [("hedis.maxConnections", "6")] - fetchedValue <- fetch "hedis" config - fetchedValue `portAndHostShouldBe` (defaultPort, 6) - describe "fetching a hedis configuration overriding its host" $ do - it "returns a hedis config with its host set to the overriden one" $ do - config <- configWith [("hedis", "redis://username:password@host:42")] - fetchedValue <- fetch "hedis" config - fetchedValue `portAndHostShouldBe` (Redis.PortNumber 42, defaultHost) - describe "fetching a hedis configuration overriding its host" $ do - it "returns a hedis config with its host set to the overriden one" $ do - config <- configWith - [ ("hedis", "redis://username:password@host:42") - , ("hedis.maxConnections", "70") - ] - fetchedValue <- fetch "hedis" config - fetchedValue `portAndHostShouldBe` (Redis.PortNumber 42, 70) diff --git a/test/Conferer/FromConfig/HedisSpec.hs b/test/Conferer/FromConfig/HedisSpec.hs new file mode 100644 --- /dev/null +++ b/test/Conferer/FromConfig/HedisSpec.hs @@ -0,0 +1,49 @@ +module Conferer.FromConfig.HedisSpec where + +import Test.Hspec +import Conferer.Types +import Data.Text +import Conferer +import Conferer.FromConfig.Hedis () +import qualified Database.Redis as Redis + +configWith :: [(Key, Text)] -> IO Config +configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues) + +portAndHostShouldBe :: Redis.ConnectInfo -> (Redis.PortID, Int) -> Expectation +portAndHostShouldBe fetchedSettings (port, host) = do + Redis.connectPort fetchedSettings `shouldBe` port + Redis.connectMaxConnections fetchedSettings `shouldBe` host + +spec :: Spec +spec = do + let defaultPort = Redis.connectPort configDef + defaultHost = Redis.connectMaxConnections configDef + describe "fetching a hedis configuration without overriding anything" $ do + it "returns hedis default config" $ do + let config = emptyConfig + fetchedValue <- getFromConfig "." config + fetchedValue `portAndHostShouldBe` (defaultPort, defaultHost) + describe "fetching a hedis configuration overriding its port" $ do + it "returns a hedis config with its port set to the overriden one" $ do + config <- configWith [("hedis.port", "9999")] + fetchedValue <- getFromConfig "hedis" config + fetchedValue `portAndHostShouldBe` (Redis.PortNumber 9999, defaultHost) + describe "fetching a hedis configuration overriding its host" $ do + it "returns a hedis config with its host set to the overriden one" $ do + config <- configWith [("hedis.maxConnections", "6")] + fetchedValue <- getFromConfig "hedis" config + fetchedValue `portAndHostShouldBe` (defaultPort, 6) + describe "fetching a hedis configuration overriding its host" $ do + it "returns a hedis config with its host set to the overriden one" $ do + config <- configWith [("hedis", "redis://username:password@host:42")] + fetchedValue <- getFromConfig "hedis" config + fetchedValue `portAndHostShouldBe` (Redis.PortNumber 42, defaultHost) + describe "fetching a hedis configuration overriding its host" $ do + it "returns a hedis config with its host set to the overriden one" $ do + config <- configWith + [ ("hedis", "redis://username:password@host:42") + , ("hedis.maxConnections", "70") + ] + fetchedValue <- getFromConfig "hedis" config + fetchedValue `portAndHostShouldBe` (Redis.PortNumber 42, 70)