servant/servant-examples/basic-auth/basic-auth.hs

106 lines
3.6 KiB
Haskell
Raw Normal View History

2016-02-17 20:23:32 +01:00
{-# 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
),
2016-03-08 23:28:27 +01:00
Context ((:.), EmptyContext), Server,
serveWithContext)
2016-02-17 20:23:32 +01:00
-- | 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
2016-03-08 23:28:27 +01:00
-- | We need to supply our handlers with the right Context. In this case,
-- Basic Authentication requires a Context Entry with the 'BasicAuthCheck' value
-- tagged with "foo-tag" This context is then supplied to 'server' and threaded
2016-02-17 20:23:32 +01:00
-- to the BasicAuth HasServer handlers.
2016-03-08 23:28:27 +01:00
serverContext :: Context (BasicAuthCheck User ': '[])
serverContext = authCheck :. EmptyContext
2016-02-17 20:23:32 +01:00
-- | 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 ()
2016-03-08 23:28:27 +01:00
main = run 8080 (serveWithContext api serverContext server)
2016-02-17 20:23:32 +01:00
{- 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"}
-}