diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,16 @@ +# Changelog +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to [PVP](https://pvp.haskell.org/). + +## [Unreleased] + +Nothing + +## [v1.0.0.0] 2020-12-29 + +First release + +[Unreleased]: https://github.com/ludat/conferer/compare/conferer-hedis_v1.0.0.0...HEAD +[v1.0.0.0]: https://github.com/ludat/conferer/compare/v0.0.0.0...conferer-hedis_v1.0.0.0 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: 281d7c448b91ec83153a88bb4b8ed273a12c0592e32338d02f02c6a7aa6c5a0b +-- hash: 11b6c1c1c753babb114e16040364b89dceaf40565d79ddf73f4dadff010e3c89 name: conferer-hedis -version: 0.4.0.1 +version: 1.0.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 @@ -15,11 +15,13 @@ homepage: https://conferer.ludat.io author: Lucas David Traverso maintainer: lucas6246@gmail.com +copyright: (c) 2020 Lucas David Traverso license: MPL-2.0 license-file: LICENSE build-type: Simple extra-doc-files: README.md + CHANGELOG.md LICENSE library @@ -29,12 +31,15 @@ Paths_conferer_hedis hs-source-dirs: src - default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables + default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables RecordWildCards StrictData + ghc-options: -Wall -Wredundant-constraints -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns build-depends: base >=4.3 && <5 - , conferer >=0.4.0.0 && <0.5.0.0 + , conferer >=1.0.0.0 && <2.0.0.0 , hedis >=0.7.0 && <1.0.0 , text >=1.1 && <1.3 + if impl(ghc >= 8.4.1) + ghc-options: -Wpartial-fields default-language: Haskell2010 test-suite specs @@ -45,12 +50,15 @@ Paths_conferer_hedis hs-source-dirs: test - default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables + default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables RecordWildCards StrictData + ghc-options: -Wall -Wredundant-constraints -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns build-depends: base >=4.3 && <5 - , conferer >=0.4.0.0 && <0.5.0.0 + , conferer >=1.0.0.0 && <2.0.0.0 , conferer-hedis , hedis >=0.7.0 && <1.0.0 , hspec , text >=1.1 && <1.3 + if impl(ghc >= 8.4.1) + ghc-options: -Wpartial-fields default-language: Haskell2010 diff --git a/src/Conferer/FromConfig/Hedis.hs b/src/Conferer/FromConfig/Hedis.hs --- a/src/Conferer/FromConfig/Hedis.hs +++ b/src/Conferer/FromConfig/Hedis.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE FlexibleInstances #-} +-- | +-- Copyright: (c) 2019 Lucas David Traverso +-- License: MPL-2.0 +-- Maintainer: Lucas David Traverso +-- Stability: stable +-- Portability: portable +-- +-- FromConfig instance for hedis +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE CPP #-} -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 +module Conferer.FromConfig.Hedis where -import Conferer.Core -import Conferer.Types -import Conferer.FromConfig.Basics -import Data.Maybe (catMaybes) +import Conferer.FromConfig +import Conferer.Config + import qualified Database.Redis as Redis -import Data.String (fromString) -import Data.Text (unpack) -import Data.Maybe (fromMaybe) +import Data.Text (Text, unpack) import Text.Read (readMaybe) -import Data.Proxy (Proxy(..)) -import Data.Typeable (typeRep) -import Control.Exception (throwIO) +import Data.Dynamic instance FromConfig Redis.PortID where - updateFromConfig = updateAllAtOnceUsingFetch fetchFromConfig = fetchFromConfigWith (\t -> do case readMaybe $ unpack t of Just n -> return $ Redis.PortNumber n @@ -42,33 +31,64 @@ #endif ) +-- | Deconstruct a 'Redis.ConnectInfo' into a many key/dynamic pairs to +-- provide valid defaults for downstream 'fetchFromConfig' +deconstructConnInfoToDefaults :: Redis.ConnectInfo -> [(Key, Dynamic)] +deconstructConnInfoToDefaults Redis.ConnInfo{..} = + [ ("host", toDyn connectHost) + , ("port", toDyn connectPort) + , ("auth", toDyn connectAuth) + , ("database", toDyn connectDatabase) + + , ("maxConnections", toDyn connectMaxConnections) + , ("maxIdleTime", toDyn connectMaxIdleTime) + , ("timeout", toDyn connectTimeout) +#if MIN_VERSION_hedis(0,10,2) + , ("tlsParams", toDyn connectTLSParams) +#endif + ] + instance DefaultConfig Redis.ConnectInfo where configDef = Redis.defaultConnectInfo instance FromConfig Redis.ConnectInfo where - fetchFromConfig key config = do - return Nothing + fetchFromConfig key originalConfig = do + firstConfig <- addDefaultsAfterDeconstructingToDefaults deconstructConnInfoToDefaults key originalConfig - updateFromConfig key config connectInfo = do - redisConfig <- -- For hedis < 0.10.0 `Redis.parseConnectInfo` doesn't exist so in that case -- we simply avoid reading the url directly from key, and instead we directly -- act as if it wasn't present #if MIN_VERSION_hedis(0,10,0) - getKey key config >>= \case - Just connectionString -> + config <- + fetchFromConfig @(Maybe Text) (key /. "url") firstConfig + >>= \case + Just connectionString -> do case Redis.parseConnectInfo $ unpack connectionString of - Right con -> return $ con - Left e -> - throwIO $ ConfigParsingError key connectionString (typeRep (Proxy :: Proxy (Redis.ConnectInfo))) - Nothing -> + Right Redis.ConnInfo{..} -> do + return $ + firstConfig + & addDefaults + [ (key /. "host", toDyn connectHost) + , (key /. "port", toDyn connectPort) + , (key /. "auth", toDyn connectAuth) + , (key /. "database", toDyn connectDatabase) + ] + Left _e -> + throwConfigParsingError @Redis.ConnectInfo key connectionString + Nothing -> do + return firstConfig +#else + config <- return firstConfig #endif - 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 }) + connectHost <- fetchFromConfig (key /. "host") config + connectPort <- fetchFromConfig (key /. "port") config + connectAuth <- fetchFromConfig (key /. "auth") config + connectDatabase <- fetchFromConfig (key /. "database") config - 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 + connectMaxConnections <- fetchFromConfig (key /. "maxConnections") config + connectMaxIdleTime <- fetchFromConfig (key /. "maxIdleTime") config + connectTimeout <- fetchFromConfig (key /. "timeout") config +#if MIN_VERSION_hedis(0,10,2) + connectTLSParams <- fetchFromConfig (key /. "tlsParams") config +#endif + pure Redis.ConnInfo{..} diff --git a/test/Conferer/FromConfig/HedisSpec.hs b/test/Conferer/FromConfig/HedisSpec.hs --- a/test/Conferer/FromConfig/HedisSpec.hs +++ b/test/Conferer/FromConfig/HedisSpec.hs @@ -1,53 +1,86 @@ +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE CPP #-} 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 +import Test.Hspec +import Conferer.FromConfig.Hedis () +import Database.Redis -configWith :: [(Key, Text)] -> IO Config -configWith keyValues = emptyConfig & addSource (mkMapSource keyValues) +import Conferer +import Conferer.Test -portAndHostShouldBe :: Redis.ConnectInfo -> (Redis.PortID, Int) -> Expectation +portAndHostShouldBe :: ConnectInfo -> (PortID, String) -> Expectation portAndHostShouldBe fetchedSettings (port, host) = do - Redis.connectPort fetchedSettings `shouldBe` port - Redis.connectMaxConnections fetchedSettings `shouldBe` host + connectPort fetchedSettings `shouldBe` port + connectHost 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 + let defaultPort = connectPort configDef + defaultHost = connectHost configDef + describe "fetching a hedis configuration from a totally empty config" $ do + it "throws an exception" $ do + config <- configWith [] [] + unsafeFetchKey @ConnectInfo config "hedis" + `shouldThrow` anyException + + describe "with no configuration" $ do it "returns hedis default config" $ do - let config = emptyConfig - fetchedValue <- getFromConfig "." config + config <- configWith [] [] + fetchedValue <- fetchKey config "hedis" configDef 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 "with configured port" $ do + it "return a hedis config with that port" $ do + config <- configWith [] [("hedis.port", "9999")] + fetchedValue <- fetchKey config "hedis" configDef + fetchedValue `portAndHostShouldBe` (PortNumber 9999, defaultHost) + + describe "with configured maxConnections" $ do + it "returns a hedis config with that max connections" $ do + config <- configWith [] [("hedis.maxConnections", "6")] + fetchedValue <- fetchKey config "hedis" configDef + connectMaxConnections fetchedValue + `shouldBe` 6 + + #if MIN_VERSION_hedis(0,10,0) - 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) + describe "with a url configured" $ do + it "returns a hedis config with host, port, auth and database from the url" $ do + config <- configWith [] [("hedis.url", "redis://username:password@host:42")] + fetchedValue <- fetchKey config "hedis" configDef + fetchedValue `portAndHostShouldBe` (PortNumber 42, "host") + + describe "and something url defined configured by itself" $ do + it "returns a hedis config with the more specific configured value" $ do + config <- configWith + [] + [ ("hedis.url", "redis://username:password@host:42") + , ("hedis.port", "72") + ] + fetchedValue <- fetchKey config "hedis" configDef + fetchedValue `portAndHostShouldBe` (PortNumber 72, "host") + + describe "and a something not defined in url" $ do + it "returns a hedis config with that value as well" $ do + config <- configWith + [] + [ ("hedis.url", "redis://username:password@host:42") + , ("hedis.maxConnections", "70") + ] + fetchedValue <- fetchKey config "hedis" configDef + fetchedValue `portAndHostShouldBe` (PortNumber 42, "host") + connectMaxConnections fetchedValue + `shouldBe` 70 + + describe "and a default not present in url" $ do + it "returns a hedis config with the right default" $ do + config <- configWith + [] + [ ("hedis.url", "redis://username:password@host:42") + ] + fetchedValue <- fetchKey config "hedis" $ configDef {connectMaxConnections = 73} + fetchedValue `portAndHostShouldBe` (PortNumber 42, "host") + connectMaxConnections fetchedValue + `shouldBe` 73 #endif