Return a Session
Define the Session type and return it for the POST /user endpoint
This commit is contained in:
parent
1d47e94bbe
commit
718152ec14
3 changed files with 49 additions and 11 deletions
|
@ -16,7 +16,7 @@ import qualified Types as T
|
||||||
|
|
||||||
type API = "user"
|
type API = "user"
|
||||||
:> ReqBody '[JSON] T.User
|
:> ReqBody '[JSON] T.User
|
||||||
:> Post '[JSON] (Maybe (Key T.User))
|
:> Post '[JSON] (Maybe T.Session)
|
||||||
:<|> "user"
|
:<|> "user"
|
||||||
:> Capture "name" Text
|
:> Capture "name" Text
|
||||||
:> Get '[JSON] (Maybe T.User)
|
:> Get '[JSON] (Maybe T.User)
|
||||||
|
|
25
src/App.hs
25
src/App.hs
|
@ -20,7 +20,7 @@ import Network.Wai.Handler.Warp as Warp
|
||||||
import Servant
|
import Servant
|
||||||
|
|
||||||
import API
|
import API
|
||||||
import Types
|
import qualified Types as T
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
server :: ConnectionPool -> Server API
|
server :: ConnectionPool -> Server API
|
||||||
|
@ -30,17 +30,22 @@ server pool =
|
||||||
userAddH newUser = liftIO $ userAdd newUser
|
userAddH newUser = liftIO $ userAdd newUser
|
||||||
userGetH name = liftIO $ userGet name
|
userGetH name = liftIO $ userGet name
|
||||||
|
|
||||||
userAdd :: User -> IO (Maybe (Key User))
|
userAdd :: T.User -> IO (Maybe T.Session)
|
||||||
userAdd newUser = flip runSqlPersistMPool pool $ do
|
userAdd newUser = flip runSqlPersistMPool pool $ do
|
||||||
exists <- selectFirst [UserName ==. (userName newUser)] []
|
exists <- selectFirst [T.UserName ==. (T.userName newUser)] []
|
||||||
case exists of
|
case exists of
|
||||||
Nothing -> Just <$> insert newUser
|
Nothing -> do
|
||||||
Just _ -> return Nothing
|
insert newUser
|
||||||
|
pure $ Just (T.Session { T.username = T.Username "wpcarro"
|
||||||
|
, T.password = T.Password "testing"
|
||||||
|
, T.role = T.RegularUser
|
||||||
|
})
|
||||||
|
Just _ -> pure Nothing
|
||||||
|
|
||||||
userGet :: Text -> IO (Maybe User)
|
userGet :: Text -> IO (Maybe T.User)
|
||||||
userGet name = flip runSqlPersistMPool pool $ do
|
userGet name = flip runSqlPersistMPool pool $ do
|
||||||
mUser <- selectFirst [UserName ==. name] []
|
mUser <- selectFirst [T.UserName ==. name] []
|
||||||
return $ entityVal <$> mUser
|
pure $ entityVal <$> mUser
|
||||||
|
|
||||||
app :: ConnectionPool -> Application
|
app :: ConnectionPool -> Application
|
||||||
app pool = serve (Proxy @ API) $ server pool
|
app pool = serve (Proxy @ API) $ server pool
|
||||||
|
@ -50,8 +55,8 @@ mkApp sqliteFile = do
|
||||||
pool <- runStderrLoggingT $ do
|
pool <- runStderrLoggingT $ do
|
||||||
createSqlitePool (cs sqliteFile) 5
|
createSqlitePool (cs sqliteFile) 5
|
||||||
|
|
||||||
runSqlPool (runMigration migrateAll) pool
|
runSqlPool (runMigration T.migrateAll) pool
|
||||||
return $ app pool
|
pure $ app pool
|
||||||
|
|
||||||
run :: FilePath -> IO ()
|
run :: FilePath -> IO ()
|
||||||
run sqliteFile =
|
run sqliteFile =
|
||||||
|
|
33
src/Types.hs
33
src/Types.hs
|
@ -33,3 +33,36 @@ instance ToJSON User where
|
||||||
object [ "name" .= name
|
object [ "name" .= name
|
||||||
, "age" .= age
|
, "age" .= age
|
||||||
]
|
]
|
||||||
|
|
||||||
|
newtype Username = Username Text
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance ToJSON Username where
|
||||||
|
toJSON (Username x) = toJSON x
|
||||||
|
|
||||||
|
newtype Password = Password Text
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance ToJSON Password where
|
||||||
|
toJSON (Password x) = toJSON x
|
||||||
|
|
||||||
|
data Role = RegularUser | Manager | Admin
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance ToJSON Role where
|
||||||
|
toJSON RegularUser = "user"
|
||||||
|
toJSON Manager = "manager"
|
||||||
|
toJSON Admin = "admin"
|
||||||
|
|
||||||
|
data Session = Session
|
||||||
|
{ username :: Username
|
||||||
|
, password :: Password
|
||||||
|
, role :: Role
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance ToJSON Session where
|
||||||
|
toJSON (Session username password role) =
|
||||||
|
object [ "username" .= username
|
||||||
|
, "password" .= password
|
||||||
|
, "role" .= role
|
||||||
|
]
|
||||||
|
|
Loading…
Reference in a new issue