Handle requests

1 files changed, 42 insertions, 12 deletions

diff --git a/app/Main.hs b/app/Main.hs
index bdbef74..3f1dcf5 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,9 +1,11 @@
 module Main
-    ( main
-    ) where
+  ( main
+  ) where
 
 import RIO
 
+import Data.Conduit (runConduit, (.|))
+import Data.Conduit.Attoparsec (sinkParser)
 import Network.HTTP.Req
     ( jsonResponse
     , req
@@ -17,17 +19,24 @@ import Network.HTTP.Req
     , defaultHttpConfig
     , runReq
     )
+import Network.HTTP.Types (status200, status500)
+import Network.Wai (responseBuilder, responseLBS, Response)
+import Network.Wai.Conduit (sourceRequestBody)
+import Network.Wai.Handler.Warp (run)
 
+import Data.Message (InMessage (..))
 import Data.Tomato (Tomato)
 import Tomato.Post (postTomato)
+import Tomato.Validate (isTomato)
 
-import qualified Data.Aeson.Types as Ae
+import qualified Data.Aeson as Ae
+import qualified Data.ByteString.Lazy.Char8 as BL8
 
 
 data App = App
     { appLogFunc :: !LogFunc
-    , appName :: !Utf8Builder
-    , appToken :: !Text
+    , appToken   :: !Text
+    , appBotId   :: !Text
     }
 
 instance HasLogFunc App where
@@ -41,13 +50,13 @@ runApp inner = do
   withLogFunc logOptions $ \logFunc -> do
     let app = App
           { appLogFunc = logFunc
-          , appName = "Tomato Bot"
-          , appToken =  "placeholder"
+          , appToken = "placeholder"
+          , appBotId = "placeholder"
           }
     runRIO app inner
 
-randomTomato :: Req Tomato
-randomTomato = do
+_randomTomato :: Req Tomato
+_randomTomato = do
     let url = https "api.unsplash.com" /: "photos" /: "random"
     js <- req GET url NoReqBody jsonResponse $
         "query" =: ("tomato" :: Text) <>
@@ -59,8 +68,6 @@ randomTomato = do
 
 tomatoBot :: RIO App ()
 tomatoBot = do
-  name <- view $ to appName
-  logInfo $ "Hello, " <> name
   logInfo $ "Fetching tomato"
   -- tomato <- runReq defaultHttpConfig randomTomato
   -- logInfo $ displayShow tomato
@@ -70,4 +77,27 @@ tomatoBot = do
   logInfo $ "All done"
 
 main :: IO ()
-main = runApp tomatoBot
+main = run 3000 $ \request send -> do
+    eres <- tryAnyDeep $ do
+      val <- runConduit
+           $ sourceRequestBody request
+          .| sinkParser Ae.json
+      case Ae.fromJSON val of
+          Ae.Success r -> return r
+          Ae.Error _s  -> error "handle this later"
+    case eres of
+      Left e -> send $ errorResponse e
+      Right inMes -> do
+          when (isTomato inMes) $ runApp tomatoBot
+          send $ validResponse inMes
+  where
+    errorResponse :: SomeException -> Response
+    errorResponse e = responseLBS
+        status500
+        [("Content-Type", "text/plain")]
+        $ BL8.pack $ "Exception occurred: " ++ show e
+    validResponse :: InMessage -> Response
+    validResponse inMes = responseBuilder
+        status200
+        [("Content-Type", "application/json")]
+        $ Ae.fromEncoding $ Ae.toEncoding $ text inMes