module Data.Text.IDN.StringPrep
(
Flags (..)
, Error
, defaultFlags
, stringprep
, Profile
, iscsi
, kerberos5
, nameprep
, sasl
, saslAnonymous
, trace
, xmppNode
, xmppResource
) where
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified System.IO.Unsafe as Unsafe
import Foreign
import Foreign.C
import Data.Text.IDN.Internal
newtype Profile = Profile (Ptr (Profile))
data Stringprep_rc = OK
| CONTAINS_UNASSIGNED
| CONTAINS_PROHIBITED
| BIDI_BOTH_L_AND_RAL
| BIDI_LEADTRAIL_NOT_RAL
| BIDI_CONTAINS_PROHIBITED
| TOO_SMALL_BUFFER
| PROFILE_ERROR
| FLAG_ERROR
| UNKNOWN_PROFILE
| NFKC_FAILED
| MALLOC_ERROR
instance Enum Stringprep_rc where
fromEnum OK = 0
fromEnum CONTAINS_UNASSIGNED = 1
fromEnum CONTAINS_PROHIBITED = 2
fromEnum BIDI_BOTH_L_AND_RAL = 3
fromEnum BIDI_LEADTRAIL_NOT_RAL = 4
fromEnum BIDI_CONTAINS_PROHIBITED = 5
fromEnum TOO_SMALL_BUFFER = 100
fromEnum PROFILE_ERROR = 101
fromEnum FLAG_ERROR = 102
fromEnum UNKNOWN_PROFILE = 103
fromEnum NFKC_FAILED = 200
fromEnum MALLOC_ERROR = 201
toEnum 0 = OK
toEnum 1 = CONTAINS_UNASSIGNED
toEnum 2 = CONTAINS_PROHIBITED
toEnum 3 = BIDI_BOTH_L_AND_RAL
toEnum 4 = BIDI_LEADTRAIL_NOT_RAL
toEnum 5 = BIDI_CONTAINS_PROHIBITED
toEnum 100 = TOO_SMALL_BUFFER
toEnum 101 = PROFILE_ERROR
toEnum 102 = FLAG_ERROR
toEnum 103 = UNKNOWN_PROFILE
toEnum 200 = NFKC_FAILED
toEnum 201 = MALLOC_ERROR
toEnum unmatched = error ("Stringprep_rc.toEnum: Cannot match " ++ show unmatched)
data Stringprep_profile_flags = NO_NFKC
| NO_BIDI
| NO_UNASSIGNED
instance Enum Stringprep_profile_flags where
fromEnum NO_NFKC = 1
fromEnum NO_BIDI = 2
fromEnum NO_UNASSIGNED = 4
toEnum 1 = NO_NFKC
toEnum 2 = NO_BIDI
toEnum 4 = NO_UNASSIGNED
toEnum unmatched = error ("Stringprep_profile_flags.toEnum: Cannot match " ++ show unmatched)
data Flags = Flags
{ enableNFKC :: Bool
, enableBidi :: Bool
, allowUnassigned :: Bool
}
deriving (Show, Eq)
defaultFlags :: Flags
defaultFlags = Flags True True False
stringprep :: Profile -> Flags -> T.Text -> Either Error T.Text
stringprep profile flags input = Unsafe.unsafePerformIO io where
io = B.useAsCString utf8 (loop inSize)
utf8 = TE.encodeUtf8 input
c_flags = encodeFlags flags
inSize = B.length utf8 + 1
loop outSize inBuf = do
res <- tryPrep outSize inBuf
case res of
Nothing -> loop (outSize + 50) inBuf
Just (Right bytes) -> return (Right (TE.decodeUtf8 bytes))
Just (Left rc) -> return (Left (cToError rc))
tryPrep outSize inBuf = allocaBytes outSize $ \outBuf -> do
copyArray outBuf inBuf inSize
let csize = fromIntegral outSize
c_rc <- c_stringprep
outBuf csize c_flags profile
let rc = fromIntegral c_rc
if rc == fromEnum TOO_SMALL_BUFFER
then return Nothing
else if rc == fromEnum OK
then fmap (Just . Right) (B.packCString outBuf)
else return (Just (Left c_rc))
encodeFlags :: Flags -> CInt
encodeFlags flags = foldr (.|.) 0 bits where
bitAt f e = if f flags then 0 else fromIntegral (fromEnum e)
bits = [ bitAt enableNFKC NO_NFKC
, bitAt enableBidi NO_BIDI
, bitAt allowUnassigned NO_UNASSIGNED
]
cToError :: CInt -> Error
cToError rc = StringPrepError (T.pack str) where
c_strerror = stringprep_strerror
str = Unsafe.unsafePerformIO (c_strerror rc >>= peekCString)
foreign import ccall "&stringprep_iscsi"
iscsi :: Profile
foreign import ccall "&stringprep_kerberos5"
kerberos5 :: Profile
foreign import ccall "&stringprep_nameprep"
nameprep :: Profile
foreign import ccall "&stringprep_saslprep"
sasl :: Profile
foreign import ccall "&stringprep_plain"
saslAnonymous :: Profile
foreign import ccall "&stringprep_trace"
trace :: Profile
foreign import ccall "&stringprep_xmpp_nodeprep"
xmppNode :: Profile
foreign import ccall "&stringprep_xmpp_resourceprep"
xmppResource :: Profile
foreign import ccall safe "Data/Text/IDN/StringPrep.chs.h stringprep"
c_stringprep :: ((Ptr CChar) -> (CULong -> (CInt -> ((Profile) -> (IO CInt)))))
foreign import ccall safe "Data/Text/IDN/StringPrep.chs.h stringprep_strerror"
stringprep_strerror :: (CInt -> (IO (Ptr CChar)))