45 lines
1.1 KiB
Haskell
45 lines
1.1 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
module Web.Authenticate.Internal
|
|
( qsEncode
|
|
, qsUrl
|
|
, AuthenticateException (..)
|
|
) where
|
|
|
|
import Codec.Binary.UTF8.String (encode)
|
|
import Numeric (showHex)
|
|
import Data.List (intercalate)
|
|
import Data.Typeable (Typeable)
|
|
import Control.Exception (Exception)
|
|
|
|
data AuthenticateException =
|
|
RpxnowException String
|
|
| NormalizationException String
|
|
| DiscoveryException String
|
|
| AuthenticationException String
|
|
deriving (Show, Typeable)
|
|
instance Exception AuthenticateException
|
|
|
|
qsUrl :: String -> [(String, String)] -> String
|
|
qsUrl s [] = s
|
|
qsUrl url pairs =
|
|
url ++ delim : intercalate "&" (map qsPair pairs)
|
|
where
|
|
qsPair (x, y) = qsEncode x ++ '=' : qsEncode y
|
|
delim = if '?' `elem` url then '&' else '?'
|
|
|
|
qsEncode :: String -> String
|
|
qsEncode =
|
|
concatMap go . encode
|
|
where
|
|
go 32 = "+" -- space
|
|
go 46 = "."
|
|
go 45 = "-"
|
|
go 126 = "~"
|
|
go 95 = "_"
|
|
go c
|
|
| 48 <= c && c <= 57 = [w2c c]
|
|
| 65 <= c && c <= 90 = [w2c c]
|
|
| 97 <= c && c <= 122 = [w2c c]
|
|
go c = '%' : showHex c ""
|
|
w2c = toEnum . fromEnum
|