netrc 0.1.0.0 → 0.2.0.0

raw patch · 27 files changed

+129/−49 lines, 27 filesdep ~basedep ~bytestringdep ~deepseqPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, deepseq, tasty, tasty-quickcheck

API changes (from Hackage documentation)

Files

• changelog.md +8/−0
• netrc.cabal +5/−1
• src-tests/data/test0a.netrc.out +1/−1
• src-tests/data/test0b.netrc.out +1/−1
• src-tests/data/test0c.netrc.out +1/−1
• src-tests/data/test0d.netrc.out +1/−1
• src-tests/data/test0e.netrc.out +1/−1
• src-tests/data/test1a.netrc.out +1/−1
• src-tests/data/test2a.netrc.out +1/−1
• src-tests/data/test2b.netrc.out +1/−1
• src-tests/data/test2c.netrc.out +1/−1
• src-tests/data/test3a.netrc.out +1/−1
• src-tests/data/test3b.netrc.out +1/−1
• src-tests/data/test3c.netrc.out +1/−1
• src-tests/data/test3e.netrc.out +1/−1
• src-tests/data/test3f.netrc.out +1/−1
• src-tests/data/test3g.netrc.out +1/−1
• src-tests/data/test4a.netrc.out +1/−1
• src-tests/data/test4b.netrc.out +1/−1
• src-tests/data/test4c.netrc.out +1/−1
• src-tests/data/test4d.netrc.out +1/−1
• src-tests/data/test4e.netrc.out +1/−1
• src-tests/data/test4f.netrc.out +1/−1
• src-tests/data/test5a.netrc.out +1/−1
• src-tests/data/test5b.netrc.out +1/−1
• src-tests/test-netrc.hs +23/−4
• src/Network/NetRc.hs +70/−21

@@ -0,0 +1,8 @@+## 0.2.0.0++  - Change data representation to associate `macdef` entries with+    their respective `machine`/`default` entry++## 0.1.0.0++  - Initial version

@@ -1,7 +1,8 @@ name:                netrc-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Parser for .netrc files homepage:            https://github.com/hvr/netrc+bug-reports:         https://github.com/hvr/netrc/issues license:             GPL-3 license-file:        LICENSE author:              Herbert Valerio Riedel@@ -12,10 +13,13 @@ cabal-version:       >=1.10 tested-with:         GHC ==7.10.1, GHC ==7.8.4, GHC ==7.6.3, GHC ==7.4.2 description:+  This package provides a parser and a printer for so-called @.netrc@ files.+  .   See <http://linux.die.net/man/5/netrc netrc(5)> manual page for more   information about @.netrc@ files.  extra-source-files:+  changelog.md   src-tests/data/*.netrc   src-tests/data/*.netrc.out 

@@ -1,1 +1,1 @@-Right (NetRc [] [])+Right (NetRc {nrHosts = [], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [] [])+Right (NetRc {nrHosts = [], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [] [])+Right (NetRc {nrHosts = [], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [] [])+Right (NetRc {nrHosts = [], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [] [])+Right (NetRc {nrHosts = [], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "host1.domain.com", nrhLogin = "log1", nrhPassword = "pass1", nrhAccount = "acct1"},NetRcHost {nrhName = "", nrhLogin = "log2", nrhPassword = "pass2", nrhAccount = ""}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "host1.domain.com", nrhLogin = "log1", nrhPassword = "pass1", nrhAccount = "acct1", nrhMacros = []},NetRcHost {nrhName = "", nrhLogin = "log2", nrhPassword = "pass2", nrhAccount = "", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "host.domain.com", nrhLogin = "log", nrhPassword = "#pass", nrhAccount = "acct"}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "host.domain.com", nrhLogin = "log", nrhPassword = "#pass", nrhAccount = "acct", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "host.domain.com", nrhLogin = "log", nrhPassword = "pass#", nrhAccount = "acct"}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "host.domain.com", nrhLogin = "log", nrhPassword = "pass#", nrhAccount = "acct", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "host.domain.com", nrhLogin = "log", nrhPassword = "pa#ss", nrhAccount = "acct"}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "host.domain.com", nrhLogin = "log", nrhPassword = "pa#ss", nrhAccount = "acct", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = ""},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = ""}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = "", nrhMacros = []},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = "", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = ""},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = ""}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = "", nrhMacros = []},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = "", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = ""},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = ""}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = "", nrhMacros = []},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = "", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = ""},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = ""}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = "", nrhMacros = []},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = "", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = ""},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = ""}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "pass", nrhAccount = "", nrhMacros = []},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = "", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "#pass", nrhAccount = ""},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = ""}] [])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "foo.domain.com", nrhLogin = "bar", nrhPassword = "#pass", nrhAccount = "", nrhMacros = []},NetRcHost {nrhName = "bar.domain.com", nrhLogin = "foo", nrhPassword = "pass", nrhAccount = "", nrhMacros = []}], nrMacros = []})

@@ -1,1 +1,1 @@-Right (NetRc [] [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\nmacdef macro2\nline3\nline4\n"}])+Right (NetRc {nrHosts = [], nrMacros = [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\nmacdef macro2\nline3\nline4\n"}]})

@@ -1,1 +1,1 @@-Right (NetRc [] [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n#\nmacdef macro2\nline3\nline4\n"}])+Right (NetRc {nrHosts = [], nrMacros = [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n#\nmacdef macro2\nline3\nline4\n"}]})

@@ -1,1 +1,1 @@-Right (NetRc [] [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n"},NetRcMacDef {nrmName = "macro2", nrmBody = "line3\nline4\n"}])+Right (NetRc {nrHosts = [], nrMacros = [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n"},NetRcMacDef {nrmName = "macro2", nrmBody = "line3\nline4\n"}]})

@@ -1,1 +1,1 @@-Right (NetRc [] [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n"},NetRcMacDef {nrmName = "macro2", nrmBody = "line3\nline4\n"}])+Right (NetRc {nrHosts = [], nrMacros = [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n"},NetRcMacDef {nrmName = "macro2", nrmBody = "line3\nline4\n"}]})

@@ -1,1 +1,1 @@-Right (NetRc [] [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n \nline3\nline4\n"}])+Right (NetRc {nrHosts = [], nrMacros = [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n \nline3\nline4\n"}]})

@@ -1,1 +1,1 @@-Right (NetRc [] [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n#\nline3\nline4\n"}])+Right (NetRc {nrHosts = [], nrMacros = [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n#\nline3\nline4\n"}]})

@@ -1,1 +1,1 @@-Right (NetRc [NetRcHost {nrhName = "", nrhLogin = "anon", nrhPassword = "blah", nrhAccount = ""}] [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n"},NetRcMacDef {nrmName = "macro2", nrmBody = "line3\nline4\n"}])+Right (NetRc {nrHosts = [NetRcHost {nrhName = "", nrhLogin = "anon", nrhPassword = "blah", nrhAccount = "", nrhMacros = [NetRcMacDef {nrmName = "macro2", nrmBody = "line3\nline4\n"}]}], nrMacros = [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n"}]})

@@ -1,1 +1,1 @@-Right (NetRc [] [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n \ndefault login anon password blah # comment\n# \n"},NetRcMacDef {nrmName = "macro2", nrmBody = "line3\nline4\n"}])+Right (NetRc {nrHosts = [], nrMacros = [NetRcMacDef {nrmName = "macro1", nrmBody = "line1\nline2\n \ndefault login anon password blah # comment\n# \n"},NetRcMacDef {nrmName = "macro2", nrmBody = "line3\nline4\n"}]})

@@ -24,18 +24,32 @@     let !retval = IUT.parseNetRc fp raw     return (LBC.pack $ show retval) +doGoTest2 :: FilePath -> IO LB.ByteString+doGoTest2 fp = do+    raw <- B.readFile fp+    let !retval = IUT.parseNetRc fp raw+    case retval of+        Left e -> return "# netrc parsing failed #"+        Right v -> return (LB.pack $ B.unpack $ IUT.netRcToByteString v)+ main :: IO () main = do     netrcFiles <- findByExtension [".netrc"] "src-tests/data" -    let goTests = testGroup "golden"+    let goTests = testGroup "ref-samples"                   [ goldenVsString tn (fp++".out") (doGoTest fp)                   | fp <- sort netrcFiles                   , let Just tn = stripPrefix "src-tests/data/" fp                   ] -    defaultMain $ testGroup "Tests" [goTests, qcTests]+    let goTests2 = testGroup "ref-samples2"+                  [ goldenVsString tn (fp++".out2") (doGoTest2 fp)+                  | fp <- sort netrcFiles+                  , let Just tn = stripPrefix "src-tests/data/" fp+                  ] +    defaultMain $ testGroup "Tests" [goTests, goTests2, qcTests]+   where      qcTests = testGroup "QC" [testProperty "roundtrip" propRoundtrip]@@ -65,7 +79,7 @@         c = choose (1,127) `suchThat` (/= 10)  instance Arbitrary IUT.NetRc where-    arbitrary = IUT.NetRc <$> arbitrary <*> arbitrary+    arbitrary = IUT.NetRc <$> listOfArbs 10 <*> listOfArbs 16  instance Arbitrary IUT.NetRcMacDef where     arbitrary = IUT.NetRcMacDef <$> (tok `suchThat` (/= "")) <*> body@@ -74,6 +88,11 @@         body = BC.unlines <$> (listOf (fromLine <$> arbitrary))  instance Arbitrary IUT.NetRcHost where-    arbitrary = IUT.NetRcHost <$> tok <*> tok <*> tok <*> tok+    arbitrary = IUT.NetRcHost <$> tok <*> tok <*> tok <*> tok <*> listOfArbs 3       where         tok = fromToken <$> arbitrary++listOfArbs :: Arbitrary a => Int -> Gen [a]+listOfArbs lim = sized $ \n -> do+    n' <- choose (0,n `min` lim)+    vectorOf n' arbitrary

@@ -23,9 +23,10 @@ -- -- As an extension to the @.netrc@-format as described in .e.g. -- <http://linux.die.net/man/5/netrc netrc(5)>, @#@-style comments are--- supported.  For simplicity, such comments are only allowed between--- entries.---+-- tolerated.  Comments are currently only allowed before, between,+-- and after @machine@\/@default@\/@macdef@ entries. Be aware though+-- that such @#@-comment are not supported by all @.netrc@-aware+-- applications, including @ftp(1)@. module Network.NetRc     ( -- * Types       NetRc(..)@@ -53,7 +54,7 @@ import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as LB import           Data.Data-import           Data.Either (partitionEithers)+import           Data.Either (rights, lefts) import           Data.List (intersperse, foldl') import           Data.Monoid import           GHC.Generics@@ -66,42 +67,62 @@ -- -- __Invariant__: fields must not contain any @TAB@s, @SPACE@, or @LF@s. data NetRcHost = NetRcHost-    { nrhName      :: !ByteString -- ^ Remote machine name (@""@ for @default@-entries)-    , nrhLogin     :: !ByteString -- ^ @login@ property (@""@ if missing)-    , nrhPassword  :: !ByteString -- ^ @password@ property (@""@ if missing)-    , nrhAccount   :: !ByteString -- ^ @account@ property (@""@ if missing)+    { nrhName      :: !ByteString   -- ^ Remote machine name (@""@ for @default@-entries)+    , nrhLogin     :: !ByteString   -- ^ @login@ property (@""@ if missing)+    , nrhPassword  :: !ByteString   -- ^ @password@ property (@""@ if missing)+    , nrhAccount   :: !ByteString   -- ^ @account@ property (@""@ if missing)+    , nrhMacros    :: [NetRcMacDef] -- ^ associated @macdef@ entries     } deriving (Eq,Ord,Show,Typeable,Data,Generic)  instance NFData NetRcHost where rnf !_ = ()  -- | @macdef@ entries defining @ftp@ macros data NetRcMacDef = NetRcMacDef-    { nrmName :: !ByteString -- ^ Name of @macdef@ entry (__Invariant__: must not contain any @TAB@s, @SPACE@, or @LF@s)-    , nrmBody :: !ByteString -- ^ Raw @macdef@ body (__Invariant__: must not contain null-lines)+    { nrmName :: !ByteString -- ^ Name of @macdef@ entry+                             --+                             -- __Invariant__: must not contain any @TAB@s, @SPACE@, or @LF@s+    , nrmBody :: !ByteString -- ^ Raw @macdef@ body+                             --+                             -- __Invariant__: must not contain null-lines, i.e. consecutive @LF@s     } deriving (Eq,Ord,Show,Typeable,Data,Generic)  instance NFData NetRcMacDef where rnf !_ = ()  -- | Represents (semantic) contents of a @.netrc@ file-data NetRc = NetRc [NetRcHost] [NetRcMacDef]-           deriving (Eq,Ord,Show,Typeable,Data,Generic)+data NetRc = NetRc+    { nrHosts  :: [NetRcHost]   -- ^ @machine@\/@default@ entries+                                --+                                -- __Note__: If it exists, the+                                -- @default@ entry ought to be the+                                -- last entry, otherwise it can cause+                                -- later entries to become invisible+                                -- for some implementations+                                -- (e.g. @ftp(1)@) +    , nrMacros :: [NetRcMacDef] -- ^ Non-associated @macdef@ entries+                                --+                                -- __Note__: @macdef@ entries not+                                -- associated with host-entries are+                                -- invisible to some applications+                                -- (e.g. @ftp(1)@).+    } deriving (Eq,Ord,Show,Typeable,Data,Generic)+ instance NFData NetRc where     rnf (NetRc ms ds) = ms `deepseq` ds `deepseq` ()  -- | Construct a 'ByteString' 'BB.Builder' netRcToBuilder :: NetRc -> BB.Builder netRcToBuilder (NetRc ms ds) =-    mconcat . intersperse nl $ map netRcHostToBuilder ms <> map netRcMacDefToBuilder ds+    mconcat . intersperse nl $ map netRcMacDefToBuilder ds <> map netRcHostToBuilder ms   where     netRcHostToBuilder (NetRcHost {..})-        = mconcat+        = mconcat $           [ mline           , prop "login"    nrhLogin           , prop "password" nrhPassword           , prop "account"  nrhAccount           , nl-          ]+          ] <> (intersperse nl $ map netRcMacDefToBuilder nrhMacros)       where         mline | B.null nrhName = BB.byteString "default"               | otherwise      = BB.byteString "machine" <> spc <> BB.byteString nrhName@@ -170,13 +191,25 @@  -- | "Text.Parsec.ByteString" 'P.Parser' for @.netrc@ grammar netRcParsec :: P.Parser NetRc-netRcParsec = (uncurry NetRc . partitionEithers) <$> (wsOrComments0 *> P.sepEndBy netrcEnt wsOrComments1)+netRcParsec = do+    entries <- uncurry NetRc . normEnts . splitEithers <$> (wsOrComments0 *> P.sepEndBy netrcEnt wsOrComments1)++    return entries   where     wsOrComments0 = P.skipMany comment >> P.skipMany (wsChars1 >> P.skipMany comment)     wsOrComments1 = P.skipMany1 (wsChars1 >> P.skipMany comment)      netrcEnt = (Left <$> hostEnt) <|> (Right <$> macDefEnt) +    normEnts [] = ([], [])+    normEnts (([], ms):es) = (normEnts' es, ms)+    normEnts es = (normEnts' es, [])++    normEnts' :: [([NetRcHost],[NetRcMacDef])] -> [NetRcHost]+    normEnts' [] = []+    normEnts' (([], _):_) = error "netRcParsec internal error"+    normEnts' ((hs, ms):es) = init hs ++ ((last hs) { nrhMacros = ms } : normEnts' es)+ macDefEnt :: P.Parser NetRcMacDef macDefEnt = do     void $ P.try (P.string "macdef")@@ -193,7 +226,7 @@ hostEnt = do     nam <- mac <|> def     ps <- P.many (P.try (wsChars1 *> pval))-    return $! foldl' setFld (NetRcHost nam "" "" "") ps+    return $! foldl' setFld (NetRcHost nam "" "" "" []) ps   where     def = P.try (P.string "default") *> pure "" @@ -203,11 +236,12 @@         tok P.<?> "hostname"      -- pval := ((account|username|password) WS+ <value>)-    pval = hlp "login" "loginname" PValLogin <|>-           hlp "account" "accountname" PValAccount <|>-           hlp "password" "password" PValPassword+    pval = hlp "login"    PValLogin   <|>+           hlp "account"  PValAccount <|>+           hlp "password" PValPassword       where-        hlp tnam vnam cons = P.try (P.string tnam) *> wsChars1 *> (cons <$> tok P.<?> vnam)+        hlp tnam cons = P.try (P.string tnam) *> wsChars1 *>+                        (cons <$> tok P.<?> (tnam ++ "-value"))      setFld n (PValLogin    v) = n { nrhLogin    = v }     setFld n (PValAccount  v) = n { nrhAccount  = v }@@ -239,3 +273,18 @@ skipToEol = P.skipMany notlf <* (lf <|> P.eof)   where     notlf = P.noneOf "\n"++-- | Regroup lst of 'Either's into pair of lists+splitEithers :: [Either l r] -> [([l], [r])]+splitEithers = goL+  where+    goL []    = []+    goL es    = let (pfx,es') = span isLeft  es in goR es' (lefts pfx)++    goR [] ls = [(ls,[])]+    goR es ls = let (pfx,es') = span isRight es in (ls,rights pfx) : goL es'++    isLeft (Left _)  = True+    isLeft (Right _) = False++    isRight = not . isLeft