module Security.Advisories.Sync.Atom
  ( latestUpdate,
  )
where

import Control.Exception (try)
import Control.Lens
import Data.Either.Extra (maybeToEither)
import qualified Data.Text as T
import Data.Time (UTCTime, defaultTimeLocale, parseTimeM, rfc822DateFormat)
import Data.Time.Format.ISO8601 (iso8601ParseM)
import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..))
import Network.Wreq
import qualified Text.Atom.Feed as FeedAtom
import qualified Text.Feed.Import as FeedImport
import qualified Text.Feed.Types as FeedTypes
import qualified Text.RSS.Syntax as FeedRSS

latestUpdate :: String -> String -> IO (Either String UTCTime)
latestUpdate :: String -> String -> IO (Either String UTCTime)
latestUpdate String
repoUrl String
branch = do
  Either HttpException (Response ByteString)
resultE <- IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response ByteString)
 -> IO (Either HttpException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ String -> IO (Response ByteString)
get (String -> IO (Response ByteString))
-> String -> IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ String
repoUrl String -> String -> String
</> String
"commits" String -> String -> String
</> String
branch String -> String -> String
</> String
"advisories.atom"
  Either String UTCTime -> IO (Either String UTCTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String UTCTime -> IO (Either String UTCTime))
-> Either String UTCTime -> IO (Either String UTCTime)
forall a b. (a -> b) -> a -> b
$
    case Either HttpException (Response ByteString)
resultE of
      Left HttpException
e ->
        String -> Either String UTCTime
forall a b. a -> Either a b
Left (String -> Either String UTCTime)
-> String -> Either String UTCTime
forall a b. (a -> b) -> a -> b
$
          case HttpException
e of
            InvalidUrlException String
url String
reason ->
              String
"Invalid URL " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
url String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
reason
            HttpExceptionRequest Request
_ HttpExceptionContent
content ->
              case HttpExceptionContent
content of
                StatusCodeException Response ()
response ByteString
body ->
                  String
"Request failed with " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Status -> String
forall a. Show a => a -> String
show (Response ()
response Response () -> Getting Status (Response ()) Status -> Status
forall s a. s -> Getting a s a -> a
^. Getting Status (Response ()) Status
forall body (f :: * -> *).
Functor f =>
(Status -> f Status) -> Response body -> f (Response body)
responseStatus) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
body
                HttpExceptionContent
_ ->
                  String
"Request failed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HttpExceptionContent -> String
forall a. Show a => a -> String
show HttpExceptionContent
content
      Right Response ByteString
result ->
        case ByteString -> Maybe Feed
forall s. FeedSource s => s -> Maybe Feed
FeedImport.parseFeedSource (ByteString -> Maybe Feed) -> ByteString -> Maybe Feed
forall a b. (a -> b) -> a -> b
$ Response ByteString
result Response ByteString
-> Getting ByteString (Response ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Response ByteString) ByteString
forall body0 body1 (f :: * -> *).
Functor f =>
(body0 -> f body1) -> Response body0 -> f (Response body1)
responseBody of
          Just (FeedTypes.AtomFeed Feed
x) ->
            String -> Maybe UTCTime -> Either String UTCTime
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Invalid feed date" (Maybe UTCTime -> Either String UTCTime)
-> Maybe UTCTime -> Either String UTCTime
forall a b. (a -> b) -> a -> b
$
              String -> Maybe UTCTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Maybe UTCTime) -> String -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$
                Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
                  Feed -> Text
FeedAtom.feedUpdated Feed
x
          Just (FeedTypes.RSSFeed RSS
x) ->
            String -> Maybe UTCTime -> Either String UTCTime
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"Invalid feed date" (Maybe UTCTime -> Either String UTCTime)
-> Maybe UTCTime -> Either String UTCTime
forall a b. (a -> b) -> a -> b
$
              RSSChannel -> Maybe Text
FeedRSS.rssLastUpdate (RSS -> RSSChannel
FeedRSS.rssChannel RSS
x)
                Maybe Text -> (Text -> Maybe UTCTime) -> Maybe UTCTime
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
rfc822DateFormat (String -> Maybe UTCTime)
-> (Text -> String) -> Text -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
          Just (FeedTypes.RSS1Feed Feed
_) -> String -> Either String UTCTime
forall a b. a -> Either a b
Left String
"RSS1 feed are not supported"
          Just (FeedTypes.XMLFeed Element
_) -> String -> Either String UTCTime
forall a b. a -> Either a b
Left String
"XML feed are not supported"
          Maybe Feed
Nothing -> String -> Either String UTCTime
forall a b. a -> Either a b
Left String
"No feed found"

infixr 5 </>

(</>) :: String -> String -> String
String
"/" </> :: String -> String -> String
</> (Char
'/' : String
ys) = Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
String
"/" </> String
ys = Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
String
"" </> (Char
'/' : String
ys) = Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
String
"" </> String
ys = Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
[Char
x] </> (Char
'/' : String
ys) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
[Char
x] </> String
ys = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys
(Char
x0 : Char
x1 : String
xs) </> String
ys = Char
x0 Char -> String -> String
forall a. a -> [a] -> [a]
: ((Char
x1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs) String -> String -> String
</> String
ys)