{-# LANGUAGE OverloadedStrings #-}

module Network.DomainAuth.DKIM.Btag (
    removeBtagValue
  ) where

import Control.Applicative
import Control.Monad
import Data.Attoparsec.ByteString (Parser)
import qualified Data.Attoparsec.ByteString as P
import Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as B
import Data.ByteString.Char8 ()
import Data.Word8

-- |
--
-- >>> removeBtagValue "DKIM-Signature: a=rsa-sha256; d=example.net; s=brisbane;\n   c=simple; q=dns/txt; i=@eng.example.net;\n   t=1117574938; x=1118006938;\n   h=from:to:subject:date;\n   z=From:foo@eng.example.net|To:joe@example.com|\n     Subject:demo=20run|Date:July=205,=202005=203:44:08=20PM=20-0700;\n   bh=MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTI=;\n   b=dzdVyOfAKCdLXdJOc9G2q8LoXSlEniSbav+yuU4zGeeruD00lszZ\n            VoG4ZHRNiYzR;\n"
-- "DKIM-Signature: a=rsa-sha256; d=example.net; s=brisbane;\n   c=simple; q=dns/txt; i=@eng.example.net;\n   t=1117574938; x=1118006938;\n   h=from:to:subject:date;\n   z=From:foo@eng.example.net|To:joe@example.com|\n     Subject:demo=20run|Date:July=205,=202005=203:44:08=20PM=20-0700;\n   bh=MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTI=;\n   b=;\n"
removeBtagValue :: ByteString -> ByteString
removeBtagValue :: ByteString -> ByteString
removeBtagValue ByteString
inp = case forall a. Parser a -> ByteString -> Either String a
P.parseOnly Parser Builder
remBtagValue ByteString
inp of
  Left String
_   -> ByteString
""
  Right Builder
bs -> ByteString -> ByteString
toStrict forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
B.toLazyByteString Builder
bs

remBtagValue :: Parser Builder
remBtagValue :: Parser Builder
remBtagValue = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Builder -> Parser Builder
inFix Parser Builder
btag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Builder
anyString
  where
    anyString :: Parser Builder
anyString = ByteString -> Builder
B.byteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
P.takeWhile (forall a b. a -> b -> a
const Bool
True)

inFix :: Parser Builder -> Parser Builder
inFix :: Parser Builder -> Parser Builder
inFix Parser Builder
p = forall i a. Parser i a -> Parser i a
P.try Parser Builder
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Builder
anyWord8 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Builder -> Parser Builder
inFix Parser Builder
p
  where
    anyWord8 :: Parser Builder
anyWord8 = Word8 -> Builder
B.word8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
P.anyWord8

btag :: Parser Builder
btag :: Parser Builder
btag = do
    Builder
b <- Word8 -> Builder
B.word8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Parser Word8
P.word8 Word8
_b
    Builder
w <- ByteString -> Builder
B.byteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
P.takeWhile (String -> Word8 -> Bool
P.inClass String
" \t\r\n")
    Builder
e <- Word8 -> Builder
B.word8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Parser Word8
P.word8 Word8
_equal
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser ByteString
P.takeWhile1 (String -> Word8 -> Bool
P.notInClass String
";")
    Builder
s <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
P.option forall a. Monoid a => a
mempty (Word8 -> Builder
B.word8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Parser Word8
P.word8 Word8
_semicolon)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Builder
b forall a. Semigroup a => a -> a -> a
<> Builder
w forall a. Semigroup a => a -> a -> a
<> Builder
e forall a. Semigroup a => a -> a -> a
<> Builder
s)