wai-feature-flags-0.1.0.0: example-app/Main.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Main
  ( main,
  )
where

import Data.Foldable (asum)
import GHC.Generics (Generic)
import qualified Network.FeatureFlags as FeatureFlags
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp

main :: IO ()
main = do
  store <- FeatureFlags.memoryStore
  featureFlagsAdmin <- FeatureFlags.mkApplication store
  Warp.run 8080 (application store featureFlagsAdmin)

application :: FeatureFlags.Store Flags -> Wai.Application -> Wai.Application
application store featureFlagsAdmin req respond = do
  flags <- FeatureFlags.fetch store
  case (Wai.requestMethod req, Wai.pathInfo req) of
    -- Mount feature flags page at /admin/flags.
    (_, "admin" : "flags" : rest) ->
      featureFlagsAdmin
        req {Wai.pathInfo = rest}
        respond
    ("GET", ["window"]) ->
      respond $
        Wai.responseLBS
          (toEnum 200)
          []
          (if openWindow flags then "open" else "closed")
    ("GET", ["pigeons"]) ->
      respond $
        Wai.responseLBS
          (toEnum 200)
          []
          (if feedPigeons flags then "fed" else "hungry")
    _ -> respond (Wai.responseLBS (toEnum 404) [] "")

data Flags
  = Flags
      { openWindow :: Bool,
        feedPigeons :: Bool
      }
  deriving (Generic)

instance FeatureFlags.Flags Flags