From 660b8d43e5272e2b71b6092b4c879a82c4d861a8 Mon Sep 17 00:00:00 2001
From: William Carroll <wpcarro@gmail.com>
Date: Fri, 24 Jul 2020 19:00:29 +0100
Subject: Support a basic API

Use Servant to create a REST API supporting the following routes:
- GET /number
- POST /other

The server interacts with a SQLite database.
---
 src/API.hs | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)
 create mode 100644 src/API.hs

(limited to 'src/API.hs')

diff --git a/src/API.hs b/src/API.hs
new file mode 100644
index 000000000000..b2c7fd57d67f
--- /dev/null
+++ b/src/API.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+--------------------------------------------------------------------------------
+module API where
+--------------------------------------------------------------------------------
+import qualified Data.Pool as DP
+import qualified Database.SQLite.Simple as DB
+
+import Data.Aeson
+import GHC.Generics
+import GHC.TypeLits
+import Network.Wai.Handler.Warp
+import Servant
+import Control.Monad.IO.Class
+--------------------------------------------------------------------------------
+
+handlers :: DP.Pool DB.Connection -> Server API
+handlers pool = do
+  getHandler pool :<|> pure 0
+
+getHandler :: DP.Pool DB.Connection -> Handler Int
+getHandler pool =
+  DP.withResource pool $ \conn -> do
+     result <- liftIO $ DB.query_ conn "select 2 + 2"
+     case result of
+       [DB.Only x] -> pure x
+       _  -> pure (-1)
+
+type API = "number" :> Get '[JSON] Int
+      :<|> "other" :> Post '[JSON] Int
+
+main :: IO ()
+main = do
+  pool <- DP.createPool (DB.open "data.db") DB.close 1 0.5 1
+  run 3000 (serve (Proxy @ API) (handlers pool))
-- 
cgit 1.4.1