Allow API users to create Trip entries

Next up:
- list trips
- update existing trip entries
- delete existing trip entries
This commit is contained in:
William Carroll 2020-07-28 09:10:54 +01:00
parent 475f62fb16
commit 52ac4d79bd
3 changed files with 79 additions and 3 deletions

View file

@ -15,3 +15,6 @@ type API = "user"
:<|> "user"
:> Capture "name" Text
:> Get '[JSON] (Maybe T.Account)
:<|> "trip"
:> ReqBody '[JSON] T.Trip
:> Post '[JSON] Bool

View file

@ -17,11 +17,13 @@ import qualified Types as T
--------------------------------------------------------------------------------
server :: FilePath -> Server API
server dbFile =
userAddH :<|> userGetH
server dbFile = userAddH
:<|> userGetH
:<|> createTripH
where
userAddH newUser = liftIO $ userAdd newUser
userGetH name = liftIO $ userGet name
createTripH trip = liftIO $ createTrip trip
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
userAdd :: T.Account -> IO (Maybe T.Session)
@ -40,6 +42,12 @@ server dbFile =
[x] -> pure (Just x)
_ -> pure Nothing
createTrip :: T.Trip -> IO Bool
createTrip trip = withConnection dbFile $ \conn -> do
execute conn "INSERT INTO Trips (username,destination,startDate,endDate,comment) VALUES (?,?,?,?,?)"
(trip & T.tripFields)
pure True
mkApp :: FilePath -> IO Application
mkApp dbFile = do
pure $ serve (Proxy @ API) $ server dbFile

View file

@ -107,8 +107,9 @@ data Account = Account
, accountProfilePicture :: ProfilePicture
} deriving (Eq, Show, Generic)
instance FromJSON Account
-- TODO(wpcarro): Prefer username to accountUsername for JSON
instance ToJSON Account
instance FromJSON Account
-- | Return a tuple with all of the fields for an Account record to use for SQL.
accountFields :: Account -> (Username, Password, Email, Role, ProfilePicture)
@ -144,3 +145,67 @@ instance ToJSON Session where
, "password" .= password
, "role" .= role
]
newtype Comment = Comment Text
deriving (Eq, Show, Generic)
instance ToJSON Comment
instance FromJSON Comment
instance ToField Comment where
toField (Comment x) = SQLText x
instance FromField Comment where
fromField = forNewtype Comment
-- TODO(wpcarro): Replace this with a different type.
newtype Date = Date Text
deriving (Eq, Show, Generic)
instance ToJSON Date
instance FromJSON Date
instance ToField Date where
toField (Date x) = SQLText x
instance FromField Date where
fromField = forNewtype Date
newtype Destination = Destination Text
deriving (Eq, Show, Generic)
-- TODO(wpcarro): Prefer username to tripUsername for JSON
instance ToJSON Destination
instance FromJSON Destination
instance ToField Destination where
toField (Destination x) = SQLText x
instance FromField Destination where
fromField = forNewtype Destination
data Trip = Trip
{ tripUsername :: Username
, tripDestination :: Destination
, tripStartDate :: Date
, tripEndDate :: Date
, tripComment :: Comment
} deriving (Eq, Show, Generic)
-- | Return the tuple representation of a Trip record for SQL.
tripFields :: Trip -> (Username, Destination, Date, Date, Comment)
tripFields (Trip{ tripUsername
, tripDestination
, tripStartDate
, tripEndDate
, tripComment
})
= ( tripUsername
, tripDestination
, tripStartDate
, tripEndDate
, tripComment
)
instance ToJSON Trip
instance FromJSON Trip