add a cookbook recipe for sqlite. cabalized cookbook examples.

This commit is contained in:
Alp Mestanogullari 2017-12-02 00:00:27 +01:00
parent 606a4a6f69
commit 8543e00aaa
6 changed files with 169 additions and 5 deletions

View file

@ -12,11 +12,10 @@ First, some throat clearing.
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
import Control.Concurrent import Control.Concurrent
import Control.Exception import Control.Exception
import Control.Monad.IO.Class
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8) import Data.Text.Encoding (decodeUtf8)
import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) import Network.HTTP.Client (newManager, defaultManagerSettings)
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Servant import Servant
import Servant.Client import Servant.Client
@ -28,7 +27,7 @@ For the sake of simplicity, it will just be read only but the same code could
be used with mutable references, database connections, files and more in place be used with mutable references, database connections, files and more in place
of our `Map`. of our `Map`.
``` ``` haskell
type Username = T.Text type Username = T.Text
type Password = T.Text type Password = T.Text
type Website = T.Text type Website = T.Text
@ -176,4 +175,4 @@ code and see what happens when you specify credentials that are not in the
database. database.
The entire program covered here is available as a literate Haskell file The entire program covered here is available as a literate Haskell file
[here](...). [here](...), along with a `cabal` project.

View file

@ -0,0 +1,28 @@
name: cookbook-basic-auth
version: 0.1
synopsis: Basic Authentication cookbook example
homepage: http://haskell-servant.readthedocs.org/
license: BSD3
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
executable cookbook-basic-auth
main-is: BasicAuth.lhs
build-depends: base == 4.*
, text
, aeson
, containers
, servant
, servant-client
, servant-server
, warp
, wai
, http-types
, markdown-unlit >= 0.4
, http-client
default-language: Haskell2010
ghc-options: -Wall -pgmL markdown-unlit
build-tool-depends: markdown-unlit:markdown-unlit

View file

@ -0,0 +1,9 @@
packages:
basic-auth/
db-sqlite-simple/
../../servant
../../servant-server
../../servant-client-core
../../servant-client
../../servant-docs
../../servant-foreign

View file

@ -0,0 +1,99 @@
# SQLite database
Let's see how we can write a simple web application that uses an
[SQLite](https://www.sqlite.org/) database to store simple textual
messages. As usual, we start with a little bit of throat clearing.
``` haskell
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
import Control.Concurrent
import Control.Exception (bracket)
import Control.Monad.IO.Class
import Database.SQLite.Simple
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Network.Wai.Handler.Warp
import Servant
import Servant.Client
```
We will only care about a single type here, the messages. We want to
be able to add a new one and retrieve them all, using two different
endpoints.
``` haskell
type Message = String
type API = ReqBody '[PlainText] Message :> Post '[JSON] NoContent
:<|> Get '[JSON] [Message]
api :: Proxy API
api = Proxy
```
We proceed with a simple function for creating a table
for holding our messages if it doesn't already exist.
``` haskell
initDB :: FilePath -> IO ()
initDB dbfile = withConnection dbfile $ \conn ->
execute_ conn
"CREATE TABLE IF NOT EXISTS messages (msg text not null)"
```
Next, our server implementation. It will be parametrised (take as
argument) by the name of the file that contains our SQLite database.
The handlers are straighforward. One takes care of inserting a new
value in the database while the other fetches all messages and returns
them. We also provide a function for serving our web app given an
SQLite database file, which simply calls servant-server's `serve` function.
``` haskell
server :: FilePath -> Server API
server dbfile = postMessage :<|> getMessages
where postMessage :: Message -> Handler NoContent
postMessage msg = do
liftIO . withConnection dbfile $ \conn ->
execute conn
"INSERT INTO messages VALUES (?)"
(Only msg)
return NoContent
getMessages :: Handler [Message]
getMessages = fmap (map fromOnly) . liftIO $
withConnection dbfile $ \conn ->
query_ conn "SELECT msg FROM messages"
runApp :: FilePath -> IO ()
runApp dbfile = run 8080 (serve api $ server dbfile)
```
Let's also derive some clients for our API and use them to
insert two messages and retrieve them in `main`.
``` haskell
postMsg :: Message -> ClientM NoContent
getMsgs :: ClientM [Message]
postMsg :<|> getMsgs = client api
main :: IO ()
main = do
-- you could read this from some configuration file,
-- environment variable or somewhere else instead.
let dbfile = "test.db"
initDB dbfile
mgr <- newManager defaultManagerSettings
bracket (forkIO $ runApp dbfile) killThread $ \_ -> do
ms <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
postMsg "hello"
postMsg "world"
getMsgs
print ms
```
This program prints `Right ["hello","world"]` the first time it is executed,
`Right ["hello","world","hello","world"]` the second time and so on.
The entire source for this example is available [here](...).

View file

@ -0,0 +1,28 @@
name: cookbook-db-sqlite-simple
version: 0.1
synopsis: Simple SQLite DB cookbook example
homepage: http://haskell-servant.readthedocs.org/
license: BSD3
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
executable cookbook-db-sqlite-simple
main-is: DBConnection.lhs
build-depends: base == 4.*
, text
, aeson
, servant
, servant-client
, servant-server
, warp
, wai
, http-types
, markdown-unlit >= 0.4
, http-client
, sqlite-simple
default-language: Haskell2010
ghc-options: -Wall -pgmL markdown-unlit
build-tool-depends: markdown-unlit:markdown-unlit

View file

@ -17,4 +17,5 @@ you name it!
.. toctree:: .. toctree::
:maxdepth: 1 :maxdepth: 1
BasicAuth.lhs basic-auth/BasicAuth.lhs
db-sqlite-simple/DBConnection.lhs