以下代码在localhost：3000处启动Web服务器。
#!/usr/bin/env stack
-- stack script --resolver=lts-12.16
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
import Yesod
import Database.Persist.Sqlite
import Control.Monad.Trans.Resource (runResourceT)
import Control.Monad.Logger (runStderrLoggingT)
import Data.Text
-- Define our entities as usual
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Book
title Text
author Text
publisher Text
date Text
price Int
deriving Show
|]
-- We keep our connection pool in the foundation. At program initialization, we
-- create our initial pool, and each time we need to perform an action we check
-- out a single connection from the pool.
data SQLi = SQLi ConnectionPool
-- We'll create a single route, to access a person. It's a very common
-- occurrence to use an Id type in routes.
mkYesod "SQLi" [parseRoutes|
/ HomeR GET
/book/#BookId BookR GET
|]
-- Nothing special here
instance Yesod SQLi
-- Now we need to define a YesodPersist instance, which will keep track of
-- which backend we're using and how to run an action.
instance YesodPersist SQLi where
type YesodPersistBackend SQLi = SqlBackend
runDB action = do
SQLi pool <- getYesod
runSqlPool action pool
searchFrame :: [Entity Book] -> Widget
searchFrame books =
[whamlet|
<table border=1>
<tr>
<th>ID
<th>Title
<th>Author
<th>Publisher
<th>Publication date
<th>Price
$forall Entity bookid book <- books
<tr>
<td>
<a href=@{BookR bookid}>#{show bookid}
<td>
#{bookTitle book}
<td>
#{bookAuthor book}
<td>
#{bookPublisher book}
<td>
#{bookDate book}
<td>
#{bookPrice book}
|]
-- List all people in the database
getHomeR :: Handler Html
getHomeR = do
mBookAuthor <- lookupGetParam "author"
maybe (do
books <- runDB $ selectList [] [Asc BookId]
defaultLayout $ searchFrame books)
(¥author -> do
books <- runDB $ selectList [BookAuthor ==. author] [Asc BookId]
defaultLayout $ [whamlet|
<h1>Search books manually
^{searchFrame books}
|]) $ mBookAuthor
-- We'll just return the show value of a person, or a 404 if the Person doesn't
-- exist.
getBookR :: BookId -> Handler String
getBookR bookId = do
book <- runDB $ get404 bookId
return $ show book
openConnectionCount :: Int
openConnectionCount = 10
main :: IO ()
main = runStderrLoggingT $ withSqlitePool ":memory:" openConnectionCount $ ¥pool -> liftIO $ do
runResourceT $ flip runSqlPool pool $ do
runMigration migrateAll
insert $ Book "A Midsummer Night's Dream" "Shakespeare" "A bookstore" "1979/01" 600
insert $ Book "Hamlet" "Shakespeare" "B bookstore" "1997/04" 1260
insert $ Book "Macbeth" "Shakespeare" "C bookstore" "2001/05" 1530
insert $ Book "King Lear" "Shakespeare" "D bookstore" "2004/07" 1890
warp 3000 $ SQLi pool
然后，加载http://localhost:3000/?author=' AND EXTRACTVALUE(0, (SELECT CONCAT('$', id, ':', pwd) FROM users LIMIT 0, 1)) #有时会导致500 Internal Server Error，即使我们加载诸如http://localhost:3000/这样的普通页面，也会发出此错误消息
实际上，这可能是SQL注入的攻击媒介。因此，我对这是由袭击或其他原因造成的天气感到困惑。有人可以解释这种行为吗？