aboutsummaryrefslogtreecommitdiff
path: root/app/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Main.hs')
-rw-r--r--app/Main.hs54
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