servant/servant-examples/auth-combinator/auth-combinator.hs
Andres Loeh 1398d1f5e1 More systematic approach to delayed checks.
This introduces a `Delayed` type in `RoutingApplication.hs` that
contains a handler together with delayed checks. There are several
blocks of delayed checks, so that we can ultimately execute them in the
order we desire.

The process is documented in more detail in `RoutingApplication.hs`.
2015-10-26 16:56:25 +01:00

80 lines
2.4 KiB
Haskell

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Text (Text)
import GHC.Generics
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 subserver = WithRequest $ \ request ->
route (Proxy :: Proxy rest) $ addAcceptCheck subserver $ cookieCheck request
where
cookieCheck req = case lookup "Cookie" (requestHeaders req) of
Nothing -> return $ FailFatal err401 { errBody = "Missing auth header" }
Just v -> do
authGranted <- isGoodCookie v
if authGranted
then return $ Route ()
else return $ FailFatal err403 { errBody = "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.
-}