a403d84 · denis · git.iko.soy

git.iko.soy/denis

Added request logger

commita403d84b76b5cd94981518ae70ef82a70feb6373 authoriko <ilyakooo0@gmail.com> dateMon 25 Feb 2019, 23:01 (8 years ago) parentec69be5

7 files changed+97−8

compare with master

unifiedsplit

denis/docs/Docs.hs+5−1 denis/package.yaml+5 denis/src/Data/CyclicBuffer.hs+16 denis/src/Server/API.hs+9−5 denis/src/Server/App.hs+3−1 denis/src/Server/Logger.hs+55 denis/src/Server/Server.hs+4−1

denis/docs/Docs.hs+5−1

@@ -21,6 +21,7 @@ import Data.Int (Int64)

2121import Data.Word (Word64)

2222import Server.API.Posts

2323import Server.API.Draft

24+import Server.Logger

2425

2526main = writeFile "docs.md" . markdown . docs . pretty $ serverProxy

2627

@@ -56,4 +57,7 @@ instance ToSample UserPostsRequest where

5657 toSamples _ = samples [UserPostsRequest 8 10, UserPostsRequest 42 20]

5758

5859instance ToSample DraftUpdate where

59− toSamples _ = samples $ [DraftUpdate 8] <*> (map snd $ toSamples Proxy)

60+ toSamples _ = samples $ [DraftUpdate 8] <*> (map snd $ toSamples Proxy)

61+

62+instance ToSample Log where

63+ toSamples _ = samples ["Log"]

denis/package.yaml+5

@@ -43,6 +43,11 @@ dependencies:

4343- http-types

4444- mmorph

4545- servant-docs

46+- stm

47+- case-insensitive

48+- wai-extra

49+- data-default-class

50+- fast-logger

4651

4752- lens

4853

denis/src/Data/CyclicBuffer.hsnew file+16

@@ -0,0 +1,16 @@

1+module Data.CyclicBuffer (

2+ CyclicBuffer(elems),

3+ mkCyclicBuffer,

4+ insertIntoCyclicBuffer

5+) where

7+data CyclicBuffer a = CyclicBuffer {

8+ elems :: [a],

9+ limit :: Int

10+}

11+

12+mkCyclicBuffer :: Int -> CyclicBuffer a

13+mkCyclicBuffer lim = CyclicBuffer [] lim

14+

15+insertIntoCyclicBuffer :: CyclicBuffer a -> a -> CyclicBuffer a

16+insertIntoCyclicBuffer (CyclicBuffer els lim) el = CyclicBuffer (take lim $ el:els) lim

denis/src/Server/API.hs+9−5

@@ -6,7 +6,7 @@

66module Server.API (

77 API,

88 serverProxy,

9− serverAPI

9+ mkServerAPI

1010) where

1111

1212import Data.Proxy

@@ -26,14 +26,16 @@ import Server.App

2626import Control.Monad.Error

2727import Server.API.Draft

2828import Server.API.Posts

29+import Server.Logger

2930

3031maybeNotFound :: App (Maybe a) -> App a

3132maybeNotFound = (>>= (\t -> case t of

3233 Just y -> return y

3334 Nothing -> throwError err404))

3435

35−type API = "authenticate" :> AuthenticationHandler

36− :<|>

36+type API =

37+ LoggerAPI :<|>

38+ "authenticate" :> AuthenticationHandler :<|>

3739 AuthProtect "basicAuth" :> (

3840 "users" :> ReqBody '[JSON] [UserId] :> Post '[JSON] [User] :<|>

3941 "posts" :> PostApi :<|>

@@ -43,8 +45,10 @@ type API = "authenticate" :> AuthenticationHandler

4345serverProxy :: Proxy API

4446serverProxy = Proxy

4547

46−serverAPI :: ServerT API App

47−serverAPI = authenticate :<|> (\uId ->

48+mkServerAPI :: Logger -> ServerT API App

49+mkServerAPI l =

50+ l :<|>

51+ authenticate :<|> (\uId ->

4852 mapM (runQnotFound . getUser) :<|>

4953 postApi uId :<|>

5054 draftApi uId

denis/src/Server/App.hs+3−1

@@ -11,7 +11,8 @@ module Server.App (

1111 DBConnection,

1212 Config(..),

1313 ask,

14− asks

14+ asks,

15+ liftIO

1516) where

1617

1718import Servant.Server

@@ -20,6 +21,7 @@ import Squeal.PostgreSQL.Pool

2021import Data.Schema

2122import Generics.SOP (K)

2223import Squeal.PostgreSQL.PQ (Connection)

24+import Control.Monad.IO.Class

2325

2426type App = ReaderT Config Handler

2527

denis/src/Server/Logger.hsnew file+55

@@ -0,0 +1,55 @@

1+{-# LANGUAGE DataKinds,

2+ TypeOperators,

3+ OverloadedStrings,

4+ ScopedTypeVariables #-}

6+module Server.Logger (

7+ Logger,

8+ LoggerAPI,

9+ mkLogger,

10+ Log

11+) where

12+

13+import Network.Wai

14+import Control.Concurrent.STM

15+import Data.CyclicBuffer

16+import Servant

17+import Servant.API

18+import Servant.Server

19+import Data.Text.Encoding

20+import qualified Data.Text as T

21+import Data.Foldable

22+import qualified Data.ByteString as BL

23+import Data.List

24+import Server.App

25+import Data.CaseInsensitive (original)

26+import Data.Monoid ((<>), mempty, mappend)

27+import Network.HTTP.Types.Header

28+import Network.Wai.Middleware.RequestLogger

29+import Data.Default.Class

30+import qualified System.Log.FastLogger as FL

31+import Data.ByteString.Char8 (unpack)

32+

33+type Log = T.Text

34+

35+type LoggerAPI = "log" :> Get '[PlainText] Log

36+type Logger = App Log

37+

38+mkLogger :: Int -> IO (Middleware, Logger)

39+mkLogger lim = do

40+ buff <- newTVarIO $ mkCyclicBuffer lim

41+ logger <- mkWaiLogger buff

42+ return (logger, getLog buff)

43+

44+getLog :: TVar (CyclicBuffer BL.ByteString) -> Logger

45+getLog buff = decodeUtf8 . BL.concat . intersperse "\n" . elems <$> liftIO (readTVarIO buff)

46+

47+mkWaiLogger :: TVar (CyclicBuffer BL.ByteString) -> IO Middleware

48+mkWaiLogger buff = let

49+ settings = def {

50+ -- outputFormat = CustomOutputFormatWithDetails (\ date req _ _ tDiff bss bldr ->

51+ -- FL.toLogStr (show date) <> (FL.toLogStr . unpack $ fold bss))

52+ outputFormat = Detailed False,

53+ destination = Callback (atomically . modifyTVar buff . flip insertIntoCyclicBuffer . FL.fromLogStr)

54+ }

55+ in mkRequestLogger settings

denis/src/Server/Server.hs+4−1

@@ -17,6 +17,7 @@ import Data.Maybe

1717import Control.Monad.Reader

1818import Network.Wai.Handler.Warp

1919import Network.HTTP.Types.Method

20+import Server.Logger

2021

2122import Network.Wai.Middleware.Cors

2223

@@ -40,8 +41,10 @@ runServer = do

4041 port <- getServerPort

4142 cfg <- getConfig

4243 let ctx = genAuthServerContext $ getPool cfg

44+ (middleLogger, logger) <- mkLogger 50

45+ let serverAPI = mkServerAPI logger

4346 let s = hoistServerWithContext serverProxy contextProxy (flip runReaderT cfg) serverAPI

44− runSettings (settings port) $ cors (const $ Just policy) $ serveWithContext serverProxy ctx s

47+ runSettings (settings port) $ cors (const $ Just policy) . middleLogger $ serveWithContext serverProxy ctx s

4548 -- TODO: remove simpleCors

4649

4750-- runServer :: IO ()