@@ -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 #-}
8+import Data.Aeson
9+import Data.ByteString (ByteString)
10+import Data.Text (Text)
11+import GHC.Generics
12+import Network.HTTP.Types
13+import Network.Wai
14+import Network.Wai.Handler.Warp
15+import Servant
16+import Servant.Server.Internal
17+
18+-- Pretty much stolen/adapted from
19+-- https://github.com/haskell-servant/HaskellSGMeetup2015/blob/master/examples/authentication-combinator/AuthenticationCombinator.hs
20+
21+type DBLookup = ByteString -> IO Bool
22+
23+isGoodCookie :: DBLookup
24+isGoodCookie = return . (== "good password")
25+
26+data AuthProtected
27+
28+instance HasServer rest => HasServer (AuthProtected :> rest) where
29+ type ServerT' (AuthProtected :> rest) m = ServerT' rest m
30+
31+ route Proxy a request respond =
32+ case lookup "Cookie" (requestHeaders request) of
33+ Nothing -> respond . succeedWith $ responseLBS status401 [] "Missing auth header."
34+ Just v -> do
35+ authGranted <- isGoodCookie v
36+ if authGranted
37+ then route (Proxy :: Proxy rest) a request respond
38+ else respond . succeedWith $ responseLBS status403 [] "Invalid cookie."
39+
40+type PrivateAPI = Get '[JSON] [PrivateData]
41+
42+type PublicAPI = Get '[JSON] [PublicData]
43+
44+type API = "private" :> AuthProtected :> PrivateAPI
45+ :<|> PublicAPI
46+
47+newtype PrivateData = PrivateData { ssshhh :: Text }
48+ deriving (Eq, Show, Generic)
49+
50+instance ToJSON PrivateData
51+
52+newtype PublicData = PublicData { somedata :: Text }
53+ deriving (Eq, Show, Generic)
54+
55+instance ToJSON PublicData
56+
57+api :: Proxy API
58+api = Proxy
59+
60+server :: Server API
61+server = return prvdata :<|> return pubdata
62+
63+ where prvdata = [PrivateData "this is a secret"]
64+ pubdata = [PublicData "this is a public piece of data"]
65+
66+main :: IO ()
67+main = run 8080 (serve api server)
68+
69+{- Sample session:
70+$ curl http://localhost:8080/
71+[{"somedata":"this is a public piece of data"}]
72+$ curl http://localhost:8080/private
73+Missing auth header.
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
77+Invalid cookie.
78+-}