summaryrefslogtreecommitdiff
path: root/apex/Ibb.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-09-05 21:42:46 -0700
committerBen Sima <ben@bsima.me>2019-09-05 21:42:46 -0700
commit752dcc5e1b04c507c67485c137b7ece2208e6f42 (patch)
tree543525e838ea2c90eac27aa27f71e62b059a9d6b /apex/Ibb.hs
parent291a40f56ccc937a1f0c6735efb795e28c5c360b (diff)
[ibb] implement first api route
Diffstat (limited to 'apex/Ibb.hs')
-rw-r--r--apex/Ibb.hs31
1 files changed, 24 insertions, 7 deletions
diff --git a/apex/Ibb.hs b/apex/Ibb.hs
index 7d8a377..6d934f9 100644
--- a/apex/Ibb.hs
+++ b/apex/Ibb.hs
@@ -11,6 +11,8 @@ import Alpha
import Biz.Ibb
import qualified Biz.Ibb.Keep as Keep
import Data.Maybe (fromMaybe)
+import Data.Acid (AcidState)
+import qualified Data.Acid.Abstract as Acid
import qualified Lucid as L
import Lucid.Base
import Miso
@@ -26,12 +28,13 @@ import System.Environment (lookupEnv)
main :: IO ()
main = do
- say "running: ibb"
+ say "rise: ibb"
port <- read
<$> fromMaybe "3000"
<$> lookupEnv "PORT" :: IO Int
+ keep <- Keep.openLocal "keep/"
say "port: 3000"
- run port $ logStdout $ compress $ app
+ run port $ logStdout $ compress $ app $ keep
where
compress = gzip def { gzipFiles = GzipCompress }
@@ -54,7 +57,7 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where
, makeAttribute "defer" mempty
]
-type ServerRoutes = ToServerRoutes Routes HtmlPage Action
+type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action
handle404 :: Application
handle404 _ respond = respond
@@ -64,19 +67,33 @@ handle404 _ respond = respond
$ HtmlPage
$ notfound
-type Api = "static" :> Raw
+type Routes = "static" :> Raw
:<|> ServerRoutes
+ :<|> "api" :> ApiRoutes
:<|> Raw
-app :: Application
-app = serve (Proxy @Api)
- $ static :<|> serverHandlers :<|> Tagged handle404
+app :: AcidState Keep.IbbKeep -> Application
+app keep = serve
+ (Proxy @Routes)
+ $ static
+ :<|> serverHandlers
+ :<|> apiHandlers keep
+ :<|> Tagged handle404
where
static = serveDirectoryWith (defaultWebAppSettings "ibb.jsexe")
+type ApiRoutes =
+ "people" :> Get '[JSON] [Person]
+
serverHandlers :: Server ServerRoutes
serverHandlers = homeHandler
where
send f u =
pure $ HtmlPage $ f Model { uri = u, people = NotAsked }
homeHandler = send home goHome
+
+-- | for now we just have one api endpoint, which returns all the people
+apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes
+apiHandlers keep = do
+ people <- Acid.query' keep $ Keep.GetPeople 20
+ return $ people