v0.1.0 first working version

:set -XOverloadedStrings

*.hi

*.o

.stack-work/

.cabal-sandbox

cabal.sandbox.config

.DS_Store

*.swp

*.keter

 No newline at end of file

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

name:          get-client-ip

version:       0.1.0

cabal-version: >= 1.8

build-type:    Simple

executable          get-client-ip

    hs-source-dirs: .

    main-is:        Main.hs

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

    extensions:     OverloadedStrings

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

                  , scotty >= 0.10.0 && < 0.11

                  , text

# This file was automatically generated by stack init

# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/

# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)

resolver: lts-3.0

# Local packages, usually specified by relative directory name

packages:

- '.'

# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)

extra-deps: []

# Override default flag values for local packages and extra-deps

flags: {}

# Extra package databases containing global packages

extra-package-dbs: []

# Control whether we use the GHC we find on the path

# system-ghc: true

# Require a specific version of stack, using version ranges

# require-stack-version: -any # Default

# require-stack-version: >= 1.0.0

# Override the architecture used by stack, especially useful on Windows

# arch: i386

# arch: x86_64

# Extra directories used by stack for building

# extra-include-dirs: [/path/to/dir]

# extra-lib-dirs: [/path/to/dir]

# Allow a newer minor version of GHC than the snapshot specifies

# compiler-check: newer-minor