Add basic-auth data types to servant core

This commit is contained in:
aaron levin 2016-02-17 18:49:01 +01:00
parent c6b6639453
commit 6dc577c821
2 changed files with 33 additions and 0 deletions

View file

@ -29,6 +29,9 @@ module Servant.API (
-- * Actual endpoints, distinguished by HTTP method -- * Actual endpoints, distinguished by HTTP method
module Servant.API.Verbs, module Servant.API.Verbs,
-- * Authentication
module Servant.API.BasicAuth,
-- * Content Types -- * Content Types
module Servant.API.ContentTypes, module Servant.API.ContentTypes,
-- | Serializing and deserializing types based on @Accept@ and -- | Serializing and deserializing types based on @Accept@ and
@ -51,6 +54,7 @@ module Servant.API (
) where ) where
import Servant.API.Alternative ((:<|>) (..)) import Servant.API.Alternative ((:<|>) (..))
import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))
import Servant.API.Capture (Capture) import Servant.API.Capture (Capture)
import Servant.API.ContentTypes (Accept (..), FormUrlEncoded, import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
FromFormUrlEncoded (..), JSON, FromFormUrlEncoded (..), JSON,

View file

@ -0,0 +1,29 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
module Servant.API.BasicAuth where
import Data.ByteString (ByteString)
import Data.Typeable (Typeable)
import GHC.TypeLits (Symbol)
-- | Combinator for <https://tools.ietf.org/html/rfc2617#section-2 Basic Access Authentication>.
--
-- *IMPORTANT*: Only use Basic Auth over HTTPS! Credentials are not hashed or
-- encrypted. Note also that because the same credentials are sent on every
-- request, Basic Auth is not as secure as some alternatives. Further, the
-- implementation in servant-server does not protect against some types of
-- timing attacks.
--
-- In Basic Auth, username and password are base64-encoded and transmitted via
-- the @Authorization@ header. Handshakes are not required, making it
-- relatively efficient.
data BasicAuth (realm :: Symbol)
deriving (Typeable)
-- | A simple datatype to hold data required to decorate a request
data BasicAuthData = BasicAuthData { basicAuthUsername :: !ByteString
, basicAuthPassword :: !ByteString
}