@@ -0,0 +1,236 @@
3+This doc will walk through a single-module implementation of a servant API connecting to a MySQL database. It will also include some basic CRUD operations.
5+Once you can wrap your head around this implemenation, understanding more complex features like resource pools would be beneficial next steps.
7+The only *prerequisite* is that you have a MySQL database open on port 3306 of your machine. Docker is an easy way to manage this.
11+- The mysql database should be up and running on 127.0.0.1:3306
13+- Our API will be exposed on localhost:8080
15+## REST actions available
48+At the time of writing this issue may occur when building your project:
51+setup: Missing dependencies on foreign libraries:
52+* Missing (or bad) C libraries: ssl, crypto
55+If using stack, this can be fixed by adding the following lines to your `stack.yaml`:
59+- /usr/local/opt/openssl/include
61+- /usr/local/opt/openssl/lib
64+Or for cabal, running your builds with these configurations passed as options.
66+## Implementation: Main.hs
71+{-# LANGUAGE DataKinds #-}
72+{-# LANGUAGE DeriveGeneric #-}
73+{-# LANGUAGE FlexibleInstances #-}
74+{-# LANGUAGE GADTs #-}
75+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
76+{-# LANGUAGE MultiParamTypeClasses #-}
77+{-# LANGUAGE QuasiQuotes #-}
78+{-# LANGUAGE TemplateHaskell #-}
79+{-# LANGUAGE TypeFamilies #-}
80+{-# LANGUAGE TypeOperators #-}
83+import Control.Monad.IO.Class (liftIO)
84+import Control.Monad.Logger (NoLoggingT (..))
85+import Control.Monad.Trans.Reader (runReaderT)
86+import Control.Monad.Trans.Resource (ResourceT, runResourceT)
87+import Data.Aeson as JSON
88+import Data.Int (Int64 (..))
89+import Data.Text (Text)
90+import qualified Data.Text as T
91+import qualified Data.Text.IO as T
92+import Database.Persist
93+import Database.Persist.MySQL (ConnectInfo (..),
95+ defaultConnectInfo, fromSqlKey, runMigration,
96+ runSqlPool, toSqlKey, withMySQLConn)
97+import Database.Persist.Sql (SqlPersistT, runSqlConn)
98+import Database.Persist.TH (mkMigrate, mkPersist,
99+ persistLowerCase, share,
101+import Database.Persist.Types (PersistValue(PersistInt64))
102+import Servant (Handler, throwError)
106+import Network.Wai.Handler.Warp
109+import System.Environment (getArgs)
111+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
113+ Id Int Primary Unique
116+ deriving Eq Show Generic
120+ "person" :> Get '[JSON] [Person]
121+ :<|> "person" :> Capture "id" Int :> Get '[JSON] Person
122+ :<|> "person" :> Capture "id" Int :> Delete '[JSON] ()
123+ :<|> "person" :> ReqBody '[JSON] Person :> Post '[JSON] Person
125+apiProxy :: Proxy Api
129+app = serve apiProxy server
131+-- Run a database operation, and lift the result into a Handler.
132+-- This minimises usage of IO operations in other functions
133+runDB :: SqlPersistT (ResourceT (NoLoggingT IO)) a -> Handler a
134+runDB a = liftIO $ runNoLoggingT $ runResourceT $ withMySQLConn connInfo $ runSqlConn a
136+-- Change these out to suit your local setup
137+connInfo :: ConnectInfo
138+connInfo = defaultConnectInfo { connectHost = "127.0.0.1", connectUser = "root", connectPassword = "abcd", connectDatabase = "test-database" }
141+doMigration = runNoLoggingT $ runResourceT $ withMySQLConn connInfo $ runReaderT $ runMigration migrateAll
150+ personGET = selectPersons
151+ personGETById id = selectPersonById id
152+ personDELETE id = deletePerson id
153+ personPOST personJson = createPerson personJson
155+selectPersons :: Handler [Person]
157+ personList <- runDB $ selectList [] []
158+ return $ map (\(Entity _ u) -> u) personList
160+selectPersonById :: Int -> Handler Person
161+selectPersonById id = do
162+ sqlResult <- runDB $ get $ PersonKey id
164+ Just person -> return person
165+ Nothing -> throwError err404 { errBody = JSON.encode "Person with ID not found." }
167+createPerson :: Person -> Handler Person
168+createPerson person = do
169+ attemptCreate <- runDB $ insert person
170+ case attemptCreate of
171+ PersonKey k -> return person
172+ _ -> throwError err503 { errBody = JSON.encode "Could not create Person." }
174+deletePerson :: Int -> Handler ()
175+deletePerson id = do runDB $ delete $ PersonKey id
180+ let arg1 = if not (null args) then Just (head args) else Nothing
182+ Just "migrate" -> doMigration
188+Assuming that you have the db running and have first run `stack exec run migrate`, the following sample requests will test your API:
194+ http://localhost:8080/person \
196+ -H 'Accept-Encoding: gzip, deflate' \
197+ -H 'Cache-Control: no-cache' \
198+ -H 'Connection: keep-alive' \
199+ -H 'Content-Length: 62' \
200+ -H 'Content-Type: application/json' \
201+ -H 'Host: localhost:8080' \
202+ -H 'cache-control: no-cache' \
213+ http://localhost:8080/person \
215+ -H 'Accept-Encoding: gzip, deflate' \
216+ -H 'Cache-Control: no-cache' \
217+ -H 'Connection: keep-alive' \
218+ -H 'Content-Length: 33' \
219+ -H 'Content-Type: application/json' \
220+ -H 'Host: localhost:8080' \
221+ -H 'cache-control: no-cache'
228+ http://localhost:8080/person/1 \
230+ -H 'Accept-Encoding: gzip, deflate' \
231+ -H 'Cache-Control: no-cache' \
232+ -H 'Connection: keep-alive' \
233+ -H 'Content-Type: application/json' \
234+ -H 'Host: localhost:8080' \
235+ -H 'cache-control: no-cache'