Skip to content

Commit

Permalink
Restructure WebService code with JSON example
Browse files Browse the repository at this point in the history
  • Loading branch information
memowe committed Feb 19, 2024
1 parent f0bd51c commit 9de8070
Show file tree
Hide file tree
Showing 8 changed files with 72 additions and 25 deletions.
29 changes: 29 additions & 0 deletions lib/LiBro/WebService.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,29 @@
module LiBro.WebService where

import Data.Aeson
import Data.Proxy
import Servant
import GHC.Generics

newtype PersonIDs = PersonIDs {personIDs :: [Int]} deriving Generic
instance ToJSON PersonIDs

type LiBroAPI = "hello" :> Get '[JSON] PersonIDs
:<|> "yay" :> Get '[PlainText] String

libroServer :: Server LiBroAPI
libroServer = handleHello
:<|> handleYay
where
handleHello :: Handler PersonIDs
handleHello = return $ PersonIDs [17, 42]

handleYay :: Handler String
handleYay = return "Yay!"

libroApi :: Proxy LiBroAPI
libroApi = Proxy

libro :: Application
libro = serve libroApi libroServer

9 changes: 0 additions & 9 deletions lib/LiBro/WebService/API.hs

This file was deleted.

10 changes: 0 additions & 10 deletions lib/LiBro/WebService/Server.hs

This file was deleted.

25 changes: 25 additions & 0 deletions lib/LiBro/WebService/State.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
module LiBro.WebService.State where

import LiBro.Config
import LiBro.Data
import LiBro.Control
import Control.Concurrent

data LiBroState = LiBroState
{ config :: Config
, mvBlocking :: MVar Blocking
, mvData :: MVar LiBroData
}

lsConfig :: LiBroState -> IO Config
lsConfig = return . config

lsData :: LiBroState -> IO LiBroData
lsData = readMVar . mvData

lsInit :: Config -> IO LiBroState
lsInit config = do

Check warning on line 21 in lib/LiBro/WebService/State.hs

View workflow job for this annotation

GitHub Actions / GHC 9.4 on ubuntu-latest

This binding for ‘config’ shadows the existing binding

Check warning on line 21 in lib/LiBro/WebService/State.hs

View workflow job for this annotation

GitHub Actions / GHC 9.4 on ubuntu-latest

This binding for ‘config’ shadows the existing binding

Check warning on line 21 in lib/LiBro/WebService/State.hs

View workflow job for this annotation

GitHub Actions / GHC 9.6 on ubuntu-latest

This binding for ‘config’ shadows the existing binding

Check warning on line 21 in lib/LiBro/WebService/State.hs

View workflow job for this annotation

GitHub Actions / GHC 9.6 on ubuntu-latest

This binding for ‘config’ shadows the existing binding
mvb <- newEmptyMVar
mvd <- newEmptyMVar
initData config mvb mvd
return $ LiBroState config mvb mvd
7 changes: 5 additions & 2 deletions libro-backend.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -41,8 +41,8 @@ library
, LiBro.Data.Storage
, LiBro.Data.SafeText
, LiBro.Control
, LiBro.WebService.API
, LiBro.WebService.Server
, LiBro.WebService
, LiBro.WebService.State
, LiBro.Util
build-depends: aeson
, attoparsec
Expand Down Expand Up @@ -75,6 +75,7 @@ executable libro-backend
test-suite libro-backend-test
import: consumer
default-extensions: OverloadedStrings
, QuasiQuotes
, DeriveGeneric
type: exitcode-stdio-1.0
hs-source-dirs: test
Expand All @@ -91,6 +92,7 @@ test-suite libro-backend-test
build-depends: libro-backend
, hspec
, hspec-wai
, hspec-wai-json
, QuickCheck
, quickcheck-text
, generic-arbitrary
Expand All @@ -108,3 +110,4 @@ test-suite libro-backend-test
, text
, transformers
, vector
, wai
2 changes: 1 addition & 1 deletion server/Main.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
module Main where

import LiBro.Config as Conf
import LiBro.WebService.Server
import LiBro.WebService
import Network.Wai.Handler.Warp

configuredMain :: Config -> IO ()
Expand Down
13 changes: 10 additions & 3 deletions test/LiBro/WebServiceSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,10 @@ module LiBro.WebServiceSpec where

import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.JSON
import Test.Hspec.Wai.QuickCheck

import LiBro.WebService.Server
import LiBro.WebService
import Data.ByteString

spec :: Spec
Expand All @@ -14,9 +15,15 @@ spec = describe "RESTful JSON web service" $ do
helloLibro :: Spec
helloLibro = describe "Dummy: hello libro!" $ with (return libro) $ do

describe "Hello endpoint" $ do
describe "Yay endpoint" $ do
it "Respond with 200 greeting" $ do
get "/hello" `shouldRespondWith` "Hello LiBro!" {matchStatus = 200}
get "/yay" `shouldRespondWith` "Yay!" {matchStatus = 200}

describe "Dummy person ID endpoint" $ do
it "Respond with IDs" $ do
get "/hello" `shouldRespondWith`
[json|{"personIDs":[17,42]}|]
{matchStatus = 200}

describe "Any other endpoint" $ do
it "Respond with 404" $ do
Expand Down
2 changes: 2 additions & 0 deletions test/run-all-tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ import qualified LiBro.ConfigSpec as Config
import qualified LiBro.ControlSpec as Control
import qualified LiBro.TestUtilSpec as TestUtil
import qualified LiBro.UtilSpec as Util
import qualified LiBro.WebServiceSpec as WebService

withLibreOffice :: IO () -> IO ()
withLibreOffice runTests = do
Expand All @@ -31,3 +32,4 @@ main = hspec $ aroundAll_ withLibreOffice $ do
Control.spec
TestUtil.spec
Util.spec
WebService.spec

0 comments on commit 9de8070

Please sign in to comment.