{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE CPP               #-}
module Keter.Rewrite
  ( ReverseProxyConfig (..)
  , RewriteRule (..)
  , RPEntry (..)
  , simpleReverseProxy
  )
  where

import Control.Applicative
import Control.Exception (bracket)
import Data.Function (fix)
import Data.Monoid ((<>))

import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Map as Map
import Data.Map ( Map )
import Data.Array ((!))
import Data.Aeson
import Control.Monad (unless)

import qualified Data.ByteString as S
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified Data.CaseInsensitive as CI

import Blaze.ByteString.Builder (fromByteString)

import Keter.Common

-- Regular expression parsing, replacement, matching
import Data.Attoparsec.Text (string, takeWhile1, endOfInput, parseOnly, Parser)
import Text.Regex.TDFA (makeRegex, matchOnceText, MatchText)
import Text.Regex.TDFA.String (Regex)
import Data.Char (isDigit)

-- Reverse proxy apparatus
import qualified Network.Wai as Wai
import qualified Network.Wai.Internal as I
import Network.HTTP.Client.Conduit
import qualified Network.HTTP.Client as NHC
import Network.HTTP.Types

data RPEntry = RPEntry
    { RPEntry -> ReverseProxyConfig
config :: ReverseProxyConfig
    , RPEntry -> Manager
httpManager :: Manager
    }

instance Show RPEntry where
  show :: RPEntry -> String
show RPEntry
x = String
"RPEntry { config = " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ RPEntry -> ReverseProxyConfig
config RPEntry
x) forall a. [a] -> [a] -> [a]
++ String
" }"

getGroup :: MatchText String -> Int -> String
getGroup :: MatchText String -> Int -> String
getGroup MatchText String
matches Int
i = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ MatchText String
matches forall i e. Ix i => Array i e -> i -> e
! Int
i

rewrite :: (String, MatchText String, String) -> String -> String -> Text
rewrite :: (String, MatchText String, String) -> String -> String -> Text
rewrite (String
before, MatchText String
match, String
after) String
input String
replacement =
  case forall a. Parser a -> Text -> Either String a
parseOnly Parser Text Text
parseSubstitute (String -> Text
T.pack String
replacement) of
    Left String
_ -> String -> Text
T.pack String
input
    Right Text
result -> String -> Text
T.pack String
before forall a. Semigroup a => a -> a -> a
<> Text
result forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
after
  where
    parseSubstitute :: Parser Text
    parseSubstitute :: Parser Text Text
parseSubstitute =
          (forall t. Chunk t => Parser t ()
endOfInput forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Text
"")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
          { Text
_ <- Text -> Parser Text Text
string Text
"\\\\"
          ; Text
rest <- Parser Text Text
parseSubstitute
          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"\\" forall a. Semigroup a => a -> a -> a
<> Text
rest
          }
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
          { Text
_ <- Text -> Parser Text Text
string Text
"\\"
          ; Int
n <- (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Text
takeWhile1 Char -> Bool
isDigit) :: Parser Int
          ; Text
rest <- Parser Text Text
parseSubstitute
          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (MatchText String -> Int -> String
getGroup MatchText String
match Int
n) forall a. Semigroup a => a -> a -> a
<> Text
rest
          }
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
          { Text
text <- (Char -> Bool) -> Parser Text Text
takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'\\')
          ; Text
rest <- Parser Text Text
parseSubstitute
          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
text forall a. Semigroup a => a -> a -> a
<> Text
rest
          }

rewriteHeader :: Map HeaderName RewriteRule -> Header -> Header
rewriteHeader :: Map HeaderName RewriteRule -> Header -> Header
rewriteHeader Map HeaderName RewriteRule
rules header :: Header
header@(HeaderName
name, ByteString
value) =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup HeaderName
name Map HeaderName RewriteRule
rules of
    Maybe RewriteRule
Nothing -> Header
header
    Just  RewriteRule
r -> (HeaderName
name, RewriteRule -> ByteString -> ByteString
regexRewrite RewriteRule
r ByteString
value)

rewriteHeaders :: Map HeaderName RewriteRule -> [Header] -> [Header]
rewriteHeaders :: Map HeaderName RewriteRule -> [Header] -> [Header]
rewriteHeaders Map HeaderName RewriteRule
ruleMap = forall a b. (a -> b) -> [a] -> [b]
map (Map HeaderName RewriteRule -> Header -> Header
rewriteHeader Map HeaderName RewriteRule
ruleMap)

regexRewrite :: RewriteRule -> S.ByteString -> S.ByteString
regexRewrite :: RewriteRule -> ByteString -> ByteString
regexRewrite (RewriteRule Text
_ Text
regex' Text
replacement) ByteString
input =
  case forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText Regex
regex String
strInput of
    Just  (String, MatchText String, String)
match -> Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ (String, MatchText String, String) -> String -> String -> Text
rewrite (String, MatchText String, String)
match String
strInput String
strReplacement
    Maybe (String, MatchText String, String)
Nothing     -> ByteString
input
  where
    strRegex :: String
strRegex = Text -> String
T.unpack Text
regex'
    regex :: Regex
    regex :: Regex
regex = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex String
strRegex
    strInput :: String
strInput = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString
input
    strReplacement :: String
strReplacement = Text -> String
T.unpack Text
replacement

filterHeaders :: [Header] -> [Header]
filterHeaders :: [Header] -> [Header]
filterHeaders = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
useHeader
  where
    useHeader :: (a, b) -> Bool
useHeader (a
"Transfer-Encoding", b
_) = Bool
False
    useHeader (a
"Content-Length", b
_)    = Bool
False
    useHeader (a
"Host", b
_)              = Bool
False
    useHeader (a, b)
_                        = Bool
True

mkRuleMap :: Set RewriteRule -> Map HeaderName RewriteRule
mkRuleMap :: Set RewriteRule -> Map HeaderName RewriteRule
mkRuleMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\RewriteRule
k -> (forall s. FoldCase s => s -> CI s
CI.mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ RewriteRule -> Text
ruleHeader RewriteRule
k, RewriteRule
k)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList

mkRequest :: ReverseProxyConfig -> Wai.Request -> Request
mkRequest :: ReverseProxyConfig -> Request -> Request
mkRequest ReverseProxyConfig
rpConfig Request
request =
   Request
NHC.defaultRequest
      { checkResponse :: Request -> Response BodyReader -> IO ()
NHC.checkResponse = \Request
_ Response BodyReader
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , responseTimeout :: ResponseTimeout
NHC.responseTimeout = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ResponseTimeout
NHC.responseTimeoutNone Int -> ResponseTimeout
NHC.responseTimeoutMicro forall a b. (a -> b) -> a -> b
$ ReverseProxyConfig -> Maybe Int
reverseTimeout ReverseProxyConfig
rpConfig
      , method :: ByteString
method = Request -> ByteString
Wai.requestMethod Request
request
      , secure :: Bool
secure = ReverseProxyConfig -> Bool
reversedUseSSL ReverseProxyConfig
rpConfig
      , host :: ByteString
host   = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ ReverseProxyConfig -> Text
reversedHost ReverseProxyConfig
rpConfig
      , port :: Int
port   = ReverseProxyConfig -> Int
reversedPort ReverseProxyConfig
rpConfig
      , path :: ByteString
path   = Request -> ByteString
Wai.rawPathInfo Request
request
      , queryString :: ByteString
queryString = Request -> ByteString
Wai.rawQueryString Request
request
      , requestHeaders :: [Header]
requestHeaders = [Header] -> [Header]
filterHeaders forall a b. (a -> b) -> a -> b
$ Map HeaderName RewriteRule -> [Header] -> [Header]
rewriteHeaders Map HeaderName RewriteRule
reqRuleMap (Request -> [Header]
Wai.requestHeaders Request
request)
      , requestBody :: RequestBody
requestBody =
          case Request -> RequestBodyLength
Wai.requestBodyLength Request
request of
            RequestBodyLength
Wai.ChunkedBody   -> GivesPopper () -> RequestBody
RequestBodyStreamChunked (forall a b. (a -> b) -> a -> b
$ Request -> BodyReader
I.getRequestBodyChunk Request
request)
            Wai.KnownLength Word64
n -> Int64 -> GivesPopper () -> RequestBody
RequestBodyStream (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) (forall a b. (a -> b) -> a -> b
$ Request -> BodyReader
I.getRequestBodyChunk Request
request)
      , decompress :: ByteString -> Bool
decompress = forall a b. a -> b -> a
const Bool
False
      , redirectCount :: Int
redirectCount = Int
0
      , cookieJar :: Maybe CookieJar
cookieJar = forall a. Maybe a
Nothing
      , requestVersion :: HttpVersion
requestVersion = Request -> HttpVersion
Wai.httpVersion Request
request
      }
  where
    reqRuleMap :: Map HeaderName RewriteRule
reqRuleMap = Set RewriteRule -> Map HeaderName RewriteRule
mkRuleMap forall a b. (a -> b) -> a -> b
$ ReverseProxyConfig -> Set RewriteRule
rewriteRequestRules ReverseProxyConfig
rpConfig

simpleReverseProxy :: Manager -> ReverseProxyConfig -> Wai.Application
simpleReverseProxy :: Manager -> ReverseProxyConfig -> Application
simpleReverseProxy Manager
mgr ReverseProxyConfig
rpConfig Request
request Response -> IO ResponseReceived
sendResponse = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (Request -> Manager -> IO (Response BodyReader)
NHC.responseOpen Request
proxiedRequest Manager
mgr)
    forall (m :: * -> *) body. MonadIO m => Response body -> m ()
responseClose
    forall a b. (a -> b) -> a -> b
$ \Response BodyReader
res -> Response -> IO ResponseReceived
sendResponse forall a b. (a -> b) -> a -> b
$ Status -> [Header] -> StreamingBody -> Response
Wai.responseStream
        (forall body. Response body -> Status
responseStatus Response BodyReader
res)
        (Map HeaderName RewriteRule -> [Header] -> [Header]
rewriteHeaders Map HeaderName RewriteRule
respRuleMap forall a b. (a -> b) -> a -> b
$ forall body. Response body -> [Header]
responseHeaders Response BodyReader
res)
        (forall {m :: * -> *} {p}.
Monad m =>
m ByteString -> (Builder -> m ()) -> p -> m ()
sendBody forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
responseBody Response BodyReader
res)
  where
    proxiedRequest :: Request
proxiedRequest = ReverseProxyConfig -> Request -> Request
mkRequest ReverseProxyConfig
rpConfig Request
request
    respRuleMap :: Map HeaderName RewriteRule
respRuleMap = Set RewriteRule -> Map HeaderName RewriteRule
mkRuleMap forall a b. (a -> b) -> a -> b
$ ReverseProxyConfig -> Set RewriteRule
rewriteResponseRules ReverseProxyConfig
rpConfig
    sendBody :: m ByteString -> (Builder -> m ()) -> p -> m ()
sendBody m ByteString
body Builder -> m ()
send p
_flush = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \m ()
loop -> do
        ByteString
bs <- m ByteString
body
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
bs) forall a b. (a -> b) -> a -> b
$ do
            () <- Builder -> m ()
send forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
bs
            m ()
loop

data ReverseProxyConfig = ReverseProxyConfig
    { ReverseProxyConfig -> Text
reversedHost :: Text
    , ReverseProxyConfig -> Int
reversedPort :: Int
    , ReverseProxyConfig -> Bool
reversedUseSSL :: Bool
    , ReverseProxyConfig -> Text
reversingHost :: Text
    , ReverseProxyConfig -> SSLConfig
reversingUseSSL :: !SSLConfig
    , ReverseProxyConfig -> Maybe Int
reverseTimeout :: Maybe Int
    , ReverseProxyConfig -> Set RewriteRule
rewriteResponseRules :: Set RewriteRule
    , ReverseProxyConfig -> Set RewriteRule
rewriteRequestRules :: Set RewriteRule
    } deriving (ReverseProxyConfig -> ReverseProxyConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
$c/= :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
== :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
$c== :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
Eq, Eq ReverseProxyConfig
ReverseProxyConfig -> ReverseProxyConfig -> Bool
ReverseProxyConfig -> ReverseProxyConfig -> Ordering
ReverseProxyConfig -> ReverseProxyConfig -> ReverseProxyConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReverseProxyConfig -> ReverseProxyConfig -> ReverseProxyConfig
$cmin :: ReverseProxyConfig -> ReverseProxyConfig -> ReverseProxyConfig
max :: ReverseProxyConfig -> ReverseProxyConfig -> ReverseProxyConfig
$cmax :: ReverseProxyConfig -> ReverseProxyConfig -> ReverseProxyConfig
>= :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
$c>= :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
> :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
$c> :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
<= :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
$c<= :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
< :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
$c< :: ReverseProxyConfig -> ReverseProxyConfig -> Bool
compare :: ReverseProxyConfig -> ReverseProxyConfig -> Ordering
$ccompare :: ReverseProxyConfig -> ReverseProxyConfig -> Ordering
Ord, Int -> ReverseProxyConfig -> ShowS
[ReverseProxyConfig] -> ShowS
ReverseProxyConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReverseProxyConfig] -> ShowS
$cshowList :: [ReverseProxyConfig] -> ShowS
show :: ReverseProxyConfig -> String
$cshow :: ReverseProxyConfig -> String
showsPrec :: Int -> ReverseProxyConfig -> ShowS
$cshowsPrec :: Int -> ReverseProxyConfig -> ShowS
Show)

instance FromJSON ReverseProxyConfig where
    parseJSON :: Value -> Parser ReverseProxyConfig
parseJSON (Object Object
o) = Text
-> Int
-> Bool
-> Text
-> SSLConfig
-> Maybe Int
-> Set RewriteRule
-> Set RewriteRule
-> ReverseProxyConfig
ReverseProxyConfig
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reversed-host"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reversed-port"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reversed-ssl" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reversing-host"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ssl" forall a. Parser (Maybe a) -> a -> Parser a
.!= SSLConfig
SSLFalse
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timeout" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Maybe a
Nothing
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rewrite-response" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Set a
Set.empty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rewrite-request" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Set a
Set.empty
    parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Wanted an object"

instance ToJSON ReverseProxyConfig where
    toJSON :: ReverseProxyConfig -> Value
toJSON ReverseProxyConfig {Bool
Int
Maybe Int
Text
Set RewriteRule
SSLConfig
rewriteRequestRules :: Set RewriteRule
rewriteResponseRules :: Set RewriteRule
reverseTimeout :: Maybe Int
reversingUseSSL :: SSLConfig
reversingHost :: Text
reversedUseSSL :: Bool
reversedPort :: Int
reversedHost :: Text
reversingUseSSL :: ReverseProxyConfig -> SSLConfig
reversingHost :: ReverseProxyConfig -> Text
rewriteResponseRules :: ReverseProxyConfig -> Set RewriteRule
rewriteRequestRules :: ReverseProxyConfig -> Set RewriteRule
reversedPort :: ReverseProxyConfig -> Int
reversedHost :: ReverseProxyConfig -> Text
reversedUseSSL :: ReverseProxyConfig -> Bool
reverseTimeout :: ReverseProxyConfig -> Maybe Int
..} = [Pair] -> Value
object
        [ Key
"reversed-host" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reversedHost
        , Key
"reversed-port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reversedPort
        , Key
"reversed-ssl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
reversedUseSSL
        , Key
"reversing-host" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reversingHost
        , Key
"ssl" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SSLConfig
reversingUseSSL
        , Key
"timeout" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
reverseTimeout
        , Key
"rewrite-response" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Set RewriteRule
rewriteResponseRules
        , Key
"rewrite-request" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Set RewriteRule
rewriteRequestRules
        ]

defaultReverseProxyConfig :: ReverseProxyConfig
defaultReverseProxyConfig :: ReverseProxyConfig
defaultReverseProxyConfig = ReverseProxyConfig
        { reversedHost :: Text
reversedHost = Text
""
        , reversedPort :: Int
reversedPort = Int
80
        , reversedUseSSL :: Bool
reversedUseSSL = Bool
False
        , reversingHost :: Text
reversingHost = Text
""
        , reversingUseSSL :: SSLConfig
reversingUseSSL = SSLConfig
SSLFalse
        , reverseTimeout :: Maybe Int
reverseTimeout = forall a. Maybe a
Nothing
        , rewriteResponseRules :: Set RewriteRule
rewriteResponseRules = forall a. Set a
Set.empty
        , rewriteRequestRules :: Set RewriteRule
rewriteRequestRules = forall a. Set a
Set.empty
        }

data RewriteRule = RewriteRule
    { RewriteRule -> Text
ruleHeader :: Text
    , RewriteRule -> Text
ruleRegex :: Text
    , RewriteRule -> Text
ruleReplacement :: Text
    } deriving (RewriteRule -> RewriteRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewriteRule -> RewriteRule -> Bool
$c/= :: RewriteRule -> RewriteRule -> Bool
== :: RewriteRule -> RewriteRule -> Bool
$c== :: RewriteRule -> RewriteRule -> Bool
Eq, Eq RewriteRule
RewriteRule -> RewriteRule -> Bool
RewriteRule -> RewriteRule -> Ordering
RewriteRule -> RewriteRule -> RewriteRule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RewriteRule -> RewriteRule -> RewriteRule
$cmin :: RewriteRule -> RewriteRule -> RewriteRule
max :: RewriteRule -> RewriteRule -> RewriteRule
$cmax :: RewriteRule -> RewriteRule -> RewriteRule
>= :: RewriteRule -> RewriteRule -> Bool
$c>= :: RewriteRule -> RewriteRule -> Bool
> :: RewriteRule -> RewriteRule -> Bool
$c> :: RewriteRule -> RewriteRule -> Bool
<= :: RewriteRule -> RewriteRule -> Bool
$c<= :: RewriteRule -> RewriteRule -> Bool
< :: RewriteRule -> RewriteRule -> Bool
$c< :: RewriteRule -> RewriteRule -> Bool
compare :: RewriteRule -> RewriteRule -> Ordering
$ccompare :: RewriteRule -> RewriteRule -> Ordering
Ord, Int -> RewriteRule -> ShowS
[RewriteRule] -> ShowS
RewriteRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewriteRule] -> ShowS
$cshowList :: [RewriteRule] -> ShowS
show :: RewriteRule -> String
$cshow :: RewriteRule -> String
showsPrec :: Int -> RewriteRule -> ShowS
$cshowsPrec :: Int -> RewriteRule -> ShowS
Show)

instance FromJSON RewriteRule where
    parseJSON :: Value -> Parser RewriteRule
parseJSON (Object Object
o) = Text -> Text -> Text -> RewriteRule
RewriteRule
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"header"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"to"
    parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Wanted an object"

instance ToJSON RewriteRule where
    toJSON :: RewriteRule -> Value
toJSON RewriteRule {Text
ruleReplacement :: Text
ruleRegex :: Text
ruleHeader :: Text
ruleReplacement :: RewriteRule -> Text
ruleRegex :: RewriteRule -> Text
ruleHeader :: RewriteRule -> Text
..} = [Pair] -> Value
object
        [ Key
"header" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
ruleHeader
        , Key
"from" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
ruleRegex
        , Key
"to" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
ruleReplacement
        ]