diff --git a/gnuidn.cabal b/gnuidn.cabal --- a/gnuidn.cabal +++ b/gnuidn.cabal @@ -1,11 +1,11 @@ name: gnuidn -version: 0.2.1 +version: 0.2.2 license: GPL-3 license-file: license.txt author: John Millikin maintainer: jmillikin@gmail.com build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.8 category: Codec, Text stability: experimental homepage: https://john-millikin.com/software/haskell-gnuidn/ @@ -13,6 +13,9 @@ synopsis: Bindings for GNU IDN +extra-source-files: + tests/*.hs + source-repository head type: git location: https://john-millikin.com/code/haskell-gnuidn/ @@ -20,7 +23,7 @@ source-repository this type: git location: https://john-millikin.com/code/haskell-gnuidn/ - tag: haskell-gnuidn_0.2.1 + tag: haskell-gnuidn_0.2.2 library ghc-options: -Wall -O2 @@ -44,3 +47,24 @@ other-modules: Data.Text.IDN.Internal + +test-suite gnuidn_tests + type: exitcode-stdio-1.0 + main-is: Tests.hs + hs-source-dirs: tests + + build-depends: + base >= 4.0 && < 5.0 + , bytestring + , chell >= 0.4 && < 0.5 + , chell-quickcheck >= 0.2 && < 0.3 + , gnuidn + , QuickCheck >= 2.4 + , text + + extra-libraries: idn + pkgconfig-depends: libidn + + build-tools: + c2hs + diff --git a/lib/Data/Text/IDN/IDNA.chs b/lib/Data/Text/IDN/IDNA.chs --- a/lib/Data/Text/IDN/IDNA.chs +++ b/lib/Data/Text/IDN/IDNA.chs @@ -102,7 +102,7 @@ encodeFlags :: Flags -> CInt encodeFlags flags = foldr (.|.) 0 bits where - bitAt f e = if f flags then 0 else fromIntegral (fromEnum e) + bitAt f e = if f flags then fromIntegral (fromEnum e) else 0 bits = [ bitAt verifySTD3 USE_STD3_ASCII_RULES , bitAt allowUnassigned ALLOW_UNASSIGNED ] diff --git a/lib/Data/Text/IDN/Punycode.chs b/lib/Data/Text/IDN/Punycode.chs --- a/lib/Data/Text/IDN/Punycode.chs +++ b/lib/Data/Text/IDN/Punycode.chs @@ -76,7 +76,7 @@ outBuf let rc = fromIntegral c_rc - if rc == fromEnum OVERFLOW + if rc == fromEnum BIG_OUTPUT then return Nothing else if rc == fromEnum SUCCESS then do diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- Copyright (C) 2015 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +module Main + ( tests + , main + ) where + +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.IDN.IDNA as IDNA +import qualified Data.Text.IDN.Punycode as PC +import qualified Data.Text.IDN.StringPrep as SP +import Test.Chell +import Test.Chell.QuickCheck +import Test.QuickCheck hiding (property) + +tests :: [Suite] +tests = + [ suite_IDNA + , suite_Punycode + , suite_StringPrep + ] + +suite_IDNA :: Suite +suite_IDNA = suite "idna" + [ test_IDNA_toASCII + , test_IDNA_toUnicode + ] + +test_IDNA_toASCII :: Test +test_IDNA_toASCII = assertions "toASCII" $ do + let toASCII = IDNA.toASCII + let defaultFlags = IDNA.defaultFlags + $expect $ equal + (toASCII defaultFlags (t "helloworld.com")) + (Right (b8 "helloworld.com")) + $expect $ equal + (toASCII defaultFlags (t "преве́д.com")) + (Right (b8 "xn--lsa32dhabb1dh.com")) + + -- verifySTD3 permits non-hostname strings. + $expect $ left (toASCII defaultFlags (t "not valid")) + $expect $ equal + (toASCII defaultFlags{IDNA.verifySTD3=False} (t "not valid")) + (Right (b8 "not valid")) + + -- allowUnassigned permits unassigned codepoints. + $expect $ left (toASCII defaultFlags (t "\x070E")) + $expect $ equal + (toASCII defaultFlags{IDNA.allowUnassigned=True} (t "\x070E")) + (Right (b8 "xn--7mb")) + +test_IDNA_toUnicode :: Test +test_IDNA_toUnicode = assertions "toUnicode" $ do + let toUnicode = IDNA.toUnicode + let defaultFlags = IDNA.defaultFlags + $expect $ equal + (toUnicode defaultFlags (b8 "helloworld.com")) + (t "helloworld.com") + $expect $ equal + (toUnicode defaultFlags (b8 "xn--lsa32dhabb1dh.com")) + (t "преве́д.com") + + -- allowUnassigned permits unassigned codepoints. + $expect $ equal + (toUnicode defaultFlags (b8 "xn--7mb")) + (t "xn--7mb") + $expect $ equal + (toUnicode defaultFlags{IDNA.allowUnassigned=True} (b8 "xn--7mb")) + (t "\x070E") + +suite_Punycode :: Suite +suite_Punycode = suite "punycode" + [ test_Punycode_Encode + , test_Punycode_Decode + ] + +test_Punycode_Encode :: Test +test_Punycode_Encode = assertions "encode" $ do + $expect (equal + (PC.encode (t "преве́д") Nothing) + (b8 "lsa32dhabb1dh")) + $expect (equal + (PC.encode (t "преве́д") (Just (== 0))) + (b8 "lsa32dhabb1Dh")) + +test_Punycode_Decode :: Test +test_Punycode_Decode = assertions "decode" $ do + do + let dec = PC.decode (b8 "lsa32dhabb1dh") + $assert (just dec) + let Just (txt,_) = dec + $expect (equal txt (t "преве́д")) + do + let dec = PC.decode (b8 "lsa32dhabb1Dh") + $assert (just dec) + let Just (txt,fn) = dec + $expect (equal txt (t "преве́д")) + $expect (equal (fn 0) True) + $expect (equal (fn 1) False) + +suite_StringPrep :: Suite +suite_StringPrep = suite "stringprep" + [ test_StringPrep_SASL + ] + +test_StringPrep_SASL :: Test +test_StringPrep_SASL = assertions "sasl" $ do + -- http://www.ietf.org/mail-archive/web/sasl/current/msg02723.html + -- http://www.ietf.org/mail-archive/web/sasl/current/msg02722.html + let prep s = SP.stringprep SP.sasl SP.defaultFlags (t s) + $expect $ equal (prep "x\xADy") (Right (t "xy")) + $expect $ equal (prep "user") (Right (t "user")) + $expect $ equal (prep "USER") (Right (t "USER")) + $expect $ equal (prep "\x2163") (Right (t "IV")) + $expect $ left (prep "\x7") + $expect $ left (prep "\x627\x31") + $expect $ equal (prep "\xAA") (Right (t "a")) + +main :: IO () +main = Test.Chell.defaultMain tests + +t :: String -> T.Text +t = T.pack + +b8 :: String -> B8.ByteString +b8 = B8.pack