diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Main.hs | 54 |
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 |