From 752dcc5e1b04c507c67485c137b7ece2208e6f42 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Thu, 5 Sep 2019 21:42:46 -0700
Subject: [ibb] implement first api route

---
 apex/Ibb.hs | 31 ++++++++++++++++++++++++-------
 1 file changed, 24 insertions(+), 7 deletions(-)

(limited to 'apex/Ibb.hs')

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
-- 
cgit v1.2.3