Commit 9c4299b1 authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

started to define the rest interface.

parent 5e1fa932
......@@ -20,6 +20,8 @@ library
, Types
, Conf
, Model
, API.User
, RealWorld
other-modules: Lib.Prelude
build-depends: base >= 4.7 && < 5
, protolude
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module API.User where
import Lib.Prelude
import Servant
import Servant.Auth.Server
import Model
import Types
import Conf
type UserInformationAPI =
"user"
:> Get '[ JSON] ResponseUser
:<|> "user"
:> ReqBody '[ JSON] RequestUpdateUser
:> Put '[ JSON] ResponseUser
userInformationApi ::
MonadIO m => AuthResult User -> ServerT UserInformationAPI (CoachT m)
userInformationApi authres = panic ""
userInformationProxy :: Proxy UserInformationAPI
userInformationProxy = Proxy
userInformationServer ::
Configuration -> AuthResult User -> Server UserInformationAPI
userInformationServer conf authres =
hoistServer
userInformationProxy
(coachToHandler conf)
(userInformationApi authres)
type UserAdministrationAPI =
"users"
:> ReqBody '[ JSON] RequestRegistration
:> Post '[ JSON] ResponseUser
:<|> "users"
:> "login"
:> ReqBody '[JSON] RequestLogin
:> Post '[ JSON] ResponseUser
userAdministrationApi :: MonadIO m => ServerT UserAdministrationAPI (CoachT m)
userAdministrationApi = panic ""
userAdministrationProxy :: Proxy UserAdministrationAPI
userAdministrationProxy = Proxy
userAdministrationServer :: Configuration -> Server UserAdministrationAPI
userAdministrationServer conf =
hoistServer
userAdministrationProxy
(coachToHandler conf)
userAdministrationApi
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module RealWorld where
import Lib.Prelude
import Control.Monad.Logger
import Database.Persist.Postgresql
import Network.Wai.Handler.Warp
import Network.Wai.Handler.Warp (Port)
import Servant
import Servant.Auth
import Servant.Auth.Server
import Conf
import Model
import API.User
type ConduitAPI auth =
"api" :> (Servant.Auth.Server.Auth auth User :> UserInformationAPI)
:<|> "api" :> UserAdministrationAPI
:<|> Raw
conduitProxy :: Proxy (ConduitAPI '[JWT])
conduitProxy = Proxy
conduitServer :: Configuration -> Server (ConduitAPI auth)
conduitServer conf =
userInformationServer conf
:<|> userAdministrationServer conf
:<|> serveDirectoryFileServer "front"
connstring :: ByteString
connstring =
"host=localhost "
<> "port=5432 "
<> "user=ibnu "
<> "password=jaran "
<> "dbname=uwu"
running :: IO ()
running = do
jwk <- generateKey
pool <- runStderrLoggingT (createPostgresqlPool connstring 10)
let jws = defaultJWTSettings jwk
cfg = defaultCookieSettings :. jws :. EmptyContext
conf = Configuration pool jws
runSqlPool doMigration pool
run 8080 (serveWithContext conduitProxy cfg (conduitServer conf))
stop :: IO ()
stop = return ()
startServe :: IO (Port, Application)
startServe = do
jwk <- generateKey
pool <- runStderrLoggingT (createPostgresqlPool connstring 10)
let jws = defaultJWTSettings jwk
cfg = defaultCookieSettings :. jws :. EmptyContext
conf = Configuration pool jws
runSqlPool doMigration pool
return (8080, serveWithContext conduitProxy cfg (conduitServer conf))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment