v1.2.0 add optional GET /_calls api

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

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"

                                                  ,"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

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 ()

name:          get-client-ip

version:       1.1.0

version:       1.2.0

cabal-version: >= 1.8

build-type:    Simple

                  , 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

* 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: