packages feed

conferer-snap (empty) → 0.1.0.1

raw patch · 6 files changed

+163/−0 lines, 6 filesdep +basedep +confererdep +conferer-snapsetup-changed

Dependencies added: base, conferer, conferer-snap, hspec, snap-core, snap-server, text

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Lucas David Traverso++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,1 @@+# conferer-snap
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ conferer-snap.cabal view
@@ -0,0 +1,58 @@+cabal-version: 1.18++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: b78259781709e8fcbc9fc0c4285a9ebe20786658ca1e4f0928429c6650d4d1d9++name:           conferer-snap+version:        0.1.0.1+synopsis:       Configuration for reading json files++description:    Library to abstract the parsing of many haskell config values from different config sources+category:       Configuration+homepage:       https://github.com/ludat/conferer#readme+author:         Lucas David Traverso+maintainer:     lucas6246@gmail.com+copyright:      MIT+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-doc-files:+    README.md+    LICENSE++library+  exposed-modules:+      Conferer.FetchFromConfig.Snap+  other-modules:+      Paths_conferer_snap+  hs-source-dirs:+      src+  default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables+  build-depends:+      base >=4.3 && <5+    , conferer ==0.1.0.1+    , snap-core >=1.0 && <2.0+    , snap-server >=1.0 && <2.0+    , text >=1.1 && <1.3+  default-language: Haskell2010++test-suite conferer-snap-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_conferer_snap+  hs-source-dirs:+      test+  default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables+  build-depends:+      base >=4.3 && <5+    , conferer ==0.1.0.1+    , conferer-snap+    , hspec+    , snap-core >=1.0 && <2.0+    , snap-server >=1.0 && <2.0+    , text >=1.1 && <1.3+  default-language: Haskell2010
+ src/Conferer/FetchFromConfig/Snap.hs view
@@ -0,0 +1,80 @@+module Conferer.FetchFromConfig.Snap+  (+  -- * How to use this+  -- | FetchFromConfig instance for snap server configuration+  --+  -- @+  -- import Conferer+  -- import Conferer.FetchFromConfig.Snap () -- from package conferer-snap+  --+  -- main = do+  --   config <- 'defaultConfig' \"awesomeapp\"+  --   snapConfig <- 'getFromConfig' \"warp\" config+  -- @+  --+  -- * Internal utility functions+  -- | These may be useful for someone but are subject to change at any point so+  -- use with care+  findKeyAndApplyConfig+  ) where++import Conferer.Core+import Conferer.Types+import Conferer.FetchFromConfig.Basics+import Data.Either (rights)+import Data.String (fromString)+import Data.Text (Text, unpack)++import qualified Snap.Http.Server.Config as Snap+import qualified Snap.Core as Snap++instance FetchFromConfig Snap.ConfigLog where+  fetch k config = do+    getKey k config+      >>= \case+        Right "NoLog" -> return $ Right $ Snap.ConfigNoLog+        Right t -> return $ Right $ Snap.ConfigFileLog $ unpack t+        Left e -> return $ Left e++instance (FetchFromConfig a, Snap.MonadSnap m) => FetchFromConfig (Snap.Config m a) where+  fetch k config = do+    pure (Right Snap.defaultConfig)+      >>= findKeyAndApplyConfig config k "default-timeout" Snap.setDefaultTimeout+      >>= findKeyAndApplyConfig config k "access-log" Snap.setAccessLog+      >>= findKeyAndApplyConfig config k "bind" Snap.setBind+      >>= findKeyAndApplyConfig config k "compression" Snap.setCompression+      >>= findKeyAndApplyConfig config k "error-log" Snap.setErrorLog+      >>= findKeyAndApplyConfig config k "hostname" Snap.setHostname+      >>= findKeyAndApplyConfig config k "locale" Snap.setLocale+      >>= findKeyAndApplyConfig config k "other" Snap.setOther+      >>= findKeyAndApplyConfig config k "port" Snap.setPort+      -- >>= findKeyAndApplyConfig config k "proxy-type" Snap.setProxyType+      >>= findKeyAndApplyConfig config k "ssl-bind" Snap.setSSLBind+      >>= findKeyAndApplyConfig config k "ssl-cert" Snap.setSSLCert+      >>= findKeyAndApplyConfig config k "ssl-key" Snap.setSSLKey+      >>= findKeyAndApplyConfig config k "ssl-chain-cert" Snap.setSSLChainCert+      >>= findKeyAndApplyConfig config k "ssl-port" Snap.setSSLPort+      >>= findKeyAndApplyConfig config k "verbose" Snap.setVerbose+      >>= findKeyAndApplyConfig config k "unix-socket" Snap.setUnixSocket+      >>= findKeyAndApplyConfig config k "unix-socket-access-mode" Snap.setUnixSocketAccessMode++-- | Concatenate many transformations to the config based on keys and functions+--+-- TODO: This should probably be on @conferer@ and maybe should use a+-- transformer stack to avoid so much repeated code+findKeyAndApplyConfig ::+  FetchFromConfig newvalue+  => Config -- ^ Complete config+  -> Key -- ^ Key that indicates the part of the config that we care about+  -> Key -- ^ Key that we use to find the config (usually concatenating with the+         -- other key)+  -> (newvalue -> config -> config) -- ^ Function that knows how to use the+                                    -- value to update the config+  -> Either Text config -- ^ Result of the last config updating+  -> IO (Either Text config) -- ^ Updated config+findKeyAndApplyConfig config k relativeKey f (Right customConfig) =+  fetch (k /. relativeKey) config+    >>= \case+      Left a -> return $ Right customConfig+      Right a -> return $ Right $ f a customConfig+findKeyAndApplyConfig config k relativeKey f (Left e) = return $ Left e
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}