diff --git a/Data/Text/ICU.hs b/Data/Text/ICU.hs --- a/Data/Text/ICU.hs +++ b/Data/Text/ICU.hs @@ -85,6 +85,28 @@ , group , prefix , suffix + -- * Spoof checking + -- $spoof + , Spoof + , SpoofParams(..) + , S.SpoofCheck(..) + , S.RestrictionLevel(..) + , S.SpoofCheckResult(..) + -- ** Construction + , spoof + , spoofWithParams + , spoofFromSource + , spoofFromSerialized + -- ** String checking + , areConfusable + , spoofCheck + , getSkeleton + -- ** Configuration + , getChecks + , getAllowedLocales + , getRestrictionLevel + -- ** Persistence + , serialize ) where import Data.Text.ICU.Break.Pure @@ -93,6 +115,8 @@ import Data.Text.ICU.Iterator import Data.Text.ICU.Normalize import Data.Text.ICU.Regex.Pure +import qualified Data.Text.ICU.Spoof as S +import Data.Text.ICU.Spoof.Pure import Data.Text.ICU.Text #if defined(__HADDOCK__) import Data.Text.Foreign @@ -159,3 +183,14 @@ -- Capturing groups are numbered starting from zero. Group zero is -- always the entire matching text. Groups greater than zero contain -- the text matching each capturing group in a regular expression. + +-- $spoof +-- +-- The 'Spoof' type performs security checks on visually confusable +-- (spoof) strings. For the impure spoof checking API (which is +-- richer, but less easy to use than the pure API), see the +-- "Data.Text.ICU.Spoof" module. +-- +-- See and +-- for detailed information +-- about the underlying algorithms and databases used by these functions. diff --git a/Data/Text/ICU/BitMask.hs b/Data/Text/ICU/BitMask.hs new file mode 100644 --- /dev/null +++ b/Data/Text/ICU/BitMask.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DefaultSignatures, ScopedTypeVariables #-} + +-- From http://stackoverflow.com/a/15911213 + +module Data.Text.ICU.BitMask + ( + -- * Bit mask twiddling API + -- $api + -- * Types + ToBitMask(..) + -- * Functions + , fromBitMask + , highestValueInBitMask + ) where + +import Data.Bits ((.&.), (.|.)) +import Data.Maybe (listToMaybe) + +-- $api +-- Conversion to and from enumerated types representable as +-- a compact bitmask. + +class ToBitMask a where + toBitMask :: a -> Int + +instance (ToBitMask a) => ToBitMask [a] where + toBitMask = foldr ((.|.) . toBitMask) 0 + +fromBitMask :: (Enum a, Bounded a, ToBitMask a) => Int -> [a] +fromBitMask bm = filter inBitMask $ enumFrom minBound + where inBitMask val = (bm .&. toBitMask val) == toBitMask val + +highestValueInBitMask :: (Enum a, Bounded a, ToBitMask a) => Int -> Maybe a +highestValueInBitMask = listToMaybe . reverse . fromBitMask diff --git a/Data/Text/ICU/Char.hsc b/Data/Text/ICU/Char.hsc --- a/Data/Text/ICU/Char.hsc +++ b/Data/Text/ICU/Char.hsc @@ -51,6 +51,7 @@ , LineBreak_(..) , SentenceBreak_(..) , WordBreak_(..) + , BidiPairedBracketType_(..) -- * Property value types , BlockCode(..) , Direction(..) @@ -66,6 +67,7 @@ , LineBreak(..) , SentenceBreak(..) , WordBreak(..) + , BidiPairedBracketType(..) -- * Functions , blockCode , charFullName @@ -357,6 +359,48 @@ | SoraSompeng | SundaneseSupplement | Takri + | BassaVah + | CaucasianAlbanian + | CopticEpactNumbers + | CombiningDiacriticalMarksExtended + | Duployan + | Elbasan + | GeometricShapesExtended + | Grantha + | Khojki + | Khudawadi + | LatinExtendedE + | LinearA + | Mahajani + | Manichaean + | MendeKikakui + | Modi + | Mro + | MyanmarExtendedB + | Nabataean + | OldNorthArabian + | OldPermic + | OrnamentalDingbats + | PahawhHmong + | Palmyrene + | PauCinHau + | PsalterPahlavi + | ShorthandFormatControls + | Siddham + | SinhalaArchaicNumbers + | SupplementalArrowsC + | Tirhuta + | WarangCiti + | Ahom + | AnatolianHieroglyphs + | CherokeeSupplement + | CJKUnifiedIdeographsExtensionE + | EarlyDynasticCuneiform + | Hatran + | Multani + | OldHungarian + | SupplementalSymbolsAndPictographs + | SuttonSignwriting deriving (Eq, Enum, Bounded, Show, Typeable) instance NFData BlockCode where @@ -475,6 +519,16 @@ -- ^ Printable character class. | POSIXXDigit -- ^ Hex digit character class. + | Cased + -- ^ Cased character class. For lowercase, uppercase and titlecase characters. + | CaseIgnorable + -- ^ Used in context-sensitive case mappings. + | ChangesWhenLowercased + | ChangesWhenUppercased + | ChangesWhenTitlecased + | ChangesWhenCasefolded + | ChangesWhenCasemapped + | ChangesWhenNFKCCasefolded deriving (Eq, Enum, Show, Typeable) instance NFData Bool_ where @@ -678,6 +732,37 @@ | Khaph | Zhain | BurushaskiYehBarree + | FarsiYeh + | Nya + | RohingyaYeh + | ManichaeanAleph + | ManichaeanAyin + | ManichaeanBeth + | ManichaeanDaleth + | ManichaeanDhamedh + | ManichaeanFive + | ManichaeanGimel + | ManichaeanHeth + | ManichaeanHundred + | ManichaeanKaph + | ManichaeanLamedh + | ManichaeanMem + | ManichaeanNun + | ManichaeanOne + | ManichaeanPe + | ManichaeanQoph + | ManichaeanResh + | ManichaeanSadhe + | ManichaeanSamekh + | ManichaeanTaw + | ManichaeanTen + | ManichaeanTeth + | ManichaeanThamedh + | ManichaeanTwenty + | ManichaeanWaw + | ManichaeanYodh + | ManichaeanZayin + | StraightWaw deriving (Eq, Enum, Show, Typeable) instance NFData JoiningGroup where @@ -748,6 +833,10 @@ | JL | JT | JV + | CloseParenthesis + | ConditionalJapaneseStarter + | LBHebrewLetter + | LBRegionalIndicator deriving (Eq, Enum, Show, Typeable) instance NFData LineBreak where @@ -918,6 +1007,10 @@ | WBLF | WBMidNumLet | WBNewline + | RegionalIndicator + | HebrewLetter + | SingleQuote + | DoubleQuote deriving (Eq, Enum, Show, Typeable) instance NFData WordBreak where @@ -926,6 +1019,24 @@ instance Property WordBreak_ (Maybe WordBreak) where fromNative _ = maybeEnum toUProperty _ = (#const UCHAR_WORD_BREAK) + +data BidiPairedBracketType_ = BidiPairedBracketType deriving (Show, Typeable) + +instance NFData BidiPairedBracketType_ where + rnf !_ = () + +data BidiPairedBracketType = + BPTNone + | BPTOpen + | BPTClose + deriving (Eq, Enum, Show, Typeable) + +instance NFData BidiPairedBracketType where + rnf !_ = () + +instance Property BidiPairedBracketType_ (Maybe BidiPairedBracketType) where + fromNative _ = maybeEnum + toUProperty _ = (#const UCHAR_BIDI_PAIRED_BRACKET_TYPE) property :: Property p v => p -> Char -> v property p c = fromNative p . u_getIntPropertyValue (fromIntegral (ord c)) . diff --git a/Data/Text/ICU/Collate/Internal.hs b/Data/Text/ICU/Collate/Internal.hs --- a/Data/Text/ICU/Collate/Internal.hs +++ b/Data/Text/ICU/Collate/Internal.hs @@ -33,8 +33,7 @@ data MCollator = MCollator {-# UNPACK #-} !(ForeignPtr UCollator) deriving (Typeable) --- | String collator type. 'Collator's are considered equal if they --- will sort strings identically. +-- | String collator type. newtype Collator = C MCollator deriving (Typeable) diff --git a/Data/Text/ICU/Spoof.hsc b/Data/Text/ICU/Spoof.hsc new file mode 100644 --- /dev/null +++ b/Data/Text/ICU/Spoof.hsc @@ -0,0 +1,468 @@ +{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, ForeignFunctionInterface, + OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} +-- | +-- Module : Data.Text.ICU.Spoof +-- Copyright : (c) 2015 Ben Hamilton +-- +-- License : BSD-style +-- Maintainer : bgertzfield@gmail.com +-- Stability : experimental +-- Portability : GHC +-- +-- String spoofing (confusability) checks for Unicode, implemented as +-- bindings to the International Components for Unicode (ICU) uspoof +-- library. +-- +-- See and +-- for detailed information +-- about the underlying algorithms and databases used by this module. + +module Data.Text.ICU.Spoof + ( + -- * Unicode spoof checking API + -- $api + -- * Types + MSpoof + , OpenFromSourceParseError(..) + , SpoofCheck(..) + , SpoofCheckResult(..) + , RestrictionLevel(..) + , SkeletonTypeOverride(..) + -- * Functions + , open + , openFromSerialized + , openFromSource + , getSkeleton + , getChecks + , setChecks + , getRestrictionLevel + , setRestrictionLevel + , getAllowedLocales + , setAllowedLocales + , areConfusable + , spoofCheck + , serialize + ) where + +#include +#include +#include + +import Control.Applicative +import Control.DeepSeq (NFData(..)) +import Control.Exception (Exception, throwIO, catchJust) +import Data.Bits ((.&.)) +import Data.ByteString (ByteString) +import Data.ByteString.Internal (create, memcpy, toForeignPtr) +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) +import Data.Int (Int32) +import Data.List (intercalate) +import Data.Text (Text, pack, splitOn, strip, unpack) +import Data.Text.Foreign (fromPtr, useAsPtr) +import Data.Text.ICU.BitMask (ToBitMask, fromBitMask, highestValueInBitMask, + toBitMask) +import Data.Text.ICU.Spoof.Internal (MSpoof, USpoof, withSpoof, wrap, + wrapWithSerialized) +import Data.Text.ICU.Error (u_PARSE_ERROR) +import Data.Text.ICU.Error.Internal (UErrorCode, UParseError, + ParseError(..), handleError, + handleOverflowError, handleParseError) +import Data.Text.ICU.Internal (UChar) +import Data.Typeable (Typeable) +import Data.Word (Word8) +import Foreign.C.String (CString, peekCString, withCString) +import Foreign.Marshal.Utils (with) +import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr) +import Foreign.Storable (peek) +import Foreign.ForeignPtr (withForeignPtr) + +-- $api +-- +-- The 'spoofCheck', 'areConfusable', and 'getSkeleton' functions analyze +-- Unicode text for visually confusable (or \"spoof\") characters. +-- +-- For example, Latin, Cyrillic, and Greek all contain unique Unicode +-- values which appear nearly identical on-screen: +-- +-- @ +-- A 0041 LATIN CAPITAL LETTER A +-- Α 0391 GREEK CAPITAL LETTER ALPHA +-- А 0410 CYRILLIC CAPITAL LETTER A +-- Ꭺ 13AA CHEROKEE LETTER GO +-- ᴀ 1D00 LATIN LETTER SMALL CAPITAL A +-- ᗅ 15C5 CANADIAN SYLLABICS CARRIER GHO +-- Ａ FF21 FULLWIDTH LATIN CAPITAL LETTER A +-- 𐊠 102A0 CARIAN LETTER A +-- 𝐀 1D400 MATHEMATICAL BOLD CAPITAL A +-- @ +-- +-- and so on. To check a string for visually confusable characters: +-- +-- 1. 'open' an 'MSpoof' +-- 2. optionally configure it with 'setChecks', 'setRestrictionLevel', +-- and/or 'setAllowedLocales', then +-- 3. 'spoofCheck' a single string, use 'areConfusable' to check if two +-- strings could be confused for each other, or use 'getSkeleton' to precompute +-- a \"skeleton\" string (similar to a hash code) which can be cached +-- and re-used to quickly check (using Unicode string comparison) if +-- two strings are confusable. +-- +-- By default, these methods will use ICU's bundled copy of +-- +-- and , +-- which could be out of date. To provide your own confusables databases, use +-- 'openFromSource'. (To avoid repeatedly parsing these databases, you +-- can then 'serialize' your configured 'MSpoof' and later +-- 'openFromSerialized' to load the pre-parsed databases.) + +data SpoofCheck + -- | Makes 'areConfusable' report if both identifiers are both from the + -- same script and are visually confusable. Does not affect 'spoofCheck'. + = SingleScriptConfusable + + -- | Makes 'areConfusable' report if both identifiers are visually + -- confusable and at least one identifier contains characters from more + -- than one script. + -- + -- Makes 'spoofCheck' report if the identifier contains multiple scripts, + -- and is confusable with some other identifier in a single script. + | MixedScriptConfusable + + -- | Makes 'areConfusable' report if each identifier is of a different + -- single script, and the identifiers are visually confusable. + | WholeScriptConfusable + + -- | By default, spoof checks assume the strings have been processed + -- through 'toCaseFold' and only check lower-case identifiers. If + -- this is set, spoof checks will check both upper and lower case + -- identifiers. + | AnyCase + + -- | Checks that identifiers are no looser than the specified + -- level passed to 'setRestrictionLevel'. + | RestrictionLevel + + -- | Checks the identifier for the presence of invisible characters, + -- such as zero-width spaces, or character sequences that are likely + -- not to display, such as multiple occurrences of the same + -- non-spacing mark. + | Invisible + + -- | Checks whether the identifier contains only characters from a + -- specified set (for example, via 'setAllowedLocales'). + | CharLimit + + -- | Checks that the identifier contains numbers from only a + -- single script. + | MixedNumbers + + -- | Enables all checks. + | AllChecks + + -- | Enables returning a 'RestrictionLevel' in the 'SpoofCheckResult'. + | AuxInfo + deriving (Bounded, Enum, Eq, Show) + +instance ToBitMask SpoofCheck where + toBitMask SingleScriptConfusable = #const USPOOF_SINGLE_SCRIPT_CONFUSABLE + toBitMask MixedScriptConfusable = #const USPOOF_MIXED_SCRIPT_CONFUSABLE + toBitMask WholeScriptConfusable = #const USPOOF_WHOLE_SCRIPT_CONFUSABLE + toBitMask AnyCase = #const USPOOF_ANY_CASE + toBitMask RestrictionLevel = #const USPOOF_RESTRICTION_LEVEL + toBitMask Invisible = #const USPOOF_INVISIBLE + toBitMask CharLimit = #const USPOOF_CHAR_LIMIT + toBitMask MixedNumbers = #const USPOOF_MIXED_NUMBERS + toBitMask AllChecks = #const USPOOF_ALL_CHECKS + toBitMask AuxInfo = #const USPOOF_AUX_INFO + +type USpoofCheck = Int32 + +data RestrictionLevel + -- | Checks that the string contains only Unicode values in the range + -- #0000#ߝ#007F# inclusive. + = ASCII + -- | Checks that the string contains only characters from a single script. + | SingleScriptRestrictive + -- | Checks that the string contains only characters from a single script, + -- or from the combinations (Latin + Han + Hiragana + Katakana), + -- (Latin + Han + Bopomofo), or (Latin + Han + Hangul). + | HighlyRestrictive + -- | Checks that the string contains only characters from the combinations + -- (Latin + Cyrillic + Greek + Cherokee), (Latin + Han + Hiragana + Katakana), + -- (Latin + Han + Bopomofo), or (Latin + Han + Hangul). + | ModeratelyRestrictive + -- | Allows arbitrary mixtures of scripts. + | MinimallyRestrictive + -- | Allows any valid identifiers, including characters outside of the + -- Identifier Profile. + | Unrestrictive + deriving (Bounded, Enum, Eq, Show) + +instance ToBitMask RestrictionLevel where + toBitMask ASCII = #const USPOOF_ASCII + toBitMask SingleScriptRestrictive = #const USPOOF_SINGLE_SCRIPT_RESTRICTIVE + toBitMask HighlyRestrictive = #const USPOOF_HIGHLY_RESTRICTIVE + toBitMask ModeratelyRestrictive = #const USPOOF_MODERATELY_RESTRICTIVE + toBitMask MinimallyRestrictive = #const USPOOF_MINIMALLY_RESTRICTIVE + toBitMask Unrestrictive = #const USPOOF_UNRESTRICTIVE + +type URestrictionLevel = Int32 + +data SpoofCheckResult + -- | The string passed all configured spoof checks. + = CheckOK + -- | The string failed one or more spoof checks. + | CheckFailed [SpoofCheck] + -- | The string failed one or more spoof checks, and + -- failed to pass the configured restriction level. + | CheckFailedWithRestrictionLevel { + -- | The spoof checks which the string failed. + failedChecks :: [SpoofCheck] + -- | The restriction level which the string failed to pass. + , failedLevel :: RestrictionLevel + } + deriving (Eq, Show) + +data SkeletonTypeOverride + -- | By default, 'getSkeleton' builds skeletons which catch + -- visually confusable characters across multiple scripts. + -- Pass this flag to override that behavior and build skeletons + -- which catch visually confusable characters across single scripts. + = SkeletonSingleScript + -- | By default, 'getSkeleton' assumes the input string has already + -- been passed through 'toCaseFold' and is lower-case. Pass this + -- flag to override that behavior and allow upper and lower-case strings. + | SkeletonAnyCase + deriving (Bounded, Enum, Eq, Show) + +instance ToBitMask SkeletonTypeOverride where + toBitMask SkeletonSingleScript = #const USPOOF_SINGLE_SCRIPT_CONFUSABLE + toBitMask SkeletonAnyCase = #const USPOOF_ANY_CASE + +type USkeletonTypeOverride = Int32 + +makeSpoofCheckResult :: USpoofCheck -> SpoofCheckResult +makeSpoofCheckResult c = + case c of + 0 -> CheckOK + _ -> + case restrictionLevel of + Nothing -> CheckFailed spoofChecks + Just l -> CheckFailedWithRestrictionLevel spoofChecks l + where spoofChecks = fromBitMask $ fromIntegral $ + c .&. #const USPOOF_ALL_CHECKS + restrictionValue = c .&. #const USPOOF_RESTRICTION_LEVEL_MASK + restrictionLevel = highestValueInBitMask $ fromIntegral $ + restrictionValue + +-- | Indicates which input file to 'openFromSource' failed to parse upon error. +data OpenFromSourceParseErrorFile = + ConfusablesTxtError | ConfusablesWholeScriptTxtError + deriving (Eq, Show) + +instance NFData OpenFromSourceParseErrorFile where + rnf !_ = () + +-- | Exception thrown with 'openFromSource' fails to parse one of the input files. +data OpenFromSourceParseError = OpenFromSourceParseError { + -- | The file which could not be parsed. + errFile :: OpenFromSourceParseErrorFile + -- | Parse error encountered opening a spoof checker from source. + , parseError :: ParseError + } deriving (Show, Typeable) + +instance NFData OpenFromSourceParseError where + rnf OpenFromSourceParseError{..} = rnf parseError `seq` rnf errFile + +instance Exception OpenFromSourceParseError + +-- | Open a spoof checker for checking Unicode strings for lookalike +-- security issues with default options (all 'SpoofCheck's except +-- 'CharLimit'). +open :: IO MSpoof +open = wrap =<< handleError uspoof_open + +isParseError :: ParseError -> Maybe ParseError +isParseError = Just + +-- | Open a spoof checker with custom rules given the UTF-8 encoded +-- contents of the @confusables.txt@ and @confusablesWholeScript.txt@ +-- files as described in . +openFromSource :: (ByteString, ByteString) -> IO MSpoof +openFromSource (confusables, confusablesWholeScript) = + unsafeUseAsCStringLen confusables $ \(cptr, clen) -> + unsafeUseAsCStringLen confusablesWholeScript $ \(wptr, wlen) -> + with 0 $ \errTypePtr -> + catchJust + isParseError + (wrap =<< (handleParseError + (== u_PARSE_ERROR) + (uspoof_openFromSource cptr (fromIntegral clen) wptr + (fromIntegral wlen) errTypePtr))) + (throwOpenFromSourceParseError errTypePtr) + +throwOpenFromSourceParseError :: Ptr Int32 -> ParseError -> IO a +throwOpenFromSourceParseError errTypePtr parseErr = do + errType <- peek errTypePtr + let errFile = + if errType == #{const USPOOF_SINGLE_SCRIPT_CONFUSABLE} + then ConfusablesTxtError + -- N.B.: ICU as of 55.1 actually leaves errFile set to 0 in this case. + else ConfusablesWholeScriptTxtError + throwIO $! OpenFromSourceParseError errFile parseErr + +-- | Open a spoof checker previously serialized to bytes using 'serialize'. +-- The returned 'MSpoof' will retain a reference to the 'ForeignPtr' inside +-- the ByteString, so ensure its contents do not change for the lifetime +-- of the lifetime of the returned value. +openFromSerialized :: ByteString -> IO MSpoof +openFromSerialized b = + case toForeignPtr b of + (ptr, off, len) -> withForeignPtr ptr $ \p -> + wrapWithSerialized ptr =<< handleError + (uspoof_openFromSerialized (p `plusPtr` off) (fromIntegral len) nullPtr) + +-- | Get the checks performed by a spoof checker. +getChecks :: MSpoof -> IO [SpoofCheck] +getChecks s = withSpoof s $ \sptr -> + (fromBitMask . fromIntegral . (.&.) #{const USPOOF_ALL_CHECKS}) <$> + handleError (uspoof_getChecks sptr) + +-- | Configure the checks performed by a spoof checker. +setChecks :: MSpoof -> [SpoofCheck] -> IO () +setChecks s c = withSpoof s $ \sptr -> + handleError $ uspoof_setChecks sptr . fromIntegral $ toBitMask c + +-- | Get the restriction level of a spoof checker. +getRestrictionLevel :: MSpoof -> IO (Maybe RestrictionLevel) +getRestrictionLevel s = withSpoof s $ \sptr -> + (highestValueInBitMask . fromIntegral) <$> uspoof_getRestrictionLevel sptr + +-- | Configure the restriction level of a spoof checker. +setRestrictionLevel :: MSpoof -> RestrictionLevel -> IO () +setRestrictionLevel s l = withSpoof s $ \sptr -> + uspoof_setRestrictionLevel sptr . fromIntegral $ toBitMask l + +-- | Get the list of locale names allowed to be used with a spoof checker. +-- (We don't use 'LocaleName' since the root and default locales have no +-- meaning here.) +getAllowedLocales :: MSpoof -> IO [String] +getAllowedLocales s = withSpoof s $ \sptr -> + splitLocales <$> (peekCString =<< handleError (uspoof_getAllowedLocales sptr)) + where splitLocales = fmap (unpack . strip) . splitOn "," . pack + +-- | Get the list of locale names allowed to be used with a spoof checker. +-- (We don't use 'LocaleName' since the root and default locales have no +-- meaning here.) +setAllowedLocales :: MSpoof -> [String] -> IO () +setAllowedLocales s locs = withSpoof s $ \sptr -> + withCString (intercalate "," locs) $ \lptr -> + handleError (uspoof_setAllowedLocales sptr lptr) + +-- | Check if two strings could be confused with each other. +areConfusable :: MSpoof -> Text -> Text -> IO SpoofCheckResult +areConfusable s t1 t2 = withSpoof s $ \sptr -> + useAsPtr t1 $ \t1ptr t1len -> + useAsPtr t2 $ \t2ptr t2len -> + makeSpoofCheckResult <$> + handleError (uspoof_areConfusable sptr + t1ptr (fromIntegral t1len) + t2ptr (fromIntegral t2len)) + +-- | Generates re-usable "skeleton" strings which can be used (via +-- Unicode equality) to check if an identifier is confusable +-- with some large set of existing identifiers. +-- +-- If you cache the returned strings in storage, you /must/ invalidate +-- your cache any time the underlying confusables database changes +-- (i.e., on ICU upgrade). +-- +-- By default, assumes all input strings have been passed through +-- 'toCaseFold' and are lower-case. To change this, pass +-- 'SkeletonAnyCase'. +-- +-- By default, builds skeletons which catch visually confusable +-- characters across multiple scripts. Pass 'SkeletonSingleScript' to +-- override that behavior and build skeletons which catch visually +-- confusable characters across single scripts. +getSkeleton :: MSpoof -> Maybe SkeletonTypeOverride -> Text -> IO Text +getSkeleton s o t = withSpoof s $ \sptr -> + useAsPtr t $ \tptr tlen -> + handleOverflowError (fromIntegral tlen) + (\dptr dlen -> uspoof_getSkeleton sptr oflags tptr + (fromIntegral tlen) dptr (fromIntegral dlen)) + (\dptr dlen -> fromPtr (castPtr dptr) (fromIntegral dlen)) + where oflags = maybe 0 (fromIntegral . toBitMask) o + +-- | Checks if a string could be confused with any other. +spoofCheck :: MSpoof -> Text -> IO SpoofCheckResult +spoofCheck s t = withSpoof s $ \sptr -> + useAsPtr t $ \tptr tlen -> + makeSpoofCheckResult <$> handleError + (uspoof_check sptr tptr (fromIntegral tlen) nullPtr) + +-- | Serializes the rules in this spoof checker to a byte array, +-- suitable for re-use by 'openFromSerialized'. +-- +-- Only includes any data provided to 'openFromSource'. Does not +-- include any other state or configuration. +serialize :: MSpoof -> IO ByteString +serialize s = withSpoof s $ \sptr -> + handleOverflowError 0 + (\dptr dlen -> (uspoof_serialize sptr dptr (fromIntegral dlen))) + (\dptr dlen -> create (fromIntegral dlen) $ \bptr -> + memcpy dptr bptr (fromIntegral dlen)) + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_open" uspoof_open + :: Ptr UErrorCode -> IO (Ptr USpoof) + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_openFromSerialized" + uspoof_openFromSerialized + :: Ptr Word8 -> Int32 -> Ptr Int32 -> Ptr UErrorCode -> IO (Ptr USpoof) + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_openFromSource" + uspoof_openFromSource + :: CString -> Int32 -> CString -> Int32 -> Ptr Int32 -> Ptr UParseError -> + Ptr UErrorCode -> IO (Ptr USpoof) + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_getChecks" + uspoof_getChecks + :: Ptr USpoof -> Ptr UErrorCode -> IO USpoofCheck + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_setChecks" + uspoof_setChecks + :: Ptr USpoof -> USpoofCheck -> Ptr UErrorCode -> IO () + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_getRestrictionLevel" + uspoof_getRestrictionLevel + :: Ptr USpoof -> IO URestrictionLevel + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_setRestrictionLevel" + uspoof_setRestrictionLevel + :: Ptr USpoof -> URestrictionLevel -> IO () + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_getAllowedLocales" + uspoof_getAllowedLocales + :: Ptr USpoof -> Ptr UErrorCode -> IO CString + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_setAllowedLocales" + uspoof_setAllowedLocales + :: Ptr USpoof -> CString -> Ptr UErrorCode -> IO () + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_areConfusable" + uspoof_areConfusable + :: Ptr USpoof -> Ptr UChar -> Int32 -> Ptr UChar -> Int32 -> Ptr UErrorCode + -> IO USpoofCheck + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_check" uspoof_check + :: Ptr USpoof -> Ptr UChar -> Int32 -> Ptr Int32 -> Ptr UErrorCode + -> IO USpoofCheck + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_getSkeleton" + uspoof_getSkeleton + :: Ptr USpoof -> USkeletonTypeOverride -> Ptr UChar -> Int32 -> Ptr UChar -> + Int32 -> Ptr UErrorCode -> IO Int32 + +foreign import ccall unsafe "hs_text_icu.h __hs_uspoof_serialize" + uspoof_serialize + :: Ptr USpoof -> Ptr Word8 -> Int32 -> Ptr UErrorCode -> IO Int32 diff --git a/Data/Text/ICU/Spoof/Internal.hs b/Data/Text/ICU/Spoof/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/Text/ICU/Spoof/Internal.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DeriveDataTypeable, EmptyDataDecls, ForeignFunctionInterface #-} +-- | +-- Module : Data.Text.ICU.Spoof.Internal +-- Copyright : (c) 2015 Ben Hamilton +-- +-- License : BSD-style +-- Maintainer : bgertzfield@gmail.com +-- Stability : experimental +-- Portability : GHC +-- +-- Internals of the spoofability check infrastructure. + +module Data.Text.ICU.Spoof.Internal + ( + -- * Unicode spoof checking API + -- $api + -- * Types + MSpoof(..) + , Spoof(..) + , USpoof + -- * Functions + , withSpoof + , wrap + , wrapWithSerialized + ) where + +import Data.Typeable (Typeable) +import Data.Word (Word8) +import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr) +import Foreign.Ptr (FunPtr, Ptr) + +-- $api +-- Low-level operations on spoof checkers. + +-- | Opaque handle to a configurable spoof checker. +data USpoof + +-- | Configurable spoof checker wrapping an opaque handle +-- and optionally wrapping a previously serialized instance. +data MSpoof = MSpoof { + serializedBuf :: Maybe (ForeignPtr Word8) + , spoofPtr :: {-# UNPACK #-} !(ForeignPtr USpoof) +} deriving (Typeable) + +-- | Spoof checker type. +newtype Spoof = S MSpoof + deriving (Typeable) + +-- | Temporarily unwraps an 'MSpoof' to perform operations on its raw 'USpoof' +-- handle. +withSpoof :: MSpoof -> (Ptr USpoof -> IO a) -> IO a +withSpoof (MSpoof _ spoof) = withForeignPtr spoof +{-# INLINE withSpoof #-} + +-- | Wraps a raw 'USpoof' handle in an 'MSpoof', closing the handle when +-- the last reference to the object is dropped. +wrap :: Ptr USpoof -> IO MSpoof +wrap = fmap (MSpoof Nothing) . newForeignPtr uspoof_close +{-# INLINE wrap #-} + +-- | Wraps a previously serialized spoof checker and raw 'USpoof' handle +-- in an 'MSpoof', closing the handle and releasing the 'ForeignPtr' when +-- the last reference to the object is dropped. +wrapWithSerialized :: ForeignPtr Word8 -> Ptr USpoof -> IO MSpoof +wrapWithSerialized s = fmap (MSpoof $ Just s) . newForeignPtr uspoof_close +{-# INLINE wrapWithSerialized #-} + +foreign import ccall unsafe "hs_text_icu.h &__hs_uspoof_close" uspoof_close + :: FunPtr (Ptr USpoof -> IO ()) diff --git a/Data/Text/ICU/Spoof/Pure.hs b/Data/Text/ICU/Spoof/Pure.hs new file mode 100644 --- /dev/null +++ b/Data/Text/ICU/Spoof/Pure.hs @@ -0,0 +1,146 @@ +-- | +-- Module : Data.Text.ICU.Spoof.Pure +-- Copyright : (c) 2015 Ben Hamilton +-- +-- License : BSD-style +-- Maintainer : bgertzfield@gmail.com +-- Stability : experimental +-- Portability : GHC +-- +-- Pure string spoof checking functions for Unicode, implemented as +-- bindings to the International Components for Unicode (ICU) +-- libraries. +-- +-- For the impure spoof checking API (which is richer, but less easy to +-- use), see the "Data.Text.ICU.Spoof" module. + +module Data.Text.ICU.Spoof.Pure + ( + -- * Types + Spoof + , SpoofParams(..) + , spoof + , spoofWithParams + , spoofFromSource + , spoofFromSerialized + -- * String spoof checks + , areConfusable + , getSkeleton + , spoofCheck + -- * Configuration + , getAllowedLocales + , getChecks + , getRestrictionLevel + -- * Persistence + , serialize + ) where + +import Data.ByteString (ByteString) +import Data.Foldable (forM_) +import Data.Text (Text) +import Data.Text.ICU.Spoof.Internal (Spoof(..)) +import System.IO.Unsafe (unsafePerformIO) +import qualified Data.Text.ICU.Spoof as S + +data SpoofParams + -- | Used to configure a 'Spoof' checker via 'spoofWithParams'. + = SpoofParams { + -- | Optional 'S.SpoofCheck's to perform on a string. By default, performs + -- all checks except 'CharLimit'. + spoofChecks :: Maybe [S.SpoofCheck] + -- | Optional 'S.RestrictionLevel' to which characters in the string will + -- be limited. By default, uses 'HighlyRestrictive'. + , level :: Maybe S.RestrictionLevel + -- | Optional locale(s) whose scripts will be used to limit the + -- set of allowed characters in a string. If set, automatically + -- enables the 'CharLimit' spoof check. + , locales :: Maybe [String] +} deriving (Show, Eq) + +applySpoofParams :: SpoofParams -> S.MSpoof -> S.MSpoof +applySpoofParams (SpoofParams c lev loc) s = unsafePerformIO $ do + forM_ c (S.setChecks s) + forM_ lev (S.setRestrictionLevel s) + forM_ loc (S.setAllowedLocales s) + return s + +-- | Open an immutable 'Spoof' checker with default options (all +-- 'S.SpoofCheck's except 'CharLimit'). +spoof :: Spoof +spoof = unsafePerformIO $ S `fmap` S.open + +-- | Open an immutable 'Spoof' checker with specific 'SpoofParams' +-- to control its behavior. +spoofWithParams :: SpoofParams -> Spoof +spoofWithParams p = unsafePerformIO $ do + s <- S.open + return (S $ applySpoofParams p s) + +-- | Open a immutable 'Spoof' checker with specific 'SpoofParams' +-- to control its behavior and custom rules given the UTF-8 encoded +-- contents of the @confusables.txt@ and @confusablesWholeScript.txt@ +-- files as described in . +spoofFromSource :: (ByteString, ByteString) -> SpoofParams -> Spoof +spoofFromSource (confusables, confusablesWholeScript) p = unsafePerformIO $ do + s <- S.openFromSource (confusables, confusablesWholeScript) + return (S $ applySpoofParams p s) + +-- | Create an immutable spoof checker with specific 'SpoofParams' +-- to control its behavior and custom rules previously returned +-- by 'serialize'. +spoofFromSerialized :: ByteString -> SpoofParams -> Spoof +spoofFromSerialized b p = unsafePerformIO $ do + s <- S.openFromSerialized b + return (S $ applySpoofParams p s) + +-- | Check two strings for confusability. +areConfusable :: Spoof -> Text -> Text -> S.SpoofCheckResult +areConfusable (S s) t1 t2 = unsafePerformIO $ S.areConfusable s t1 t2 + +-- | Check a string for spoofing issues. +spoofCheck :: Spoof -> Text -> S.SpoofCheckResult +spoofCheck (S s) t = unsafePerformIO $ S.spoofCheck s t + +-- | Generates re-usable \"skeleton\" strings which can be used (via +-- Unicode equality) to check if an identifier is confusable +-- with some large set of existing identifiers. +-- +-- If you cache the returned strings in storage, you /must/ invalidate +-- your cache any time the underlying confusables database changes +-- (i.e., on ICU upgrade). +-- +-- By default, assumes all input strings have been passed through +-- 'toCaseFold' and are lower-case. To change this, pass +-- 'SkeletonAnyCase'. +-- +-- By default, builds skeletons which catch visually confusable +-- characters across multiple scripts. Pass 'SkeletonSingleScript' to +-- override that behavior and build skeletons which catch visually +-- confusable characters across single scripts. +getSkeleton :: Spoof -> Maybe S.SkeletonTypeOverride -> Text -> Text +getSkeleton (S s) o t = unsafePerformIO $ S.getSkeleton s o t + +-- | Gets the restriction level currently configured in the spoof +-- checker, if present. +getRestrictionLevel :: Spoof -> Maybe S.RestrictionLevel +getRestrictionLevel (S s) = unsafePerformIO $ S.getRestrictionLevel s + +-- | Gets the checks currently configured in the spoof checker. +getChecks :: Spoof -> [S.SpoofCheck] +getChecks (S s) = unsafePerformIO $ S.getChecks s + +-- | Gets the locales whose scripts are currently allowed by the spoof +-- checker. (We don't use 'LocaleName' since the root and default +-- locales have no meaning here.) +getAllowedLocales :: Spoof -> [String] +getAllowedLocales (S s) = unsafePerformIO $ S.getAllowedLocales s + +-- | Serializes the rules in this spoof checker to a byte array, +-- suitable for re-use by 'spoofFromSerialized'. +-- +-- Only includes any data provided to 'openFromSource'. Does not +-- include any other state or configuration. +serialize :: Spoof -> ByteString +serialize (S s) = unsafePerformIO $ S.serialize s + +{-# INLINE spoofCheck #-} diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -12,14 +12,21 @@ # Prerequisites This library is implemented as bindings to the well-respected [ICU -library](http://www.icu-project.org/), which is not included. The versions -of ICU currently supported are 4.0 and newer. +library](http://www.icu-project.org/) (which is not bundled, and must +be installed separately). +# Compatibility + +Upstream ICU occasionally introduces backwards-incompatible API +breaks. This package tries to stay up to date with upstream, and is +currently more or less in sync with ICU 55. + + # Get involved! Please report bugs via the -[bitbucket issue tracker](http://bitbucket.org/bos/text-icu/issues). +[github issue tracker](http://github.com/bos/text-icu/issues). Master [Mercurial repository](http://bitbucket.org/bos/text-icu): diff --git a/cbits/text_icu.c b/cbits/text_icu.c --- a/cbits/text_icu.c +++ b/cbits/text_icu.c @@ -1,4 +1,5 @@ #include "hs_text_icu.h" +#include "stdbool.h" UBreakIterator* __hs_ubrk_open(UBreakIteratorType type, const char *locale, const UChar *text, int32_t textLength, @@ -25,7 +26,7 @@ return ubrk_safeClone(bi, stackBuffer, pBufferSize, status); } -int32_t __hs_ubrk_current(UBreakIterator *bi) +int32_t __hs_ubrk_current(const UBreakIterator *bi) { return ubrk_current(bi); } @@ -305,7 +306,7 @@ int32_t __hs_u_strCompareIter(UCharIterator *iter1, UCharIterator *iter2) { - return u_strCompareIter(iter1, iter2, TRUE); + return u_strCompareIter(iter1, iter2, true); } UBlockCode __hs_ublock_getCode(UChar32 c) @@ -385,8 +386,8 @@ return uregex_close(regexp); } -URegularExpression *__hs_uregex_clone(URegularExpression *regexp, - UErrorCode *pErrorCode) +URegularExpression * __hs_uregex_clone(const URegularExpression *regexp, + UErrorCode *pErrorCode) { return uregex_clone(regexp, pErrorCode); } @@ -448,4 +449,99 @@ UErrorCode *status) { return uregex_group(regexp, groupNum, dest, destCapacity, status); +} + +USpoofChecker *__hs_uspoof_open(UErrorCode *status) +{ + return uspoof_open(status); +} + +USpoofChecker *__hs_uspoof_openFromSerialized(const void *data, int32_t length, + int32_t *pActualLength, + UErrorCode *status) +{ + return uspoof_openFromSerialized(data, length, pActualLength, status); +} + +USpoofChecker *__hs_uspoof_openFromSource(const char *confusables, + int32_t confusablesLen, + const char *confusablesWholeScript, + int32_t confusablesWholeScriptLen, + int32_t *errType, + UParseError *parseError, + UErrorCode *status) +{ + // Work around missing call to umtx_initOnce() in uspoof_openFromSource() + // causing crash when gNfdNormalizer is accessed + uspoof_getInclusionSet(status); + return uspoof_openFromSource(confusables, confusablesLen, + confusablesWholeScript, + confusablesWholeScriptLen, + errType, parseError, status); +} + +void __hs_uspoof_setChecks(USpoofChecker *sc, int32_t checks, + UErrorCode *status) +{ + uspoof_setChecks(sc, checks, status); +} + +int32_t __hs_uspoof_getChecks(const USpoofChecker *sc, UErrorCode *status) +{ + return uspoof_getChecks(sc, status); +} + +void __hs_uspoof_setRestrictionLevel(USpoofChecker *sc, URestrictionLevel level) +{ + uspoof_setRestrictionLevel(sc, level); +} + +URestrictionLevel __hs_uspoof_getRestrictionLevel(const USpoofChecker *sc) +{ + return uspoof_getRestrictionLevel(sc); +} + +void __hs_uspoof_setAllowedLocales(USpoofChecker *sc, const char *localesList, + UErrorCode *status) +{ + uspoof_setAllowedLocales(sc, localesList, status); +} + +const char *__hs_uspoof_getAllowedLocales(USpoofChecker *sc, UErrorCode *status) +{ + return uspoof_getAllowedLocales(sc, status); +} + +int32_t __hs_uspoof_check(USpoofChecker *sc, const UChar *id, + int32_t length, int32_t *position, + UErrorCode *status) +{ + return uspoof_check(sc, id, length, position, status); +} + +int32_t __hs_uspoof_areConfusable(USpoofChecker *sc, + const UChar *id1, int32_t length1, + const UChar *id2, int32_t length2, + UErrorCode *status) +{ + return uspoof_areConfusable(sc, id1, length1, id2, length2, status); +} + +int32_t __hs_uspoof_getSkeleton(USpoofChecker *sc, + int32_t type, const UChar *id, int32_t length, + UChar *dest, int32_t destCapacity, + UErrorCode *status) +{ + return uspoof_getSkeleton(sc, type, id, length, dest, destCapacity, status); +} + +int32_t __hs_uspoof_serialize(USpoofChecker *sc, void *data, int32_t capacity, + UErrorCode *status) +{ + return uspoof_serialize(sc, data, capacity, status); +} + +void __hs_uspoof_close(USpoofChecker *sc) +{ + uspoof_close(sc); } diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,10 @@ +0.7.1.0 + +* Add fix for undefined TRUE value in cbits (#52) +* Improve CI and documentation (#20) + +Thanks to everyone who contributed! + 0.7.0.0 * Built and tested against ICU 53. diff --git a/include/hs_text_icu.h b/include/hs_text_icu.h --- a/include/hs_text_icu.h +++ b/include/hs_text_icu.h @@ -11,6 +11,7 @@ #include "unicode/uiter.h" #include "unicode/unorm.h" #include "unicode/uregex.h" +#include "unicode/uspoof.h" #include "unicode/ustring.h" #include @@ -26,7 +27,7 @@ UBreakIterator * __hs_ubrk_safeClone(const UBreakIterator *bi, void *stackBuffer, int32_t *pBufferSize, UErrorCode *status); -int32_t __hs_ubrk_current(UBreakIterator *bi); +int32_t __hs_ubrk_current(const UBreakIterator *bi); int32_t __hs_ubrk_first(UBreakIterator *bi); int32_t __hs_ubrk_last(UBreakIterator *bi); int32_t __hs_ubrk_next(UBreakIterator *bi); @@ -80,7 +81,6 @@ int32_t __hs_ucol_getSortKey(const UCollator *coll, const UChar *source, int32_t sourceLength, uint8_t *result, int32_t resultLength); -UBool __hs_ucol_equals(const UCollator *source, const UCollator *target); /* ucnv.h */ @@ -142,8 +142,8 @@ void __hs_uregex_setStackLimit(URegularExpression *regexp, int32_t limit, UErrorCode *status); void __hs_uregex_close(URegularExpression *regexp); -URegularExpression *__hs_uregex_clone(URegularExpression *regexp, - UErrorCode *pErrorCode); +URegularExpression * __hs_uregex_clone(const URegularExpression *regexp, + UErrorCode *pErrorCode); const UChar *__hs_uregex_pattern(const URegularExpression *regexp, int32_t *patLength, UErrorCode *status); int32_t __hs_uregex_flags(const URegularExpression *regexp, @@ -176,3 +176,45 @@ const UChar *src, int32_t srcLength, const char *locale, UErrorCode *pErrorCode); int32_t __hs_u_strCompareIter(UCharIterator *iter1, UCharIterator *iter2); + +/* uspoof.h */ + +USpoofChecker *__hs_uspoof_open(UErrorCode *status); +USpoofChecker *__hs_uspoof_openFromSerialized(const void *data, int32_t length, + int32_t *pActualLength, + UErrorCode *status); +USpoofChecker *__hs_uspoof_openFromSource(const char *confusables, + int32_t confusablesLen, + const char *confusablesWholeScript, + int32_t confusablesWholeScriptLen, + int32_t *errType, + UParseError *parseError, + UErrorCode *status); +void __hs_uspoof_setChecks(USpoofChecker *sc, int32_t checks, + UErrorCode *status); +int32_t __hs_uspoof_getChecks(const USpoofChecker *sc, UErrorCode *status); + +// Yes, these really don't take UErrorCode *.. +void __hs_uspoof_setRestrictionLevel(USpoofChecker *sc, + URestrictionLevel restrictionLevel); +URestrictionLevel __hs_uspoof_getRestrictionLevel(const USpoofChecker *sc); + +void __hs_uspoof_setAllowedLocales(USpoofChecker *sc, const char *localesList, + UErrorCode *status); +const char *__hs_uspoof_getAllowedLocales(USpoofChecker *sc, + UErrorCode *status); + +int32_t __hs_uspoof_check(USpoofChecker *sc, const UChar *id, + int32_t length, int32_t *position, + UErrorCode *status); +int32_t __hs_uspoof_areConfusable(USpoofChecker *sc, + const UChar *id1, int32_t length1, + const UChar *id2, int32_t length2, + UErrorCode *status); +int32_t __hs_uspoof_getSkeleton(USpoofChecker *sc, int32_t checks, + const UChar *id, int32_t length, + UChar *dest, int32_t destCapacity, + UErrorCode *status); +int32_t __hs_uspoof_serialize(USpoofChecker *sc, void *data, int32_t capacity, + UErrorCode *status); +void __hs_uspoof_close(USpoofChecker *sc); diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -13,7 +13,8 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text.ICU (NormalizationMode(..)) -import QuickCheckUtils () +import QuickCheckUtils (NonEmptyText(..), LatinSpoofableText(..), + NonSpoofableText(..)) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import qualified Data.Text as T @@ -78,7 +79,14 @@ t_digitToInt = t_rnf $ I.digitToInt t_numericValue = t_rnf $ I.numericValue +-- Spoofing +t_nonspoofable (NonSpoofableText t) = I.spoofCheck I.spoof t == I.CheckOK +t_spoofable (LatinSpoofableText t) = I.spoofCheck I.spoof t == + I.CheckFailed [I.WholeScriptConfusable] +t_confusable (NonEmptyText t) = I.areConfusable I.spoof t t == + I.CheckFailed [I.SingleScriptConfusable] + tests :: Test tests = testGroup "Properties" [ @@ -101,4 +109,7 @@ , testProperty "t_mirror" t_mirror , testProperty "t_digitToInt" t_digitToInt , testProperty "t_numericValue" t_numericValue + , testProperty "t_spoofable" t_spoofable + , testProperty "t_nonspoofable" t_nonspoofable + , testProperty "t_confusable" t_confusable ] diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs --- a/tests/QuickCheckUtils.hs +++ b/tests/QuickCheckUtils.hs @@ -1,13 +1,14 @@ {-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module QuickCheckUtils () where +module QuickCheckUtils (NonEmptyText(..), LatinSpoofableText(..), + NonSpoofableText(..)) where import Control.Applicative ((<$>)) import Control.DeepSeq (NFData(..)) import Data.Text.ICU (Collator, LocaleName(..), NormalizationMode(..)) import Data.Text.ICU.Break (available) -import Test.QuickCheck (Arbitrary(..), elements) +import Test.QuickCheck (Arbitrary(..), Gen, elements, listOf1) import qualified Data.Text as T import qualified Data.Text.ICU as I @@ -26,3 +27,34 @@ instance Arbitrary Collator where arbitrary = I.collator <$> arbitrary + +newtype NonEmptyText = NonEmptyText { nonEmptyText :: T.Text } deriving Show +instance Arbitrary NonEmptyText where + arbitrary = NonEmptyText <$> T.pack <$> listOf1 arbitrary + +newtype LatinSpoofableText = LatinSpoofableText { latinSpoofableText :: T.Text } + deriving Show +instance Arbitrary LatinSpoofableText where + arbitrary = LatinSpoofableText <$> T.pack <$> + listOf1 genCyrillicLatinSpoofableChar + +genCyrillicLatinSpoofableChar :: Gen Char +genCyrillicLatinSpoofableChar = elements ( + "\x043A\x043E\x0433\x0435\x043A\x043C" ++ + ['\x043E'..'\x0443'] ++ + ['\x0445'..'\x0446'] ++ + "\x044A" ++ + ['\x0454'..'\x0456'] ++ + "\x0458\x045B\x048D\x0491\x0493\x049B\x049F\x04AB\x04AD\x04AF\x04B1\x04BB\ + \\x04BD\x04BF" ++ + ['\x04CE'..'\x04CF'] ++ + "\x04D5\x04D9\x04E9\x0501\x0511\x051B\x051D") + +newtype NonSpoofableText = NonSpoofableText { nonSpoofableText :: T.Text } + deriving Show + +instance Arbitrary NonSpoofableText where + arbitrary = NonSpoofableText <$> T.pack <$> listOf1 genNonSpoofableChar + +genNonSpoofableChar :: Gen Char +genNonSpoofableChar = elements "QDFRz" diff --git a/text-icu.cabal b/text-icu.cabal --- a/text-icu.cabal +++ b/text-icu.cabal @@ -1,5 +1,5 @@ name: text-icu -version: 0.7.0.1 +version: 0.7.1.0 synopsis: Bindings to the ICU library homepage: https://github.com/bos/text-icu bug-reports: https://github.com/bos/text-icu/issues @@ -29,8 +29,10 @@ unique binary representation.) . * Regular expression search and replace. + . + * Security checks for visually confusable (spoofable) strings. maintainer: Bryan O'Sullivan -copyright: 2009-2014 Bryan O'Sullivan +copyright: 2009-2015 Bryan O'Sullivan category: Data, Text license: BSD3 license-file: LICENSE @@ -59,8 +61,10 @@ Data.Text.ICU.Error Data.Text.ICU.Normalize Data.Text.ICU.Regex + Data.Text.ICU.Spoof Data.Text.ICU.Types other-modules: + Data.Text.ICU.BitMask Data.Text.ICU.Break.Pure Data.Text.ICU.Break.Types Data.Text.ICU.Collate.Internal @@ -72,9 +76,14 @@ Data.Text.ICU.Normalize.Internal Data.Text.ICU.Regex.Internal Data.Text.ICU.Regex.Pure + Data.Text.ICU.Spoof.Internal + Data.Text.ICU.Spoof.Pure Data.Text.ICU.Text c-sources: cbits/text_icu.c include-dirs: include + if os(darwin) + extra-lib-dirs: /usr/local/opt/icu4c/lib + include-dirs: /usr/local/opt/icu4c/include extra-libraries: icuuc if os(mingw32) extra-libraries: icuin icudt