git.iko.soy/isoparsec
on master help sign in
Added more ssh tests (#29)

* Added more tests * stopped weeds

commit27a120ffe30d3bf388e85a97a991e090a5b5718e authoriko <ilyakooo0@gmail.com> dateSat 15 Feb 2020, 14:36 (7 years ago) parent54a5b3b
4 files changed+33−117
compare with master
unifiedsplit
.gitignore+1 isoparsec.cabal−113 test/Spec/Helper.hs+26 test/Spec/Ssh.hs+6−4
.gitignore+1
@@ -20,3 +20,4 @@ cabal.project.local
2020cabal.project.local~
2121.HTF/
2222.ghc.environment.*
23+*.cabal
isoparsec.cabaldeleted−113
@@ -1,113 +0,0 @@
1−cabal-version: 1.12
2−
3−-- This file has been generated from package.yaml by hpack version 0.31.2.
4−--
5−-- see: https://github.com/sol/hpack
6−--
7−-- hash: 2b8bf0f1dd722fe9b761b465eeaa17ff976877aa7a5c517e092915bdc90158d7
8−
9−name: isoparsec
10−version: 0.1.0.0
11−description: Please see the README on GitHub at <https://github.com/ilyakooo0/isoparsec#readme>
12−homepage: https://github.com/ilyakooo0/isoparsec#readme
13−bug-reports: https://github.com/ilyakooo0/isoparsec/issues
14−author: Ilya Kostyuchenko
15−maintainer: ilyakooo0@gmail.com
16−copyright: 2019 Ilya Kostyuchenko
17−license: MIT
18−license-file: LICENSE
19−build-type: Simple
20−extra-source-files:
21− README.md
22− ChangeLog.md
23−
24−source-repository head
25− type: git
26− location: https://github.com/ilyakooo0/isoparsec
27−
28−library
29− exposed-modules:
30− Control.Arrow.Extra
31− Control.Arrow.Extra.ArrowChoice
32− Control.Arrow.Extra.ArrowPlus
33− Control.Arrow.Extra.ArrowZero
34− Control.Arrow.Extra.BaseArrow
35− Control.Arrow.Extra.Orphans
36− Control.Arrow.Extra.PolyArrow
37− Control.SemiIso
38− Control.Tuple.Morph
39− Data.Isoparsec
40− Data.Isoparsec.ByteString
41− Data.Isoparsec.Char
42− Data.Isoparsec.Chunks
43− Data.Isoparsec.Cokleisli
44− Data.Isoparsec.Internal
45− Data.Isoparsec.Megaparsec
46− Data.Isoparsec.Printer
47− Data.Isoparsec.ToIsoparsec
48− Data.Isoparsec.Tokenable
49− other-modules:
50− Control.Prism
51− hs-source-dirs:
52− src
53− default-extensions: AllowAmbiguousTypes ConstraintKinds DataKinds DefaultSignatures DeriveGeneric FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses OverloadedStrings PatternSynonyms PolyKinds ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators UndecidableInstances RankNTypes
54− build-depends:
55− base >=4.7 && <5
56− , bytestring
57− , containers
58− , megaparsec
59− , mtl
60− , profunctors
61− default-language: Haskell2010
62−
63−test-suite isoparsec-test
64− type: exitcode-stdio-1.0
65− main-is: Spec.hs
66− other-modules:
67− Spec.Helper
68− Spec.JSON
69− Spec.Megaparsec.BasicNums
70− Spec.Orphans
71− Spec.Ssh
72− Spec.TwoDigits
73− Control.Arrow.Extra
74− Control.Arrow.Extra.ArrowChoice
75− Control.Arrow.Extra.ArrowPlus
76− Control.Arrow.Extra.ArrowZero
77− Control.Arrow.Extra.BaseArrow
78− Control.Arrow.Extra.Orphans
79− Control.Arrow.Extra.PolyArrow
80− Control.Prism
81− Control.SemiIso
82− Control.Tuple.Morph
83− Data.Isoparsec
84− Data.Isoparsec.ByteString
85− Data.Isoparsec.Char
86− Data.Isoparsec.Chunks
87− Data.Isoparsec.Cokleisli
88− Data.Isoparsec.Internal
89− Data.Isoparsec.Megaparsec
90− Data.Isoparsec.Printer
91− Data.Isoparsec.ToIsoparsec
92− Data.Isoparsec.Tokenable
93− Paths_isoparsec
94− hs-source-dirs:
95− test
96− src
97− default-extensions: AllowAmbiguousTypes ConstraintKinds DataKinds DefaultSignatures DeriveGeneric FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses OverloadedStrings PatternSynonyms PolyKinds ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators UndecidableInstances RankNTypes
98− ghc-options: -threaded -rtsopts -with-rtsopts=-N
99− build-depends:
100− QuickCheck
101− , base >=4.7 && <5
102− , bytestring
103− , containers
104− , hspec
105− , lens
106− , megaparsec
107− , mtl
108− , profunctors
109− , tasty
110− , tasty-hspec
111− , tasty-quickcheck
112− , word8
113− default-language: Haskell2010
test/Spec/Helper.hs+26
@@ -1,6 +1,7 @@
11module Spec.Helper
22 ( shouldParseBS,
33 roundtrip,
4+ parseSatisfyBS,
45 )
56where
67
@@ -17,6 +18,31 @@ import Test.Tasty.QuickCheck
1718import Text.Megaparsec as M
1819import Prelude as P hiding ((.))
1920
21+parseSatisfy ::
22+ forall x s.
23+ ( ToIsoparsec x s,
24+ Stream s,
25+ Show x,
26+ Show (M.Token s),
27+ Show s,
28+ Isoparsec (Kleisli (Parsec Void s)) s
29+ ) =>
30+ s ->
31+ (Either (ParseErrorBundle s Void) x -> Bool) ->
32+ Expectation
33+parseSatisfy s p = runMegaparsec @Void @s toIsoparsec s `shouldSatisfy` p
34+
35+parseSatisfyBS ::
36+ forall x.
37+ ( ToIsoparsec x ByteString,
38+ Show x,
39+ Isoparsec (Kleisli (Parsec Void ByteString)) ByteString
40+ ) =>
41+ ByteString ->
42+ (Either (ParseErrorBundle ByteString Void) x -> Bool) ->
43+ Expectation
44+parseSatisfyBS = parseSatisfy
45+
2046shouldParse ::
2147 forall x s.
2248 ( ToIsoparsec x s,
test/Spec/Ssh.hs+6−4
@@ -9,6 +9,7 @@ where
99import Control.Lens.TH
1010import Data.ByteString as BS
1111import qualified Data.Char as C
12+import Data.Either
1213import Data.Isoparsec
1314import Data.Isoparsec.ByteString
1415import GHC.Generics
@@ -98,10 +99,9 @@ instance ToIsoparsec Payload ByteString where
9899 &&& auto @SSHString
99100 )
100101 <+> ( _VersionPayload <.> chunk "SSH-2.0-"
101− &&& ( (tokensWhile (not . flip BS.elem " \n\r") >>> utf8)
102− &&& ( (chunk " " >>> takeUntil "\r\n" >>^ turn (badKonst ""))
103− <+> chunk "\r\n"
104− )
102+ &&& (tokensWhile (`BS.notElem` " \n\r") >>> utf8)
103+ &&& ( (chunk " " >>> takeUntil "\r\n" >>^ turn (badKonst ""))
104+ <+> chunk "\r\n"
105105 )
106106 )
107107 <+> (_IgnorePayload <.> specific IgnoreMsg &&& tokensWhile (const True))
@@ -169,7 +169,9 @@ spec :: Spec
169169spec = do
170170 it "deserialize payload" $ do
171171 "SSH-2.0-TesT\r\n" `shouldParseBS` VersionPayload "TesT"
172+ "SSH-2.0-TesT" `parseSatisfyBS` isLeft @_ @Payload
172173 "SSH-2.0-TesT random comment\r\n" `shouldParseBS` VersionPayload "TesT"
174+ "SSH-2.0-TesT random comment" `parseSatisfyBS` isLeft @_ @Payload
173175 "\x2__" `shouldParseBS` IgnorePayload "__"
174176 "\x5\0\0\0\x6tested" `shouldParseBS` ServiceRequest (SSHString "tested")
175177 it "deserialize packet" $ do