{-# 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 Parser Builder -> ByteString -> Either String Builder
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
B.toLazyByteString Builder
bs

remBtagValue :: Parser Builder
remBtagValue :: Parser Builder
remBtagValue = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> Parser Builder -> Parser ByteString (Builder -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Builder -> Parser Builder
inFix Parser Builder
btag Parser ByteString (Builder -> Builder)
-> Parser Builder -> Parser Builder
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
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 (ByteString -> Builder)
-> Parser ByteString ByteString -> Parser Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString ByteString
P.takeWhile (Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True)

inFix :: Parser Builder -> Parser Builder
inFix :: Parser Builder -> Parser Builder
inFix Parser Builder
p = Parser Builder -> Parser Builder
forall i a. Parser i a -> Parser i a
P.try Parser Builder
p Parser Builder -> Parser Builder -> Parser Builder
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> Parser Builder -> Parser ByteString (Builder -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Builder
anyWord8 Parser ByteString (Builder -> Builder)
-> Parser Builder -> Parser Builder
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
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 (Word8 -> Builder) -> Parser ByteString Word8 -> Parser Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
P.anyWord8

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