diff options
-rw-r--r-- | src/API.hs | 3 | ||||
-rw-r--r-- | src/App.hs | 12 | ||||
-rw-r--r-- | src/Types.hs | 67 |
3 files changed, 79 insertions, 3 deletions
diff --git a/src/API.hs b/src/API.hs index 70da1921d251..f858e6d7ab53 100644 --- a/src/API.hs +++ b/src/API.hs @@ -15,3 +15,6 @@ type API = "user" :<|> "user" :> Capture "name" Text :> Get '[JSON] (Maybe T.Account) + :<|> "trip" + :> ReqBody '[JSON] T.Trip + :> Post '[JSON] Bool diff --git a/src/App.hs b/src/App.hs index b80a3ba4f619..20d99e385ad2 100644 --- a/src/App.hs +++ b/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 diff --git a/src/Types.hs b/src/Types.hs index d57fa92ed31e..14536ae8c3ba 100644 --- a/src/Types.hs +++ b/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 |