domain-auth 0.2.2 → 0.2.3
raw patch · 9 files changed
+162/−107 lines, 9 filesdep +cryptondep +crypton-x509dep −cryptonitedep −x509PVP ok
version bump matches the API change (PVP)
Dependencies added: crypton, crypton-x509
Dependencies removed: cryptonite, x509
API changes (from Hackage documentation)
Files
- Network/DomainAuth/DKIM.hs +16/−17
- Network/DomainAuth/DKIM/Btag.hs +0/−3
- Network/DomainAuth/DKIM/Verify.hs +1/−0
- Network/DomainAuth/Mail/Mail.hs +61/−9
- Network/DomainAuth/PRD/Lexer.hs +0/−1
- Network/DomainAuth/Pubkey/Base64.hs +0/−1
- Network/DomainAuth/Pubkey/RSAPub.hs +7/−4
- Network/DomainAuth/SPF.hs +2/−5
- domain-auth.cabal +75/−67
Network/DomainAuth/DKIM.hs view
@@ -32,26 +32,25 @@ -- >>> rs <- makeResolvSeed defaultResolvConf -- >>> :{ -- let lst = ["DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;"--- ," d=gmail.com; s=20161025;"--- ," h=mime-version:from:date:message-id:subject:to;"--- ," bh=IQB23UrpTWE7dPV0Ebeqy3ZJyCILT/tw2Ixhmh83FJ0=;"--- ," b=BCZrZwEnJfrdbbNqM+bWHeDrdHKvc6DvjafGCDndUUkHPbfVvvx2RTYfkC3LT1uCZC"--- ," 7vzKmucESLK5PVh4mAGNQjHDmdvhq7GIubOVK8Uoq+MpjZ321SwNI7rck/uLq512bfvO"--- ," NU9nYcUGNIKh+rho6V8XHX/REsfE+a8jGUvywZgV5IoORfTvejEluuy360PN0rAjSmi3"--- ," j5WRFV7XR5pCzAN78hmsUaTzf8zdwQwIlSsnUylnlRmc97xU5Ou3VBzxBV+ScXZsX5jI"--- ," TNv+ujuZcoO0fS0zm7UwmcOzXb01cQpBDqHK8cBvEdQ4+8LSx/Nf1UaOBrecw6GiwN23"--- ," BFBg=="--- ,"MIME-Version: 1.0"--- ,"Received: by 10.37.15.133 with HTTP; Wed, 20 Sep 2017 01:19:02 -0700 (PDT)"+-- ," d=gmail.com; s=20221208; t=1692239637; x=1692844437;"+-- ," h=to:subject:message-id:date:from:mime-version:from:to:cc:subject"+-- ," :date:message-id:reply-to;"+-- ," bh=g3zLYH4xKxcPrHOD18z9YfpQcnk/GaJedfustWU5uGs=;"+-- ," b=ceWXhAaIcvcQCkqTELkw1Bk7v+0pwT8VjmmE49M2nNhXQqA/DXR/aRljXAxGFIm2eU"+-- ," qhHFwQBh9JHbDWXUpltPWisIEDVI+rgOZFRQ7s9OrhJ4Vfmi+Y9Tu3LqmrzvacjdRM2Z"+-- ," 9RNfk4Wv1xk4jGas+JU0T296Z2BYOR5qxB5X/rmMhPNanKeZDmrhUOk+DWrbC+uJ0wcn"+-- ," P/jb76YBwTKBN1ySRrB0SdbruOIm0kYHYZoNMW/QWsR8f9PGthbAedCZrdjyixb7uXkz"+-- ," YmmGi6+XlLL3czZrj+RRrQlFn/xANIrE7sc0YYkhnehvBM6zZtgqesPflVbTlVEMMQg2"+-- ," N22A=="+-- ,"To: kazu@iij.ad.jp"+-- ,"Subject: test"+-- ,"Message-ID: <CAKipW39HW14nu7NN6xsdnNtu_PakrgeOAXo6agtkm=ScFmXqJQ@mail.gmail.com>"+-- ,"Date: Thu, 17 Aug 2023 11:33:46 +0900" -- ,"From: Kazu Yamamoto <kazu.yamamoto@gmail.com>"--- ,"Date: Wed, 20 Sep 2017 17:19:02 +0900"--- ,"Message-ID: <CAKipW39GqeTzzQzB6WhM86_P==xTHwioa5gE=wZZ96fzf1j3Vw@mail.gmail.com>"--- ,"Subject: test for DKIM"--- ,"To: Kazu Yamamoto <kazu@iij.ad.jp>"+-- ,"MIME-Version: 1.0" -- ,"Content-Type: text/plain; charset=\"UTF-8\"" -- ,""--- ,"this is test."--- ,""+-- ,"test" -- ] -- mail = getMail $ BS8.intercalate "\r\n" lst -- in withResolver rs $ \rslv -> runDKIM rslv mail
Network/DomainAuth/DKIM/Btag.hs view
@@ -8,13 +8,10 @@ import Control.Monad import Data.Attoparsec.ByteString (Parser) import qualified Data.Attoparsec.ByteString as P-import qualified Data.Attoparsec.Combinator as P (option) import Data.ByteString as BS import Data.ByteString.Builder (Builder)-import Data.ByteString.Lazy (toStrict) import qualified Data.ByteString.Builder as B import Data.ByteString.Char8 ()-import Data.Monoid import Data.Word8 -- |
Network/DomainAuth/DKIM/Verify.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Network.DomainAuth.DKIM.Verify ( verifyDKIM, prepareDKIM
Network/DomainAuth/Mail/Mail.hs view
@@ -19,11 +19,16 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.Foldable as F (foldr) import Data.List+import Data.Maybe (catMaybes) import Data.Sequence (Seq, viewr, ViewR(..), empty) import Network.DomainAuth.Mail.Types import qualified Network.DomainAuth.Utils as B (empty) import Network.DomainAuth.Utils hiding (empty) +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.ByteString.Char8+ ---------------------------------------------------------------- -- | Looking up 'Field' from 'Header' with 'FieldKey'.@@ -48,16 +53,63 @@ -- RFC 4871 is ambiguous, so implement only normal case. -- | Obtaining all fields with DKIM algorithm.+--+-- >>> fieldsWith ["from","to","subject","date","message-id"] [Field "from" "From" ["foo"],Field "to" "To" ["bar"],Field "subject" "Subject" ["baz"],Field "date" "Date" ["qux"],Field "message-id" "Message-Id" ["quux"], Field "received" "Received" ["fiz"], Field "filtered-out" "Filtered-Out" ["buzz"], Field "not-needed" "Not-Needed" ["fizz"]]+-- [Field {fieldSearchKey = "from", fieldKey = "From", fieldValue = ["foo"]},Field {fieldSearchKey = "to", fieldKey = "To", fieldValue = ["bar"]},Field {fieldSearchKey = "subject", fieldKey = "Subject", fieldValue = ["baz"]},Field {fieldSearchKey = "date", fieldKey = "Date", fieldValue = ["qux"]},Field {fieldSearchKey = "message-id", fieldKey = "Message-Id", fieldValue = ["quux"]}] fieldsWith :: [CanonFieldKey] -> Header -> Header-fieldsWith [] _ = []-fieldsWith _ [] = []-fieldsWith (k:ks) is- | fs == [] = fieldsWith (k:ks) (tail is')- | otherwise = take len (reverse fs) ++ fieldsWith ks' is'- where- (fs,is') = span (\fld -> fieldSearchKey fld == k) is- (kx,ks') = span (==k) ks- len = length kx + 1 -- including k+fieldsWith kx hx = catMaybes $ enm kx hx (\k h -> k == fieldSearchKey h)++-- | RFC 6376 says:+-- Signers MAY claim to have signed header fields that do not exist+-- (that is, Signers MAY include the header field name in the "h=" tag+-- even if that header field does not exist in the message). When+-- computing the signature, the nonexisting header field MUST be treated+-- as the null string (including the header field name, header field+-- value, all punctuation, and the trailing CRLF).+--+-- INFORMATIVE RATIONALE: This allows Signers to explicitly assert+-- the absence of a header field; if that header field is added+-- later, the signature will fail.+--+-- INFORMATIVE NOTE: A header field name need only be listed once+-- more than the actual number of that header field in a message at+-- the time of signing in order to prevent any further additions.+-- For example, if there is a single Comments header field at the+-- time of signing, listing Comments twice in the "h=" tag is+-- sufficient to prevent any number of Comments header fields from+-- being appended; it is not necessary (but is legal) to list+-- Comments three or more times in the "h=" tag.+--+-- 'Notihng' represents the null above.+--+-- >>> enm [1,2,3] [1,1,2,2,2,3,4,5] (==)+-- [Just 1,Just 2,Just 3]+-- >>> enm [1,1,2,3] [1,1,2,2,2,3,4,5] (==)+-- [Just 1,Just 1,Just 2,Just 3]+-- >>> enm [1,1,1,2,3] [1,1,2,2,2,3,4,5] (==)+-- [Just 1,Just 1,Nothing,Just 2,Just 3]+enm :: [a] -> [b] -> (a -> b -> Bool) -> [Maybe b]+enm [] _ _ = []+enm _ [] _ = []+enm (k:kx) hs0 eq = case fnd (eq k) hs0 of+ Nothing -> Nothing : enm kx hs0 eq+ Just (x,hs) -> Just x : enm kx hs eq++-- >>> fnd (== 1) [1,2,3]+-- Just (1,[2,3])+-- >>> fnd (== 2) [1,2,3]+-- Just (2,[1,3])+-- >>> fnd (== 3) [1,2,3]+-- Just (3,[1,2])+-- >>> fnd (== 4) [1,2,3]+-- Nothing+fnd :: (a -> Bool) -> [a] -> Maybe (a,[a])+fnd _ [] = Nothing+fnd p (x:xs)+ | p x = Just (x, xs)+ | otherwise = case fnd p xs of+ Nothing -> Nothing+ Just (y,ys) -> Just (y, x:ys) ----------------------------------------------------------------
Network/DomainAuth/PRD/Lexer.hs view
@@ -7,7 +7,6 @@ import Control.Applicative import Data.Attoparsec.ByteString (Parser) import qualified Data.Attoparsec.ByteString as P-import qualified Data.Attoparsec.Combinator as P (choice) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Char8 ()
Network/DomainAuth/Pubkey/Base64.hs view
@@ -11,7 +11,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BL-import Data.Monoid ((<>)) import Data.Word import Network.DomainAuth.Utils
Network/DomainAuth/Pubkey/RSAPub.hs view
@@ -24,8 +24,8 @@ -- >>> rs <- DNS.makeResolvSeed DNS.defaultResolvConf -- >>> withResolver rs $ \rslv -> lookupPublicKey rslv "dk200510._domainkey.yahoo.co.jp" -- Just (PublicKey {public_size = 128, public_n = 124495277115430906234131617223399742059624761592171426860362133400468320289284068350453787798555522712914036293436636386707903510390018044090096883314714401752103035965668114514933570840775088208966674120428191313530595210688523478828022953238411688594634270571841869051696953556782155414877029327479844990933, public_e = 65537})--- >>> withResolver rs $ \rslv -> lookupPublicKey rslv "20161025._domainkey.gmail.com"--- Just (PublicKey {public_size = 256, public_n = 24002918530496096406691035681124918576525139397315303508411989678485471042094243709057313703002506577481962009015943359911855470236184740304869372300375695346466126498491672986773463137306714366250125164042667360646066116764211863426455899157774209331432246892273100824803003088472583507901403747123280231573655315087668569169140244507741538460717772392364103610973022227332742456151275783849571119048507254523999452581754451573432729267867937880516609319975372273089173378196646435625090021348583100824870283641053888848697729241628460935831026221013673635926904278136940569963717548356154570137751386534390787055991, public_e = 65537})+-- >>> withResolver rs $ \rslv -> lookupPublicKey rslv "20221208._domainkey.gmail.com"+-- Just (PublicKey {public_size = 256, public_n = 22678151869562939359899136428859256198402569240680475393086048829021713182010490409724483359945551283969506235489826762257419985891230334120904178414351809046671461143996599803281758436654811035615578092428632166371331342907633917876752170113620966009358291594609542956251740141784694619901495773614035042135465203364073740861194611021551592336450807473519143746970021740067888325723330796836146546417386918505126721680365151889317110944800331756379997471380657912089911948147086686452887197011845657708078311037666769039161141500897109834073427400667740315220146696437513966171590587213846521825862509466370365529359, public_e = 65537}) lookupPublicKey :: DNS.Resolver -> Domain -> IO (Maybe PublicKey) lookupPublicKey resolver domain = do mpub <- lookupPublicKey' resolver domain@@ -47,5 +47,8 @@ decodeRSAPublicyKey b64 = pub where der = B.decode b64- Right ans1 = decodeASN1' (undefined :: DER) der- Right (PubKeyRSA pub,[]) = fromASN1 ans1+ pub = case decodeASN1' (undefined :: DER) der of+ Left _ -> error "decodeRSAPublicyKey (1)"+ Right ans1 -> case fromASN1 ans1 of+ Right (PubKeyRSA p,[]) -> p+ _ -> error "decodeRSAPublicyKey (2)"
Network/DomainAuth/SPF.hs view
@@ -28,9 +28,9 @@ -- -- pass (IPv4 & IPv6): ----- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "mew.org" "210.130.207.72"+-- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "mew.org" "202.238.220.92" -- pass--- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "iij.ad.jp" "2001:240:bb42:8010::1:126"+-- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "iij.ad.jp" "2001:240:bb5f:86c::1:41" -- pass -- -- hardfail:@@ -50,9 +50,6 @@ -- >>> let limit1 = defaultLimit { ipv4_masklen = 24 } -- >>> withResolver rs $ \rslv -> runSPF limit1 rslv "gmail.com" "72.14.192.1" -- softfail--- >>> let limit2 = defaultLimit { limit = 2 }--- >>> withResolver rs $ \rslv -> runSPF limit2 rslv "nifty.com" "202.248.88.1"--- permerror runSPF :: Limit -> Resolver -> Domain -> IP -> IO DAResult runSPF lim resolver dom ip =
domain-auth.cabal view
@@ -1,71 +1,79 @@-Name: domain-auth-Version: 0.2.2-Author: Kazu Yamamoto <kazu@iij.ad.jp>-Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>-License: BSD3-License-File: LICENSE-Synopsis: Domain authentication library-Description: Library for Sender Policy Framework, SenderID,- DomainKeys and DKIM.-Category: Network-Cabal-Version: >= 1.10-Build-Type: Simple+cabal-version: >=1.10+name: domain-auth+version: 0.2.3+license: BSD3+license-file: LICENSE+maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+author: Kazu Yamamoto <kazu@iij.ad.jp>+synopsis: Domain authentication library+description:+ Library for Sender Policy Framework, SenderID,+ DomainKeys and DKIM. +category: Network+build-type: Simple++source-repository head+ type: git+ location: https://github.com/kazu-yamamoto/domain-auth+ library- Default-Language: Haskell2010- GHC-Options: -Wall- Exposed-Modules: Network.DomainAuth- Network.DomainAuth.Mail- Network.DomainAuth.DK- Network.DomainAuth.DKIM- Network.DomainAuth.SPF- Network.DomainAuth.PRD- Network.DomainAuth.Types- Other-Modules: Network.DomainAuth.Utils- Network.DomainAuth.Mail.Mail- Network.DomainAuth.Mail.Parser- Network.DomainAuth.Mail.Types- Network.DomainAuth.Mail.XMail- Network.DomainAuth.DK.Parser- Network.DomainAuth.DK.Types- Network.DomainAuth.DK.Verify- Network.DomainAuth.DKIM.Btag- Network.DomainAuth.DKIM.Parser- Network.DomainAuth.DKIM.Types- Network.DomainAuth.DKIM.Verify- Network.DomainAuth.Pubkey.Base64- Network.DomainAuth.Pubkey.RSAPub- Network.DomainAuth.PRD.Domain- Network.DomainAuth.PRD.Lexer- Network.DomainAuth.PRD.PRD- Network.DomainAuth.SPF.Eval- Network.DomainAuth.SPF.Parser- Network.DomainAuth.SPF.Resolver- Network.DomainAuth.SPF.Types- Build-Depends: base >= 4 && < 5- , attoparsec- , asn1-encoding- , asn1-types- , bytestring- , containers- , cryptonite- , dns >= 1.0- , iproute- , memory- , network- , x509- , word8+ exposed-modules:+ Network.DomainAuth+ Network.DomainAuth.Mail+ Network.DomainAuth.DK+ Network.DomainAuth.DKIM+ Network.DomainAuth.SPF+ Network.DomainAuth.PRD+ Network.DomainAuth.Types -Test-Suite doctest- Type: exitcode-stdio-1.0- Default-Language: Haskell2010- HS-Source-Dirs: test- Ghc-Options: -Wall- Main-Is: doctests.hs- Build-Depends: base >= 4 && < 5- , doctest >= 0.9.3- , pretty-simple+ other-modules:+ Network.DomainAuth.Utils+ Network.DomainAuth.Mail.Mail+ Network.DomainAuth.Mail.Parser+ Network.DomainAuth.Mail.Types+ Network.DomainAuth.Mail.XMail+ Network.DomainAuth.DK.Parser+ Network.DomainAuth.DK.Types+ Network.DomainAuth.DK.Verify+ Network.DomainAuth.DKIM.Btag+ Network.DomainAuth.DKIM.Parser+ Network.DomainAuth.DKIM.Types+ Network.DomainAuth.DKIM.Verify+ Network.DomainAuth.Pubkey.Base64+ Network.DomainAuth.Pubkey.RSAPub+ Network.DomainAuth.PRD.Domain+ Network.DomainAuth.PRD.Lexer+ Network.DomainAuth.PRD.PRD+ Network.DomainAuth.SPF.Eval+ Network.DomainAuth.SPF.Parser+ Network.DomainAuth.SPF.Resolver+ Network.DomainAuth.SPF.Types -Source-Repository head- Type: git- Location: git://github.com/kazu-yamamoto/domain-auth.git+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4 && <5,+ attoparsec,+ asn1-encoding,+ asn1-types,+ bytestring,+ containers,+ crypton,+ dns >=1.0,+ iproute,+ memory,+ network,+ crypton-x509,+ word8++test-suite doctest+ type: exitcode-stdio-1.0+ main-is: doctests.hs+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4 && <5,+ doctest >=0.9.3,+ pretty-simple