v1.2.1 should show last 10 calls. not all calls. (b8c26644) · Commits · Yuanle Song / get-client-ip

Lib.hs

0 → 100644

+15 −0

Original line number	Diff line number	Diff line
		module Lib ( boundedPushRight
		) where

		import qualified Data.Sequence as S

		-- \| use Seq as a ring buffer. push new item to Seq on the right, if length is
		-- greater than given size, remove item from the left, so that size is always
		-- within maxSize.
		boundedPushRight :: S.Seq a -> Int -> a -> S.Seq a
		boundedPushRight buffer maxSize item =
		if S.length buffer == maxSize
		then
		(S.\|>) (S.drop 1 buffer) item
		else
		(S.\|>) buffer item

LibTest.hs

0 → 100644

+24 −0

Original line number	Diff line number	Diff line
		import Lib
		import qualified Data.Sequence as S
		import qualified Data.Foldable as F
		import Test.Hspec

		{-# ANN module ("HLint: ignore Redundant do" :: String) #-}

		main :: IO ()
		main = hspec $ do
		describe "boundedPushRight" $ do
		it "should work" $ do
		let buf = S.empty :: S.Seq Int

		let buf1 = boundedPushRight buf 3 1
		F.toList buf1 `shouldBe` [1]

		let buf2 = boundedPushRight buf1 3 2
		F.toList buf2 `shouldBe` [1, 2]

		let buf3 = boundedPushRight buf2 3 3
		F.toList buf3 `shouldBe` [1, 2, 3]

		let buf4 = boundedPushRight buf3 3 4
		F.toList buf4 `shouldBe` [2, 3, 4]

LucidDemo.hs

+9 −4

Original line number	Diff line number	Diff line
		import Data.Text.Lazy (Text)
		import qualified Data.Text.Lazy.IO as LIO
		import qualified Data.Text.Lazy as L
		import Lucid
		import Test.Hspec

		{-# ANN module ("HLint: ignore Redundant do" :: String) #-}

		value1 :: Text
		value1 = "value1"
		@@ -19,6 +22,8 @@ demoPage = return $ renderText $ do
		td_ "value3"

		main :: IO ()
		main = do
		main = hspec $ do
		describe "demoPage" $ do
		it "should work" $ do
		text <- demoPage
		LIO.putStrLn text
		text `shouldBe` L.pack "<head><title>recent calls</title></head><body><table><tr><th>field1</th><th>field2</th><th>field3</th></tr><tr><td>value1</td><td>value2</td><td>value3</td></tr></table></body>"

Main.hs

+16 −11

Original line number	Diff line number	Diff line
		{-# LANGUAGE OverloadedStrings #-}

		import Control.Applicative ((<\|>), liftA2)
		import Data.Monoid ((<>))
		import Data.Maybe (fromMaybe)
		@@ -8,6 +6,7 @@ import qualified Data.Text.Lazy as L
		import Text.Read (readMaybe)
		import Data.List.Extra (lower)
		import qualified Data.Sequence as S
		import Lib (boundedPushRight)
		import Control.Concurrent.MVar
		import Control.Monad (when)
		import Control.Monad.IO.Class (liftIO)
		@@ -23,6 +22,8 @@ import System.Environment (lookupEnv)
		import Network.HTTP.Types (StdMethod(HEAD) , status404)
		import Web.Scotty

		{-# ANN module ("HLint: ignore Redundant do" :: String) #-}

		-- in RAM call history for most recent 10 calls.
		data CallHistory = CallHistory {
		chTime :: Text
		@@ -32,6 +33,7 @@ data CallHistory = CallHistory {

		data RuntimeConfig = RuntimeConfig {
		rcServeHistoryPage :: Bool
		, rcHistorySize :: Int
		, rcCallHistory :: MVar (S.Seq CallHistory)
		}

		@@ -71,7 +73,8 @@ writeCallHistoryMaybe rc rawIP =
		chTime = time
		, chClientIP = rawIP
		, chUserAgent = fromMaybe "unknown" userAgent}
		liftIO $ putMVar (rcCallHistory rc) ((S.\|>) callHistory newEntry)
		liftIO $ putMVar (rcCallHistory rc)
		(boundedPushRight callHistory (rcHistorySize rc) newEntry)

		getClientIP :: RuntimeConfig -> ActionM ()
		getClientIP rc = do
		@@ -91,9 +94,6 @@ getEnvDefault variable defaultValue stringReader = do
		Just [] -> defaultValue
		Just xs -> fromMaybe defaultValue (stringReader xs)

		getListenPort :: IO Int
		getListenPort = getEnvDefault "PORT" 8081 readMaybe

		readBoolMaybe :: String -> Maybe Bool
		readBoolMaybe str = Just (lower str `elem` ["true", "yes", "1"])

		@@ -122,7 +122,9 @@ buildHistoryHtml rc = do
		html_ [lang_ "en"] $ do
		head_ $ do
		title_ "recent calls"
		body_ $ table_ $ do
		body_ $ do
		p_ $ toHtml $ "recent " <> show (rcHistorySize rc) <> " entries are saved"
		table_ $ do
		thead
		tbody

		@@ -143,12 +145,15 @@ showHistory rc =

		main :: IO ()
		main = do
		port <- getListenPort
		port <- getEnvDefault "PORT" 8081 readMaybe
		serveHistoryPage <- getEnvDefault "SERVE_HISTORY_PAGE" False readBoolMaybe
		when serveHistoryPage $
		historySize <- getEnvDefault "HISTORY_SIZE" 10 readMaybe
		when serveHistoryPage $ do
		putStrLn "Enabled GET /_calls api"
		putStrLn $ "Keep a maximum of " <> show historySize <> " call history"
		callHistory <- newMVar S.empty
		let rc = RuntimeConfig { rcServeHistoryPage = serveHistoryPage
		, rcHistorySize = historySize
		, rcCallHistory = callHistory}
		scotty port $ do
		get "/" (getClientIP rc)

get-client-ip.cabal

+16 −2

Original line number	Diff line number	Diff line
		name: get-client-ip
		version: 1.2.0
		version: 1.2.1
		cabal-version: >= 1.8
		build-type: Simple

		executable get-client-ip
		hs-source-dirs: .
		main-is: Main.hs
		other-modules: Lib
		ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N
		extensions: OverloadedStrings
		build-depends: base >= 4 && < 5
		@@ -17,7 +18,19 @@ executable get-client-ip
		, time
		, lucid

		executable lucid-demo
		test-suite lib-test
		type: exitcode-stdio-1.0
		hs-source-dirs: .
		main-is: LibTest.hs
		other-modules: Lib
		ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N
		extensions: OverloadedStrings
		build-depends: base >= 4 && < 5
		, containers
		, hspec

		test-suite lucid-demo
		type: exitcode-stdio-1.0
		hs-source-dirs: .
		main-is: LucidDemo.hs
		ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N
		@@ -25,3 +38,4 @@ executable lucid-demo
		build-depends: base >= 4 && < 5
		, lucid
		, text
		, hspec