Add Basic Auth example

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

@@ -0,0 +1,97 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# 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.Server.Internal.Auth (BasicAuthCheck(BasicAuthCheck), AuthResult(Authorized,Unauthorized))
+import           Servant.Server           (serve, (.:), Server, Config(EmptyConfig), ConfigEntry)
+
+-- | 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
+
+-- | a value holding a proxy of our basic auth realm.
+authRealm :: Proxy "foo-realm"
+authRealm = Proxy
+
+-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.
+authCheck :: BasicAuthCheck User
+authCheck =
+  let check username password =
+        if username == "servant" && password == "server"
+        then return (Authorized (User "servant"))
+        else return Unauthorized
+  in BasicAuthCheck check
+
+serverConfig :: Config (ConfigEntry "foo-realm" (BasicAuthCheck User) ': '[])
+serverConfig = authCheck .: EmptyConfig
+
+server :: Server API
+server =
+  let publicAPIHandler = return [PublicData "foo", PublicData "bar"]
+      privateAPIHandler (user :: User) = return (PrivateData (userName user))
+  in publicAPIHandler :<|> privateAPIHandler
+
+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"}
+-}

servant-examples/servant-examples.cabal

@@ -105,6 +105,22 @@ executable auth-combinator
   hs-source-dirs: auth-combinator
   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 socket-io-chat
   main-is: socket-io-chat.hs
   ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing