Add a basic authentication example

This commit is contained in:
aaron levin 2016-02-17 20:23:32 +01:00
parent f13c61956c
commit e13965ae34
2 changed files with 121 additions and 0 deletions

View file

@ -0,0 +1,105 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module Main where
import Data.Aeson (ToJSON)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import GHC.Generics (Generic)
import Network.Wai.Handler.Warp (run)
import Servant.API ((:<|>) ((:<|>)), (:>), BasicAuth,
Get, JSON)
import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
import Servant.Server (BasicAuthCheck (BasicAuthCheck),
BasicAuthResult( Authorized
, Unauthorized
),
Config ((:.), EmptyConfig), Server,
serve)
-- | let's define some types that our API returns.
-- | private data that needs protection
newtype PrivateData = PrivateData { ssshhh :: Text }
deriving (Eq, Show, Generic)
instance ToJSON PrivateData
-- | public data that anyone can use.
newtype PublicData = PublicData { somedata :: Text }
deriving (Eq, Show, Generic)
instance ToJSON PublicData
-- | A user we'll grab from the database when we authenticate someone
newtype User = User { userName :: Text }
deriving (Eq, Show)
-- | a type to wrap our public api
type PublicAPI = Get '[JSON] [PublicData]
-- | a type to wrap our private api
type PrivateAPI = Get '[JSON] PrivateData
-- | our API
type API = "public" :> PublicAPI
:<|> "private" :> BasicAuth "foo-realm" User :> PrivateAPI
-- | a value holding a proxy of our API type
api :: Proxy API
api = Proxy
-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.
authCheck :: BasicAuthCheck User
authCheck =
let check (BasicAuthData username password) =
if username == "servant" && password == "server"
then return (Authorized (User "servant"))
else return Unauthorized
in BasicAuthCheck check
-- | We need to supply our handlers with the right configuration. In this case,
-- Basic Authentication requires a Config Entry with the 'BasicAuthCheck' value
-- tagged with "foo-tag" This config is then supplied to 'server' and threaded
-- to the BasicAuth HasServer handlers.
serverConfig :: Config (BasicAuthCheck User ': '[])
serverConfig = authCheck :. EmptyConfig
-- | an implementation of our server. Here is where we pass all the handlers to our endpoints.
-- In particular, for the BasicAuth protected handler, we need to supply a function
-- that takes 'User' as an argument.
server :: Server API
server =
let publicAPIHandler = return [PublicData "foo", PublicData "bar"]
privateAPIHandler (user :: User) = return (PrivateData (userName user))
in publicAPIHandler :<|> privateAPIHandler
-- | hello, server!
main :: IO ()
main = run 8080 (serve api serverConfig server)
{- Sample session
$ curl -XGET localhost:8080/public
[{"somedata":"foo"},{"somedata":"bar"}
$ curl -iXGET localhost:8080/private
HTTP/1.1 401 Unauthorized
transfer-encoding: chunked
Date: Thu, 07 Jan 2016 22:36:38 GMT
Server: Warp/3.1.8
WWW-Authenticate: Basic realm="foo-realm"
$ curl -iXGET localhost:8080/private -H "Authorization: Basic c2VydmFudDpzZXJ2ZXI="
HTTP/1.1 200 OK
transfer-encoding: chunked
Date: Thu, 07 Jan 2016 22:37:58 GMT
Server: Warp/3.1.8
Content-Type: application/json
{"ssshhh":"servant"}
-}

View file

@ -89,6 +89,22 @@ executable wai-middleware
hs-source-dirs: wai-middleware hs-source-dirs: wai-middleware
default-language: Haskell2010 default-language: Haskell2010
executable basic-auth
main-is: basic-auth.hs
ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
build-depends:
aeson >= 0.8
, base >= 4.7 && < 5
, bytestring
, http-types
, servant == 0.5.*
, servant-server == 0.5.*
, text
, wai
, warp
hs-source-dirs: basic-auth
default-language: Haskell2010
executable auth-combinator executable auth-combinator
main-is: auth-combinator.hs main-is: auth-combinator.hs
ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing