-
Notifications
You must be signed in to change notification settings - Fork 0
/
ReservationsHttpClient.hs
28 lines (24 loc) · 1.03 KB
/
ReservationsHttpClient.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
module ReservationsHttpClient where
import Data.Time.Calendar (toGregorian)
import Data.Time.LocalTime (ZonedTime, localDay, zonedTimeToLocalTime)
import Control.Applicative ((<$>))
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Catch (MonadThrow)
import Text.Printf (printf)
import Network.HTTP.Simple
import ReservationsApi (Slot, Reservation)
import qualified OpeningJson as OJ
import qualified ReservationJson as RJ
baseAddress = "http://localhost:56268"
getSlots :: (MonadIO m, MonadThrow m) => ZonedTime -> m [Slot]
getSlots zt = do
let (y, m, d) = toGregorian $ localDay $ zonedTimeToLocalTime zt
request <- parseRequest $ printf "%s/availability/%d/%d/%d" baseAddress y m d
response <- httpJSON request
return $ fmap OJ.toSlot $ OJ.openings $ getResponseBody response
postReservation :: Reservation -> IO ()
postReservation r = do
request <- setRequestBodyJSON (RJ.fromReservation r)
<$> parseRequest (printf "POST %s/reservations" baseAddress)
response <- httpNoBody request
print $ getResponseStatus response