{- |
Module      :  ./Common/Percent.hs
Description :  precent encode and decode
Copyright   :  (c) Christian Maeder, DFKI GmbH 2014
License     :  GPLv2 or higher, see LICENSE.txt
Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

precent encode or decode URLs, URIs and IRSs via UTF8
http://tools.ietf.org/html/rfc3986
-}

module Common.Percent
  ( encodeBut
  , reserved
  , genDelim
  , subDelim
  , dolDelim
  , isUnreserved
  , encode
  , decode
  ) where

import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Char8 as Char8
import Data.Char

{- according to http://tools.ietf.org/html/rfc3986#section-2.1
uppercase uppercase hexadecimal digits should be used -}
encodeChar8 :: (Char -> Bool) -> String -> String
encodeChar8 :: (Char -> Bool) -> String -> String
encodeChar8 keep :: Char -> Bool
keep = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> String) -> String -> String)
-> (Char -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ \ c :: Char
c -> case Char
c of
  _ | Char -> Bool
keep Char
c -> [Char
c]
  _ -> let (d :: Int
d, m :: Int
m) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod (Char -> Int
ord Char
c) 16 in
      '%' Char -> String -> String
forall a. a -> [a] -> [a]
: (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char
toUpper (Char -> Char) -> (Int -> Char) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
intToDigit) [Int
d, Int
m]

encodeBut :: (Char -> Bool) -> String -> String
encodeBut :: (Char -> Bool) -> String -> String
encodeBut keep :: Char -> Bool
keep = (Char -> Bool) -> String -> String
encodeChar8 Char -> Bool
keep (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Char8.unpack (ByteString -> String)
-> (String -> ByteString) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
UTF8.fromString

-- http://tools.ietf.org/html/rfc3986#section-2.2
reserved :: String
reserved :: String
reserved = String
genDelim String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
subDelim

genDelim :: String
genDelim :: String
genDelim = ":/?#[]@"

subDelim :: String
subDelim :: String
subDelim = String
dolDelim String -> String -> String
forall a. [a] -> [a] -> [a]
++ "(),;"

dolDelim :: String
dolDelim :: String
dolDelim = "!$&'*+="

-- http://tools.ietf.org/html/rfc3986#section-2.3
isUnreserved :: Char -> Bool
isUnreserved :: Char -> Bool
isUnreserved c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
|| Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c "_.-~"

{- according to http://tools.ietf.org/html/rfc3986#section-2.3
unreserved characters should not be encoded -}

-- | encode all chars but not the unreserved (ascii) ones
encode :: String -> String
encode :: String -> String
encode = (Char -> Bool) -> String -> String
encodeBut Char -> Bool
isUnreserved

decodeChar8 :: String -> String
decodeChar8 :: String -> String
decodeChar8 s :: String
s = case String
s of
  "" -> ""
  '%' : x1 :: Char
x1 : x2 :: Char
x2 : r :: String
r | Char -> Bool
isHexDigit Char
x1 Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
x2
    -> Int -> Char
chr (Char -> Int
digitToInt Char
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
x2) Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeChar8 String
r
  c :: Char
c : r :: String
r -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeChar8 String
r

-- | decode percent signs followed by two hex-digits
decode :: String -> String
decode :: String -> String
decode = ByteString -> String
UTF8.toString (ByteString -> String)
-> (String -> ByteString) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
Char8.pack (String -> ByteString)
-> (String -> String) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
decodeChar8