@@ -0,0 +1,78 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE OverloadedStrings #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
9+import Data.ByteString (ByteString)
10+import Data.Text (Text)
12+import Network.HTTP.Types
14+import Network.Wai.Handler.Warp
16+import Servant.Server.Internal
18+-- Pretty much stolen/adapted from
19+-- https://github.com/haskell-servant/HaskellSGMeetup2015/blob/master/examples/authentication-combinator/AuthenticationCombinator.hs
21+type DBLookup = ByteString -> IO Bool
23+isGoodCookie :: DBLookup
24+isGoodCookie = return . (== "good password")
28+instance HasServer rest => HasServer (AuthProtected :> rest) where
29+ type ServerT' (AuthProtected :> rest) m = ServerT' rest m
31+ route Proxy a request respond =
32+ case lookup "Cookie" (requestHeaders request) of
33+ Nothing -> respond . succeedWith $ responseLBS status401 [] "Missing auth header."
35+ authGranted <- isGoodCookie v
37+ then route (Proxy :: Proxy rest) a request respond
38+ else respond . succeedWith $ responseLBS status403 [] "Invalid cookie."
40+type PrivateAPI = Get '[JSON] [PrivateData]
42+type PublicAPI = Get '[JSON] [PublicData]
44+type API = "private" :> AuthProtected :> PrivateAPI
47+newtype PrivateData = PrivateData { ssshhh :: Text }
48+ deriving (Eq, Show, Generic)
50+instance ToJSON PrivateData
52+newtype PublicData = PublicData { somedata :: Text }
53+ deriving (Eq, Show, Generic)
55+instance ToJSON PublicData
61+server = return prvdata :<|> return pubdata
63+ where prvdata = [PrivateData "this is a secret"]
64+ pubdata = [PublicData "this is a public piece of data"]
67+main = run 8080 (serve api server)
70+$ curl http://localhost:8080/
71+[{"somedata":"this is a public piece of data"}]
72+$ curl http://localhost:8080/private
74+$ curl -H "Cookie: good password" http://localhost:8080/private
75+[{"ssshhh":"this is a secret"}]
76+$ curl -H "Cookie: bad password" http://localhost:8080/private