Main.hs

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative ((<|>), liftA2)
import Data.Monoid ((<>))
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as L
import Web.Scotty

getClientIP1 :: ActionM (Maybe Text)
getClientIP1 = header "HTTP_CLIENT_IP"

getClientIP2 :: ActionM (Maybe Text)
getClientIP2 =
  fmap (maybe Nothing (Just . firstElement)) (header "HTTP_X_FORWARDED_FOR") where
      firstElement :: Text -> Text
      firstElement = head . L.splitOn ","

getClientIP3 :: ActionM (Maybe Text)
getClientIP3 = foldl1 (liftA2 (<|>)) $ map header ["HTTP_X_FORWARDED"
                                                  ,"HTTP_X_CLUSTER_CLIENT_IP"
                                                  ,"HTTP_FORWARDED_FOR"
                                                  ,"HTTP_FORWARDED"
                                                  ,"REMOTE_ADDR"]

getClientIP :: ActionM ()
getClientIP = do
  ip <- foldl1 (liftA2 (<|>)) [getClientIP1, getClientIP2, getClientIP3]
  case ip of
    Nothing -> text "unknown\n"
    Just rawIp -> text $ rawIp <> "\n"

main :: IO ()
main = scotty 3000 $ do
  get "/" $ getClientIP