Implement tomato retrieval

1 files changed, 29 insertions, 51 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 1b40313..27dcbae 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -6,19 +6,7 @@ import RIO
 
 import Data.Conduit (runConduit, (.|))
 import Data.Conduit.Attoparsec (sinkParser)
-import Network.HTTP.Req
-    ( jsonResponse
-    , req
-    , (=:)
-    , NoReqBody (..)
-    , (/:)
-    , GET (..)
-    , https
-    , responseBody
-    , Req
-    , defaultHttpConfig
-    , runReq
-    )
+import Network.HTTP.Req (defaultHttpConfig, runReq)
 import Network.HTTP.Types (status200, status500)
 import Network.Wai (responseBuilder, responseLBS, Response)
 import Network.Wai.Conduit (sourceRequestBody)
@@ -26,9 +14,9 @@ import Network.Wai.Handler.Warp (run)
 import System.Environment (getArgs)
 
 import Data.Message (InMessage (..))
-import Data.Tomato (Tomato)
 import Tomato.Post (postTomato)
 import Tomato.Validate (isTomato)
+import Tomato.Retrieve (randomTomato)
 
 import qualified Data.Aeson as Ae
 import qualified Data.ByteString.Lazy.Char8 as BL8
@@ -47,8 +35,8 @@ instance HasLogFunc App where
 runApp :: RIO App a -> IO a
 runApp inner = do
   logOptions' <- logOptionsHandle stderr False
-  -- let logOptions = setLogUseTime True $ setLogUseLoc True logOptions'
-  let logOptions = logOptions'
+  let logOptions = setLogUseTime True $ setLogUseLoc True logOptions'
+  -- let logOptions = logOptions'
   withLogFunc logOptions $ \logFunc -> do
     let app = App
           { appLogFunc = logFunc
@@ -57,46 +45,28 @@ runApp inner = do
           }
     runRIO app inner
 
-_randomTomato :: Req Tomato
-_randomTomato = do
-    let url = https "api.unsplash.com" /: "photos" /: "random"
-    js <- req GET url NoReqBody jsonResponse $
-        "query" =: ("tomato" :: Text) <>
-        "client_id" =: ("FbzqI-oR7277JwL1ZGsyUw7yG1F5U0U3WhQ3kOW71Do" :: Text)
-    tomato <- case Ae.fromJSON (responseBody js) of
-        Ae.Success r -> pure r
-        Ae.Error _s  -> error "deal with this later"
-    return tomato
-
 tomatoBot :: RIO App ()
 tomatoBot = do
   logInfo $ "Fetching tomato"
-  -- tomato <- runReq defaultHttpConfig randomTomato
-  -- logInfo $ displayShow tomato
-  -- url <- runReq defaultHttpConfig postTomato
+  runReq defaultHttpConfig randomTomato
+  logInfo $ "Posting tomato"
   runReq defaultHttpConfig postTomato
-  -- logInfo $ displayShow url
-  logInfo $ "All done"
+  logInfo $ "Done"
 
-main :: IO ()
-main = do
-    args <- getArgs
-    when (null args) (error "no port")
-    let portS = readMaybe $ L'.head args
-    let port = maybe (error "invalid port") id portS
-    run port $ \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
+runServer :: Int -> IO ()
+runServer port = run port $ \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
@@ -108,3 +78,11 @@ main = do
         status200
         [("Content-Type", "application/json")]
         $ Ae.fromEncoding $ Ae.toEncoding $ text inMes
+
+main :: IO ()
+main = do
+    args <- getArgs
+    when (null args) (error "no port")
+    let portS = readMaybe $ L'.head args
+    let port = maybe (error "invalid port") id portS
+    runServer port