conferer-hedis 0.4.0.1 → 1.0.0.0
raw patch · 4 files changed
+166/−89 lines, 4 filesdep ~conferer
Dependency ranges changed: conferer
Files
- CHANGELOG.md +16/−0
- conferer-hedis.cabal +14/−6
- src/Conferer/FromConfig/Hedis.hs +64/−44
- test/Conferer/FromConfig/HedisSpec.hs +72/−39
+ CHANGELOG.md view
@@ -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
conferer-hedis.cabal view
@@ -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
src/Conferer/FromConfig/Hedis.hs view
@@ -1,36 +1,25 @@-{-# LANGUAGE FlexibleInstances #-}+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- 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{..}
test/Conferer/FromConfig/HedisSpec.hs view
@@ -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