packages feed

chakra (empty) → 0.1.0

raw patch · 18 files changed

+1237/−0 lines, 18 filesdep +aesondep +ansi-terminaldep +basesetup-changed

Dependencies added: aeson, ansi-terminal, base, bytestring, chakra, cryptonite, data-default, data-has, dotenv, envy, fast-logger, hspec, http-types, iproute, jose, lens, mtl, network, network-uri, options, optparse-simple, prometheus-client, prometheus-metrics-ghc, rio, servant-auth, servant-auth-server, servant-server, streaming-commons, string-conversions, text, time, transformers, unordered-containers, wai, wai-cli, wai-extra, wai-middleware-prometheus, warp

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2020 Cackharot++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,169 @@+# Chakra :: Web Api Template++[![Hackage](https://img.shields.io/hackage/v/chakra.svg)](https://hackage.haskell.org/package/chakra) [![Build Status](https://github.com/cackharot/chakra/workflows/ci/badge.svg)](https://github.com/cackharot/chakra/actions?query=workflow%3Aci) [![Hackage Deps](https://img.shields.io/hackage-deps/v/chakra.svg)](http://packdeps.haskellers.com/reverse/chakra)++A REST web api server template in Haskell.++This serves as a base to create API projects that comes with the following features to avoid repeated bolierplate in each one.++- Light weight & super fast Warp http server+- Supports HTTP 1.1 & HTTP/2 TLS by warp+- JSON as input/output serialization using Aeson library+- Structured logging (JSON) both application & HTTP request+- Define the REST interface using Servant library+- JWT (Bearer) token based authentication+- Application config via ENVIRONMENT variables (via dotenv & envy)+- Health & Info endpoints+- Prometheus metrics endpoint++## TODO++- [x] Integrate with RIO+- [x] Integrate with Servant+- [x] Integrate with FastLogger+- [x] Integrate with doenv & envy+- [x] Integrate with Prometheus+- [x] Integrate with wai-util+- [x] Setup JWT Authentication+- [x] JSON Error formatting+- [x] Setup HTTPS+- [ ] Setup PSQL/SqlLite pool with Presistent+- [x] Setup Stack template++## Getting started++To create a bare minimum API service all you need is below:++```haskell+#!/usr/bin/env stack+{- stack --resolver lts-14.27 runghc+ --package chakra+-}+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators #-}+import RIO+import Chakra+import Servant++type HelloRoute = "hello" :> QueryParam "name" Text :> Get '[PlainText] Text+type API = HelloRoute :<|> EmptyAPI++hello :: Maybe Text -> BasicApp Text+hello name = do+  let name' = fromMaybe "Sensei!" name+  logInfo $ "Saying hello to " <> display name'+  return $ "Hello " <> name' <> "!"++main :: IO ()+main = do+  let infoDetail = InfoDetail "example" "dev" "0.1" "change me"+      appEnv = appEnvironment infoDetail+      appVer = appVersion infoDetail+      appAPI = Proxy :: Proxy API+      appServer = hello :<|> emptyServer+  logFunc <- buildLogger appEnv appVer+  middlewares <- chakraMiddlewares infoDetail+  runChakraAppWithMetrics+    middlewares+    EmptyContext+    (logFunc, infoDetail)+    appAPI+    appServer+```++### Usage++Add this package to your application and refer `examples` directory for inspiration.++```bash+# Create a new haskell app using stack's rio template+stack new UserApi rio+```++Edit the below files to include the dependencies++```yaml+# Stack package.yaml+dependencies:+- base >= 4.11 && < 10+- chakra+- rio+- servant-server++# stack.yaml+resolver: lts-14.27+packages:+- .+extra-deps:+- git: https://github.com/cackharot/haskell-web-api-template.git+  commit: 70425ea54e4bc117582cdc0495f2b88827dbbf52+- prometheus-metrics-ghc-1.0.1.1+- wai-middleware-prometheus-1.0.0+- servant-auth-0.4.0.0+- servant-auth-server-0.4.6.0+- servant-server-0.18.2+- servant-0.18.2+```++A stack project template is also available for bootstraping quickly++```bash+stack new UserApi https://raw.githubusercontent.com/cackharot/haskell-web-api-template/main/chakra.hsfiles+```++## Build & Run++```bash+make build+PORT=3000 make run++open http://localhost:3000/health+```++### Endpoints++Info: http://localhost:3000/info++Health: http://localhost:3000/health++Metrics: http://localhost:3000/metrics++## Run tests++```bash+make test+```++## HTTPS Setup++Generate RootCA & localhost Public & Private key pair++Be sure to edit `certs/domains.ext` file if you need more DNS aliases before executing these commands.++```bash+openssl req -x509 -nodes -new -sha256 -days 1024 -newkey rsa:2048 -keyout "certs/RootCA.key" -out "certs/RootCA.pem" -subj "/C=US/CN=Localhost-Root-CA"+openssl x509 -outform pem -in "certs/RootCA.pem" -out "certs/RootCA.crt"++openssl req -new -nodes -newkey rsa:2048 -keyout "certs/localhost.key" -out "certs/localhost.csr" -subj "/C=US/ST=NoWhere/L=NoWhere/O=Localhost-Certificates/CN=localhost.local"+openssl x509 -req -sha256 -days 1024 -in "certs/localhost.csr" -CA "certs/RootCA.pem" -CAkey "certs/RootCA.key" -CAcreateserial -extfile "certs/domains.ext" -out "certs/localhost.crt"+```++Once you have these keys then to start the server in https run the below command:++```bash+/path/to/urapiexec --port 3443 --protocol http+tls --tlskey certs/localhost.key --tlscert certs/localhost.crt+```++open https://localhost:3443/health++## JWT Authentication++This template supports only authentication against standard JWT issued by Azure, Okta, Keybase & other OAuth JWT authentication providers.+However its easily customizable to authenticate against custom issued JWT token. This template does not issue a JWT token.++The validate any incoming JWT's we need the public keys (provider by JWT issuer) to verify the payload and also need to verify the audiences.+These are configurable via ENV variables++```bash+JWK_PATH="secrets/jwk.sig"+JWK_AUDIENCES="api://some-resource-id"+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ chakra.cabal view
@@ -0,0 +1,193 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: ed84bd45513e7957dd1254d806c83022fb78ac260bef475addae82254f097b0b++name:           chakra+version:        0.1.0+synopsis:       A REST Web Api server template for building (micro)services.++description:    A REST Web Api server template, that serves as a reference+                and avoids repetive boilerplate when building many (micro)services.+                This combines best libraries available in Haskell web development, like RIO, warp, servant, etc.,+                and principles around 12-factor app.+                .+                Check @'Chakra'@ module documentation for example.+                .+                Idea is to provide Curated & Opinionated set of packages and+                patterns to build well designed web api applications in Haskell.+                .+                Inspiration from Python Flask, ASP.NET Core+                .+                For more details, please see the README on Github at <https://github.com/cackharot/haskell-web-api-template#readme>+category:       Web+homepage:       https://github.com/cackharot/haskell-web-api-template#readme+bug-reports:    https://github.com/cackharot/haskell-web-api-template/issues+author:         Cackharot+maintainer:     cackharot@gmail.com+copyright:      2020 Cackharot+license:        MIT+license-file:   LICENSE+tested-with:    GHC==8.8.4+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/cackharot/haskell-web-api-template++library+  exposed-modules:+      Chakra+      Chakra.Types+      Chakra.App+      Chakra.Config+      Chakra.Logging+      Chakra.Util+      Chakra.JWT+      Network.Wai.Middleware.Health+      Network.Wai.Middleware.Info+  other-modules:+      Chakra.RequestLogging+      Paths_chakra+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+  build-depends:+      aeson+    , ansi-terminal+    , base >=4.11 && <10+    , bytestring+    , cryptonite+    , data-default+    , data-has+    , dotenv+    , envy+    , fast-logger+    , http-types+    , iproute+    , jose+    , lens+    , mtl+    , network+    , network-uri+    , options+    , prometheus-client+    , prometheus-metrics-ghc+    , rio+    , servant-auth >=0.4.0.0+    , servant-auth-server >=0.4.6.0+    , servant-server >=0.18.2+    , streaming-commons+    , string-conversions+    , text+    , time+    , transformers+    , unordered-containers+    , wai+    , wai-cli+    , wai-extra+    , wai-middleware-prometheus+    , warp+  default-language: Haskell2010++executable chakra-exe+  main-is: Main.hs+  other-modules:+      User+      Paths_chakra+  hs-source-dirs:+      examples+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T+  build-depends:+      aeson+    , ansi-terminal+    , base >=4.11 && <10+    , bytestring+    , chakra+    , cryptonite+    , data-default+    , data-has+    , dotenv+    , envy+    , fast-logger+    , http-types+    , iproute+    , jose+    , lens+    , mtl+    , network+    , network-uri+    , options+    , optparse-simple+    , prometheus-client+    , prometheus-metrics-ghc+    , rio+    , servant-auth >=0.4.0.0+    , servant-auth-server >=0.4.6.0+    , servant-server >=0.18.2+    , streaming-commons+    , string-conversions+    , text+    , time+    , transformers+    , unordered-containers+    , wai+    , wai-cli+    , wai-extra+    , wai-middleware-prometheus+    , warp+  default-language: Haskell2010++test-suite chakra-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      UtilSpec+      Paths_chakra+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , ansi-terminal+    , base >=4.11 && <10+    , bytestring+    , chakra+    , cryptonite+    , data-default+    , data-has+    , dotenv+    , envy+    , fast-logger+    , hspec+    , http-types+    , iproute+    , jose+    , lens+    , mtl+    , network+    , network-uri+    , options+    , prometheus-client+    , prometheus-metrics-ghc+    , rio+    , servant-auth >=0.4.0.0+    , servant-auth-server >=0.4.6.0+    , servant-server >=0.18.2+    , streaming-commons+    , string-conversions+    , text+    , time+    , transformers+    , unordered-containers+    , wai+    , wai-cli+    , wai-extra+    , wai-middleware-prometheus+    , warp+  default-language: Haskell2010
+ examples/Main.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Main (main) where++import RIO+import Chakra+import Servant+import Configuration.Dotenv (defaultConfig, loadFile)+import qualified Data.Text as T+import Options.Applicative.Simple+import qualified Paths_chakra+import Servant.Auth.Server as SAS+import qualified User as U++type API auths = (SAS.Auth auths AuthenticatedUser :> U.UserAPI) :<|> EmptyAPI++appAPI :: Proxy (API '[SAS.JWT])+appAPI = Proxy++main :: IO ()+main = do+  hSetBuffering stdin LineBuffering+  _ <- loadFile defaultConfig -- load .env file if available+  -- Load the AppSettings data from ENV variables+  withAppSettingsFromEnv $ \appSettings -> do+    -- Override the version from cabal file+    let ver = $(simpleVersion Paths_chakra.version) -- TH to get cabal project's git sha version+        infoDetail = appSettings {appVersion = T.pack ver}+    logFunc <- buildLogger (appEnvironment infoDetail) (appVersion infoDetail)+    userRepo <- U.newInMemRepo+    middlewares <- chakraMiddlewares infoDetail+    jwtCfg <- getJWTAuthSettings+    let cookieCfg = defaultCookieSettings {cookieIsSecure = SAS.NotSecure}+        sctx = cookieCfg :. jwtCfg :. chakraErrorFormatters :. EmptyContext+        appServer = U.server :<|> emptyServer+    -- Run API server with JWT auth and in-mem user repo+    runChakraAppWithMetrics+      middlewares+      sctx+      (logFunc, infoDetail, userRepo)+      appAPI+      appServer
+ examples/User.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}++module User (UserAppCtx, server, UserAPI, userAPI, newInMemRepo) where++import RIO+import Chakra+import Data.Aeson+import Data.Has+import qualified Data.HashMap.Strict as B+import Servant+import Servant.Auth.Server as SAS++newtype Name = Name Text+  deriving (Eq, Show, Generic)++newtype Email = Email Text+  deriving (Eq, Show, Generic)++data User = User+  { _name :: !Name,+    _email :: !Email+  }+  deriving (Eq, Show, Generic)++instance ToJSON Name++instance FromJSON Name++instance ToJSON Email++instance FromJSON Email++instance ToJSON User++instance FromJSON User++data UserRepo = UserRepo+  { _getUser :: !(Text -> IO (Maybe User)),+    _getAllUsers :: !(IO [User]),+    _insertUser :: !(Text -> User -> IO ())+  }++class HasUserRepo env where+  userRepoL :: Lens' env UserRepo++instance {-# OVERLAPPABLE #-} Has UserRepo m => HasUserRepo m where+  userRepoL = hasLens++type UserAPI =+  "users"+    :> ( Get '[JSON] [User]+           :<|> Capture "id" Text :> Get '[JSON] (Maybe User)+           :<|> ReqBody '[JSON] User :> Post '[JSON] NoContent+       )++userAPI :: Proxy UserAPI+userAPI = Proxy++type UserAppCtx = (ModLogger, InfoDetail, UserRepo)++type UserApp = RIO UserAppCtx++server (SAS.Authenticated user) = getUsers :<|> findUserById :<|> createUser+server _ = throwUnauthorized :<|> const throwUnauthorized :<|> const throwUnauthorized++newInMemRepo :: (MonadUnliftIO m) => m UserRepo+newInMemRepo = do+  store <- liftIO $ atomically $ newTVar (B.fromList defaultUsers)+  return $+    UserRepo+      { _getUser = \uid -> do+          u <- atomically $ readTVar store+          return $ B.lookup uid u,+        _getAllUsers = do+          u <- atomically $ readTVar store+          return $ B.elems u,+        _insertUser = \uid u -> do+          lst <- atomically $ readTVar store+          atomically $ writeTVar store (B.insert uid u lst)+          return ()+      }++defaultUsers :: [(Text, User)]+defaultUsers = [("1234", User (Name "name1") (Email "email@test.com"))]++getUsers :: UserApp [User]+getUsers = do+  logWarn "Fetching users from db"+  repo <- askObj+  users <- liftIO $ _getAllUsers repo+  return users++findUserById :: Text -> UserApp (Maybe User)+findUserById userId = do+  logInfoS "find" ("Find by id = " <> display userId)+  repo <- askObj+  mu <- liftIO $ _getUser repo $ userId+  return mu++createUser :: User -> UserApp NoContent+createUser u = do+  logInfoS "create" "New user created"+  repo <- askObj+  liftIO $ _insertUser repo "33" u+  return NoContent
+ src/Chakra.hs view
@@ -0,0 +1,109 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE Trustworthy #-}++{-| +This module re-exports all functionality of this package for easy use.+Users expected to import this module only.++__Examples:__++@+__import__ "Chakra"+@++== Getting started++To create a bare minimum API service all you need is below:++@+\#!\/usr\/bin\/env stack+\{\- stack --resolver lts-14.27 runghc --package chakra \-\}+\{\-\# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators \#\-\}+import RIO+import Chakra+import Servant++type HelloRoute = "hello" :> QueryParam "name" Text :> Get '[PlainText] Text+type API = HelloRoute :<|> EmptyAPI++hello :: Maybe Text -> BasicApp Text+hello name = do+  let name' = fromMaybe "Sensei!" name+  logInfo $ "Saying hello to " <> display name'+  return $ "Hello " <> name' <> "!"++main :: IO ()+main = do+  let infoDetail = InfoDetail "example" "dev" "0.1" "change me"+      appEnv = appEnvironment infoDetail+      appVer = appVersion infoDetail+      appAPI = Proxy :: Proxy API+      appServer = hello :<|> emptyServer+  logFunc <- buildLogger appEnv appVer+  middlewares <- chakraMiddlewares infoDetail+  runChakraAppWithMetrics+    middlewares+    EmptyContext+    (logFunc, infoDetail)+    appAPI+    appServer+@+-}+module Chakra+  (+    -- $main+    module Chakra.App,+    -- $config+    module Chakra.Config,+    -- $jwt+    module Chakra.JWT,+    -- $logging+    module Chakra.Logging,+    -- $types+    module Chakra.Types,+    -- $util+    module Chakra.Util,+    module Chakra,+  )+where++import Chakra.App+import Chakra.Config+import Chakra.JWT+import Chakra.Logging+import Chakra.Types+import Chakra.Util+import RIO++-- | Basic application context, mostly used in examples.+-- For real life you need to create one for your application+type BasicAppCtx = (ModLogger, InfoDetail)++-- | Nice type synonym to mark your servant handlers+-- For real life you need to create one for your application+type BasicApp = RIO BasicAppCtx+++{- $codec+ Main App functionalities+-}++{- $config+ Configuration reading from ENV utility functions+-}++{- $logging+ Logging related functionalities+-}++{- $jwt+ JWT based authentication functionalities+-}++{- $types+ Package defined Types+-}++{- $util+ Assorted conventient functions+-}
+ src/Chakra/App.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |Defines convenience functions to run a servant base api in wrap server+module Chakra.App+  ( module Chakra.App,+  )+where++import Control.Monad.Trans.Except (ExceptT (..))+import Data.Aeson+import Data.Proxy+import Network.Wai+import Network.Wai.Cli+import Network.Wai.Middleware.Health (health)+import Network.Wai.Middleware.Info (info)+import qualified Network.Wai.Middleware.Prometheus as P+import qualified Prometheus as P+import qualified Prometheus.Metric.GHC as P+import RIO+import Chakra.RequestLogging+import Servant as X hiding (And, Handler)+import qualified Servant+import qualified Chakra.Types as T (InfoDetail (..))+import Chakra.Util++-- | Setup servant with custom context so that the handers can take custom effects/ctx+chakraApp ::+  forall β χ ψ.+  ( HasServer χ ψ,+    HasContextEntry (ψ .++ DefaultErrorFormatters) ErrorFormatters+  ) =>+  -- |Servant Context e.g., EmptyContext+  Context ψ -> +  -- |Application Has stacking in tuple type e.g., (ModLogger,ModHttpClient,UserRepo)+  β ->+  -- | Servant API Proxy+  Proxy χ ->+  -- | Servant api handlers in `RIO β` monad+  ServerT χ (RIO β) ->+  -- | Returns WAI compatiable Application so you can run using wrap+  Application+chakraApp sctx ctx api app = serveWithContext api sctx $ srv ctx+  where+    srv c = hoistServerWithContext api (Proxy @ψ) (runChakraHandler c) app++-- | Starts the warp server with given middlewares, context, api definition and api server+-- Does not enable/registers GHC internal metrics+runChakraApp ::+  ( MonadIO m,+    HasServer χ ψ,+    HasContextEntry (ψ .++ DefaultErrorFormatters) ErrorFormatters+  ) =>+  -- |WAI based middlewares+  Middleware ->+  -- |Servant Context e.g., EmptyContext+  Context ψ ->+  -- |Application Has stacking in tuple type e.g., (ModLogger,ModHttpClient,UserRepo)+  β ->+  -- | Servant API Proxy+  Proxy χ ->+  -- | Servant api handlers in `RIO β` monad+  ServerT χ (RIO β) ->+  -- Runs the resulting WAI application using wai-cli `defWaiMain` function+  m ()+runChakraApp middlewares sctx ctx api apiHandlers =+  liftIO $+    defWaiMain $ middlewares $ chakraApp sctx ctx api apiHandlers++-- | Starts the warp server with given middlewares, context, api definition and api server+-- Enables prometheus metrics (with GHC internal metrics) (Needs -with-rtsopts=-T)+runChakraAppWithMetrics ::+  ( MonadIO m,+    HasServer χ ψ,+    HasContextEntry (ψ .++ DefaultErrorFormatters) ErrorFormatters+  ) =>+  -- |WAI based middlewares+  Middleware ->+  -- |Servant Context e.g., EmptyContext+  Context ψ ->+  -- |Application Has stacking in tuple type e.g., (ModLogger,ModHttpClient,UserRepo)+  β ->+  -- | Servant API Proxy+  Proxy χ ->+  -- | Servant api handlers in `RIO β` monad+  ServerT χ (RIO β) ->+  -- Runs the resulting WAI application using wai-cli `defWaiMain` function+  m ()+runChakraAppWithMetrics middlewares sctx ctx api apiHandlers = do+  _ <- registerMetrics+  runChakraApp middlewares sctx ctx api apiHandlers++-- | Return default set of middlewares applied+chakraMiddlewares :: T.InfoDetail -> IO Middleware+chakraMiddlewares infoDetail = do+  logger <-+    jsonRequestLogger (T.appEnvironment infoDetail) (T.appVersion infoDetail)+  return $ logger . P.prometheus P.def . health . info jsonInfoDetail+  where+    jsonInfoDetail = encode infoDetail++-- | Registers GHC runtime metrics so that /metrics endpoint will return rich GHC info+-- Requires `-with-rtsopts=-T`+registerMetrics :: MonadIO m => m P.GHCMetrics+registerMetrics = P.register P.ghcMetrics++-- | Custom Servant Error formatter overrides to return in JSON format+chakraErrorFormatters :: ErrorFormatters+chakraErrorFormatters =+  defaultErrorFormatters+    { bodyParserErrorFormatter = jsonErrorFormatter,+      notFoundErrorFormatter = notFoundFormatter+    }++-- | Natural transformation to run handlers in RIO monad instead of ServantT+runChakraHandler :: a -> RIO a h -> Servant.Handler h+runChakraHandler ctx a = Servant.Handler $ ExceptT $ try $ runReaderT (unRIO a) ctx
+ src/Chakra/Config.hs view
@@ -0,0 +1,19 @@+-- |Config utility module, uses System.Envy to read ENV values and builds a data+module Chakra.Config where++import qualified System.Envy as Envy+import System.IO (hPutStrLn, stderr)++-- | Read from ENVIRONMENT Variables and return your target `t` data+-- `t` should have a instance of FromEnv+-- Example: +-- @ +--    instance FromEnv MyAppSettings+-- @+withAppSettingsFromEnv :: Envy.FromEnv t => (t -> IO ()) -> IO ()+withAppSettingsFromEnv f = Envy.decodeEnv >>= callF+  where+    callF x =+      case x of+        Left e -> hPutStrLn stderr ("Error reading env: " ++ e)+        Right c -> f c
+ src/Chakra/JWT.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |Contains JWT authentication settings+module Chakra.JWT where++import           Control.Lens         (preview)+import           Control.Monad.Except (Monad (return))+import           Crypto.JOSE          (JWK, JWKSet (..))+import           Crypto.JWT           (StringOrURI, string, uri)+import qualified Data.Aeson           as Aeson+import           Data.ByteString      (readFile)+import qualified Data.Text            as T+import           Network.URI          (parseURI)+import           RIO                  (Eq ((==)), IO, Maybe (Just, Nothing),+                                       Semigroup ((<>)), const, either, error,+                                       fromMaybe, id, maybe, ($), (++))+import           Servant.Auth.Server  (IsMatch (..), JWTSettings (..),+                                       generateKey)+import           System.Environment   (lookupEnv)++-- |Build JWT settings to be used in Servant Auth context+-- Looks for `JWK_AUDIENCES` and `JWK_PATH` in environment values+-- to load the sig file and value to verify the incoming jwt audience claim+getJWTAuthSettings :: IO JWTSettings+getJWTAuthSettings = do+  jwkSet <- acquireJwks+  signKey <- generateKey+  audienceCfg <- lookupEnv "JWK_AUDIENCES"+  let audMatches = maybe (const Matches) checkAud audienceCfg+      checkAud audConfig = \tokenAud ->+        if preview uri tokenAud == parseURI audConfig then+          Matches+        else if preview string tokenAud == Just (T.pack audConfig) then+          Matches+        else+          DoesNotMatch+  return $ buildJWTSettings signKey jwkSet audMatches++buildJWTSettings :: JWK -> JWKSet -> (StringOrURI -> IsMatch) -> JWTSettings+buildJWTSettings signKey jwkSet audMatches =+  JWTSettings+    { signingKey = signKey,+      jwtAlg = Nothing,+      validationKeys = vkeys signKey jwkSet,+      audienceMatches = audMatches+    }+  where+    vkeys k (JWKSet x) = JWKSet (x ++ [k])++acquireJwks :: IO JWKSet+acquireJwks = do+  envUrl <- lookupEnv "JWK_PATH"+  let jwkPath = fromMaybe "secrets/jwk.sig" envUrl+  fileContent <- readFile jwkPath+  let parsed = Aeson.eitherDecodeStrict fileContent+  return $ either (\e -> error $ "Invalid JWK file: " <> e) id parsed
+ src/Chakra/Logging.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |Logging utility functions+module Chakra.Logging+  ( LogMessage,+    ModLogger,+    Formatter,+    jsonFormatter,+    newLogger,+    buildLogger,+  )+where++import Data.Aeson+  ( ToJSON (toEncoding),+    defaultOptions,+    encode,+    genericToEncoding,+  )+import Data.Has (Has (hasLens))+import qualified Data.Text.Encoding as T+import RIO+import System.Log.FastLogger++type ModLogger = LogFunc++type Formatter = TimedFastLogger -> CallStack -> LogSource -> LogLevel -> Utf8Builder -> IO ()++data LogMessage = LogMessage+  { message :: !Text,+    logSource :: !Text,+    callStack :: !Text,+    timestamp :: !Text,+    level :: !Text,+    appVersion :: !Text,+    appEnvironment :: !Text+  }+  deriving (Eq, Show, Generic)++instance ToJSON LogMessage where+  toEncoding = genericToEncoding defaultOptions++instance ToLogStr LogMessage where+  toLogStr a = (toLogStr . encode $ a) <> "\n"++instance {-# OVERLAPPABLE #-} Has ModLogger a => HasLogFunc a where+  logFuncL = hasLens++-- | Creates a logger module using a given formatting function.+-- | Also returns the underlying TimedFastLogger for use outside of your app (e.g. in some WAI middleware).+newLogger :: LogType -> Formatter -> IO (TimedFastLogger, ModLogger)+newLogger logtype formatter = do+  tc <- newTimeCache simpleTimeFormat'+  (fl, _cleanupAction) <- newTimedFastLogger tc logtype+  -- todo clean up+  return (fl, mkLogFunc $ formatter fl)++-- | Builds LogMessage and json encodes to string+jsonFormatter :: Text -> Text -> Formatter+jsonFormatter envName appVer logger cs src logLvl msg = logger buildJsonLogMsg+  where+    showLevel LevelDebug = "debug"+    showLevel LevelInfo = "info"+    showLevel LevelWarn = "warn"+    showLevel LevelError = "error"+    showLevel (LevelOther t) = "" <> t <> ""+    buildJsonLogMsg t =+      toLogStr $+        LogMessage+          (utf8BuilderToText msg)+          (utf8BuilderToText . displayBytesUtf8 . fromLogStr . toLogStr $ src)+          (utf8BuilderToText $ displayCallStack cs)+          (T.decodeUtf8 t)+          (showLevel logLvl)+          appVer+          envName++-- | Convenient function to create json formatted logger with appName & appVer values+buildLogger :: Text -> Text -> IO ModLogger+buildLogger envName appVer = do+  (_, lf) <- newLogger (LogStderr defaultBufSize) (jsonFormatter envName appVer)+  return lf
+ src/Chakra/RequestLogging.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE OverloadedStrings #-}++-- |Contains functions to log WAI request in JSON format+module Chakra.RequestLogging+  (jsonRequestLogger)+where++import           Data.Aeson                           as X (KeyValue ((.=)),+                                                            ToJSON (toJSON),+                                                            Value (String),+                                                            encode, object)+import qualified Data.ByteString.Builder              as BB (toLazyByteString)+import qualified Data.ByteString.Char8                as S8+import           Data.ByteString.Lazy                 (toStrict)+import           Data.Default                         (Default (def))+import           Data.IP                              (fromHostAddress,+                                                       fromIPv4)+import qualified Data.Text                            as T+import           Data.Text.Encoding                   (decodeUtf8With)+import           Data.Text.Encoding.Error             (lenientDecode)+import           Data.Time                            (NominalDiffTime)+import           Network.HTTP.Types                   as H (HttpVersion (HttpVersion),+                                                            QueryItem,+                                                            Status (statusCode))+import           Network.Socket                       (PortNumber,+                                                       SockAddr (..))+import           Network.Wai+import           Network.Wai.Middleware.RequestLogger (OutputFormat (..), OutputFormatterWithDetails,+                                                       mkRequestLogger,+                                                       outputFormat)+import           RIO                                  (Text, Word32,+                                                       maybeToList)+import           System.Log.FastLogger                (toLogStr)+import           Text.Printf                          (printf)++-- | JSON formatted request log middleware for WAI applications+-- | it logs the given appName and appVer values+jsonRequestLogger :: Text -> Text -> IO Middleware+jsonRequestLogger envName appVer =+  mkRequestLogger $+  def {outputFormat = CustomOutputFormatWithDetails (formatAsJSONCustom envName appVer)}++formatAsJSONCustom :: Text -> Text -> OutputFormatterWithDetails+formatAsJSONCustom envName appVer date req status responseSize duration reqBody response =+  toLogStr+    (encode $+     object+       [ "env" .= envName+       , "appVersion" .= appVer+       , "request" .= requestToJSON req reqBody (Just duration)+       , "response" .=+         object+           [ "status" .= statusCode status+           , "size" .= responseSize+           , "body" .=+             if statusCode status >= 400+               then Just .+                    decodeUtf8With lenientDecode .+                    toStrict . BB.toLazyByteString $+                    response+               else Nothing+           ]+       , "time" .= decodeUtf8With lenientDecode date+       ]) <>+  "\n"++requestToJSON :: Request -> [S8.ByteString] -> Maybe NominalDiffTime -> Value+requestToJSON req reqBody duration =+  object $+  [ "method" .= decodeUtf8With lenientDecode (requestMethod req)+  , "path" .= decodeUtf8With lenientDecode (rawPathInfo req)+  , "queryString" .= map queryItemToJSON (queryString req)+  , "size" .= requestBodyLengthToJSON (requestBodyLength req)+  , "body" .= decodeUtf8With lenientDecode (S8.concat reqBody)+  , "remoteHost" .= sockToJSON (remoteHost req)+  , "httpVersion" .= httpVersionToJSON (httpVersion req)+      -- , "headers" .= requestHeadersToJSON (requestHeaders req)+  ] <>+  maybeToList+    (("durationMs" .=) .+     readAsDouble . printf "%.2f" . rationalToDouble . (* 1000) . toRational <$>+     duration)+  where+    rationalToDouble :: Rational -> Double+    rationalToDouble = fromRational++readAsDouble :: String -> Double+readAsDouble = read++queryItemToJSON :: QueryItem -> Value+queryItemToJSON (name, mValue) =+  toJSON+    ( decodeUtf8With lenientDecode name+    , fmap (decodeUtf8With lenientDecode) mValue)++word32ToHostAddress :: Word32 -> Text+word32ToHostAddress = T.intercalate "." . map (T.pack . show) . fromIPv4 . fromHostAddress++sockToJSON :: SockAddr -> Value+sockToJSON (SockAddrInet pn ha) =+  object ["port" .= portToJSON pn, "hostAddress" .= word32ToHostAddress ha]+sockToJSON (SockAddrInet6 pn _ ha _) =+  object ["port" .= portToJSON pn, "hostAddress" .= ha]+sockToJSON (SockAddrUnix sock) =+  object ["unix" .= sock]++portToJSON :: PortNumber -> Value+portToJSON = toJSON . toInteger++httpVersionToJSON :: HttpVersion -> Value+httpVersionToJSON (HttpVersion major minor) = String $ T.pack (show major) <> "." <> T.pack (show minor)++requestBodyLengthToJSON :: RequestBodyLength -> Value+requestBodyLengthToJSON ChunkedBody     = String "Unknown"+requestBodyLengthToJSON (KnownLength l) = toJSON l
+ src/Chakra/Types.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE NoImplicitPrelude    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE UndecidableInstances #-}++-- |Types+module Chakra.Types where++import Data.Default+import qualified Data.Aeson             as A+import qualified Data.Text              as T+import           RIO+import           Servant.Auth.Server+import           System.Envy++data InfoDetail = InfoDetail+  { appName        :: !Text,+    appEnvironment :: !Text,+    appVersion     :: !Text,+    appDescription :: !Text+  }+  deriving (Show, Eq, Generic)++instance FromEnv InfoDetail++instance Default InfoDetail where+  def = InfoDetail "example" "dev" "0.1" "change me"++instance A.ToJSON InfoDetail where+  toJSON =+    A.genericToJSON+      A.defaultOptions {A.fieldLabelModifier = A.camelTo2 '_' . drop 3}++data AuthenticatedUser = AuthenticatedUser+  { aud   :: !Text,+    iss   :: !Text,+    appid :: !Text,+    aio   :: !Text,+    oid   :: !Text,+    sub   :: !Text,+    tid   :: !Text+  }+  deriving (Show, Generic)++instance A.ToJSON AuthenticatedUser++instance A.FromJSON AuthenticatedUser++instance ToJWT AuthenticatedUser++instance FromJWT AuthenticatedUser where+  decodeJWT m = case A.fromJSON . A.toJSON $ m of+    A.Error e   -> Left $ T.pack e+    A.Success a -> Right a
+ src/Chakra/Util.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE NoImplicitPrelude    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UnicodeSyntax        #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |As name suggests few utilities to make life easier+module Chakra.Util+where++import           Data.Aeson+import qualified Data.ByteString.Lazy as L (ByteString)+import           Data.Has+-- import           Data.Text.Encoding       (decodeUtf8With)+-- import           Data.Text.Encoding.Error (lenientDecode)+import           Network.HTTP.Types   (hContentType)+import           Network.Wai+import           RIO+import           Servant++-- | Construct plain ServerError Type with given status code and error text+errText :: ServerError -> L.ByteString -> ServerError+errText e t =+  e {errHeaders = [(hContentType, "text/plain; charset=utf-8")], errBody = t}++-- | Creates and throws a simple text/plain ServerError.+throwErrText :: MonadThrow u => ServerError -> L.ByteString -> u a+throwErrText e t = throwM $ errText e t++-- | Throws Unauthorized error+throwUnauthorized :: MonadThrow u => u a+throwUnauthorized = throwM $ errText err401 "Unauthorized access!"++-- | Custom JSON payload error formatter+jsonErrorFormatter :: ErrorFormatter+jsonErrorFormatter _tr _req err =+  err400 {errBody = encode err, errHeaders = [("Content-Type", "application/json; charset=utf-8")]}++-- | Custom JSON payload error formatter for 404+notFoundFormatter :: NotFoundErrorFormatter+notFoundFormatter req =+  err404+    { errBody = encode b+    , errHeaders = [("Content-Type", "application/json; charset=utf-8")]+    }+  where+    dl = decodeUtf8With lenientDecode+    b =+      object+        [ "error_code" .= dl "404"+        , "error_message" .= dl "NotFound"+        , "path" .= dl (rawPathInfo req)+        ]++-- | 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
+ src/Network/Wai/Middleware/Health.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Middleware.Health+       (health)+where++import           Network.HTTP.Types        (methodGet, status200)+import           Network.HTTP.Types.Header (hContentType)+import           Network.Wai++health :: Middleware+health app req sendResponse =+  case rawPathInfo req of+    "/health" ->+      if getReq+        then healthy+        else next+    _ -> next+  where+    next = app req sendResponse+    getReq = requestMethod req == methodGet+    healthy = sendResponse $ responseLBS status200 headers "Healthy"+    headers = [(hContentType, "text/plain")]
+ src/Network/Wai/Middleware/Info.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Middleware.Info+       (info)+where++import qualified Data.ByteString.Lazy      as LB+import           Network.HTTP.Types        (methodGet, status200)+import           Network.HTTP.Types.Header (hContentType)+import           Network.Wai++info :: LB.ByteString -> Middleware+info payload app req sendResponse =+  case rawPathInfo req of+    "/info" ->+      if getReq+        then returnInfo+        else next+    _ -> next+  where+    next = app req sendResponse+    getReq = requestMethod req == methodGet+    returnInfo = sendResponse $ responseLBS status200 headers payload+    headers = [(hContentType, "application/json")]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/UtilSpec.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE NoImplicitPrelude #-}++module UtilSpec (spec) where++import RIO+import Test.Hspec+import Test.Hspec.QuickCheck++spec :: Spec+spec = do+  describe "Bool" $ do+    it "works with True" $+      True `shouldBe` True++    it "works with False" $+      False `shouldBe` False++    it "works with True and False" $+      True `shouldBe` not False