From 8543e00aaa06542d92a14d55be924a0c7eb7daf6 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sat, 2 Dec 2017 00:00:27 +0100 Subject: [PATCH] add a cookbook recipe for sqlite. cabalized cookbook examples. --- doc/cookbook/{ => basic-auth}/BasicAuth.lhs | 7 +- doc/cookbook/basic-auth/basic-auth.cabal | 28 ++++++ doc/cookbook/cabal.project | 9 ++ .../db-sqlite-simple/DBConnection.lhs | 99 +++++++++++++++++++ .../db-sqlite-simple/db-sqlite-simple.cabal | 28 ++++++ doc/cookbook/index.rst | 3 +- 6 files changed, 169 insertions(+), 5 deletions(-) rename doc/cookbook/{ => basic-auth}/BasicAuth.lhs (98%) create mode 100644 doc/cookbook/basic-auth/basic-auth.cabal create mode 100644 doc/cookbook/cabal.project create mode 100644 doc/cookbook/db-sqlite-simple/DBConnection.lhs create mode 100644 doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal diff --git a/doc/cookbook/BasicAuth.lhs b/doc/cookbook/basic-auth/BasicAuth.lhs similarity index 98% rename from doc/cookbook/BasicAuth.lhs rename to doc/cookbook/basic-auth/BasicAuth.lhs index 782fbe33..436a784b 100644 --- a/doc/cookbook/BasicAuth.lhs +++ b/doc/cookbook/basic-auth/BasicAuth.lhs @@ -12,11 +12,10 @@ First, some throat clearing. {-# LANGUAGE TypeOperators #-} import Control.Concurrent import Control.Exception -import Control.Monad.IO.Class import qualified Data.Map as Map import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) -import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) +import Network.HTTP.Client (newManager, defaultManagerSettings) import Network.Wai.Handler.Warp import Servant 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 of our `Map`. -``` +``` haskell type Username = T.Text type Password = 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. The entire program covered here is available as a literate Haskell file -[here](...). +[here](...), along with a `cabal` project. diff --git a/doc/cookbook/basic-auth/basic-auth.cabal b/doc/cookbook/basic-auth/basic-auth.cabal new file mode 100644 index 00000000..7fde791c --- /dev/null +++ b/doc/cookbook/basic-auth/basic-auth.cabal @@ -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 diff --git a/doc/cookbook/cabal.project b/doc/cookbook/cabal.project new file mode 100644 index 00000000..3fe56809 --- /dev/null +++ b/doc/cookbook/cabal.project @@ -0,0 +1,9 @@ +packages: + basic-auth/ + db-sqlite-simple/ + ../../servant + ../../servant-server + ../../servant-client-core + ../../servant-client + ../../servant-docs + ../../servant-foreign diff --git a/doc/cookbook/db-sqlite-simple/DBConnection.lhs b/doc/cookbook/db-sqlite-simple/DBConnection.lhs new file mode 100644 index 00000000..5f0e25b4 --- /dev/null +++ b/doc/cookbook/db-sqlite-simple/DBConnection.lhs @@ -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](...). diff --git a/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal b/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal new file mode 100644 index 00000000..7df6a159 --- /dev/null +++ b/doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal @@ -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 diff --git a/doc/cookbook/index.rst b/doc/cookbook/index.rst index 570088a5..fef56b4e 100644 --- a/doc/cookbook/index.rst +++ b/doc/cookbook/index.rst @@ -17,4 +17,5 @@ you name it! .. toctree:: :maxdepth: 1 - BasicAuth.lhs + basic-auth/BasicAuth.lhs + db-sqlite-simple/DBConnection.lhs