From aaff5a12bf545947e2b56b861255db5269327850 Mon Sep 17 00:00:00 2001
From: Yuanle Song <sylecn@gmail.com>
Date: Tue, 2 Apr 2019 18:12:53 +0800
Subject: [PATCH] v1.2.0 add optional GET /_calls api
this feature can be enabled by environment variable SERVE_HISTORY_PAGE=1
---
LucidDemo.hs | 24 +++++++++
Main.hs | 115 +++++++++++++++++++++++++++++++++++++++++---
get-client-ip.cabal | 15 +++++-
operational | 86 +++++++++++++++++++++++++++++++++
4 files changed, 232 insertions(+), 8 deletions(-)
create mode 100644 LucidDemo.hs
create mode 100644 operational
diff --git a/LucidDemo.hs b/LucidDemo.hs
new file mode 100644
index 0000000..83fc2a9
--- /dev/null
+++ b/LucidDemo.hs
@@ -0,0 +1,24 @@
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy.IO as LIO
+import Lucid
+
+value1 :: Text
+value1 = "value1"
+
+demoPage :: IO Text
+demoPage = return $ renderText $ do
+ head_ (title_ "recent calls")
+ body_ $ table_ $ do
+ tr_ $ do
+ th_ "field1"
+ th_ "field2"
+ th_ "field3"
+ tr_ $ do
+ td_ (toHtml value1)
+ td_ "value2"
+ td_ "value3"
+
+main :: IO ()
+main = do
+ text <- demoPage
+ LIO.putStrLn text
diff --git a/Main.hs b/Main.hs
index 3c1eb2a..5dec6d9 100644
--- a/Main.hs
+++ b/Main.hs
@@ -6,10 +6,35 @@ import Data.Maybe (fromMaybe)
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as L
import Text.Read (readMaybe)
+import Data.List.Extra (lower)
+import qualified Data.Sequence as S
+import Control.Concurrent.MVar
+import Control.Monad (when)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Foldable as F
+import Data.Time ( getCurrentTime
+ , formatTime
+ , defaultTimeLocale
+ , TimeZone(..)
+ , utcToZonedTime
+ )
+import Lucid
import System.Environment (lookupEnv)
-import Network.HTTP.Types (StdMethod(HEAD))
+import Network.HTTP.Types (StdMethod(HEAD) , status404)
import Web.Scotty
+-- in RAM call history for most recent 10 calls.
+data CallHistory = CallHistory {
+ chTime :: Text
+ , chClientIP :: Text
+ , chUserAgent :: Text
+ } deriving (Show)
+
+data RuntimeConfig = RuntimeConfig {
+ rcServeHistoryPage :: Bool
+ , rcCallHistory :: MVar (S.Seq CallHistory)
+ }
+
getClientIP1 :: ActionM (Maybe Text)
getClientIP1 = header "CLIENT-IP"
@@ -26,12 +51,34 @@ getClientIP3 = foldl1 (liftA2 (<|>)) $ map header ["X-FORWARDED"
,"FORWARDED"
,"REMOTE-ADDR"]
-getClientIP :: ActionM ()
-getClientIP = do
+-- | get current time in CST timezone.
+getCurrentTimeCST :: IO Text
+getCurrentTimeCST = do
+ now <- getCurrentTime
+ let tz = TimeZone { timeZoneMinutes=480
+ , timeZoneSummerOnly=False
+ , timeZoneName="CST"}
+ return $ L.pack $ formatTime defaultTimeLocale "%c %z" (utcToZonedTime tz now)
+
+-- | if rcServeHistoryPage is enabled, add call history to rcCallHistory Seq.
+writeCallHistoryMaybe :: RuntimeConfig -> Text -> ActionM ()
+writeCallHistoryMaybe rc rawIP =
+ when (rcServeHistoryPage rc) $ do
+ time <- liftIO getCurrentTimeCST
+ userAgent <- header "User-Agent"
+ callHistory <- liftIO $ takeMVar (rcCallHistory rc)
+ let newEntry = CallHistory {
+ chTime = time
+ , chClientIP = rawIP
+ , chUserAgent = fromMaybe "unknown" userAgent}
+ liftIO $ putMVar (rcCallHistory rc) ((S.|>) callHistory newEntry)
+
+getClientIP :: RuntimeConfig -> ActionM ()
+getClientIP rc = do
ip <- foldl1 (liftA2 (<|>)) [getClientIP1, getClientIP2, getClientIP3]
- case ip of
- Nothing -> text "unknown\n"
- Just rawIp -> text $ rawIp <> "\n"
+ let rawIP = fromMaybe "unknown" ip
+ text $ rawIP <> "\n"
+ writeCallHistoryMaybe rc rawIP
-- | look up an environment variable, if it doesn't exist or is empty, use
-- default value instead. Otherwise, call a reader function on it and use that
@@ -47,9 +94,63 @@ getEnvDefault variable defaultValue stringReader = do
getListenPort :: IO Int
getListenPort = getEnvDefault "PORT" 8081 readMaybe
+readBoolMaybe :: String -> Maybe Bool
+readBoolMaybe str = Just (lower str `elem` ["true", "yes", "1"])
+
+buildHistoryText :: RuntimeConfig -> IO Text
+buildHistoryText rc = do
+ callHistory <- readMVar (rcCallHistory rc)
+ return $ F.foldl' (\out ch -> out <> chClientIP ch <> ", "
+ <> chTime ch <> ", "
+ <> chUserAgent ch <> "\n")
+ "time, client ip, user-agent\n" callHistory
+
+buildHistoryHtml :: RuntimeConfig -> IO Text
+buildHistoryHtml rc = do
+ callHistory <- readMVar (rcCallHistory rc)
+ let thead = tr_ $ do
+ th_ "client ip"
+ th_ "time"
+ th_ "user-agent"
+ let tbody = F.mapM_
+ (\ch -> tr_ $ do
+ td_ $ toHtml $ chClientIP ch
+ td_ $ toHtml $ chTime ch
+ td_ $ toHtml $ chUserAgent ch) callHistory
+ return $ renderText $ do
+ doctype_
+ html_ [lang_ "en"] $ do
+ head_ $ do
+ title_ "recent calls"
+ body_ $ table_ $ do
+ thead
+ tbody
+
+showHistory :: RuntimeConfig -> ActionM ()
+showHistory rc =
+ if rcServeHistoryPage rc then
+ do
+ accept <- header "accept"
+ case accept of
+ Just "text/plain" -> do
+ result <- liftIO $ buildHistoryText rc
+ text result
+ _ -> do
+ history <- liftIO $ buildHistoryHtml rc
+ html history
+ else
+ status status404
+
main :: IO ()
main = do
port <- getListenPort
+ serveHistoryPage <- getEnvDefault "SERVE_HISTORY_PAGE" False readBoolMaybe
+ when serveHistoryPage $
+ putStrLn "Enabled GET /_calls api"
+ callHistory <- newMVar S.empty
+ let rc = RuntimeConfig { rcServeHistoryPage = serveHistoryPage
+ , rcCallHistory = callHistory}
scotty port $ do
- get "/" getClientIP
+ get "/" (getClientIP rc)
+ get "/_calls" (showHistory rc)
addroute HEAD "/" $ return ()
diff --git a/get-client-ip.cabal b/get-client-ip.cabal
index 54578e3..5537240 100644
--- a/get-client-ip.cabal
+++ b/get-client-ip.cabal
@@ -1,5 +1,5 @@
name: get-client-ip
-version: 1.1.0
+version: 1.2.0
cabal-version: >= 1.8
build-type: Simple
@@ -12,3 +12,16 @@ executable get-client-ip
, scotty
, text
, http-types
+ , extra
+ , containers
+ , time
+ , lucid
+
+executable lucid-demo
+ hs-source-dirs: .
+ main-is: LucidDemo.hs
+ ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N
+ extensions: OverloadedStrings
+ build-depends: base >= 4 && < 5
+ , lucid
+ , text
diff --git a/operational b/operational
new file mode 100644
index 0000000..29e49ea
--- /dev/null
+++ b/operational
@@ -0,0 +1,86 @@
+* COMMENT -*- mode: org -*-
+#+Date: 2019-04-02
+Time-stamp: <2019-04-02>
+#+STARTUP: content
+* notes :entry:
+** 2019-04-02 how to deploy get-client-ip? :doc:
+- update code as necessary.
+ update version in get-client-ip.cabal
+- build project using stack.
+ stack build
+- test the app
+ env SERVE_HISTORY_PAGE=1 stack exec get-client-ip
+
+ curl http://127.0.0.1:8081/
+- build docker image
+ ./build-docker-image.sh
+
+ push docker image according to the output message.
+- update docker image version in k8s app yaml
+ ~/sysadmin/de02-kubernetes/apps/get-client-ip.yaml
+- deploy k8s app
+ kubectl apply -f ~/sysadmin/de02-kubernetes/apps/get-client-ip.yaml
+- commit changes to git.
+ project git.
+ k8s app yaml git. ~/sysadmin/de02-kubernetes/
+
+* later :entry:
+* current :entry:
+**
+* done :entry:
+** 2019-04-02 make get-client-ip build docker image and deploy on gocd.
+- uploading docker image from ryzen5 host is not good.
+ oh, this image is public and on docker hub.
+
+ see ~/sysadmin/de02-kubernetes/apps/get-client-ip.yaml
+ it's using a public image.
+-
+** 2019-04-02 show last 10 calls to get-client-ip.
+provide a web page that shows last 10 calls
+https://myip.emacsos.com/_calls
+
+| client-ip | time | user-agent |
+|--------------+----------------------------+-------------------|
+| 49.67.97.101 | 02/Apr/2019:13:58:24 +0800 | Python-urllib/2.7 |
+
+This allow me to get sheni's IP without login to de01 to see nginx log.
+
+- dev
+ - a in RAM buffer will do.
+ but there are multiple instances deployed on k8s.
+ use k8s redis service then.
+ - use an async action to insert record to redis. allow it to fail.
+ if redis is not running, that action just do nothing except leave a error
+ msg log.
+ - I don't want to introduce redis to the app. maybe just save in ram. user
+ can call GET /_calls multiple times to see results from all nodes.
+ - which data type to use as the ring buffer?
+
+ haskell - Purely functional (persistent) ring buffer - Stack Overflow
+ https://stackoverflow.com/questions/52898190/purely-functional-persistent-ring-buffer
+ Data.Sequence
+
+ fixed length circular buffer in haskell - Stack Overflow
+ https://stackoverflow.com/questions/6510175/fixed-length-circular-buffer-in-haskell
+ vector: Efficient Arrays
+
+ I will use Data.Sequence.
+ - do I need to make it thread safe? is persistent data types safe by
+ default?
+
+ yes. because it always return a new Seq object.
+ - put it in a MVar.
+ - why import getCurrentTime fail?
+ import Date.Time.Clock (getCurrentTime)
+ I have time in pkg list.
+
+ it's typo. "Date" vs "Data"!!
+ - build html response
+ blaze
+ lucid
+
+ Lucid: templating DSL for HTML
+ https://chrisdone.com/posts/lucid/
+ -
+
+* wontfix :entry:
--
GitLab