@@ -0,0 +1,33 @@
1+{-#LANGUAGE DataKinds, TypeOperators, OverloadedStrings #-}
2+module Main where
3+
4+import Data.Text
5+import Data.ByteString (ByteString)
6+import Data.Proxy
7+import Servant.API
8+import Servant.API.Authentication
9+import Servant.Server
10+import Servant.Server.Internal.Authentication
11+import Network.Wai.Handler.Warp
12+
13+
14+data User = User
15+ { username :: ByteString
16+ , ha1 :: ByteString -- ^ MD5(username:realm:password)
17+ }
18+
19+
20+-- | A table with just one user. namely "username:foo:password"
21+table = [("username", User "username" "22f93fe54b9edf660a2f85310adc8a56")]
22+
23+type API = AuthProtect (DigestAuth "foo") User 'Strict :> "foo" :> Get '[JSON] Text
24+
25+api :: Server API
26+api = digestAuthStrict ha1 lookupUser (const . return $ "hello")
27+
28+lookupUser :: DigestAuth "foo" -> IO (Maybe User)
29+lookupUser authData = return . lookup (daUsername authData) $ table
30+
31+
32+main :: IO ()
33+main = run 8080 (serve (Proxy :: Proxy API) api)