add a cookbook recipe for sqlite. cabalized cookbook examples.
This commit is contained in:
parent
606a4a6f69
commit
8543e00aaa
6 changed files with 169 additions and 5 deletions
|
@ -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.
|
28
doc/cookbook/basic-auth/basic-auth.cabal
Normal file
28
doc/cookbook/basic-auth/basic-auth.cabal
Normal 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
|
9
doc/cookbook/cabal.project
Normal file
9
doc/cookbook/cabal.project
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
packages:
|
||||||
|
basic-auth/
|
||||||
|
db-sqlite-simple/
|
||||||
|
../../servant
|
||||||
|
../../servant-server
|
||||||
|
../../servant-client-core
|
||||||
|
../../servant-client
|
||||||
|
../../servant-docs
|
||||||
|
../../servant-foreign
|
99
doc/cookbook/db-sqlite-simple/DBConnection.lhs
Normal file
99
doc/cookbook/db-sqlite-simple/DBConnection.lhs
Normal 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](...).
|
28
doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal
Normal file
28
doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal
Normal 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
|
|
@ -17,4 +17,5 @@ you name it!
|
||||||
.. toctree::
|
.. toctree::
|
||||||
:maxdepth: 1
|
:maxdepth: 1
|
||||||
|
|
||||||
BasicAuth.lhs
|
basic-auth/BasicAuth.lhs
|
||||||
|
db-sqlite-simple/DBConnection.lhs
|
||||||
|
|
Loading…
Reference in a new issue