content: {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Brok.IO.Http
      ( check
      , mkManager
      ) where
  
  import ClassyPrelude
  
  import Control.Concurrent      (threadDelay)
  import Network.Connection      (TLSSettings (TLSSettingsSimple))
  import Network.HTTP.Client     (HttpExceptionContent (InternalException), Manager, httpNoBody,
                                  newManager)
  import Network.HTTP.Client.TLS (mkManagerSettings)
  import Network.HTTP.Simple     (HttpException, HttpException (..), Request, addRequestHeader,
                                  getResponseStatusCode, parseRequest, setRequestMethod)
  
  import Brok.IO.CLI       (replace)
  import Brok.Types.Brok   (Brok, appConfig, appTLSManager)
  import Brok.Types.Config (interval)
  import Brok.Types.Link
  import Brok.Types.URL    (URL)
  
  type StatusCode = Either HttpException Int
  
  mkManager :: Bool -> IO Manager
  mkManager checkCerts = do
      let tls = TLSSettingsSimple (not checkCerts) False False
      let settings = mkManagerSettings tls Nothing
      newManager settings
  
  setHeaders :: Request -> Request
  setHeaders = addRequestHeader "User-Agent" "smallhadroncollider/brok"
  
  makeRequest :: ByteString -> URL -> Brok StatusCode
  makeRequest method url = do
      manager <- asks appTLSManager
      delay <- interval <$> asks appConfig
      lift . try $ do
          request <- setHeaders . setRequestMethod method <$> parseRequest (unpack url)
          threadDelay (fromIntegral delay * 1000) -- wait for a little while
          getResponseStatusCode <$> httpNoBody request manager
  
  tryWithGet :: URL -> StatusCode -> Brok StatusCode
  tryWithGet url (Right code)
      | code >= 400 = makeRequest "GET" url
      | otherwise = pure (Right code)
  tryWithGet url (Left (HttpExceptionRequest _ (InternalException _))) = makeRequest "GET" url
  tryWithGet url (Left _) = makeRequest "GET" url
  
  fetch :: URL -> Brok StatusCode
  fetch url = replace ("Fetching: " <> url) >> makeRequest "HEAD" url >>= tryWithGet url
  
  codeToResponse :: Link -> StatusCode -> Link
  codeToResponse lnk (Right code)
      | code >= 200 && code < 300 = working lnk code
      | otherwise = broken lnk code
  codeToResponse lnk (Left (HttpExceptionRequest _ _)) = failure lnk
  codeToResponse lnk (Left (InvalidUrlException _ _)) = invalid lnk
  
  check :: Link -> Brok Link
  check lnk = codeToResponse lnk <$> fetch (getURL lnk)
  