2014-08-09 22:23:41 +02:00
|
|
|
module Data.HTTPSEverywhere.Rules (
|
2017-12-06 13:21:57 +01:00
|
|
|
RuleSet,
|
|
|
|
getRulesets,
|
2014-08-09 22:23:41 +02:00
|
|
|
rewriteURL,
|
|
|
|
rewriteCookie
|
|
|
|
) where
|
|
|
|
|
2014-08-24 06:40:06 +02:00
|
|
|
import Prelude hiding (null, head)
|
2014-08-10 01:16:57 +02:00
|
|
|
import Data.Bool (bool)
|
2017-12-11 05:13:59 +01:00
|
|
|
import Data.Functor.Infix ((<$$>), (<$$$>))
|
2014-08-09 22:23:41 +02:00
|
|
|
import Network.HTTP.Client (Cookie)
|
2014-08-10 21:32:49 +02:00
|
|
|
import Network.URI (URI)
|
2014-08-24 06:40:06 +02:00
|
|
|
import Pipes ((>->))
|
|
|
|
import Pipes.Prelude (head, null)
|
2017-12-11 05:13:59 +01:00
|
|
|
import Control.Monad.Identity (Identity(runIdentity))
|
2017-12-06 13:21:57 +01:00
|
|
|
import Data.HTTPSEverywhere.Rules.Internal (getRulesets, getRulesetsMatching, havingRulesThatTrigger, havingCookieRulesThatTrigger, setSecureFlag, RuleSet)
|
2014-08-09 22:23:41 +02:00
|
|
|
|
2017-12-11 05:52:40 +01:00
|
|
|
rewriteURL' :: Monad m => [RuleSet] -> URI -> m (Maybe URI)
|
|
|
|
rewriteURL' rs url = head $ getRulesetsMatching rs url >-> havingRulesThatTrigger url
|
2014-08-09 22:23:41 +02:00
|
|
|
|
2017-12-11 05:52:40 +01:00
|
|
|
rewriteURL :: [RuleSet] -> (URI -> Maybe URI)
|
2017-12-11 05:13:59 +01:00
|
|
|
rewriteURL = runIdentity <$$> rewriteURL'
|
|
|
|
|
2017-12-11 05:52:40 +01:00
|
|
|
rewriteCookie' :: Monad m => [RuleSet] -> URI -> Cookie -> m (Maybe Cookie)
|
|
|
|
rewriteCookie' rs url cookie = Just (setSecureFlag cookie) `bool` Nothing <$> null producer
|
2017-12-06 13:21:57 +01:00
|
|
|
where producer = getRulesetsMatching rs url >-> havingCookieRulesThatTrigger cookie
|
2017-12-11 05:13:59 +01:00
|
|
|
|
2017-12-11 05:52:40 +01:00
|
|
|
rewriteCookie :: [RuleSet] -> URI -> (Cookie -> Maybe Cookie)
|
2017-12-11 05:13:59 +01:00
|
|
|
rewriteCookie = runIdentity <$$$> rewriteCookie'
|