Allow API users to create Trip entries
Next up: - list trips - update existing trip entries - delete existing trip entries
This commit is contained in:
parent
475f62fb16
commit
52ac4d79bd
3 changed files with 79 additions and 3 deletions
|
@ -15,3 +15,6 @@ type API = "user"
|
|||
:<|> "user"
|
||||
:> Capture "name" Text
|
||||
:> Get '[JSON] (Maybe T.Account)
|
||||
:<|> "trip"
|
||||
:> ReqBody '[JSON] T.Trip
|
||||
:> Post '[JSON] Bool
|
||||
|
|
12
src/App.hs
12
src/App.hs
|
@ -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
|
||||
|
|
67
src/Types.hs
67
src/Types.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue