packages feed

magicbane 0.3.0 → 0.4.0

raw patch · 9 files changed

+124/−77 lines, 9 filesdep −data-default

Dependencies removed: data-default

Files

library/Magicbane.hs view
@@ -1,64 +1,43 @@-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-signatures #-}-{-# LANGUAGE Trustworthy, NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, LambdaCase #-}+{-# LANGUAGE Trustworthy, UnicodeSyntax #-}  -- | A Dropwizard-inspired web framework that integrates --   Servant, monad-metrics/EKG, monad-logger/fast-logger, and other useful libraries --   to provide a smooth web service development experience. -----   This module provides all the stuff you need.+--   This module provides all the stuff you need for an application:+--   - reexports from all the modules below, including orphan instances from Magicbane.Has+--   - orphan instances for RIO+--   - reexports from various utility packages+--   - a basic example context for simple apps module Magicbane (   module X , module Magicbane ) where +import           RIO.Orphans as X () import           Control.Error.Util as X hiding ((??), err, errLn, tryIO, handleExceptT, syncIO, bool)-import           Control.Monad.IO.Class import           Control.Monad.Trans.Maybe as X hiding (liftListen, liftPass, liftCallCC) import           UnliftIO.Exception as X hiding (Handler) import           UnliftIO.Concurrent as X-import qualified System.Envy-import           System.Envy as X hiding ((.=), (.!=), decode)-import qualified System.IO-import           Data.Default as X import           Data.List.Split as X (splitOn) import           Data.String.Conversions as X hiding ((<>))-import           Data.String.Conversions.Monomorphic as X+import           Data.String.Conversions.Monomorphic as X hiding (fromString) import           Data.Aeson as X import           Data.Aeson.QQ as X-import           Data.Text (Text) import           Text.RawString.QQ as X import           Network.URI as X-import qualified Network.HTTP.Link import           Network.HTTP.Link as X hiding (Link) import           Network.HTTP.Types as X hiding (Header) import           Network.Wai as X (Application, Middleware) import           Network.Wai.Cli as X hiding (port) import           Magicbane.App as X hiding (Or)+import           Magicbane.Config as X+import           Magicbane.Has as X import           Magicbane.Logging as X import           Magicbane.Metrics as X import           Magicbane.Validation as X import           Magicbane.HTTPClient as X import           Magicbane.Util as X--type Host = Header "Host" Text-type Form = ReqBody '[FormUrlEncoded] [(Text, Text)]--type HTTPLink = Network.HTTP.Link.Link-type WithLink α = (Headers '[Header "Link" [HTTPLink]] α)--instance (Default α) ⇒ DefConfig α where-  defConfig = def--decodeEnvy = System.Envy.decode---- | Reads an Envy configuration from the env variables and launches the given action if successful.---   (Does environment variable reading ever fail in practice? Probably not.)-withEnvConfig ∷ FromEnv α ⇒ (α → IO ()) → IO ()-withEnvConfig a = decodeEnv >>= \case-                                    Left e → hPutStrLn System.IO.stderr ("error reading env: " ++ e)-                                    Right c → a c--hPutStrLn h s = liftIO $ System.IO.hPutStrLn h s  type BasicContext = (ModHttpClient, ModLogger) type BasicApp α = RIO BasicContext α
library/Magicbane/App.hs view
@@ -1,5 +1,4 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# LANGUAGE NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving, TypeApplications, ScopedTypeVariables, CPP #-}+{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax, TypeApplications, ScopedTypeVariables, CPP #-}  -- | Extends Servant with context, based on RIO. --   The context should be a tuple of all your moudles and configs and stuff, so that the Data.Has module would let you access these items by type.@@ -10,10 +9,8 @@ ) where  import           RIO-import           RIO.Orphans as X () import           Control.Monad.Trans.Except (ExceptT (..)) import           Data.Proxy as X-import           Data.Has as X import           Servant as X hiding (And, Handler) import qualified Servant @@ -24,11 +21,3 @@ magicbaneApp ∷ forall β χ ψ. (HasServer χ ψ) ⇒ Proxy χ → Context ψ → β → ServerT χ (RIO β) → Application magicbaneApp api sctx ctx actions = serveWithContext api sctx $ srv ctx   where srv c = hoistServerWithContext api (Proxy @ψ) (runMagicbaneHandler c) actions---- | Gets a value of any type from the context.-askObj ∷ (Has β α, MonadReader α μ) ⇒ μ β-askObj = asks getter---- | Gets a thing from a value of any type from the context. (Useful for configuration fields.)-askOpt ∷ (Has β α, MonadReader α μ) ⇒ (β → ψ) → μ ψ-askOpt f = asks $ f . getter
+ library/Magicbane/Config.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE Trustworthy, NoMonomorphismRestriction, OverloadedStrings, UnicodeSyntax, LambdaCase #-}++-- | Utility functions and reexports for System.Envy, an environment variable config reader.+module Magicbane.Config (+  module X+, module Magicbane.Config+) where++import qualified System.Envy+import           System.Envy as X hiding ((.=), (.!=), decode)+import           System.IO (stderr)+import           Magicbane.Util (hPutStrLn)++decodeEnvy = System.Envy.decode++-- | Reads an Envy configuration from the env variables and launches the given action if successful.+--   (Does environment variable reading ever fail in practice? Probably not.)+withEnvConfig ∷ FromEnv α ⇒ (α → IO ()) → IO ()+withEnvConfig a = decodeEnv >>= \case+                                    Left e → hPutStrLn stderr ("error reading env: " ++ e)+                                    Right c → a c
library/Magicbane/HTTPClient.hs view
@@ -1,5 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE OverloadedStrings, UnicodeSyntax, FlexibleContexts, FlexibleInstances, UndecidableInstances, ConstraintKinds #-}+{-# LANGUAGE Trustworthy, NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, FlexibleContexts, ConstraintKinds #-}  -- | Provides an HTTP(S) client via http-client(-tls) in a Magicbane app context. --   Also provides a simple composable interface for making arbitrary requests, based on http-client-conduit.@@ -9,16 +8,18 @@ , module X ) where -import           Control.Monad.Reader+import           RIO+import qualified RIO.Map as M+import qualified RIO.Set as S import           Control.Monad.Catch as X (MonadCatch) import           Control.Monad.Trans.Except as X (ExceptT (..), runExceptT) import qualified Control.Monad.Trans.Except as MTE import           Control.Monad.IO.Unlift as X (MonadUnliftIO) import           UnliftIO.Exception (tryAny)-import           Data.Has+import           Data.Aeson (ToJSON, encode) import           Data.Bifunctor import           Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as L (ByteString)+import qualified Data.ByteString.Lazy as L (ByteString, toStrict) import           Data.Conduit import qualified Data.Conduit.Combinators as C import           Data.String.Conversions@@ -34,9 +35,6 @@  newtype ModHttpClient = ModHttpClient Manager -instance (Has ModHttpClient α) ⇒ HasHttpManager α where-  getHttpManager = (\(ModHttpClient m) → m) <$> getter- newHttpClient ∷ IO ModHttpClient newHttpClient = ModHttpClient <$> newTlsManager @@ -59,11 +57,20 @@  -- | Sets a x-www-form-urlencoded form as the request body (also sets the content-type). postForm ∷ (MonadHTTP ψ μ) ⇒ [(Text, Text)] → Request → ExceptT Text μ Request-postForm form req =-  return req { method = "POST"-             , requestHeaders = [ (hContentType, "application/x-www-form-urlencoded; charset=utf-8") ]-             , requestBody = RequestBodyBS $ writeForm form }+postForm form req = return+  $ req { method = "POST"+        , requestBody = RequestBodyBS $ writeForm form }+    & applyHeaders+        [ (hContentType, "application/x-www-form-urlencoded; charset=utf-8") ] +-- | Sets a JSON value as the request body (via ToJSON; also sets the content-type).+postJson ∷ (MonadHTTP ψ μ, ToJSON α) ⇒ α → Request → ExceptT Text μ Request+postJson body req = return+  $ req { method = "POST"+        , requestBody = RequestBodyBS . L.toStrict . encode $ body }+    & applyHeaders+        [ (hContentType, "application/json; charset=utf-8") ]+ -- | Performs the request, using a given function to read the body. This is what all other performWith functions are based on. performWithFn ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ (ConduitM ι ByteString μ () → ConduitT () Void μ ρ) → Request → ExceptT Text μ (Response ρ) performWithFn fn req = do@@ -79,3 +86,21 @@ -- | Performs the request, reading the body into a lazy ByteString. performWithBytes ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ Request → ExceptT Text μ (Response L.ByteString) performWithBytes = performWithFn (.| C.sinkLazy)++-- | Add headers to the request, preserving any existing headers not specified in the new set.+applyHeaders ∷ RequestHeaders → Request → Request+applyHeaders headers req =+  req { requestHeaders = updated }+  where+    updated = M.toList $ new `M.union` old+    new = M.fromList headers+    old = M.fromList $ requestHeaders req++-- | Remove listed headers from the request.+removeHeaders ∷ [HeaderName] → Request → Request+removeHeaders headerNames req =+  req { requestHeaders = updated }+  where+    updated = M.toList $ old `M.withoutKeys` keysToRemove+    keysToRemove = S.fromList headerNames+    old = M.fromList $ requestHeaders req
+ library/Magicbane/Has.hs view
@@ -0,0 +1,32 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE Trustworthy, UnicodeSyntax, FlexibleInstances, UndecidableInstances #-}++-- | Orphan instances and utility functions for Data.Has, a typeclass for extracting values from a structure by type.+module Magicbane.Has (+  module X+, module Magicbane.Has+) where++import           Data.Has as X+import           Control.Monad.Reader (MonadReader, asks)+import           RIO (HasLogFunc(..))+import           Magicbane.Logging (ModLogger)+import           Magicbane.Metrics (ModMetrics(..), MonadMetrics, getMetrics)+import           Magicbane.HTTPClient (ModHttpClient(..), HasHttpManager, getHttpManager)++instance {-# OVERLAPPABLE #-} (Has ModHttpClient α) ⇒ HasHttpManager α where+  getHttpManager = (\(ModHttpClient m) → m) <$> getter++instance {-# OVERLAPPABLE #-} Has ModLogger α ⇒ HasLogFunc α where+  logFuncL = hasLens++instance (Has ModMetrics α, Monad μ, MonadReader α μ) ⇒ MonadMetrics μ where+  getMetrics = (\(ModMetrics m) → m) <$> asks getter++-- | Gets a value of any type from the context.+askObj ∷ (Has β α, MonadReader α μ) ⇒ μ β+askObj = asks getter++-- | Gets a thing from a value of any type from the context. (Useful for configuration fields.)+askOpt ∷ (Has β α, MonadReader α μ) ⇒ (β → ψ) → μ ψ+askOpt f = asks $ f . getter
library/Magicbane/Logging.hs view
@@ -1,5 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE OverloadedStrings, UnicodeSyntax, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-}  -- | Provides logging via fast-logger in a Magicbane app context. module Magicbane.Logging (@@ -8,14 +7,10 @@ ) where  import           RIO-import           Data.Has import           System.Log.FastLogger import           System.Log.FastLogger as X (LogType(..), defaultBufSize)  type ModLogger = LogFunc--instance Has ModLogger α ⇒ HasLogFunc α where-  logFuncL = hasLens  type Formatter = TimedFastLogger → CallStack → LogSource → LogLevel → Utf8Builder → IO ()
library/Magicbane/Metrics.hs view
@@ -1,5 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE OverloadedStrings, UnicodeSyntax, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE UnicodeSyntax #-}  -- | Provides metrics via monad-metrics/EKG in a Magicbane app context. --   Also reexports Wai metrics middleware.@@ -8,21 +7,15 @@ , module X ) where -import           Data.Has import qualified Control.Monad.Metrics import           Control.Monad.Metrics as X hiding (initialize, initializeWith, run, run') import           System.Metrics as X (Store, registerGcMetrics) import qualified System.Remote.Monitoring.Wai import           System.Remote.Monitoring.Wai as X (serverMetricStore) import           Network.Wai.Metrics as X--- replacing ClassyPrelude-import           Control.Monad.Reader import           Data.ByteString (ByteString)  newtype ModMetrics = ModMetrics Metrics--instance (Has ModMetrics α, Monad μ, MonadReader α μ) ⇒ MonadMetrics μ where-  getMetrics = (\(ModMetrics m) → m) <$> asks getter  forkMetricsServer ∷ ByteString → Int → IO System.Remote.Monitoring.Wai.Server forkMetricsServer = System.Remote.Monitoring.Wai.forkServer
library/Magicbane/Util.hs view
@@ -1,12 +1,13 @@-{-# LANGUAGE OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators, MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings, UnicodeSyntax, DataKinds, FlexibleContexts #-} --- | Various useful functions.+-- | Various useful functions and type definitions. module Magicbane.Util where -import           RIO (MonadThrow, throwM)+import           RIO (MonadThrow, throwM, MonadIO, liftIO) import           Control.Arrow import           Control.Monad import           Control.Error (hush)+import qualified System.IO import qualified Data.ByteString.Lazy as L (ByteString) import qualified Data.HashMap.Strict as HMS import qualified Data.Sequences as S@@ -23,9 +24,19 @@ import           Data.Aeson import           Network.URI import           Network.HTTP.Types (hContentType)-import           Web.FormUrlEncoded hiding (parseMaybe)+import qualified Network.HTTP.Link+import           Web.FormUrlEncoded import           Servant +type Host = Header "Host" Text+type Form = ReqBody '[FormUrlEncoded] [(Text, Text)]++type HTTPLink = Network.HTTP.Link.Link+type WithLink α = (Headers '[Header "Link" [HTTPLink]] α)++hPutStrLn ∷ MonadIO μ ⇒ System.IO.Handle → String → μ ()+hPutStrLn h s = liftIO $ System.IO.hPutStrLn h s+ -- | Merges two JSON objects recursively. When the values are not objects, just returns the left one. mergeVal ∷ Value → Value → Value mergeVal (Object x) (Object y) = Object $ HMS.unionWith mergeVal x y@@ -40,7 +51,7 @@ readForm x = map (fromST *** fromST) <$> hush (mimeUnrender (Proxy ∷ Proxy FormUrlEncoded) $ toLBS x)  -- | Reads a Servant incoming form as a list of key-value pairs (for use in FromForm instances).-formList ∷ Form → [(Text, Text)]+formList ∷ Web.FormUrlEncoded.Form → [(Text, Text)] formList = fromMaybe [] . hush . fromForm  -- | Converts a flat key-value form with keys in typical nesting syntax (e.g. "one[two][three]") to an Aeson Value with nesting (for use in FromForm instances).
magicbane.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 16f20d3488e7908f6f190f6fe542bac616d2a863b4cdb40a363c7a8c5fcadd95+-- hash: fc096cdac0f766409152087a8e14aa8f6fb03ec3925e6b49f1c29e3feaa5e600  name:           magicbane-version:        0.3.0+version:        0.4.0 synopsis:       A web framework that integrates Servant, RIO, EKG, fast-logger, wai-cli…  description:    Inspired by Dropwizard, Magicbane provides a packaged framework for developing web services using the best available libraries, including Servant, RIO, Aeson, EKG/monad-metrics, fast-logger, wai-cli and others.@@ -36,7 +36,6 @@     , bytestring     , conduit     , conduit-combinators-    , data-default     , data-has     , ekg-core     , ekg-wai@@ -76,6 +75,8 @@   exposed-modules:       Magicbane       Magicbane.App+      Magicbane.Config+      Magicbane.Has       Magicbane.Logging       Magicbane.Metrics       Magicbane.Validation