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"
|
:<|> "user"
|
||||||
:> Capture "name" Text
|
:> Capture "name" Text
|
||||||
:> Get '[JSON] (Maybe T.Account)
|
:> 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 :: FilePath -> Server API
|
||||||
server dbFile =
|
server dbFile = userAddH
|
||||||
userAddH :<|> userGetH
|
:<|> userGetH
|
||||||
|
:<|> createTripH
|
||||||
where
|
where
|
||||||
userAddH newUser = liftIO $ userAdd newUser
|
userAddH newUser = liftIO $ userAdd newUser
|
||||||
userGetH name = liftIO $ userGet name
|
userGetH name = liftIO $ userGet name
|
||||||
|
createTripH trip = liftIO $ createTrip trip
|
||||||
|
|
||||||
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
|
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
|
||||||
userAdd :: T.Account -> IO (Maybe T.Session)
|
userAdd :: T.Account -> IO (Maybe T.Session)
|
||||||
|
@ -40,6 +42,12 @@ server dbFile =
|
||||||
[x] -> pure (Just x)
|
[x] -> pure (Just x)
|
||||||
_ -> pure Nothing
|
_ -> 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 :: FilePath -> IO Application
|
||||||
mkApp dbFile = do
|
mkApp dbFile = do
|
||||||
pure $ serve (Proxy @ API) $ server dbFile
|
pure $ serve (Proxy @ API) $ server dbFile
|
||||||
|
|
67
src/Types.hs
67
src/Types.hs
|
@ -107,8 +107,9 @@ data Account = Account
|
||||||
, accountProfilePicture :: ProfilePicture
|
, accountProfilePicture :: ProfilePicture
|
||||||
} deriving (Eq, Show, Generic)
|
} deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
instance FromJSON Account
|
-- TODO(wpcarro): Prefer username to accountUsername for JSON
|
||||||
instance ToJSON Account
|
instance ToJSON Account
|
||||||
|
instance FromJSON Account
|
||||||
|
|
||||||
-- | Return a tuple with all of the fields for an Account record to use for SQL.
|
-- | Return a tuple with all of the fields for an Account record to use for SQL.
|
||||||
accountFields :: Account -> (Username, Password, Email, Role, ProfilePicture)
|
accountFields :: Account -> (Username, Password, Email, Role, ProfilePicture)
|
||||||
|
@ -144,3 +145,67 @@ instance ToJSON Session where
|
||||||
, "password" .= password
|
, "password" .= password
|
||||||
, "role" .= role
|
, "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