{-# LANGUAGE DeriveDataTypeable #-}

module Data.Text.Punycode.Decode (PunycodeDecodeException (..), decode) where

import Control.Exception.Base
import qualified Data.ByteString as BS
import Data.Char
import Data.Serialize hiding (decode)
import qualified Data.Text as T
import Data.Text.Punycode.Shared
import Data.Typeable
import Data.Word

data PunycodeDecodeException
  = GenericDecodeException
  | InternalStringTooShort
  | InputTooShort
  | RightOfHyphenShouldBeAlphanumeric
  | LeftOfHyphenShouldBeBasic
  | CantStartWithDash
  | InvalidCodePoint
  deriving (PunycodeDecodeException -> PunycodeDecodeException -> Bool
(PunycodeDecodeException -> PunycodeDecodeException -> Bool)
-> (PunycodeDecodeException -> PunycodeDecodeException -> Bool)
-> Eq PunycodeDecodeException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PunycodeDecodeException -> PunycodeDecodeException -> Bool
== :: PunycodeDecodeException -> PunycodeDecodeException -> Bool
$c/= :: PunycodeDecodeException -> PunycodeDecodeException -> Bool
/= :: PunycodeDecodeException -> PunycodeDecodeException -> Bool
Eq, Int -> PunycodeDecodeException -> ShowS
[PunycodeDecodeException] -> ShowS
PunycodeDecodeException -> String
(Int -> PunycodeDecodeException -> ShowS)
-> (PunycodeDecodeException -> String)
-> ([PunycodeDecodeException] -> ShowS)
-> Show PunycodeDecodeException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PunycodeDecodeException -> ShowS
showsPrec :: Int -> PunycodeDecodeException -> ShowS
$cshow :: PunycodeDecodeException -> String
show :: PunycodeDecodeException -> String
$cshowList :: [PunycodeDecodeException] -> ShowS
showList :: [PunycodeDecodeException] -> ShowS
Show, Typeable)

instance Exception PunycodeDecodeException

-- | Decode a string into its unicode form
decode :: BS.ByteString -> Either PunycodeDecodeException T.Text
decode :: ByteString -> Either PunycodeDecodeException Text
decode ByteString
input
  | ByteString
input ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [Word8] -> ByteString
BS.pack [Word8
45, Word8
45] = Text -> Either PunycodeDecodeException Text
forall a b. b -> Either a b
Right (Text -> Either PunycodeDecodeException Text)
-> Text -> Either PunycodeDecodeException Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"-"
  | Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
input) Bool -> Bool -> Bool
&& ByteString -> Int
BS.length ((Word8 -> Bool) -> ByteString -> ByteString
BS.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45) ByteString
input) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
input Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45 = PunycodeDecodeException -> Either PunycodeDecodeException Text
forall a b. a -> Either a b
Left PunycodeDecodeException
CantStartWithDash
  | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isExtendedBasic) Text
before = PunycodeDecodeException -> Either PunycodeDecodeException Text
forall a b. a -> Either a b
Left PunycodeDecodeException
LeftOfHyphenShouldBeBasic
  | Bool
otherwise = case Get (Either PunycodeDecodeException Text)
-> ByteString
-> Either String (Either PunycodeDecodeException Text)
forall a. Get a -> ByteString -> Either String a
runGet (Int
-> Int -> Int -> Text -> Get (Either PunycodeDecodeException Text)
inner2 Int
initial_n Int
0 Int
initial_bias Text
before) ByteString
after of
      Right Either PunycodeDecodeException Text
out -> Either PunycodeDecodeException Text
out
      Left String
_ -> PunycodeDecodeException -> Either PunycodeDecodeException Text
forall a b. a -> Either a b
Left PunycodeDecodeException
InputTooShort
  where
    (Text
before, ByteString
after)
      | (Word8 -> Bool) -> ByteString -> Bool
BS.any Word8 -> Bool
f ByteString
input = (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.init ByteString
b1, ByteString
a1)
      | Bool
otherwise = (Text
T.empty, ByteString
input)
    f :: Word8 -> Bool
f = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'-'))
    (ByteString
b1, ByteString
a1) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.breakEnd Word8 -> Bool
f ByteString
input

inner2 :: Int -> Int -> Int -> T.Text -> Get (Either PunycodeDecodeException T.Text)
inner2 :: Int
-> Int -> Int -> Text -> Get (Either PunycodeDecodeException Text)
inner2 Int
n Int
oldi Int
bias Text
output = do
  Bool
b <- Get Bool
isEmpty
  Bool -> Get (Either PunycodeDecodeException Text)
helper Bool
b
  where
    helper :: Bool -> Get (Either PunycodeDecodeException Text)
helper Bool
False = do
      Maybe Int
i <- Int -> Int -> Int -> Int -> Get (Maybe Int)
inner Int
base Int
1 Int
oldi Int
bias
      Maybe Int -> Get (Either PunycodeDecodeException Text)
helper' Maybe Int
i
      where
        helper' :: Maybe Int -> Get (Either PunycodeDecodeException Text)
helper' Maybe Int
Nothing = Either PunycodeDecodeException Text
-> Get (Either PunycodeDecodeException Text)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PunycodeDecodeException Text
 -> Get (Either PunycodeDecodeException Text))
-> Either PunycodeDecodeException Text
-> Get (Either PunycodeDecodeException Text)
forall a b. (a -> b) -> a -> b
$ PunycodeDecodeException -> Either PunycodeDecodeException Text
forall a b. a -> Either a b
Left PunycodeDecodeException
RightOfHyphenShouldBeAlphanumeric
        helper' (Just Int
i) = case Either PunycodeDecodeException Text
output' of
          Right Text
output'' -> Int
-> Int -> Int -> Text -> Get (Either PunycodeDecodeException Text)
inner2 Int
n' (Int
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bias' Text
output''
          Left PunycodeDecodeException
err -> Either PunycodeDecodeException Text
-> Get (Either PunycodeDecodeException Text)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PunycodeDecodeException Text
 -> Get (Either PunycodeDecodeException Text))
-> Either PunycodeDecodeException Text
-> Get (Either PunycodeDecodeException Text)
forall a b. (a -> b) -> a -> b
$ PunycodeDecodeException -> Either PunycodeDecodeException Text
forall a b. a -> Either a b
Left PunycodeDecodeException
err
          where
            bias' :: Int
bias' = Int -> Int -> Bool -> Int
adapt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
oldi) (Text -> Int
T.length Text
output Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
oldi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
            n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Text -> Int
T.length Text
output Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Text -> Int
T.length Text
output Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            output' :: Either PunycodeDecodeException Text
output' = Text -> Int -> Int -> Either PunycodeDecodeException Text
insertInto Text
output Int
n' Int
i'
    helper Bool
True = Either PunycodeDecodeException Text
-> Get (Either PunycodeDecodeException Text)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PunycodeDecodeException Text
 -> Get (Either PunycodeDecodeException Text))
-> Either PunycodeDecodeException Text
-> Get (Either PunycodeDecodeException Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either PunycodeDecodeException Text
forall a b. b -> Either a b
Right Text
output

inner :: Int -> Int -> Int -> Int -> Get (Maybe Int)
inner :: Int -> Int -> Int -> Int -> Get (Maybe Int)
inner Int
k Int
w Int
i Int
bias = do
  Word8
word8 <- Get Word8
getWord8
  Maybe Int -> Get (Maybe Int)
helper (Maybe Int -> Get (Maybe Int)) -> Maybe Int -> Get (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Word8 -> Maybe Int
word8ToDigit Word8
word8
  where
    helper :: Maybe Int -> Get (Maybe Int)
helper Maybe Int
Nothing = Maybe Int -> Get (Maybe Int)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
    helper (Just Int
digit)
      | Int
digit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
t = Maybe Int -> Get (Maybe Int)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> Get (Maybe Int)) -> Maybe Int -> Get (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i'
      | Bool
otherwise = Int -> Int -> Int -> Int -> Get (Maybe Int)
inner (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
base) Int
w' Int
i' Int
bias
      where
        w' :: Int
w' = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
t)
        i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
digit Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w
        t :: Int
t
          | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bias Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tmin = Int
tmin
          | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bias Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tmax = Int
tmax
          | Bool
otherwise = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bias

insertInto :: T.Text -> Int -> Int -> Either PunycodeDecodeException T.Text
insertInto :: Text -> Int -> Int -> Either PunycodeDecodeException Text
insertInto Text
input Int
n Int
i
  | Text -> Int
T.length Text
input Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = PunycodeDecodeException -> Either PunycodeDecodeException Text
forall a b. a -> Either a b
Left PunycodeDecodeException
InternalStringTooShort
  | Bool
otherwise = case Maybe Char
n' of
      Just Char
n'' -> Text -> Either PunycodeDecodeException Text
forall a b. b -> Either a b
Right (Text -> Either PunycodeDecodeException Text)
-> Text -> Either PunycodeDecodeException Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Int -> Text -> Text
T.take Int
i Text
input, Char -> Text
T.singleton Char
n'', Int -> Text -> Text
T.drop Int
i Text
input]
      Maybe Char
Nothing -> PunycodeDecodeException -> Either PunycodeDecodeException Text
forall a b. a -> Either a b
Left PunycodeDecodeException
InvalidCodePoint
  where
    n' :: Maybe Char
n' = Int -> Maybe Char
safeChr Int
n

safeChr :: Int -> Maybe Char
safeChr :: Int -> Maybe Char
safeChr Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char
forall a. Bounded a => a
maxBound :: Char) = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
x
  | Bool
otherwise = Maybe Char
forall a. Maybe a
Nothing

word8ToDigit :: Word8 -> Maybe Int
word8ToDigit :: Word8 -> Maybe Int
word8ToDigit = Int -> Maybe Int
helper (Int -> Maybe Int) -> (Word8 -> Int) -> Word8 -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  where
    helper :: Int -> Maybe Int
helper Int
word8
      | Int
word8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Int
ord Char
'a' Bool -> Bool -> Bool
&& Int
word8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
'z' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
word8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Char -> Int
ord Char
'a')
      | Int
word8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Int
ord Char
'A' Bool -> Bool -> Bool
&& Int
word8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
'Z' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
word8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Char -> Int
ord Char
'A')
      | Int
word8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Int
ord Char
'0' Bool -> Bool -> Bool
&& Int
word8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Int
ord Char
'9' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
word8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Char -> Int
ord Char
'0')
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing

isExtendedBasic :: Char -> Bool
isExtendedBasic :: Char -> Bool
isExtendedBasic Char
x
  | Char -> Bool
isBasic Char
x = Bool
True
  | Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
128 = Bool
True
  | Bool
otherwise = Bool
False