Fix compiler errors in servant-examples.
This commit is contained in:
parent
e0fe0a1f39
commit
cf59abd2b8
2 changed files with 38 additions and 4 deletions
33
servant-examples/digest-auth/digest-auth.hs
Normal file
33
servant-examples/digest-auth/digest-auth.hs
Normal file
|
@ -0,0 +1,33 @@
|
||||||
|
{-#LANGUAGE DataKinds, TypeOperators, OverloadedStrings #-}
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Data.Text
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import Data.Proxy
|
||||||
|
import Servant.API
|
||||||
|
import Servant.API.Authentication
|
||||||
|
import Servant.Server
|
||||||
|
import Servant.Server.Internal.Authentication
|
||||||
|
import Network.Wai.Handler.Warp
|
||||||
|
|
||||||
|
|
||||||
|
data User = User
|
||||||
|
{ username :: ByteString
|
||||||
|
, ha1 :: ByteString -- ^ MD5(username:realm:password)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
-- | A table with just one user. namely "username:foo:password"
|
||||||
|
table = [("username", User "username" "22f93fe54b9edf660a2f85310adc8a56")]
|
||||||
|
|
||||||
|
type API = AuthProtect (DigestAuth "foo") User 'Strict :> "foo" :> Get '[JSON] Text
|
||||||
|
|
||||||
|
api :: Server API
|
||||||
|
api = digestAuthStrict ha1 lookupUser (const . return $ "hello")
|
||||||
|
|
||||||
|
lookupUser :: DigestAuth "foo" -> IO (Maybe User)
|
||||||
|
lookupUser authData = return . lookup (daUsername authData) $ table
|
||||||
|
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = run 8080 (serve (Proxy :: Proxy API) api)
|
|
@ -16,6 +16,7 @@ import Servant.JS
|
||||||
import System.Random
|
import System.Random
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.IO as TIO
|
||||||
import qualified Language.Javascript.JQuery as JQ
|
import qualified Language.Javascript.JQuery as JQ
|
||||||
|
|
||||||
data Point = Point
|
data Point = Point
|
||||||
|
@ -91,14 +92,14 @@ server' :: Server API'
|
||||||
server' = server
|
server' = server
|
||||||
:<|> serveDirectory "tutorial/t9"
|
:<|> serveDirectory "tutorial/t9"
|
||||||
|
|
||||||
apiJS :: String
|
apiJS :: Text
|
||||||
apiJS = jsForAPI api jquery
|
apiJS = jsForAPI api jquery
|
||||||
|
|
||||||
writeJSFiles :: IO ()
|
writeJSFiles :: IO ()
|
||||||
writeJSFiles = do
|
writeJSFiles = do
|
||||||
writeFile "tutorial/t9/api.js" apiJS
|
TIO.writeFile "tutorial/t9/api.js" apiJS
|
||||||
jq <- readFile =<< JQ.file
|
jq <- TIO.readFile =<< JQ.file
|
||||||
writeFile "tutorial/t9/jq.js" jq
|
TIO.writeFile "tutorial/t9/jq.js" jq
|
||||||
|
|
||||||
app :: Application
|
app :: Application
|
||||||
app = serve api' server'
|
app = serve api' server'
|
||||||
|
|
Loading…
Reference in a new issue