From e13965ae34c09abeedf933df47ef0041f58765c9 Mon Sep 17 00:00:00 2001
From: aaron levin <aaron.levin@soundcloud.com>
Date: Wed, 17 Feb 2016 20:23:32 +0100
Subject: [PATCH] Add a basic authentication example

---
 servant-examples/basic-auth/basic-auth.hs | 105 ++++++++++++++++++++++
 servant-examples/servant-examples.cabal   |  16 ++++
 2 files changed, 121 insertions(+)
 create mode 100644 servant-examples/basic-auth/basic-auth.hs

diff --git a/servant-examples/basic-auth/basic-auth.hs b/servant-examples/basic-auth/basic-auth.hs
new file mode 100644
index 00000000..1d538169
--- /dev/null
+++ b/servant-examples/basic-auth/basic-auth.hs
@@ -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"}
+-}
diff --git a/servant-examples/servant-examples.cabal b/servant-examples/servant-examples.cabal
index d62c01c7..a36a5eba 100644
--- a/servant-examples/servant-examples.cabal
+++ b/servant-examples/servant-examples.cabal
@@ -89,6 +89,22 @@ executable wai-middleware
   hs-source-dirs: wai-middleware
   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
   main-is: auth-combinator.hs
   ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing