example-handlers-haskell/src/App/External.hs at main · nicolashery/example-handlers-haskell · GitHub

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
module App.External
  ( main,
    -- Suppress 'defined but not used warnings'
    BookingId (unBookingId),
    PaymentId (unPaymentId),
  )
where

import App.Json (defaultParseJSON, defaultToJSON)
import Control.Monad (when)
import Control.Monad.Except (MonadError (throwError))
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON))
import Data.Text (Text)
import GHC.Generics (Generic)
import Network.Wai.Handler.Warp (run)
import Servant
  ( Handler,
    JSON,
    Post,
    Proxy (Proxy),
    ReqBody,
    Server,
    ServerError (errBody),
    err400,
    serve,
    (:>),
    type (:<|>) ((:<|>)),
  )

newtype BookingId = BookingId {unBookingId :: Text}
  deriving (ToJSON)

newtype PaymentId = PaymentId {unPaymentId :: Text}
  deriving (ToJSON)

data BookingRequest = BookingRequest
  { bookingRequestVenue :: Text,
    bookingRequestSeats :: [Text]
  }
  deriving (Generic)

instance FromJSON BookingRequest where
  parseJSON = defaultParseJSON "bookingRequest"

data BookingResponse = BookingResponse
  { bookingResponseBookingId :: BookingId,
    bookingResponseSeatsReserved :: Int
  }
  deriving (Generic)

instance ToJSON BookingResponse where
  toJSON = defaultToJSON "bookingResponse"

data PaymentRequest = PaymentRequest
  { paymentRequestCardholderName :: Text,
    paymentRequestCardNumber :: Text
  }
  deriving (Generic)

instance FromJSON PaymentRequest where
  parseJSON = defaultParseJSON "paymentRequest"

data PaymentResponse = PaymentResponse
  { paymentResponsePaymentId :: PaymentId,
    paymentResponseAmountCharged :: Int
  }
  deriving (Generic)

instance ToJSON PaymentResponse where
  toJSON = defaultToJSON "paymentResponse"

type Api =
  "booking" :> ReqBody '[JSON] BookingRequest :> Post '[JSON] BookingResponse
    :<|> "payment" :> ReqBody '[JSON] PaymentRequest :> Post '[JSON] PaymentResponse

postBookingHandler :: BookingRequest -> Handler BookingResponse
postBookingHandler BookingRequest {bookingRequestVenue = venue} = do
  when (venue == "TDE8751") $ do
    throwError $ err400 {errBody = "Invalid venue"}
  pure $
    BookingResponse
      { bookingResponseBookingId = BookingId "TKCY693D5ACB",
        bookingResponseSeatsReserved = 3
      }

postPaymentHandler :: PaymentRequest -> Handler PaymentResponse
postPaymentHandler PaymentRequest {paymentRequestCardNumber = cardNumber} = do
  when (cardNumber == "a192901463306478") $ do
    throwError $ err400 {errBody = "Invalid card number"}
  pure $
    PaymentResponse
      { paymentResponsePaymentId = PaymentId "zTNBbSdy3vdOSnRT3xzFHviB",
        paymentResponseAmountCharged = 5200
      }

server :: Server Api
server =
  postBookingHandler
    :<|> postPaymentHandler

api :: Proxy Api
api = Proxy

main :: IO ()
main = do
  let port = 3001
      waiApp = serve api server
  run port waiApp