brok 0.2.0.0 → 1.0.0
raw patch · 18 files changed
+171/−79 lines, 18 filesdep +connectiondep +http-client-tlsdep +template-haskelldep ~ansi-terminaldep ~attoparsecdep ~directory
Dependencies added: connection, http-client-tls, template-haskell
Dependency ranges changed: ansi-terminal, attoparsec, directory, file-embed, http-client, text, time
Files
- README.md +12/−0
- brok.cabal +14/−11
- src/Brok.hs +20/−10
- src/Brok/IO/CLI.hs +15/−15
- src/Brok/IO/DB.hs +10/−10
- src/Brok/IO/Document.hs +2/−2
- src/Brok/IO/Http.hs +24/−10
- src/Brok/IO/Output.hs +4/−4
- src/Brok/Parser/Options.hs +13/−2
- src/Brok/Types/App.hs +0/−9
- src/Brok/Types/Brok.hs +21/−0
- src/Brok/Types/Config.hs +2/−0
- src/Brok/Types/Link.hs +2/−2
- src/Brok/Types/Next.hs +1/−0
- src/Brok/Types/Result.hs +2/−2
- template/usage.txt +1/−0
- test/IO/HttpTest.hs +15/−2
- test/OptionsTest.hs +13/−0
README.md view
@@ -75,6 +75,18 @@ brok --no-cache test.md links.tex ``` +#### Check Certificates++Most browsers will display a website even if it has certificate issues (such as an incomplete certificate chain). By default Brök will not check certificates, so replicate this behaviour.++If you would like to enforce certificate checking, you can turn this on:++```bash+brok --check-certs test.md+```++Any sites with certificate issues will then return a `Could not connect` error.+ #### Ignore URLs You can tell brök to ignore URLs with specified prefixes:
brok.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: brok-version: 0.2.0.0+version: 1.0.0 license: BSD3 license-file: LICENSE copyright: 2019 Small Hadron Collider@@ -34,7 +34,7 @@ Brok.Parser.DB Brok.Parser.Links Brok.Parser.Options- Brok.Types.App+ Brok.Types.Brok Brok.Types.Config Brok.Types.Link Brok.Types.Next@@ -46,16 +46,19 @@ default-language: Haskell2010 default-extensions: OverloadedStrings NoImplicitPrelude build-depends:- ansi-terminal >=0.9.1 && <0.10,- attoparsec >=0.13.2.3 && <0.14,+ ansi-terminal >=0.10.3 && <0.11,+ attoparsec >=0.13.2.4 && <0.14, base >=4.7 && <5, classy-prelude >=1.5.0 && <1.6,- directory >=1.3.3.0 && <1.4,- file-embed >=0.0.11.1 && <0.1,- http-client >=0.6.4 && <0.7,+ connection >=0.3.1 && <0.4,+ directory >=1.3.6.0 && <1.4,+ file-embed >=0.0.11.2 && <0.1,+ http-client >=0.6.4.1 && <0.7,+ http-client-tls >=0.3.5.3 && <0.4, http-conduit >=2.3.7.3 && <2.4,- text >=1.2.3.1 && <1.3,- time >=1.8.0.2 && <1.9+ template-haskell >=2.15.0.0 && <2.16,+ text >=1.2.4.0 && <1.3,+ time >=1.9.3 && <1.10 executable brok main-is: Main.hs@@ -69,7 +72,7 @@ base >=4.7 && <5, brok -any, classy-prelude >=1.5.0 && <1.6,- file-embed >=0.0.11.1 && <0.1+ file-embed >=0.0.11.2 && <0.1 test-suite brok-test type: exitcode-stdio-1.0@@ -88,7 +91,7 @@ base >=4.7 && <5, brok -any, classy-prelude >=1.5.0 && <1.6,- file-embed >=0.0.11.1 && <0.1,+ file-embed >=0.0.11.2 && <0.1, tasty >=1.2.3 && <1.3, tasty-discover >=4.2.1 && <4.3, tasty-expected-failure >=0.11.1.2 && <0.12,
src/Brok.hs view
@@ -12,23 +12,27 @@ import Data.Text.IO (hPutStrLn) import System.Exit (exitFailure, exitSuccess) +import Data.Version (showVersion)+import Language.Haskell.TH.Syntax (liftString)+import qualified Paths_brok (version)+ import Brok.IO.CLI (header, replace) import Brok.IO.DB (getCached, setCached) import Brok.IO.Document (readContent)-import Brok.IO.Http (check)+import Brok.IO.Http (check, mkManager) import Brok.IO.Output (output) import Brok.Options (parse) import Brok.Parser.Links (links)-import Brok.Types.App (App)-import qualified Brok.Types.Config as C (files, ignore, interval, onlyFailures)+import Brok.Types.Brok (Brok, appConfig, mkApp)+import qualified Brok.Types.Config as C (checkCerts, files, ignore, interval, onlyFailures) import Brok.Types.Link (getURL, isSuccess) import Brok.Types.Next (Next (..)) import Brok.Types.Result (cachedLinks, ignoredLinks, justLinks, linkIOMap, parseLinks, pathToResult) -go :: App ()+go :: Brok () go = do- config <- ask+ config <- asks appConfig -- read files content <- traverse (readContent . pathToResult) (C.files config) -- find links in each file@@ -53,17 +57,23 @@ then void exitFailure else void exitSuccess -showHelp :: IO ()-showHelp = putStr $ decodeUtf8 $(embedFile "template/usage.txt")+putHelp :: IO ()+putHelp = putStr $ decodeUtf8 $(embedFile "template/usage.txt") +putVersion :: IO ()+putVersion = putStrLn $ "brök " <> $(liftString $ showVersion Paths_brok.version)+ -- entry point brok :: IO () brok = do config <- parse <$> getArgs case config of- Right (Continue cnf) -> runReaderT go cnf- Right Help -> showHelp+ Right (Continue cnf) -> do+ manager <- mkManager (C.checkCerts cnf)+ runReaderT go (mkApp cnf manager)+ Right Help -> putHelp+ Right Version -> putVersion Left _ -> do hPutStrLn stderr "Invalid format"- showHelp+ putHelp void exitFailure
src/Brok/IO/CLI.hs view
@@ -5,59 +5,59 @@ import ClassyPrelude -import Brok.Types.App (App) import Brok.Types.Config (noColor)+import Brok.Types.Brok (Brok, appConfig) import Data.Text.IO (hPutStr, hPutStrLn) import System.Console.ANSI (Color (Blue, Green, Magenta, Red, Yellow), ColorIntensity (Dull), ConsoleLayer (Foreground), SGR (Reset, SetColor), hClearLine, hCursorUpLine, hSetSGR) -setSGR :: Handle -> [SGR] -> App ()+setSGR :: Handle -> [SGR] -> Brok () setSGR hndl settings = do- colourize <- not <$> asks noColor+ colourize <- not . noColor <$> asks appConfig when colourize $ lift (hSetSGR hndl settings) -blank :: App ()+blank :: Brok () blank = putStrLn "" -message :: Text -> App ()+message :: Text -> Brok () message msg = do setSGR stdout [SetColor Foreground Dull Blue] putStrLn msg setSGR stdout [Reset] -mehssage :: Text -> App ()+mehssage :: Text -> Brok () mehssage msg = do setSGR stdout [SetColor Foreground Dull Yellow] putStrLn msg setSGR stdout [Reset] -header :: Text -> App ()+header :: Text -> Brok () header msg = do setSGR stdout [SetColor Foreground Dull Magenta] putStrLn $ "*** " ++ msg ++ " ***" setSGR stdout [Reset] -successMessage :: Text -> App ()+successMessage :: Text -> Brok () successMessage msg = do setSGR stdout [SetColor Foreground Dull Green] putStrLn msg setSGR stdout [Reset] -errorMessage :: Text -> App ()+errorMessage :: Text -> Brok () errorMessage msg = do setSGR stderr [SetColor Foreground Dull Red] lift $ hPutStrLn stderr msg setSGR stderr [Reset] -errors :: Text -> [Text] -> App ()+errors :: Text -> [Text] -> Brok () errors _ [] = return () errors msg missing = do errorMessage msg lift $ hPutStrLn stderr "" errorMessage (unlines $ ("- " ++) <$> missing) -split :: Handle -> Color -> Text -> Text -> App ()+split :: Handle -> Color -> Text -> Text -> Brok () split hdl color left right = do setSGR hdl [SetColor Foreground Dull color] lift $ hPutStr hdl left@@ -65,16 +65,16 @@ lift $ hPutStr hdl $ ": " ++ right lift $ hPutStrLn hdl "" -splitErr :: Text -> Text -> App ()+splitErr :: Text -> Text -> Brok () splitErr = split stderr Red -splitOut :: Text -> Text -> App ()+splitOut :: Text -> Text -> Brok () splitOut = split stdout Green -splitMeh :: Text -> Text -> App ()+splitMeh :: Text -> Text -> Brok () splitMeh = split stdout Yellow -replace :: Text -> App ()+replace :: Text -> Brok () replace msg = do lift $ hCursorUpLine stdout 1 lift $ hClearLine stdout
src/Brok/IO/DB.hs view
@@ -13,20 +13,20 @@ import System.Directory (doesFileExist) import Brok.Parser.DB (db)-import Brok.Types.App (App) import Brok.Types.Config (cache)+import Brok.Types.Brok (Brok, appConfig) import Brok.Types.URL (URL) path :: String path = ".brokdb" -- time stuff-removeOld :: Integer -> [(URL, Integer)] -> App [(URL, Integer)]+removeOld :: Integer -> [(URL, Integer)] -> Brok [(URL, Integer)] removeOld age cached = do timestamp <- lift getPOSIXTime return $ filter ((\val -> timestamp - val < fromInteger age) . fromInteger . snd) cached -stamp :: URL -> App (URL, Integer)+stamp :: URL -> Brok (URL, Integer) stamp lnk = do timestamp <- lift $ round <$> getPOSIXTime return (lnk, timestamp)@@ -35,12 +35,12 @@ linkToText :: (URL, Integer) -> Text linkToText (lnk, int) = concat [lnk, " ", tshow int] -write :: [(URL, Integer)] -> App ()+write :: [(URL, Integer)] -> Brok () write links = writeFile path . encodeUtf8 . unlines $ linkToText <$> links -setCached :: [URL] -> App ()+setCached :: [URL] -> Brok () setCached links = do- mAge <- asks cache+ mAge <- cache <$> asks appConfig case mAge of Nothing -> pure () Just age -> do@@ -49,19 +49,19 @@ write $ current ++ stamped -- read db-read :: Integer -> FilePath -> App [(URL, Integer)]+read :: Integer -> FilePath -> Brok [(URL, Integer)] read age filepath = removeOld age =<< fromRight [] . db . decodeUtf8 <$> readFile filepath -load :: Integer -> App [(URL, Integer)]+load :: Integer -> Brok [(URL, Integer)] load age = do exists <- lift $ doesFileExist path if exists then read age path else return [] -getCached :: App [URL]+getCached :: Brok [URL] getCached = do- mAge <- asks cache+ mAge <- cache <$> asks appConfig case mAge of Nothing -> pure [] (Just age) -> (fst <$>) <$> load age
src/Brok/IO/Document.hs view
@@ -9,10 +9,10 @@ import System.Directory (doesFileExist) -import Brok.Types.App (App)+import Brok.Types.Brok (Brok) import Brok.Types.Result -readContent :: Result -> App Result+readContent :: Result -> Brok Result readContent result = do let path = getPath result let filepath = unpack path
src/Brok/IO/Http.hs view
@@ -3,38 +3,52 @@ module Brok.IO.Http ( check+ , mkManager ) where import ClassyPrelude -import Control.Concurrent (threadDelay)-import Network.HTTP.Simple (HttpException, HttpException (..), Request, addRequestHeader,- getResponseStatusCode, httpNoBody, parseRequest, setRequestMethod)+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.App (App)+import Brok.Types.Brok (Brok, appTLSManager) 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 :: Integer -> ByteString -> URL -> App StatusCode-makeRequest delay method url =+makeRequest :: Integer -> ByteString -> URL -> Brok StatusCode+makeRequest delay method url = do+ manager <- asks appTLSManager lift . try $ do request <- setHeaders . setRequestMethod method <$> parseRequest (unpack url) threadDelay (fromIntegral delay * 1000) -- wait for a little while- getResponseStatusCode <$> httpNoBody request+ getResponseStatusCode <$> httpNoBody request manager -tryWithGet :: Integer -> URL -> StatusCode -> App StatusCode+tryWithGet :: Integer -> URL -> StatusCode -> Brok StatusCode tryWithGet delay url (Right code) | code >= 400 = makeRequest delay "GET" url | otherwise = return (Right code)+tryWithGet delay url (Left (HttpExceptionRequest _ (InternalException _))) =+ makeRequest delay "GET" url tryWithGet delay url (Left _) = makeRequest delay "GET" url -fetch :: Integer -> URL -> App StatusCode+fetch :: Integer -> URL -> Brok StatusCode fetch delay url = replace ("Fetching: " ++ url) >> makeRequest delay "HEAD" url >>= tryWithGet delay url @@ -45,5 +59,5 @@ codeToResponse lnk (Left (HttpExceptionRequest _ _)) = failure lnk codeToResponse lnk (Left (InvalidUrlException _ _)) = invalid lnk -check :: Integer -> Link -> App Link+check :: Integer -> Link -> Brok Link check delay lnk = codeToResponse lnk <$> fetch delay (getURL lnk)
src/Brok/IO/Output.hs view
@@ -8,12 +8,12 @@ import ClassyPrelude import Brok.IO.CLI-import Brok.Types.App (App)+import Brok.Types.Brok (Brok) import Brok.Types.Link import Brok.Types.Result -- output-linkOutput :: Link -> App ()+linkOutput :: Link -> Brok () linkOutput (Link url BareLink) = splitErr "- Failed (unknown)" url linkOutput (Link url Ignored) = mehssage $ "- Ignored: " ++ url linkOutput (Link url Cached) = splitOut "- OK (cached)" url@@ -31,7 +31,7 @@ outputPath :: TFilePath -> Text outputPath path = concat ["\n", "[", path, "]"] -outputMap :: Bool -> Result -> App Bool+outputMap :: Bool -> Result -> Brok Bool outputMap _ (Result path NotFound) = do errorMessage $ outputPath path errorMessage " - File not found"@@ -60,7 +60,7 @@ return anyErrs outputMap _ _ = return False -output :: Bool -> [Result] -> App Bool+output :: Bool -> [Result] -> Brok Bool output onlyFailures results = do errs <- traverse (outputMap onlyFailures) results let anyErrs = foldl' (||) False errs
src/Brok/Parser/Options.hs view
@@ -20,6 +20,7 @@ | Ignore [Text] | Files [Text] | NoColor+ | CheckCerts | OnlyFailures onlyFailuresP :: Parser Option@@ -28,6 +29,9 @@ noColorP :: Parser Option noColorP = lexeme $ string "--no-color" $> NoColor +checkCertsP :: Parser Option+checkCertsP = lexeme $ string "--check-certs" $> CheckCerts+ noCacheP :: Parser Option noCacheP = lexeme $ string "--no-cache" $> Cache Nothing @@ -54,19 +58,26 @@ convert dc (Interval i) = dc {interval = i} convert dc (Files i) = dc {files = i} convert dc NoColor = dc {noColor = True}+ convert dc CheckCerts = dc {checkCerts = True} convert dc OnlyFailures = dc {onlyFailures = True} arguments :: Parser Config arguments = do- opts <- many' (noCacheP <|> cacheP <|> intervalP <|> ignoreP <|> noColorP <|> onlyFailuresP)+ opts <-+ many'+ (noCacheP <|> cacheP <|> intervalP <|> ignoreP <|> noColorP <|> checkCertsP <|>+ onlyFailuresP) fls <- many1 fileP return . optsToConfig $ opts ++ [Files fls] helpP :: Parser Next helpP = lexeme $ (string "--help" <|> string "-h") $> Help +versionP :: Parser Next+versionP = lexeme $ (string "--version" <|> string "-v") $> Version+ next :: Parser Next-next = helpP <|> (Continue <$> arguments)+next = helpP <|> versionP <|> (Continue <$> arguments) -- run parser options :: [Text] -> Either Text Next
− src/Brok/Types/App.hs
@@ -1,9 +0,0 @@-module Brok.Types.App- ( App- ) where--import ClassyPrelude--import Brok.Types.Config (Config)--type App a = ReaderT Config IO a
+ src/Brok/Types/Brok.hs view
@@ -0,0 +1,21 @@+module Brok.Types.Brok+ ( Brok+ , appConfig+ , appTLSManager+ , mkApp+ ) where++import ClassyPrelude++import Brok.Types.Config (Config)+import Network.HTTP.Client (Manager)++data App = App+ { appConfig :: Config+ , appTLSManager :: Manager+ }++mkApp :: Config -> Manager -> App+mkApp config manager = App config manager++type Brok a = ReaderT App IO a
src/Brok/Types/Config.hs view
@@ -12,6 +12,7 @@ , interval :: Integer , files :: [Text] , noColor :: Bool+ , checkCerts :: Bool , onlyFailures :: Bool } deriving (Show, Eq) @@ -23,5 +24,6 @@ , interval = 100 , files = [] , noColor = False+ , checkCerts = False , onlyFailures = False }
src/Brok/Types/Link.hs view
@@ -4,7 +4,7 @@ import ClassyPrelude -import Brok.Types.App (App)+import Brok.Types.Brok (Brok) import Brok.Types.URL (URL) data LinkType@@ -61,6 +61,6 @@ isSuccess (Link _ (Working _)) = True isSuccess _ = False -lmap :: (Link -> App Link) -> Link -> App Link+lmap :: (Link -> Brok Link) -> Link -> Brok Link lmap fn (Link url BareLink) = fn (Link url BareLink) lmap _ lnk = return lnk
src/Brok/Types/Next.hs view
@@ -9,4 +9,5 @@ data Next = Continue Config | Help+ | Version deriving (Show, Eq)
src/Brok/Types/Result.hs view
@@ -4,7 +4,7 @@ import ClassyPrelude -import Brok.Types.App (App)+import Brok.Types.Brok (Brok) import Brok.Types.Link import Brok.Types.URL (URL) @@ -56,7 +56,7 @@ ignoredLinks :: [URL] -> Result -> Result ignoredLinks = findLinks ignoredLink -linkIOMap :: (Link -> App Link) -> Result -> App Result+linkIOMap :: (Link -> Brok Link) -> Result -> Brok Result linkIOMap fn (Result path (Links links)) = Result path . Links <$> traverse (lmap fn) links linkIOMap _ result = pure result
template/usage.txt view
@@ -3,6 +3,7 @@ Options: --no-color Don't use color codes in the output+--check-certs Sites with certificate issues will fail --cache SECONDS The number of seconds to cache successful results for (default: 86400) --interval MILLISECONDS The number of milliseconds between each request (default: 100) --ignore URLS A list of URL prefixes to ignore
test/IO/HttpTest.hs view
@@ -7,13 +7,16 @@ import Test.Tasty -import Brok.IO.Http (check)+import Brok.IO.Http (check, mkManager)+import Brok.Types.Brok (mkApp) import Brok.Types.Config (defaultConfig) import Brok.Types.Link (Link (Link), LinkType (..), urlToLink) import Test.Tasty.HUnit testLink :: Text -> IO Link-testLink link = runReaderT (check 0 (urlToLink link)) defaultConfig+testLink lnk = do+ manager <- mkManager False+ runReaderT (check 0 (urlToLink lnk)) (mkApp defaultConfig manager) test_http :: TestTree test_http =@@ -37,6 +40,16 @@ "Returns a 200" (Link "https://code.tutsplus.com/tutorials/stateful-vs-stateless-functional-components-in-react--cms-29541"+ (Working 200))+ result+ , testCase "buginit.com (Incomplete certificate chain)" $ do+ result <-+ testLink+ "https://buginit.com/javascript/javascript-destructuring-es6-the-complete-guide/"+ assertEqual+ "Returns a 200"+ (Link+ "https://buginit.com/javascript/javascript-destructuring-es6-the-complete-guide/" (Working 200)) result , testCase "Non-existent site" $ do
test/OptionsTest.hs view
@@ -21,6 +21,13 @@ [ testCase "--help" (assertEqual "return Help" (Right Help) (parse ["--help"])) , testCase "-h" (assertEqual "return Help" (Right Help) (parse ["-h"])) ]+ , testGroup+ "Version"+ [ testCase+ "--version"+ (assertEqual "return Version" (Right Version) (parse ["--version"]))+ , testCase "-v" (assertEqual "return Version" (Right Version) (parse ["-v"]))+ ] , testCase "single file" (assertEqual@@ -45,6 +52,12 @@ "gives back files" (Right (Continue (defaultConfig {noColor = True, files = ["blah.md"]}))) (parse ["--no-color", "blah.md"]))+ , testCase+ "single file with check-certs option"+ (assertEqual+ "gives back files"+ (Right (Continue (defaultConfig {checkCerts = True, files = ["blah.md"]})))+ (parse ["--check-certs", "blah.md"])) , testCase "single file with no-cache option" (assertEqual