-- | Drives the WAI application in-process, against a fresh in-memory
-- database for each test.
module Main (main) where

import Control.Exception (bracket)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Network.HTTP.Types
import Network.Wai (Application, requestHeaders, requestMethod)
import Network.Wai.Test
import Test.Hspec

import Todo.App
import Todo.Db qualified as Db

origin :: ByteString
origin = "http://127.0.0.1:8080"

withApp :: (Application -> IO a) -> IO a
withApp run = bracket (Db.open ":memory:") Db.close $ \db ->
  run (app (Config (Just origin) False) db)

get :: ByteString -> Session SResponse
get path = request (setPath defaultRequest path)

post :: ByteString -> [(ByteString, ByteString)] -> [Header] -> Session SResponse
post path form headers =
  srequest $
    SRequest
      (setPath defaultRequest {requestMethod = methodPost, requestHeaders = (hContentType, "application/x-www-form-urlencoded") : headers} path)
      (BL.fromStrict (BS.drop 1 (renderSimpleQuery True form)))

body :: SResponse -> T.Text
body = T.decodeUtf8 . BL.toStrict . simpleBody

-- | Labels on the page, in order.
labels :: SResponse -> [T.Text]
labels r =
  [ T.takeWhile (/= '<') (T.drop 1 (T.dropWhile (/= '>') chunk))
  | chunk <- drop 1 (T.splitOn "data-action=\"edit\"" (body r))
  ]

main :: IO ()
main = hspec $ around withApp $ do
  describe "pages" $ do
    it "serves an empty list and hands out a cookie" $ runSession $ do
      r <- get "/"
      assertStatus 200 r
      let cookie = lookup hSetCookie (simpleHeaders r)
      liftIO $ do
        cookie `shouldSatisfy` maybe False ("todo_list=" `BS.isPrefixOf`)
        cookie `shouldSatisfy` maybe False ("HttpOnly" `BS.isInfixOf`)
        cookie `shouldSatisfy` maybe False ("SameSite=Lax" `BS.isInfixOf`)
        cookie `shouldSatisfy` maybe False ("Path=/" `BS.isInfixOf`)
      assertBodyContains "<section class=\"main\" hidden=\"\">" r
      assertBodyContains "· Haskell" r

    it "keeps the cookie it handed out" $ runSession $ do
      _ <- get "/"
      r <- get "/"
      assertNoHeader hSetCookie r

    it "answers health and version checks" $ runSession $ do
      get "/healthz" >>= assertStatus 200
      r <- get "/api/version"
      assertStatus 200 r
      assertBody (BL.fromStrict (T.encodeUtf8 version)) r

    it "serves the shared stylesheets byte for byte" $ runSession $ do
      r <- get "/static/index.css"
      want <- liftIO (BS.readFile "../../shared/index.css")
      assertBody (BL.fromStrict want) r

    it "says 404 for anything else" $ runSession $
      get "/nope" >>= assertStatus 404

  describe "actions" $ do
    it "adds a trimmed todo and redirects to the filter" $ runSession $ do
      r <- post "/todos" [("title", "  buy milk  "), ("filter", "active")] []
      assertStatus 303 r
      assertHeader hLocation "/active" r
      page <- get "/"
      liftIO $ labels page `shouldBe` ["buy milk"]

    it "ignores a blank title" $ runSession $ do
      _ <- post "/todos" [("title", "   ")] []
      page <- get "/"
      liftIO $ labels page `shouldBe` []

    it "sends an unknown filter back to /" $ runSession $ do
      r <- post "/todos" [("title", "x"), ("filter", "bogus")] []
      assertHeader hLocation "/" r

    it "toggles, renames and deletes" $ runSession $ do
      mapM_ (\t -> post "/todos" [("title", t)] []) ["a", "b", "c"]
      post "/todos/1/toggle" [("filter", "all")] [] >>= assertStatus 303
      active <- get "/active"
      liftIO $ labels active `shouldBe` ["b", "c"]
      completed <- get "/completed"
      liftIO $ labels completed `shouldBe` ["a"]
      _ <- post "/todos/2/edit" [("title", " bee ")] []
      _ <- post "/todos/3/edit" [("title", "  ")] []
      page <- get "/"
      liftIO $ labels page `shouldBe` ["a", "bee"]
      _ <- post "/todos/1/destroy" [] []
      page' <- get "/"
      liftIO $ labels page' `shouldBe` ["bee"]

    it "toggles all, and back when all were done" $ runSession $ do
      mapM_ (\t -> post "/todos" [("title", t)] []) ["a", "b"]
      _ <- post "/todos/1/toggle" [] []
      _ <- post "/todos/toggle-all" [] []
      done <- get "/completed"
      liftIO $ labels done `shouldBe` ["a", "b"]
      _ <- post "/todos/toggle-all" [] []
      active <- get "/active"
      liftIO $ labels active `shouldBe` ["a", "b"]

    it "clears completed todos" $ runSession $ do
      mapM_ (\t -> post "/todos" [("title", t)] []) ["a", "b"]
      _ <- post "/todos/2/toggle" [] []
      _ <- post "/todos/clear-completed" [] []
      page <- get "/"
      liftIO $ labels page `shouldBe` ["a"]

    it "answers a fragment when app.js asks for one" $ runSession $ do
      r <- post "/todos" [("title", "x")] [(fragmentHeader, "1")]
      assertStatus 200 r
      liftIO $ body r `shouldSatisfy` T.isPrefixOf "<section class=\"main\">"

    it "opens the editor with ?edit=" $ runSession $ do
      _ <- post "/todos" [("title", "x")] []
      r <- get "/?edit=1"
      assertBodyContains "<li data-id=\"1\" class=\"editing\">" r
      assertBodyContains "action=\"/todos/1/edit\"" r

  describe "safety" $ do
    it "refuses a cross-origin post and accepts its own origin" $ runSession $ do
      post "/todos" [("title", "evil")] [("Origin", "https://evil.example")] >>= assertStatus 403
      post "/todos" [("title", "fine")] [("Origin", origin)] >>= assertStatus 303
      page <- get "/"
      liftIO $ labels page `shouldBe` ["fine"]

    it "keeps lists apart" $ \application -> do
      runSession (post "/todos" [("title", "mine")] [] >> pure ()) application
      runSession
        ( do
            post "/todos/1/toggle" [] [] >>= assertStatus 404
            post "/todos/1/edit" [("title", "stolen")] [] >>= assertStatus 404
            post "/todos/1/destroy" [] [] >>= assertStatus 404
            page <- get "/"
            liftIO $ labels page `shouldBe` []
        )
        application

    it "gives a garbled cookie a fresh list" $ runSession $ do
      r <- request (setPath defaultRequest {requestHeaders = [(hCookie, "todo_list=%%%")]} "/")
      assertStatus 200 r
      assertHeaderContains' hSetCookie "todo_list=" r

    it "escapes titles and keeps Unicode" $ runSession $ do
      _ <- post "/todos" [("title", T.encodeUtf8 "<img src=x> & \"q\" naïve 🚀")] []
      r <- get "/"
      assertBodyContains (BL.fromStrict (T.encodeUtf8 "&lt;img src=x&gt; &amp; &quot;q&quot; naïve 🚀")) r
      assertHeader hContentLength (T.encodeUtf8 (T.pack (show (BL.length (simpleBody r))))) r

    it "takes a 10,000 character title" $ runSession $ do
      let long = T.replicate 10000 "日"
      post "/todos" [("title", T.encodeUtf8 long)] [] >>= assertStatus 303
      r <- get "/"
      liftIO $ labels r `shouldBe` [long]
  where
    assertHeaderContains' name needle r =
      liftIO $ lookup name (simpleHeaders r) `shouldSatisfy` maybe False (needle `BS.isPrefixOf`)