add an auth combinator example

servant-examples/auth-combinator/auth-combinator.hs

@@ -0,0 +1,78 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+import Data.Aeson
+import Data.ByteString (ByteString)
+import Data.Text (Text)
+import GHC.Generics
+import Network.HTTP.Types
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Servant
+import Servant.Server.Internal
+
+-- Pretty much stolen/adapted from
+-- https://github.com/haskell-servant/HaskellSGMeetup2015/blob/master/examples/authentication-combinator/AuthenticationCombinator.hs
+
+type DBLookup = ByteString -> IO Bool
+
+isGoodCookie :: DBLookup
+isGoodCookie = return . (== "good password")
+
+data AuthProtected
+
+instance HasServer rest => HasServer (AuthProtected :> rest) where
+  type ServerT' (AuthProtected :> rest) m = ServerT' rest m
+
+  route Proxy a request respond =
+    case lookup "Cookie" (requestHeaders request) of
+      Nothing -> respond . succeedWith $ responseLBS status401 [] "Missing auth header."
+      Just v  -> do
+        authGranted <- isGoodCookie v
+        if authGranted
+          then route (Proxy :: Proxy rest) a request respond
+          else respond . succeedWith $ responseLBS status403 [] "Invalid cookie."
+
+type PrivateAPI = Get '[JSON] [PrivateData]
+
+type PublicAPI = Get '[JSON] [PublicData]
+
+type API = "private" :> AuthProtected :> PrivateAPI
+      :<|> PublicAPI
+
+newtype PrivateData = PrivateData { ssshhh :: Text }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON PrivateData
+
+newtype PublicData = PublicData { somedata :: Text }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON PublicData
+
+api :: Proxy API
+api = Proxy
+
+server :: Server API
+server = return prvdata :<|> return pubdata
+
+  where prvdata = [PrivateData "this is a secret"]
+        pubdata = [PublicData "this is a public piece of data"]
+
+main :: IO ()
+main = run 8080 (serve api server)
+
+{- Sample session:
+$ curl http://localhost:8080/
+[{"somedata":"this is a public piece of data"}]
+$ curl http://localhost:8080/private
+Missing auth header.
+$ curl -H "Cookie: good password" http://localhost:8080/private
+[{"ssshhh":"this is a secret"}]
+$ curl -H "Cookie: bad password" http://localhost:8080/private
+Invalid cookie.
+-}

servant-examples/servant-examples.cabal

@@ -1,7 +1,8 @@
 name:                servant-examples
 version:             0.3
 synopsis:            Example programs for servant
-description:         Example programs for servant
+description:         Example programs for servant,
+                     showcasing solutions to common needs.
 homepage:            http://haskell-servant.github.io/
 license:             BSD3
 license-file:        LICENSE
@@ -10,13 +11,10 @@ maintainer:          alpmestan@gmail.com
 -- copyright:           
 category:            Web
 build-type:          Simple
--- extra-source-files:  
 cabal-version:       >=1.10
 
 executable hackage
   main-is:             hackage.hs
-  -- other-modules:       
-  -- other-extensions:
   build-depends:
       aeson >= 0.8
     , base >=4.7
@@ -41,3 +39,18 @@ executable wai-middleware
     , warp
   hs-source-dirs: wai-middleware
   default-language: Haskell2010
+
+executable auth-combinator
+  main-is: auth-combinator.hs
+  build-depends:
+      aeson >= 0.8
+    , base >= 4.7
+    , bytestring
+    , http-types
+    , servant
+    , servant-server
+    , text
+    , wai
+    , warp
+  hs-source-dirs: auth-combinator
+  default-language: Haskell2010