Create a gist now

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Composable routes in servant
module ServantHelpers(Server,Proxy(..),err400, err404,liftIO,liftIOMaybeToEither) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Either (EitherT, left, right)
import Servant(ServantErr,Proxy(..))
import Servant.Server
liftIOMaybeToEither :: (MonadIO m) => a -> IO (Maybe b) -> EitherT a m b
liftIOMaybeToEither err x = do
m <- liftIO x
case m of
Nothing -> left err
Just x -> right x
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module StorageServer where
import Models
import Servant.API
import ServantHelpers
import StorageDB
type ProjectAPI = Get '[JSON] ProjectList
:<|> Capture "pId" ProjectId :> Get '[JSON] Project
:<|> ReqBody '[JSON] Project :> Post '[JSON] Project
:<|> Capture "pId" ProjectId :> Delete '[JSON] ProjectId
type TenantAPI = Get '[JSON] Tenants
:<|> Capture "tId" TenantId :> Get '[JSON] Tenant
:<|> ReqBody '[JSON] Tenant :> Post '[JSON] Tenant
:<|> Capture "tId" TenantId :> Delete '[JSON] TenantId
:<|> Capture "tId" TenantId :> "projects" :> ProjectAPI
type AdminAPI = "builddatabase" :> Get '[JSON] String
type StorageAPI = "tenants" :> TenantAPI
:<|> "admin" :> AdminAPI
projectServer :: TenantId -> Server ProjectAPI
projectServer tId =
liftIO (getProjectListForTenant tId)
:<|> liftIOMaybeToEither err404 . findProject tId
:<|> liftIOMaybeToEither err400 . insertProject
:<|> liftIO . deleteProject tId
tenantServer :: Server TenantAPI
tenantServer =
liftIO getTenants
:<|> liftIOMaybeToEither err404 . findTenant
:<|> liftIOMaybeToEither err400 . insertTenant
:<|> liftIO . deleteTenant
:<|> projectServer
adminServer :: Server AdminAPI
adminServer = liftIO buildDatabase
storageAPI :: Proxy StorageAPI
storageAPI = Proxy
storageServer :: Server StorageAPI
storageServer = tenantServer :<|> adminServer
-- $ curl -H "Content-Type: application/json" -X POST -d '{"tenantId":1,"tenantName":"facebook"}' http://localhost:8081/tenants/
-- {"tenantName":"facebook","tenantId":2}
-- $ curl -H "Content-Type: application/json" -X POST -d '{"projectId":1,"projectTenantId":1,"projectDescription":"a project","projectContent"
-- :"some value"}' http://localhost:8081/tenants/1/projects
-- {"projectTenantId":1,"projectContent":"some value","projectId":1,"projectDescription":"a project"}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment