{-# LANGUAGE OverloadedStrings #-}

module Network.DomainAuth.DK.Types where

import Data.ByteString (ByteString)
import qualified Data.Map as M
import Network.DNS
import Network.DomainAuth.Mail

----------------------------------------------------------------

-- | Canonicalized key for DomainKey-Signature:.
dkFieldKey :: CanonFieldKey
dkFieldKey :: CanonFieldKey
dkFieldKey = CanonFieldKey
"domainkey-signature"

----------------------------------------------------------------

data DkAlgorithm = DK_RSA_SHA1 deriving (DkAlgorithm -> DkAlgorithm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DkAlgorithm -> DkAlgorithm -> Bool
$c/= :: DkAlgorithm -> DkAlgorithm -> Bool
== :: DkAlgorithm -> DkAlgorithm -> Bool
$c== :: DkAlgorithm -> DkAlgorithm -> Bool
Eq,Int -> DkAlgorithm -> ShowS
[DkAlgorithm] -> ShowS
DkAlgorithm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DkAlgorithm] -> ShowS
$cshowList :: [DkAlgorithm] -> ShowS
show :: DkAlgorithm -> String
$cshow :: DkAlgorithm -> String
showsPrec :: Int -> DkAlgorithm -> ShowS
$cshowsPrec :: Int -> DkAlgorithm -> ShowS
Show)
data DkCanonAlgo = DK_SIMPLE | DK_NOFWS deriving (DkCanonAlgo -> DkCanonAlgo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DkCanonAlgo -> DkCanonAlgo -> Bool
$c/= :: DkCanonAlgo -> DkCanonAlgo -> Bool
== :: DkCanonAlgo -> DkCanonAlgo -> Bool
$c== :: DkCanonAlgo -> DkCanonAlgo -> Bool
Eq,Int -> DkCanonAlgo -> ShowS
[DkCanonAlgo] -> ShowS
DkCanonAlgo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DkCanonAlgo] -> ShowS
$cshowList :: [DkCanonAlgo] -> ShowS
show :: DkCanonAlgo -> String
$cshow :: DkCanonAlgo -> String
showsPrec :: Int -> DkCanonAlgo -> ShowS
$cshowsPrec :: Int -> DkCanonAlgo -> ShowS
Show)
--data DkQuery = DK_DNS deriving (Eq,Show)
type DkFields = M.Map ByteString Bool -- Key Bool

-- | Abstract type for DomainKey-Signature:
data DK = DK {
    DK -> DkAlgorithm
dkAlgorithm :: DkAlgorithm
  , DK -> CanonFieldKey
dkSignature :: ByteString
  , DK -> DkCanonAlgo
dkCanonAlgo :: DkCanonAlgo
  , DK -> CanonFieldKey
dkDomain0   :: ByteString
  , DK -> Maybe DkFields
dkFields    :: Maybe DkFields
--  , dkQuery     :: Maybe DkQuery -- gmail does not provide, sigh
  , DK -> CanonFieldKey
dkSelector0 :: ByteString
  } deriving (DK -> DK -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DK -> DK -> Bool
$c/= :: DK -> DK -> Bool
== :: DK -> DK -> Bool
$c== :: DK -> DK -> Bool
Eq,Int -> DK -> ShowS
[DK] -> ShowS
DK -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DK] -> ShowS
$cshowList :: [DK] -> ShowS
show :: DK -> String
$cshow :: DK -> String
showsPrec :: Int -> DK -> ShowS
$cshowsPrec :: Int -> DK -> ShowS
Show)

-- | Getting of the value of the \"d\" tag in DomainKey-Signature:.
dkDomain :: DK -> Domain
dkDomain :: DK -> CanonFieldKey
dkDomain = DK -> CanonFieldKey
dkDomain0

-- | Getting of the value of the \"s\" tag in DomainKey-Signature:.
dkSelector :: DK -> ByteString
dkSelector :: DK -> CanonFieldKey
dkSelector = DK -> CanonFieldKey
dkSelector0