v1.3.0 add GET /_calls/unique api

module Main ( newUniqueCallHistory

            , main ) where

import Control.Applicative ((<|>), liftA2)

import Data.Monoid ((<>))

import Data.Maybe (fromMaybe)

import Data.List.Extra (lower)

import qualified Data.Sequence as S

import Lib (boundedPushRight)

import MainHelper (CallHistory(..), newUniqueCallHistory)

import Control.Concurrent.MVar

import Control.Monad (when)

import Control.Monad.IO.Class (liftIO)

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

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

    , rcHistorySize :: Int

    , rcCallHistory :: MVar (S.Seq CallHistory)

    , rcUniqueCallHistory :: MVar (S.Seq CallHistory)

    }

data HistoryType = AllHistory

                 | UniqueHistory

getClientIP1 :: ActionM (Maybe Text)

getClientIP1 = header "CLIENT-IP"

      time <- liftIO getCurrentTimeCST

      userAgent <- header "User-Agent"

      !callHistory <- liftIO $ takeMVar (rcCallHistory rc)

      !uniqueCallHistory <- liftIO $ takeMVar (rcUniqueCallHistory rc)

      let newEntry = CallHistory {

                       chTime = time

                     , chClientIP = rawIP

                     , chUserAgent = fromMaybe "unknown" userAgent}

      liftIO $ putMVar (rcCallHistory rc)

                       (boundedPushRight callHistory (rcHistorySize rc) newEntry)

      liftIO $ putMVar (rcUniqueCallHistory rc)

                       (newUniqueCallHistory uniqueCallHistory

                                             (rcHistorySize rc)

                                             newEntry)

getClientIP :: RuntimeConfig -> ActionM ()

getClientIP rc = do

readBoolMaybe :: String -> Maybe Bool

readBoolMaybe str = Just (lower str `elem` ["true", "yes", "1"])

buildHistoryText :: RuntimeConfig -> IO Text

buildHistoryText rc = do

    callHistory <- readMVar (rcCallHistory rc)

getHistory :: RuntimeConfig -> HistoryType -> MVar (S.Seq CallHistory)

getHistory rc historyType =

    case historyType of

      AllHistory -> rcCallHistory rc

      UniqueHistory -> rcUniqueCallHistory rc

buildHistoryText :: RuntimeConfig -> HistoryType -> IO Text

buildHistoryText rc historyType = do

    callHistory <- readMVar $ getHistory rc historyType

    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)

buildHistoryHtml :: RuntimeConfig -> HistoryType -> IO Text

buildHistoryHtml rc historyType = do

    callHistory <- readMVar $ getHistory rc historyType

    let thead = tr_ $ do

                  th_ "client ip"

                  th_ "time"

            thead

            tbody

showHistory :: RuntimeConfig -> ActionM ()

showHistory rc =

showHistory :: RuntimeConfig -> HistoryType -> ActionM ()

showHistory rc historyType =

  if rcServeHistoryPage rc then

      do

        accept <- header "accept"

        case accept of

          Just "text/plain" -> do

            result <- liftIO $ buildHistoryText rc

            result <- liftIO $ buildHistoryText rc historyType

            text result

          _ -> do

            history <- liftIO $ buildHistoryHtml rc

            history <- liftIO $ buildHistoryHtml rc historyType

            html history

  else

      status status404

  serveHistoryPage <- getEnvDefault "SERVE_HISTORY_PAGE" False readBoolMaybe

  historySize <- getEnvDefault "HISTORY_SIZE" 10 readMaybe

  when serveHistoryPage $ do

    putStrLn "Enabled GET /_calls api"

    putStrLn "Enabled history api"

    putStrLn $ "Keep a maximum of " <> show historySize <> " call history"

  callHistory <- newMVar S.empty

  uniqueCallHistory <- newMVar S.empty

  let rc = RuntimeConfig { rcServeHistoryPage = serveHistoryPage

                         , rcHistorySize = historySize

                         , rcCallHistory = callHistory}

                         , rcCallHistory = callHistory

                         , rcUniqueCallHistory = uniqueCallHistory}

  scotty port $ do

    get "/" (getClientIP rc)

    get "/_calls" (showHistory rc)

    get "/_calls" (showHistory rc AllHistory)

    get "/_calls/unique" (showHistory rc UniqueHistory)

    addroute HEAD "/" $ return ()

module MainHelper ( CallHistory(..)

                  , newUniqueCallHistory

                  ) where

import qualified Data.Sequence as S

import Data.Text.Lazy (Text)

import Lib (boundedPushRight)

-- in RAM call history for most recent 10 calls.

data CallHistory = CallHistory {

      chTime :: Text

    , chClientIP :: Text

    , chUserAgent :: Text

    } deriving (Show, Eq)

-- | insert a new unique call history, return a new unique call history Seq.

newUniqueCallHistory :: S.Seq CallHistory -> Int -> CallHistory -> S.Seq CallHistory

newUniqueCallHistory oldSeq historySize newEntry =

    case S.findIndexR (\entry -> chClientIP entry == chClientIP newEntry) oldSeq of

      Just index -> S.deleteAt index oldSeq S.|> newEntry

      Nothing -> boundedPushRight oldSeq historySize newEntry

import MainHelper (CallHistory(..), newUniqueCallHistory)

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 "newUniqueCallHistory" $ do

    it "should work" $ do

      let buf = S.empty:: S.Seq CallHistory

      let buf1 = newUniqueCallHistory buf 1 $ CallHistory "time1" "ip1" "ua1"

      F.toList buf1 `shouldBe` [ CallHistory "time1" "ip1" "ua1" ]

      let buf2 = newUniqueCallHistory buf1 1 $ CallHistory "time2" "ip1" "ua1"

      F.toList buf2 `shouldBe` [ CallHistory "time2" "ip1" "ua1" ]

      let buf3 = newUniqueCallHistory buf1 2 $ CallHistory "time3" "ip2" "ua2"

      F.toList buf3 `shouldBe` [ CallHistory "time1" "ip1" "ua1"

                               , CallHistory "time3" "ip2" "ua2" ]

      let buf4 = newUniqueCallHistory buf1 1 $ CallHistory "time3" "ip2" "ua2"

      F.toList buf4 `shouldBe` [ CallHistory "time3" "ip2" "ua2" ]

name:          get-client-ip

version:       1.2.2

version:       1.3.0

cabal-version: >= 1.8

build-type:    Simple

    hs-source-dirs: .

    main-is:        Main.hs

    other-modules:  Lib

                  , MainHelper

    ghc-options:    -Wall -threaded -O2 -rtsopts -with-rtsopts=-N

    extensions:     OverloadedStrings

                  , BangPatterns

                  , containers

                  , hspec

test-suite          main-helper-test

    type:           exitcode-stdio-1.0

    hs-source-dirs: .

    main-is:        MainHelperTest.hs

    other-modules:  Lib

                  , MainHelper

    ghc-options:    -Wall -threaded -O2 -rtsopts -with-rtsopts=-N

    extensions:     OverloadedStrings

    build-depends:  base   >= 4      && < 5

                  , text

                  , containers

                  , hspec

test-suite          lucid-demo

    type:           exitcode-stdio-1.0

    hs-source-dirs: .

* COMMENT -*- mode: org -*-

#+Date: 2019-04-02

Time-stamp: <2019-09-03>

Time-stamp: <2020-01-12>

#+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

  stack build --test --pedantic

- test the app

  stack exec get-client-ip

  env SERVE_HISTORY_PAGE=1 stack exec get-client-ip

      unable to recognize "/home/sylecn/sysadmin/de02-kubernetes/apps/get-client-ip.yaml": Get https://88.99.191.174:6443/api?timeout=32s: Forbidden port

      unable to recognize "/home/sylecn/sysadmin/de02-kubernetes/apps/get-client-ip.yaml": Get https://88.99.191.174:6443/api?timeout=32s: Forbidden port

    #+END_SRC

** 2019-09-03 how to deploy to prod? TLDR version			:doc:

- test code locally.

- build docker image

  run ./build-docker-image.sh

- update image version in yaml file and apply it.

  kubectl apply -f ~/sysadmin/de02-kubernetes/apps/get-client-ip.yaml

** 2019-09-03 how to run get-client-ip in dev env.

- without history api:

  ab -c 20 -n 100000 http://localhost:8081/

  curl http://localhost:8081/_calls

** 2020-01-12 APIs							:doc:

- GET /

  return client public IP address

- GET /_calls

  return recent calls

- GET /_calls/unique

  return recent calls from unqiue IPs.

* later                                                               :entry:

* current                                                             :entry:

** 

** 2019-09-03 how to deploy to prod?

- test code locally.

- build docker image

  run ./build-docker-image.sh

- update yaml file and apply it.

  update image version in yaml.

  kubectl apply -f ~/sysadmin/de02-kubernetes/apps/get-client-ip.yaml

* done                                                                :entry:

** 2020-01-12 add an API to show recent unique IPs.

- GET /_calls/unique

  return recent client unique IPs.

  only when history is enabled.

- writeCallHistoryMaybe

  if this IP exists, drop that entry, insert new entry for it.

  if this IP doesn't exist, push new entry, remove the oldest entry if length

  exceeded max history size.

- works on first try. very cool.

** 2019-09-03 bug: when /_calls is not called, all IP records (thunks) are saved

in memory because of lazy evaluation. This cost a memory leak.