diff --git a/servant-examples/auth-combinator/auth-combinator.hs b/servant-examples/auth-combinator/auth-combinator.hs new file mode 100644 index 00000000..3277c97e --- /dev/null +++ b/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. +-} \ No newline at end of file diff --git a/servant-examples/servant-examples.cabal b/servant-examples/servant-examples.cabal index 65a92b98..f1edd49c 100644 --- a/servant-examples/servant-examples.cabal +++ b/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