add an auth combinator example

This commit is contained in:
Alp Mestanogullari 2015-04-24 14:00:57 +02:00
parent e371fb886f
commit 4c86c7395c
2 changed files with 95 additions and 4 deletions

View file

@ -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.
-}

View file

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