diff --git a/language-docker.cabal b/language-docker.cabal --- a/language-docker.cabal +++ b/language-docker.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack -- --- hash: 1dcabc3e868541acb7c49590054c62c6637d1deaefc81e4b39de64333bc9d239 +-- hash: f800aba94b9f6bbf2894ac78e2f4a135d3e9e89e04d9a7b0549bdd0941e97cbd name: language-docker -version: 11.0.0 +version: 12.0.0 synopsis: Dockerfile parser, pretty-printer and embedded DSL description: All functions for parsing and pretty-printing Dockerfiles are exported through @Language.Docker@. For more fine-grained operations look for specific modules that implement a certain functionality. See the for the source-code and examples. @@ -61,6 +61,9 @@ Language.Docker.Parser.Pairs Language.Docker.Parser.Prelude Language.Docker.Parser.Run + Language.Docker.Syntax.Port + Language.Docker.Syntax.PortRange + Language.Docker.Syntax.Protocol Paths_language_docker hs-source-dirs: src @@ -90,6 +93,7 @@ Language.Docker.ParseAddSpec Language.Docker.ParseCmdSpec Language.Docker.ParseCopySpec + Language.Docker.ParseExposeSpec Language.Docker.ParsePragmaSpec Language.Docker.ParserSpec Language.Docker.ParseRunSpec diff --git a/src/Language/Docker/Parser/Expose.hs b/src/Language/Docker/Parser/Expose.hs --- a/src/Language/Docker/Parser/Expose.hs +++ b/src/Language/Docker/Parser/Expose.hs @@ -12,22 +12,48 @@ reserved "EXPOSE" Expose <$> ports +ports :: (?esc :: Char) => Parser Ports +ports = Ports <$> portspec `sepEndBy` requiredWhitespace + +portspec :: (?esc :: Char) => Parser PortSpec +portspec = + ( try parsePortRangeSpec "A range of ports optionally followed by the protocol" ) + <|> ( parsePortSpec "A port optionally followed by the protocol" ) + +parsePortRangeSpec :: (?esc :: Char) => Parser PortSpec +parsePortRangeSpec = PortRangeSpec <$> portRange + +parsePortSpec :: (?esc :: Char) => Parser PortSpec +parsePortSpec = PortSpec <$> port + port :: (?esc :: Char) => Parser Port port = (try portVariable "a variable") - <|> (try portRange "a port range optionally followed by the protocol (udp/tcp)") -- There a many valid representations of ports <|> (try portWithProtocol "a port with its protocol (udp/tcp)") <|> (portInt "a valid port number") -ports :: (?esc :: Char) => Parser Ports -ports = Ports <$> port `sepEndBy` requiredWhitespace +portRangeLimit :: (?esc :: Char) => Parser Port +portRangeLimit = number <|> variable + where + number = do + num <- natural + return $ Port (fromIntegral num) TCP -portRange :: Parser Port + variable = do + void (char '$') + var <- someUnless "the variable name" (\c -> c == '-' || c == '/') + return $ PortStr (T.append "$" var) + +portRange :: (?esc :: Char) => Parser PortRange portRange = do - start <- natural + start <- portRangeLimit void $ char '-' - finish <- try natural + finish <- try portRangeLimit proto <- try protocol <|> return TCP - return $ PortRange (fromIntegral start) (fromIntegral finish) proto + return $ PortRange (setProto start proto) (setProto finish proto) + where + setProto :: Port -> Protocol -> Port + setProto (Port p _) prot = Port p prot + setProto (PortStr s) _ = PortStr s protocol :: Parser Protocol protocol = do diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -123,12 +123,9 @@ accumulate c EscapeAccum {buffer, escaping = False} = EscapeAccum (B.singleton c <> buffer) 0 False -prettyPrintPort :: Port -> Doc ann -prettyPrintPort (PortStr str) = pretty str -prettyPrintPort (PortRange start stop TCP) = pretty start <> "-" <> pretty stop -prettyPrintPort (PortRange start stop UDP) = pretty start <> "-" <> pretty stop <> "/udp" -prettyPrintPort (Port num TCP) = pretty num <> "/tcp" -prettyPrintPort (Port num UDP) = pretty num <> "/udp" +prettyPrintPortSpec :: PortSpec -> Doc ann +prettyPrintPortSpec (PortSpec port) = pretty port +prettyPrintPortSpec (PortRangeSpec portrange) = pretty portrange prettyPrintFileList :: NonEmpty SourcePath -> TargetPath -> Doc ann prettyPrintFileList sources (TargetPath dest) = @@ -273,7 +270,7 @@ pretty w Expose (Ports ps) -> do "EXPOSE" - hsep (fmap prettyPrintPort ps) + hsep (fmap prettyPrintPortSpec ps) Volume dir -> do "VOLUME" pretty dir diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -4,7 +4,13 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} -module Language.Docker.Syntax where +module Language.Docker.Syntax + ( module Language.Docker.Syntax, + module Language.Docker.Syntax.Port, + module Language.Docker.Syntax.PortRange, + module Language.Docker.Syntax.Protocol + ) +where import Data.Default.Class (Default (..)) import Data.List (intercalate, isInfixOf) @@ -18,6 +24,12 @@ import GHC.Exts (IsList (..)) import Text.Printf + +import Language.Docker.Syntax.Port +import Language.Docker.Syntax.PortRange +import Language.Docker.Syntax.Protocol + + data Image = Image { registryName :: !(Maybe Registry), @@ -56,30 +68,19 @@ } deriving (Show, Eq, Ord, IsString) -data Protocol - = TCP - | UDP - deriving (Show, Eq, Ord) - -data Port - = Port - !Int - !Protocol - | PortStr !Text - | PortRange - !Int - !Int - !Protocol +data PortSpec + = PortSpec !Port + | PortRangeSpec !PortRange deriving (Show, Eq, Ord) newtype Ports = Ports - { unPorts :: [Port] + { unPorts :: [PortSpec] } deriving (Show, Eq, Ord) instance IsList Ports where - type Item Ports = Port + type Item Ports = PortSpec fromList = Ports toList (Ports ps) = ps diff --git a/src/Language/Docker/Syntax/Port.hs b/src/Language/Docker/Syntax/Port.hs new file mode 100644 --- /dev/null +++ b/src/Language/Docker/Syntax/Port.hs @@ -0,0 +1,19 @@ +module Language.Docker.Syntax.Port where + + +import Data.Text +import Prettyprinter +import Language.Docker.Syntax.Protocol + + +-- | A port can either be a number (plus a protocol, tcp by default) or a +-- variable. +data Port + = Port !Int !Protocol + | PortStr !Text + deriving (Show, Eq, Ord) + + +instance Pretty Port where + pretty (Port num proto) = pretty num <> pretty proto + pretty (PortStr str) = pretty str diff --git a/src/Language/Docker/Syntax/PortRange.hs b/src/Language/Docker/Syntax/PortRange.hs new file mode 100644 --- /dev/null +++ b/src/Language/Docker/Syntax/PortRange.hs @@ -0,0 +1,20 @@ +module Language.Docker.Syntax.PortRange where + + +import Prettyprinter +import Language.Docker.Syntax.Port +import Language.Docker.Syntax.Protocol + + +-- | A port range starts and ends with either a number or a variable and can +-- have a protocol associated (tcp by default). The protocol of the start and +-- end port shall be ignored. +data PortRange + = PortRange !Port !Port + deriving (Show, Eq, Ord) + + +instance Pretty PortRange where + pretty (PortRange (Port start UDP) end) = pretty start <> "-" <> pretty end <> "/udp" + pretty (PortRange (PortStr start) (Port end UDP)) = pretty start <> "-" <> pretty end <> "/udp" + pretty (PortRange start end) = pretty start <> "-" <> pretty end diff --git a/src/Language/Docker/Syntax/Protocol.hs b/src/Language/Docker/Syntax/Protocol.hs new file mode 100644 --- /dev/null +++ b/src/Language/Docker/Syntax/Protocol.hs @@ -0,0 +1,15 @@ +module Language.Docker.Syntax.Protocol where + + +import Prettyprinter + + +data Protocol + = TCP + | UDP + deriving (Show, Eq, Ord) + + +instance Pretty Protocol where + pretty TCP = "" + pretty UDP = "/udp" diff --git a/test/Language/Docker/ParseExposeSpec.hs b/test/Language/Docker/ParseExposeSpec.hs new file mode 100644 --- /dev/null +++ b/test/Language/Docker/ParseExposeSpec.hs @@ -0,0 +1,148 @@ +module Language.Docker.ParseExposeSpec where + +import Data.Default.Class (def) +import qualified Data.Text as Text +import Language.Docker.Syntax +import TestHelper +import Test.Hspec + + +spec :: Spec +spec = do + describe "parse EXPOSE" $ do + + it "should handle number ports" $ + let content = "EXPOSE 8080" + in assertAst + content + [ Expose + ( Ports + [ PortSpec (Port 8080 TCP) + ] + ) + ] + + it "should handle many number ports" $ + let content = "EXPOSE 8080 8081" + in assertAst + content + [ Expose + ( Ports + [ PortSpec (Port 8080 TCP), + PortSpec (Port 8081 TCP) + ] + ) + ] + + it "should handle ports with protocol" $ + let content = "EXPOSE 8080/TCP 8081/UDP" + in assertAst + content + [ Expose + ( Ports + [ PortSpec (Port 8080 TCP), + PortSpec (Port 8081 UDP) + ] + ) + ] + + it "should handle ports with protocol and variables" $ + let content = "EXPOSE $PORT 8080 8081/UDP" + in assertAst + content + [ Expose + ( Ports + [ PortSpec (PortStr "$PORT"), + PortSpec (Port 8080 TCP), + PortSpec (Port 8081 UDP) + ] + ) + ] + + it "should handle port ranges" $ + let content = "EXPOSE 80 81 8080-8085" + in assertAst + content + [ Expose + ( Ports + [ PortSpec (Port 80 TCP), + PortSpec (Port 81 TCP), + PortRangeSpec + ( PortRange (Port 8080 TCP) (Port 8085 TCP) ) + ] + ) + ] + + it "should handle udp port ranges" $ + let content = "EXPOSE 80 81 8080-8085/udp" + in assertAst + content + [ Expose + ( Ports + [ PortSpec (Port 80 TCP), + PortSpec (Port 81 TCP), + PortRangeSpec + ( PortRange (Port 8080 UDP) (Port 8085 UDP) ) + ] + ) + ] + + it "should handle one variable port ranges 1" $ + let content = "EXPOSE 8080-${bar}/udp" + in assertAst + content + [ Expose + ( Ports + [ PortRangeSpec + ( PortRange (Port 8080 UDP) (PortStr "${bar}") ) + ] + ) + ] + + it "should handle one variable port ranges 2" $ + let content = "EXPOSE ${foo}-8080/udp" + in assertAst + content + [ Expose + ( Ports + [ PortRangeSpec + ( PortRange (PortStr "${foo}") (Port 8080 UDP) ) + ] + ) + ] + + it "should handle two variables port ranges" $ + let content = "EXPOSE ${foo}-${bar}/udp" + in assertAst + content + [ Expose + ( Ports + [ PortRangeSpec + ( PortRange (PortStr "${foo}") (PortStr "${bar}") ) + ] + ) + ] + + it "should handle multiline variables" $ + let content = + "EXPOSE ${PORT} ${PORT_SSL} \\\n\ + \ ${PORT_HTTP} ${PORT_HTTPS} \\\n\ + \ ${PORT_REP} \\\n\ + \ ${PORT_ADMIN} ${PORT_ADMIN_HTTP}" + in assertAst + content + [ Expose + ( Ports + [ PortSpec (PortStr "${PORT}"), + PortSpec (PortStr "${PORT_SSL}"), + PortSpec (PortStr "${PORT_HTTP}"), + PortSpec (PortStr "${PORT_HTTPS}"), + PortSpec (PortStr "${PORT_REP}"), + PortSpec (PortStr "${PORT_ADMIN}"), + PortSpec (PortStr "${PORT_ADMIN_HTTP}") + ] + ) + ] + it "should fail with wrong protocol" $ + let content = "EXPOSE 80/ip" + in expectFail content diff --git a/test/Language/Docker/ParserSpec.hs b/test/Language/Docker/ParserSpec.hs --- a/test/Language/Docker/ParserSpec.hs +++ b/test/Language/Docker/ParserSpec.hs @@ -289,48 +289,6 @@ Comment " This is a comment", Run "echo hello" ] - describe "expose" $ do - it "should handle number ports" $ - let content = "EXPOSE 8080" - in assertAst content [Expose (Ports [Port 8080 TCP])] - it "should handle many number ports" $ - let content = "EXPOSE 8080 8081" - in assertAst content [Expose (Ports [Port 8080 TCP, Port 8081 TCP])] - it "should handle ports with protocol" $ - let content = "EXPOSE 8080/TCP 8081/UDP" - in assertAst content [Expose (Ports [Port 8080 TCP, Port 8081 UDP])] - it "should handle ports with protocol and variables" $ - let content = "EXPOSE $PORT 8080 8081/UDP" - in assertAst content [Expose (Ports [PortStr "$PORT", Port 8080 TCP, Port 8081 UDP])] - it "should handle port ranges" $ - let content = "EXPOSE 80 81 8080-8085" - in assertAst content [Expose (Ports [Port 80 TCP, Port 81 TCP, PortRange 8080 8085 TCP])] - it "should handle udp port ranges" $ - let content = "EXPOSE 80 81 8080-8085/udp" - in assertAst content [Expose (Ports [Port 80 TCP, Port 81 TCP, PortRange 8080 8085 UDP])] - it "should handle multiline variables" $ - let content = - "EXPOSE ${PORT} ${PORT_SSL} \\\n\ - \ ${PORT_HTTP} ${PORT_HTTPS} \\\n\ - \ ${PORT_REP} \\\n\ - \ ${PORT_ADMIN} ${PORT_ADMIN_HTTP}" - in assertAst - content - [ Expose - ( Ports - [ PortStr "${PORT}", - PortStr "${PORT_SSL}", - PortStr "${PORT_HTTP}", - PortStr "${PORT_HTTPS}", - PortStr "${PORT_REP}", - PortStr "${PORT_ADMIN}", - PortStr "${PORT_ADMIN_HTTP}" - ] - ) - ] - it "should fail with wrong protocol" $ - let content = "EXPOSE 80/ip" - in expectFail content describe "syntax" $ do it "should handle lowercase instructions (#7 - https://github.com/beijaflor-io/haskell-language-dockerfile/issues/7)" $ let content = "from ubuntu"