eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Fix formatting and add more comments in basic-auth

Browse source
This commit is contained in:
aaron levin 2016-01-07 23:43:55 +01:00
parent 1eed61517b
commit 38c3cb7045
1 changed files with 20 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
servant-examples/basic-auth/basic-auth.hs
View file

@ -1,21 +1,22 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Main where module Main where
import Data.Aeson (ToJSON) import Data.Aeson (ToJSON)
import Data.Proxy (Proxy (Proxy)) import Data.Proxy (Proxy (Proxy))
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import Servant.API ((:<|>)((:<|>)), (:>), BasicAuth, Get, JSON) import Servant.API ((:<|>) ((:<|>)), (:>), BasicAuth,
import Servant.Server.Internal.Auth (BasicAuthCheck(BasicAuthCheck), AuthResult(Authorized,Unauthorized)) Get, JSON)
import Servant.Server (serve, (.:), Server, Config(EmptyConfig), ConfigEntry) import Servant.Server (Config (EmptyConfig),
ConfigEntry, Server, serve, (.:))
import Servant.Server.Internal.Auth (AuthResult (Authorized, Unauthorized),
BasicAuthCheck (BasicAuthCheck))
-- | let's define some types that our API returns. -- | let's define some types that our API returns.
@ -62,15 +63,24 @@ authCheck =
else return Unauthorized else return Unauthorized
in BasicAuthCheck check 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 the realm that BasicAuth protects (in this case "foo-realm").
-- This config is then supplied to 'server' and threaded to the BasicAuth HasServer
-- handlers.
serverConfig :: Config (ConfigEntry "foo-realm" (BasicAuthCheck User) ': '[]) serverConfig :: Config (ConfigEntry "foo-realm" (BasicAuthCheck User) ': '[])
serverConfig = authCheck .: EmptyConfig 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 :: Server API
server = server =
let publicAPIHandler = return [PublicData "foo", PublicData "bar"] let publicAPIHandler = return [PublicData "foo", PublicData "bar"]
privateAPIHandler (user :: User) = return (PrivateData (userName user)) privateAPIHandler (user :: User) = return (PrivateData (userName user))
in publicAPIHandler :<|> privateAPIHandler in publicAPIHandler :<|> privateAPIHandler
-- | hello, server!
main :: IO () main :: IO ()
main = run 8080 (serve api serverConfig server) main = run 8080 (serve api serverConfig server)