diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # 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) +[![Hackage](https://img.shields.io/hackage/v/chakra.svg)](https://hackage.haskell.org/package/chakra) [![Build Status](https://github.com/cackharot/haskell-web-api-template/workflows/Chakra%20CI/badge.svg)](https://github.com/cackharot/haskell-web-api-template/actions?query=workflow%3A%22Chakra+CI%22) [![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. @@ -36,7 +36,7 @@ ```haskell #!/usr/bin/env stack -{- stack --resolver lts-14.27 runghc +{- stack --resolver lts-18.14 runghc --package chakra -} {-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, DataKinds, TypeOperators #-} @@ -90,18 +90,11 @@ - servant-server # stack.yaml -resolver: lts-14.27 +resolver: lts-18.14 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 +- chakra-0.1.1 ``` A stack project template is also available for bootstraping quickly diff --git a/chakra.cabal b/chakra.cabal --- a/chakra.cabal +++ b/chakra.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack -- --- hash: ed84bd45513e7957dd1254d806c83022fb78ac260bef475addae82254f097b0b +-- hash: e0ea050f431aab024199de31ebbeaa04193373c1703450ee2efdd26f817d5445 name: chakra -version: 0.1.0 +version: 0.1.1 synopsis: A REST Web Api server template for building (micro)services. description: A REST Web Api server template, that serves as a reference @@ -31,7 +31,8 @@ copyright: 2020 Cackharot license: MIT license-file: LICENSE -tested-with: GHC==8.8.4 +tested-with: + GHC==8.10.7 build-type: Simple extra-source-files: README.md @@ -59,35 +60,25 @@ 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 + , servant-auth + , servant-auth-server + , servant-server , transformers - , unordered-containers , wai , wai-cli , wai-extra @@ -105,7 +96,6 @@ 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 @@ -118,22 +108,15 @@ , 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 + , servant-auth + , servant-auth-server + , servant-server , transformers , unordered-containers , wai @@ -154,37 +137,27 @@ 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 + , servant-auth + , servant-auth-server + , servant-server , transformers - , unordered-containers , wai , wai-cli , wai-extra diff --git a/examples/Main.hs b/examples/Main.hs --- a/examples/Main.hs +++ b/examples/Main.hs @@ -1,23 +1,34 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} 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 Chakra +import Configuration.Dotenv (defaultConfig, loadFile) +import Options.Applicative.Simple import qualified Paths_chakra -import Servant.Auth.Server as SAS -import qualified User as U +import RIO +import qualified RIO.Text as T +import Servant +import Servant.Auth.Server as SAS +import qualified User as U -type API auths = (SAS.Auth auths AuthenticatedUser :> U.UserAPI) :<|> EmptyAPI +type HelloRoute = "hello" :> QueryParam "name" Text :> Get '[PlainText] Text + +type API auths = (SAS.Auth auths AuthenticatedUser :> U.UserAPI) + :<|> HelloRoute :<|> EmptyAPI + +hello :: Maybe Text -> U.UserApp Text +hello name = do + let name' = fromMaybe "Sensei!" name + logInfo $ "Saying hello to " <> display name' + return $ "Hello " <> name' <> "!" + + appAPI :: Proxy (API '[SAS.JWT]) appAPI = Proxy @@ -36,7 +47,7 @@ jwtCfg <- getJWTAuthSettings let cookieCfg = defaultCookieSettings {cookieIsSecure = SAS.NotSecure} sctx = cookieCfg :. jwtCfg :. chakraErrorFormatters :. EmptyContext - appServer = U.server :<|> emptyServer + appServer = U.server :<|> hello :<|> emptyServer -- Run API server with JWT auth and in-mem user repo runChakraAppWithMetrics middlewares diff --git a/examples/User.hs b/examples/User.hs --- a/examples/User.hs +++ b/examples/User.hs @@ -1,21 +1,21 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE NoImplicitPrelude #-} -module User (UserAppCtx, server, UserAPI, userAPI, newInMemRepo) where +module User (UserAppCtx, UserApp, server, UserAPI, userAPI, newInMemRepo) where -import RIO -import Chakra -import Data.Aeson -import Data.Has +import Chakra +import Data.Aeson +import Data.Has import qualified Data.HashMap.Strict as B -import Servant -import Servant.Auth.Server as SAS +import RIO +import Servant +import Servant.Auth.Server as SAS newtype Name = Name Text deriving (Eq, Show, Generic) @@ -24,7 +24,7 @@ deriving (Eq, Show, Generic) data User = User - { _name :: !Name, + { _name :: !Name, _email :: !Email } deriving (Eq, Show, Generic) @@ -42,9 +42,9 @@ instance FromJSON User data UserRepo = UserRepo - { _getUser :: !(Text -> IO (Maybe User)), + { _getUser :: !(Text -> IO (Maybe User)), _getAllUsers :: !(IO [User]), - _insertUser :: !(Text -> User -> IO ()) + _insertUser :: !(Text -> User -> IO ()) } class HasUserRepo env where diff --git a/src/Chakra.hs b/src/Chakra.hs --- a/src/Chakra.hs +++ b/src/Chakra.hs @@ -1,7 +1,7 @@ {-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE Trustworthy #-} -{-| +{-| This module re-exports all functionality of this package for easy use. Users expected to import this module only. @@ -67,13 +67,13 @@ ) where -import Chakra.App -import Chakra.Config -import Chakra.JWT -import Chakra.Logging -import Chakra.Types -import Chakra.Util -import RIO +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 diff --git a/src/Chakra/App.hs b/src/Chakra/App.hs --- a/src/Chakra/App.hs +++ b/src/Chakra/App.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UnicodeSyntax #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UnicodeSyntax #-} -- |Defines convenience functions to run a servant base api in wrap server module Chakra.App @@ -12,22 +12,22 @@ ) 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 Chakra.RequestLogging +import qualified Chakra.Types as T (InfoDetail (..)) +import Chakra.Util +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 Prometheus as P +import qualified Prometheus.Metric.GHC as P +import RIO +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 :: @@ -36,7 +36,7 @@ HasContextEntry (ψ .++ DefaultErrorFormatters) ErrorFormatters ) => -- |Servant Context e.g., EmptyContext - Context ψ -> + Context ψ -> -- |Application Has stacking in tuple type e.g., (ModLogger,ModHttpClient,UserRepo) β -> -- | Servant API Proxy diff --git a/src/Chakra/JWT.hs b/src/Chakra/JWT.hs --- a/src/Chakra/JWT.hs +++ b/src/Chakra/JWT.hs @@ -5,37 +5,29 @@ -- |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) +import Crypto.JOSE (JWK, JWKSet (..)) +import Crypto.JWT (StringOrURI, string, uri) +import qualified Data.Aeson as Aeson +import Network.URI (parseURI) +import RIO +import RIO.ByteString (readFile) +import qualified RIO.Text as T +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 :: MonadUnliftIO m => m JWTSettings getJWTAuthSettings = do - jwkSet <- acquireJwks - signKey <- generateKey - audienceCfg <- lookupEnv "JWK_AUDIENCES" + jwkSet <- liftIO acquireJwks + signKey <- liftIO generateKey + audienceCfg <- liftIO $ 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 + if RIO.preview uri tokenAud == parseURI audConfig || RIO.preview string tokenAud == Just (T.pack audConfig) then + Matches else DoesNotMatch return $ buildJWTSettings signKey jwkSet audMatches buildJWTSettings :: JWK -> JWKSet -> (StringOrURI -> IsMatch) -> JWTSettings diff --git a/src/Chakra/Logging.hs b/src/Chakra/Logging.hs --- a/src/Chakra/Logging.hs +++ b/src/Chakra/Logging.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -18,28 +18,23 @@ ) 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 +import Data.Aeson (ToJSON (toEncoding), defaultOptions, + encode, genericToEncoding) +import Data.Has (Has (hasLens)) +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, + { message :: !Text, + logSource :: !Text, + callStack :: !Text, + timestamp :: !Text, + level :: !Text, + appVersion :: !Text, appEnvironment :: !Text } deriving (Eq, Show, Generic) @@ -66,10 +61,10 @@ 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 LevelDebug = "debug" + showLevel LevelInfo = "info" + showLevel LevelWarn = "warn" + showLevel LevelError = "error" showLevel (LevelOther t) = "" <> t <> "" buildJsonLogMsg t = toLogStr $ @@ -77,7 +72,7 @@ (utf8BuilderToText msg) (utf8BuilderToText . displayBytesUtf8 . fromLogStr . toLogStr $ src) (utf8BuilderToText $ displayCallStack cs) - (T.decodeUtf8 t) + (utf8BuilderToText . displayBytesUtf8 $ t) (showLevel logLvl) appVer envName diff --git a/src/Chakra/RequestLogging.hs b/src/Chakra/RequestLogging.hs --- a/src/Chakra/RequestLogging.hs +++ b/src/Chakra/RequestLogging.hs @@ -10,26 +10,28 @@ 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, +import Network.Wai.Middleware.RequestLogger (OutputFormat (..), + OutputFormatterWithDetails, mkRequestLogger, outputFormat) import RIO (Text, Word32, + decodeUtf8With, + lenientDecode, maybeToList) +import qualified RIO.ByteString as B (ByteString, concat) +import qualified RIO.ByteString.Lazy as BL +import qualified RIO.Text as T +import RIO.Time (NominalDiffTime) import System.Log.FastLogger (toLogStr) import Text.Printf (printf) @@ -56,22 +58,21 @@ if statusCode status >= 400 then Just . decodeUtf8With lenientDecode . - toStrict . BB.toLazyByteString $ - response + BL.toStrict . BB.toLazyByteString $ response else Nothing ] , "time" .= decodeUtf8With lenientDecode date ]) <> "\n" -requestToJSON :: Request -> [S8.ByteString] -> Maybe NominalDiffTime -> Value +requestToJSON :: Request -> [B.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) + , "body" .= decodeUtf8With lenientDecode (B.concat reqBody) , "remoteHost" .= sockToJSON (remoteHost req) , "httpVersion" .= httpVersionToJSON (httpVersion req) -- , "headers" .= requestHeadersToJSON (requestHeaders req) diff --git a/src/Chakra/Types.hs b/src/Chakra/Types.hs --- a/src/Chakra/Types.hs +++ b/src/Chakra/Types.hs @@ -8,10 +8,10 @@ -- |Types module Chakra.Types where -import Data.Default -import qualified Data.Aeson as A -import qualified Data.Text as T +import qualified Data.Aeson as A +import Data.Default import RIO +import qualified RIO.Text as T import Servant.Auth.Server import System.Envy diff --git a/src/Chakra/Util.hs b/src/Chakra/Util.hs --- a/src/Chakra/Util.hs +++ b/src/Chakra/Util.hs @@ -9,13 +9,11 @@ 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.HTTP.Types (hContentType) import Network.Wai import RIO +import qualified RIO.ByteString.Lazy as L (ByteString) import Servant -- | Construct plain ServerError Type with given status code and error text diff --git a/src/Network/Wai/Middleware/Info.hs b/src/Network/Wai/Middleware/Info.hs --- a/src/Network/Wai/Middleware/Info.hs +++ b/src/Network/Wai/Middleware/Info.hs @@ -3,10 +3,10 @@ (info) where -import qualified Data.ByteString.Lazy as LB import Network.HTTP.Types (methodGet, status200) import Network.HTTP.Types.Header (hContentType) import Network.Wai +import qualified RIO.ByteString.Lazy as LB info :: LB.ByteString -> Middleware info payload app req sendResponse =