module Data.Text.IDN.StringPrep
(
Flags (..)
, Error (..)
, defaultFlags
, stringprep
, Profile
, profileNameprep
, profileSaslPrep
, profilePlain
, profileTrace
, profileKerberos5
, profileNodeprep
, profileResourceprep
, profileISCSI
) where
import Data.Bits ((.|.))
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as TE
import qualified Foreign as F
import qualified Foreign.C as F
import System.IO.Unsafe (unsafePerformIO)
data Error
= ErrorContainsUnassigned
| ErrorContainsProhibited
| ErrorBidiBothLAndRAL
| ErrorBidiLeadTrailNotRAL
| ErrorBidiContainsProhibited
| ErrorInconsistentProfile
| ErrorInvalidFlag
| ErrorNormalisationFailed
| ErrorUnknown Integer
deriving (Show, Eq)
data Flags = Flags
{ enableNFKC :: Bool
, enableBidi :: Bool
, allowUnassigned :: Bool
}
newtype Profile = Profile (F.Ptr Profile)
defaultFlags :: Flags
defaultFlags = Flags True True False
stringprep :: Profile -> Flags -> TL.Text -> Either Error TL.Text
stringprep profile flags input = unsafePerformIO io where
utf8 = TE.encodeUtf8 $ T.concat $ TL.toChunks input
cflags = encodeFlags flags
len = B.length utf8 + 1
io = B.useAsCString utf8 (loop len)
loop bufsize pIn = F.allocaBytes bufsize $ \buf -> do
F.copyArray buf pIn len
let csize = fromIntegral bufsize
rc <- c_stringprep buf csize cflags profile
case rc of
100 -> loop (bufsize + 50) pIn
0 -> do
bytes <- B.packCString buf
return $ Right $ TL.fromChunks [TE.decodeUtf8 bytes]
_ -> return $ Left $ cToError rc
encodeFlags :: Flags -> F.CInt
encodeFlags flags = foldr (.|.) 0 bits where
bit f x y = if f flags then x else y
bits = [ bit enableNFKC 0 1
, bit enableBidi 0 2
, bit allowUnassigned 0 4
]
cToError :: F.CInt -> Error
cToError x = case x of
1 -> ErrorContainsUnassigned
2 -> ErrorContainsProhibited
3 -> ErrorBidiBothLAndRAL
4 -> ErrorBidiLeadTrailNotRAL
5 -> ErrorBidiContainsProhibited
101 -> ErrorInconsistentProfile
102 -> ErrorInvalidFlag
200 -> ErrorNormalisationFailed
_ -> ErrorUnknown $ toInteger x
foreign import ccall unsafe "stringprep"
c_stringprep :: F.CString -> F.CSize -> F.CInt -> Profile -> IO F.CInt
foreign import ccall "&stringprep_nameprep"
profileNameprep :: Profile
foreign import ccall "&stringprep_saslprep"
profileSaslPrep :: Profile
foreign import ccall "&stringprep_plain"
profilePlain :: Profile
foreign import ccall "&stringprep_trace"
profileTrace :: Profile
foreign import ccall "&stringprep_kerberos5"
profileKerberos5 :: Profile
foreign import ccall "&stringprep_xmpp_nodeprep"
profileNodeprep :: Profile
foreign import ccall "&stringprep_xmpp_resourceprep"
profileResourceprep :: Profile
foreign import ccall "&stringprep_iscsi"
profileISCSI :: Profile