Amend greet.hs to include authentication
This commit is contained in:
parent
d0ee287ba1
commit
8dbc857c8e
1 changed files with 27 additions and 0 deletions
|
@ -12,6 +12,7 @@ import Data.String.Conversions
|
|||
import Data.Text (Text)
|
||||
import GHC.Generics
|
||||
import Servant.API
|
||||
import Servant.API.Authentication
|
||||
import Servant.Docs
|
||||
|
||||
-- * Example
|
||||
|
@ -29,6 +30,16 @@ instance ToJSON Greet
|
|||
instance MimeRender PlainText Greet where
|
||||
mimeRender Proxy (Greet s) = "\"" <> cs s <> "\""
|
||||
|
||||
-- | Our required authentication object
|
||||
newtype Cookie = Cookie String deriving (Show)
|
||||
|
||||
-- | Our user object returned when someone has been authenticated
|
||||
newtype User = User String deriving (Show)
|
||||
|
||||
-- | Some secret data returned from the /private endpoint.
|
||||
newtype SecretData = SecretData Text deriving (Generic, Show)
|
||||
instance ToJSON SecretData
|
||||
|
||||
-- We add some useful annotations to our captures,
|
||||
-- query parameters and request body to make the docs
|
||||
-- really helpful.
|
||||
|
@ -55,6 +66,19 @@ instance ToSample Greet where
|
|||
instance ToSample Int where
|
||||
toSamples _ = singleSample 1729
|
||||
|
||||
instance ToSample User User where
|
||||
toSample _ = Just (User "I'm a user!")
|
||||
|
||||
instance ToSample Cookie Cookie where
|
||||
toSample _ = Just (Cookie "cookie")
|
||||
|
||||
instance ToSample SecretData SecretData where
|
||||
toSample _ = Just (SecretData "shhhhh!")
|
||||
|
||||
instance ToAuthInfo (AuthProtect Cookie User 'Strict) where
|
||||
toAuthInfo _ = AuthenticationInfo "In this sentence we outline how authentication works."
|
||||
"The following data is required on each request as a serialized header."
|
||||
|
||||
-- We define some introductory sections, these will appear at the top of the
|
||||
-- documentation.
|
||||
--
|
||||
|
@ -83,6 +107,9 @@ type TestApi =
|
|||
-- DELETE /greet/:greetid
|
||||
:<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] ()
|
||||
|
||||
-- GET /private
|
||||
:<|> "private" :> AuthProtect Cookie User 'Strict :> Get '[JSON] SecretData
|
||||
|
||||
testApi :: Proxy TestApi
|
||||
testApi = Proxy
|
||||
|
||||
|
|
Loading…
Reference in a new issue