From 41781e728ae12d9049f3798bd9942c46c69e0150 Mon Sep 17 00:00:00 2001
From: aaron levin <vilevin@gmail.com>
Date: Mon, 11 May 2015 16:16:34 -0400
Subject: [PATCH] Add BasicAuth data type

---
 servant/servant.cabal                     |  1 +
 servant/src/Servant/API.hs                |  3 +++
 servant/src/Servant/API/Authentication.hs | 25 +++++++++++++++++++++++
 3 files changed, 29 insertions(+)
 create mode 100644 servant/src/Servant/API/Authentication.hs

diff --git a/servant/servant.cabal b/servant/servant.cabal
index f717eab3..30d849b4 100644
--- a/servant/servant.cabal
+++ b/servant/servant.cabal
@@ -26,6 +26,7 @@ library
   exposed-modules:
     Servant.API
     Servant.API.Alternative
+    Servant.API.Authentication
     Servant.API.Capture
     Servant.API.ContentTypes
     Servant.API.Delete
diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs
index 2e6abb2a..99420311 100644
--- a/servant/src/Servant/API.hs
+++ b/servant/src/Servant/API.hs
@@ -5,6 +5,8 @@ module Servant.API (
   -- | Type-level combinator for expressing subrouting: @':>'@
   module Servant.API.Alternative,
   -- | Type-level combinator for alternative endpoints: @':<|>'@
+  module Servant.API.Authentication,
+  -- | Type-level combinator for endpoints requiring auth: @'BasicAuth'@
 
   -- * Accessing information from the request
   module Servant.API.Capture,
@@ -58,6 +60,7 @@ module Servant.API (
   ) where
 
 import           Servant.API.Alternative     ((:<|>) (..))
+import           Servant.API.Authentication  (BasicAuth)
 import           Servant.API.Capture         (Capture)
 import           Servant.API.ContentTypes    (Accept (..), FormUrlEncoded,
                                               FromFormUrlEncoded (..), JSON,
diff --git a/servant/src/Servant/API/Authentication.hs b/servant/src/Servant/API/Authentication.hs
new file mode 100644
index 00000000..e4c71453
--- /dev/null
+++ b/servant/src/Servant/API/Authentication.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE PolyKinds          #-}
+{-# OPTIONS_HADDOCK not-home    #-}
+module Servant.API.Authentication (BasicAuth) where
+
+import           Data.Typeable (Typeable)
+import           GHC.TypeLits  (Symbol)
+
+-- | Basic Authentication with respect to a specified @realm@ and a @lookup@
+-- type to encapsulate authentication logic.
+--
+-- Example:
+-- >>> type AuthLookup = Text -> IO User
+-- >>> type MyApi = BasicAuth "book-realm" :> "books" :> Get '[JSON] [Book]
+data BasicAuth (realm :: Symbol) lookup
+    deriving (Typeable)
+
+-- $setup
+-- >>> import Servant.API
+-- >>> import Data.Aeson
+-- >>> import Data.Text
+-- >>> data User
+-- >>> data Book
+-- >>> instance ToJSON Book where { toJSON = undefined }