{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- |
-- XML Signature Syntax and Processing
--
-- <http://www.w3.org/TR/xmldsig-core1/> (selected portions)
module SAML2.XML.Signature.Types where

import Control.Lens (Lens')
import Crypto.Number.Serialize (i2osp, os2ip)
import qualified Data.X509 as X509

import SAML2.XML
import qualified SAML2.XML.Schema as XS
import qualified Text.XML.HXT.Arrow.Pickle.Xml.Invertible as XP
import qualified SAML2.XML.Canonical as C14N
import SAML2.XML.ASN1

nsFrag :: String -> URI
nsFrag :: String -> URI
nsFrag = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2000/09/xmldsig" String
"" (String -> URI) -> (String -> String) -> String -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:)

nsFrag11 :: String -> URI
nsFrag11 :: String -> URI
nsFrag11 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2009/xmldsig11" String
"" (String -> URI) -> (String -> String) -> String -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'#'Char -> String -> String
forall a. a -> [a] -> [a]
:)

ns :: Namespace 
ns :: Namespace
ns = String -> URI -> Namespace
mkNamespace String
"ds" (URI -> Namespace) -> URI -> Namespace
forall a b. (a -> b) -> a -> b
$ String -> URI
nsFrag String
""

ns11 :: Namespace 
ns11 :: Namespace
ns11 = String -> URI -> Namespace
mkNamespace String
"dsig11" (URI -> Namespace) -> URI -> Namespace
forall a b. (a -> b) -> a -> b
$ String -> URI
nsFrag11 String
""

xpElem :: String -> XP.PU a -> XP.PU a
xpElem :: String -> PU a -> PU a
xpElem = Namespace -> String -> PU a -> PU a
forall a. Namespace -> String -> PU a -> PU a
xpTrimElemNS Namespace
ns

xpElem11 :: String -> XP.PU a -> XP.PU a
xpElem11 :: String -> PU a -> PU a
xpElem11 = Namespace -> String -> PU a -> PU a
forall a. Namespace -> String -> PU a -> PU a
xpTrimElemNS Namespace
ns11

-- |§4.1
type CryptoBinary = Integer -- as Base64Binary

xpCryptoBinary :: XP.PU CryptoBinary
xpCryptoBinary :: PU CryptoBinary
xpCryptoBinary = (Base64Binary -> CryptoBinary, CryptoBinary -> Base64Binary)
-> PU Base64Binary -> PU CryptoBinary
forall a b. (a -> b, b -> a) -> PU a -> PU b
XP.xpWrap (Base64Binary -> CryptoBinary
forall ba. ByteArrayAccess ba => ba -> CryptoBinary
os2ip, CryptoBinary -> Base64Binary
forall ba. ByteArray ba => CryptoBinary -> ba
i2osp) PU Base64Binary
XS.xpBase64Binary

-- |§4.2
data Signature = Signature
  { Signature -> Maybe String
signatureId :: Maybe ID
  , Signature -> SignedInfo
signatureSignedInfo :: SignedInfo
  , Signature -> SignatureValue
signatureSignatureValue :: SignatureValue
  , Signature -> Maybe KeyInfo
signatureKeyInfo :: Maybe KeyInfo
  , Signature -> [Object]
signatureObject :: [Object]
  } deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, Int -> Signature -> String -> String
[Signature] -> String -> String
Signature -> String
(Int -> Signature -> String -> String)
-> (Signature -> String)
-> ([Signature] -> String -> String)
-> Show Signature
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Signature] -> String -> String
$cshowList :: [Signature] -> String -> String
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> String -> String
$cshowsPrec :: Int -> Signature -> String -> String
Show)

instance XP.XmlPickler Signature where
  xpickle :: PU Signature
xpickle = String -> PU Signature -> PU Signature
forall a. String -> PU a -> PU a
xpElem String
"Signature" (PU Signature -> PU Signature) -> PU Signature -> PU Signature
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|((((i, s), v), k), o) <-> Signature i s v k o|] 
    Bijection
  (->)
  ((((Maybe String, SignedInfo), SignatureValue), Maybe KeyInfo),
   [Object])
  Signature
-> PU
     ((((Maybe String, SignedInfo), SignatureValue), Maybe KeyInfo),
      [Object])
-> PU Signature
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
      PU (Maybe String) -> PU SignedInfo -> PU (Maybe String, SignedInfo)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU SignedInfo
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Maybe String, SignedInfo)
-> PU SignatureValue
-> PU ((Maybe String, SignedInfo), SignatureValue)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU SignatureValue
forall a. XmlPickler a => PU a
XP.xpickle
      PU ((Maybe String, SignedInfo), SignatureValue)
-> PU (Maybe KeyInfo)
-> PU (((Maybe String, SignedInfo), SignatureValue), Maybe KeyInfo)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU KeyInfo -> PU (Maybe KeyInfo)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU KeyInfo
forall a. XmlPickler a => PU a
XP.xpickle
      PU (((Maybe String, SignedInfo), SignatureValue), Maybe KeyInfo)
-> PU [Object]
-> PU
     ((((Maybe String, SignedInfo), SignatureValue), Maybe KeyInfo),
      [Object])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Object -> PU [Object]
forall a. PU a -> PU [a]
XP.xpList PU Object
forall a. XmlPickler a => PU a
XP.xpickle)

class Signable a where
  signature' :: Lens' a (Maybe Signature)
  signedID :: a -> XS.ID

-- |§4.3
data SignatureValue = SignatureValue
  { SignatureValue -> Maybe String
signatureValueId :: Maybe ID
  , SignatureValue -> Base64Binary
signatureValue :: XS.Base64Binary
  } deriving (SignatureValue -> SignatureValue -> Bool
(SignatureValue -> SignatureValue -> Bool)
-> (SignatureValue -> SignatureValue -> Bool) -> Eq SignatureValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureValue -> SignatureValue -> Bool
$c/= :: SignatureValue -> SignatureValue -> Bool
== :: SignatureValue -> SignatureValue -> Bool
$c== :: SignatureValue -> SignatureValue -> Bool
Eq, Int -> SignatureValue -> String -> String
[SignatureValue] -> String -> String
SignatureValue -> String
(Int -> SignatureValue -> String -> String)
-> (SignatureValue -> String)
-> ([SignatureValue] -> String -> String)
-> Show SignatureValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SignatureValue] -> String -> String
$cshowList :: [SignatureValue] -> String -> String
show :: SignatureValue -> String
$cshow :: SignatureValue -> String
showsPrec :: Int -> SignatureValue -> String -> String
$cshowsPrec :: Int -> SignatureValue -> String -> String
Show)

instance XP.XmlPickler SignatureValue where
  xpickle :: PU SignatureValue
xpickle = String -> PU SignatureValue -> PU SignatureValue
forall a. String -> PU a -> PU a
xpElem String
"SignatureValue" (PU SignatureValue -> PU SignatureValue)
-> PU SignatureValue -> PU SignatureValue
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|(i, v) <-> SignatureValue i v|] 
    Bijection (->) (Maybe String, Base64Binary) SignatureValue
-> PU (Maybe String, Base64Binary) -> PU SignatureValue
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
      PU (Maybe String)
-> PU Base64Binary -> PU (Maybe String, Base64Binary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Base64Binary
XS.xpBase64Binary)

-- |§4.4
data SignedInfo = SignedInfo
  { SignedInfo -> Maybe String
signedInfoId :: Maybe ID
  , SignedInfo -> CanonicalizationMethod
signedInfoCanonicalizationMethod :: CanonicalizationMethod
  , SignedInfo -> SignatureMethod
signedInfoSignatureMethod :: SignatureMethod
  , SignedInfo -> List1 Reference
signedInfoReference :: List1 Reference
  } deriving (SignedInfo -> SignedInfo -> Bool
(SignedInfo -> SignedInfo -> Bool)
-> (SignedInfo -> SignedInfo -> Bool) -> Eq SignedInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignedInfo -> SignedInfo -> Bool
$c/= :: SignedInfo -> SignedInfo -> Bool
== :: SignedInfo -> SignedInfo -> Bool
$c== :: SignedInfo -> SignedInfo -> Bool
Eq, Int -> SignedInfo -> String -> String
[SignedInfo] -> String -> String
SignedInfo -> String
(Int -> SignedInfo -> String -> String)
-> (SignedInfo -> String)
-> ([SignedInfo] -> String -> String)
-> Show SignedInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SignedInfo] -> String -> String
$cshowList :: [SignedInfo] -> String -> String
show :: SignedInfo -> String
$cshow :: SignedInfo -> String
showsPrec :: Int -> SignedInfo -> String -> String
$cshowsPrec :: Int -> SignedInfo -> String -> String
Show)

instance XP.XmlPickler SignedInfo where
  xpickle :: PU SignedInfo
xpickle = String -> PU SignedInfo -> PU SignedInfo
forall a. String -> PU a -> PU a
xpElem String
"SignedInfo" (PU SignedInfo -> PU SignedInfo) -> PU SignedInfo -> PU SignedInfo
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|(((i, c), s), r) <-> SignedInfo i c s r|] 
    Bijection
  (->)
  (((Maybe String, CanonicalizationMethod), SignatureMethod),
   List1 Reference)
  SignedInfo
-> PU
     (((Maybe String, CanonicalizationMethod), SignatureMethod),
      List1 Reference)
-> PU SignedInfo
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
      PU (Maybe String)
-> PU CanonicalizationMethod
-> PU (Maybe String, CanonicalizationMethod)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU CanonicalizationMethod
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Maybe String, CanonicalizationMethod)
-> PU SignatureMethod
-> PU ((Maybe String, CanonicalizationMethod), SignatureMethod)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU SignatureMethod
forall a. XmlPickler a => PU a
XP.xpickle
      PU ((Maybe String, CanonicalizationMethod), SignatureMethod)
-> PU (List1 Reference)
-> PU
     (((Maybe String, CanonicalizationMethod), SignatureMethod),
      List1 Reference)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Reference -> PU (List1 Reference)
forall a. PU a -> PU (List1 a)
xpList1 PU Reference
forall a. XmlPickler a => PU a
XP.xpickle)

-- |§4.4.1
data CanonicalizationMethod = CanonicalizationMethod 
  { CanonicalizationMethod -> IdentifiedURI CanonicalizationAlgorithm
canonicalizationMethodAlgorithm :: IdentifiedURI C14N.CanonicalizationAlgorithm
  , CanonicalizationMethod -> Maybe InclusiveNamespaces
canonicalizationMethodInclusiveNamespaces :: Maybe C14N.InclusiveNamespaces
  , CanonicalizationMethod -> Nodes
canonicalizationMethod :: Nodes
  } deriving (CanonicalizationMethod -> CanonicalizationMethod -> Bool
(CanonicalizationMethod -> CanonicalizationMethod -> Bool)
-> (CanonicalizationMethod -> CanonicalizationMethod -> Bool)
-> Eq CanonicalizationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CanonicalizationMethod -> CanonicalizationMethod -> Bool
$c/= :: CanonicalizationMethod -> CanonicalizationMethod -> Bool
== :: CanonicalizationMethod -> CanonicalizationMethod -> Bool
$c== :: CanonicalizationMethod -> CanonicalizationMethod -> Bool
Eq, Int -> CanonicalizationMethod -> String -> String
[CanonicalizationMethod] -> String -> String
CanonicalizationMethod -> String
(Int -> CanonicalizationMethod -> String -> String)
-> (CanonicalizationMethod -> String)
-> ([CanonicalizationMethod] -> String -> String)
-> Show CanonicalizationMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CanonicalizationMethod] -> String -> String
$cshowList :: [CanonicalizationMethod] -> String -> String
show :: CanonicalizationMethod -> String
$cshow :: CanonicalizationMethod -> String
showsPrec :: Int -> CanonicalizationMethod -> String -> String
$cshowsPrec :: Int -> CanonicalizationMethod -> String -> String
Show)

instance XP.XmlPickler CanonicalizationMethod where
  xpickle :: PU CanonicalizationMethod
xpickle = String -> PU CanonicalizationMethod -> PU CanonicalizationMethod
forall a. String -> PU a -> PU a
xpElem String
"CanonicalizationMethod" (PU CanonicalizationMethod -> PU CanonicalizationMethod)
-> PU CanonicalizationMethod -> PU CanonicalizationMethod
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|((a, n), x) <-> CanonicalizationMethod a n x|] 
    Bijection
  (->)
  ((IdentifiedURI CanonicalizationAlgorithm,
    Maybe InclusiveNamespaces),
   Nodes)
  CanonicalizationMethod
-> PU
     ((IdentifiedURI CanonicalizationAlgorithm,
       Maybe InclusiveNamespaces),
      Nodes)
-> PU CanonicalizationMethod
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String
-> PU (IdentifiedURI CanonicalizationAlgorithm)
-> PU (IdentifiedURI CanonicalizationAlgorithm)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Algorithm" PU (IdentifiedURI CanonicalizationAlgorithm)
forall a. XmlPickler a => PU a
XP.xpickle
      PU (IdentifiedURI CanonicalizationAlgorithm)
-> PU (Maybe InclusiveNamespaces)
-> PU
     (IdentifiedURI CanonicalizationAlgorithm,
      Maybe InclusiveNamespaces)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU InclusiveNamespaces -> PU (Maybe InclusiveNamespaces)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU InclusiveNamespaces
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (IdentifiedURI CanonicalizationAlgorithm,
   Maybe InclusiveNamespaces)
-> PU Nodes
-> PU
     ((IdentifiedURI CanonicalizationAlgorithm,
       Maybe InclusiveNamespaces),
      Nodes)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Nodes
XP.xpAnyCont)

simpleCanonicalization :: C14N.CanonicalizationAlgorithm -> CanonicalizationMethod
simpleCanonicalization :: CanonicalizationAlgorithm -> CanonicalizationMethod
simpleCanonicalization CanonicalizationAlgorithm
a = IdentifiedURI CanonicalizationAlgorithm
-> Maybe InclusiveNamespaces -> Nodes -> CanonicalizationMethod
CanonicalizationMethod (CanonicalizationAlgorithm
-> IdentifiedURI CanonicalizationAlgorithm
forall b a. a -> Identified b a
Identified CanonicalizationAlgorithm
a) Maybe InclusiveNamespaces
forall a. Maybe a
Nothing []

-- |§4.4.2
data SignatureMethod = SignatureMethod
  { SignatureMethod -> IdentifiedURI SignatureAlgorithm
signatureMethodAlgorithm :: IdentifiedURI SignatureAlgorithm
  , SignatureMethod -> Maybe Int
signatureMethodHMACOutputLength :: Maybe Int
  , SignatureMethod -> Nodes
signatureMethod :: Nodes
  } deriving (SignatureMethod -> SignatureMethod -> Bool
(SignatureMethod -> SignatureMethod -> Bool)
-> (SignatureMethod -> SignatureMethod -> Bool)
-> Eq SignatureMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureMethod -> SignatureMethod -> Bool
$c/= :: SignatureMethod -> SignatureMethod -> Bool
== :: SignatureMethod -> SignatureMethod -> Bool
$c== :: SignatureMethod -> SignatureMethod -> Bool
Eq, Int -> SignatureMethod -> String -> String
[SignatureMethod] -> String -> String
SignatureMethod -> String
(Int -> SignatureMethod -> String -> String)
-> (SignatureMethod -> String)
-> ([SignatureMethod] -> String -> String)
-> Show SignatureMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SignatureMethod] -> String -> String
$cshowList :: [SignatureMethod] -> String -> String
show :: SignatureMethod -> String
$cshow :: SignatureMethod -> String
showsPrec :: Int -> SignatureMethod -> String -> String
$cshowsPrec :: Int -> SignatureMethod -> String -> String
Show)

instance XP.XmlPickler SignatureMethod where
  xpickle :: PU SignatureMethod
xpickle = String -> PU SignatureMethod -> PU SignatureMethod
forall a. String -> PU a -> PU a
xpElem String
"SignatureMethod" (PU SignatureMethod -> PU SignatureMethod)
-> PU SignatureMethod -> PU SignatureMethod
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|((a, l), x) <-> SignatureMethod a l x|] 
    Bijection
  (->)
  ((IdentifiedURI SignatureAlgorithm, Maybe Int), Nodes)
  SignatureMethod
-> PU ((IdentifiedURI SignatureAlgorithm, Maybe Int), Nodes)
-> PU SignatureMethod
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String
-> PU (IdentifiedURI SignatureAlgorithm)
-> PU (IdentifiedURI SignatureAlgorithm)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Algorithm" PU (IdentifiedURI SignatureAlgorithm)
forall a. XmlPickler a => PU a
XP.xpickle
      PU (IdentifiedURI SignatureAlgorithm)
-> PU (Maybe Int)
-> PU (IdentifiedURI SignatureAlgorithm, Maybe Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Int -> PU (Maybe Int)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU Int -> PU Int
forall a. String -> PU a -> PU a
xpElem String
"HMACOutputLength" PU Int
forall a. XmlPickler a => PU a
XP.xpickle)
      PU (IdentifiedURI SignatureAlgorithm, Maybe Int)
-> PU Nodes
-> PU ((IdentifiedURI SignatureAlgorithm, Maybe Int), Nodes)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Nodes
XP.xpAnyCont)

-- |§4.4.3
data Reference = Reference
  { Reference -> Maybe String
referenceId :: Maybe ID
  , Reference -> Maybe URI
referenceURI :: Maybe AnyURI
  , Reference -> Maybe URI
referenceType :: Maybe AnyURI -- xml object type
  , Reference -> Maybe Transforms
referenceTransforms :: Maybe Transforms
  , Reference -> DigestMethod
referenceDigestMethod :: DigestMethod
  , Reference -> Base64Binary
referenceDigestValue :: XS.Base64Binary -- ^§4.3.3.6
  } deriving (Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c== :: Reference -> Reference -> Bool
Eq, Int -> Reference -> String -> String
[Reference] -> String -> String
Reference -> String
(Int -> Reference -> String -> String)
-> (Reference -> String)
-> ([Reference] -> String -> String)
-> Show Reference
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Reference] -> String -> String
$cshowList :: [Reference] -> String -> String
show :: Reference -> String
$cshow :: Reference -> String
showsPrec :: Int -> Reference -> String -> String
$cshowsPrec :: Int -> Reference -> String -> String
Show)

instance XP.XmlPickler Reference where
  xpickle :: PU Reference
xpickle = String -> PU Reference -> PU Reference
forall a. String -> PU a -> PU a
xpElem String
"Reference" (PU Reference -> PU Reference) -> PU Reference -> PU Reference
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|(((((i, u), t), f), m), v) <-> Reference i u t f m v|] 
    Bijection
  (->)
  (((((Maybe String, Maybe URI), Maybe URI), Maybe Transforms),
    DigestMethod),
   Base64Binary)
  Reference
-> PU
     (((((Maybe String, Maybe URI), Maybe URI), Maybe Transforms),
       DigestMethod),
      Base64Binary)
-> PU Reference
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
      PU (Maybe String) -> PU (Maybe URI) -> PU (Maybe String, Maybe URI)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU URI -> PU (Maybe URI)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"URI" PU URI
XS.xpAnyURI
      PU (Maybe String, Maybe URI)
-> PU (Maybe URI) -> PU ((Maybe String, Maybe URI), Maybe URI)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU URI -> PU (Maybe URI)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Type" PU URI
XS.xpAnyURI
      PU ((Maybe String, Maybe URI), Maybe URI)
-> PU (Maybe Transforms)
-> PU (((Maybe String, Maybe URI), Maybe URI), Maybe Transforms)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Transforms -> PU (Maybe Transforms)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU Transforms
forall a. XmlPickler a => PU a
XP.xpickle
      PU (((Maybe String, Maybe URI), Maybe URI), Maybe Transforms)
-> PU DigestMethod
-> PU
     ((((Maybe String, Maybe URI), Maybe URI), Maybe Transforms),
      DigestMethod)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU DigestMethod
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  ((((Maybe String, Maybe URI), Maybe URI), Maybe Transforms),
   DigestMethod)
-> PU Base64Binary
-> PU
     (((((Maybe String, Maybe URI), Maybe URI), Maybe Transforms),
       DigestMethod),
      Base64Binary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU Base64Binary -> PU Base64Binary
forall a. String -> PU a -> PU a
xpElem String
"DigestValue" PU Base64Binary
XS.xpBase64Binary)

-- |§4.4.3.4
newtype Transforms = Transforms{ Transforms -> List1 Transform
transforms :: List1 Transform }
  deriving (Transforms -> Transforms -> Bool
(Transforms -> Transforms -> Bool)
-> (Transforms -> Transforms -> Bool) -> Eq Transforms
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transforms -> Transforms -> Bool
$c/= :: Transforms -> Transforms -> Bool
== :: Transforms -> Transforms -> Bool
$c== :: Transforms -> Transforms -> Bool
Eq, Int -> Transforms -> String -> String
[Transforms] -> String -> String
Transforms -> String
(Int -> Transforms -> String -> String)
-> (Transforms -> String)
-> ([Transforms] -> String -> String)
-> Show Transforms
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Transforms] -> String -> String
$cshowList :: [Transforms] -> String -> String
show :: Transforms -> String
$cshow :: Transforms -> String
showsPrec :: Int -> Transforms -> String -> String
$cshowsPrec :: Int -> Transforms -> String -> String
Show)

instance XP.XmlPickler Transforms where
  xpickle :: PU Transforms
xpickle = String -> PU Transforms -> PU Transforms
forall a. String -> PU a -> PU a
xpElem String
"Transforms" (PU Transforms -> PU Transforms) -> PU Transforms -> PU Transforms
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|l <-> Transforms l|]
    Bijection (->) (List1 Transform) Transforms
-> PU (List1 Transform) -> PU Transforms
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU Transform -> PU (List1 Transform)
forall a. PU a -> PU (List1 a)
xpList1 PU Transform
forall a. XmlPickler a => PU a
XP.xpickle

data Transform = Transform
  { Transform -> IdentifiedURI TransformAlgorithm
transformAlgorithm :: IdentifiedURI TransformAlgorithm
  , Transform -> Maybe InclusiveNamespaces
transformInclusiveNamespaces :: Maybe C14N.InclusiveNamespaces
  , Transform -> [TransformElement]
transform :: [TransformElement]
  } deriving (Transform -> Transform -> Bool
(Transform -> Transform -> Bool)
-> (Transform -> Transform -> Bool) -> Eq Transform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transform -> Transform -> Bool
$c/= :: Transform -> Transform -> Bool
== :: Transform -> Transform -> Bool
$c== :: Transform -> Transform -> Bool
Eq, Int -> Transform -> String -> String
[Transform] -> String -> String
Transform -> String
(Int -> Transform -> String -> String)
-> (Transform -> String)
-> ([Transform] -> String -> String)
-> Show Transform
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Transform] -> String -> String
$cshowList :: [Transform] -> String -> String
show :: Transform -> String
$cshow :: Transform -> String
showsPrec :: Int -> Transform -> String -> String
$cshowsPrec :: Int -> Transform -> String -> String
Show)

instance XP.XmlPickler Transform where
  xpickle :: PU Transform
xpickle = String -> PU Transform -> PU Transform
forall a. String -> PU a -> PU a
xpElem String
"Transform" (PU Transform -> PU Transform) -> PU Transform -> PU Transform
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|((a, n), l) <-> Transform a n l|]
    Bijection
  (->)
  ((IdentifiedURI TransformAlgorithm, Maybe InclusiveNamespaces),
   [TransformElement])
  Transform
-> PU
     ((IdentifiedURI TransformAlgorithm, Maybe InclusiveNamespaces),
      [TransformElement])
-> PU Transform
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String
-> PU (IdentifiedURI TransformAlgorithm)
-> PU (IdentifiedURI TransformAlgorithm)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Algorithm" PU (IdentifiedURI TransformAlgorithm)
forall a. XmlPickler a => PU a
XP.xpickle
      PU (IdentifiedURI TransformAlgorithm)
-> PU (Maybe InclusiveNamespaces)
-> PU (IdentifiedURI TransformAlgorithm, Maybe InclusiveNamespaces)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU InclusiveNamespaces -> PU (Maybe InclusiveNamespaces)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU InclusiveNamespaces
forall a. XmlPickler a => PU a
XP.xpickle
      PU (IdentifiedURI TransformAlgorithm, Maybe InclusiveNamespaces)
-> PU [TransformElement]
-> PU
     ((IdentifiedURI TransformAlgorithm, Maybe InclusiveNamespaces),
      [TransformElement])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU TransformElement -> PU [TransformElement]
forall a. PU a -> PU [a]
XP.xpList PU TransformElement
forall a. XmlPickler a => PU a
XP.xpickle)

simpleTransform :: TransformAlgorithm -> Transform
simpleTransform :: TransformAlgorithm -> Transform
simpleTransform TransformAlgorithm
a = IdentifiedURI TransformAlgorithm
-> Maybe InclusiveNamespaces -> [TransformElement] -> Transform
Transform (TransformAlgorithm -> IdentifiedURI TransformAlgorithm
forall b a. a -> Identified b a
Identified TransformAlgorithm
a) Maybe InclusiveNamespaces
forall a. Maybe a
Nothing []

data TransformElement
  = TransformElementXPath XString
  | TransformElement Node 
  deriving (TransformElement -> TransformElement -> Bool
(TransformElement -> TransformElement -> Bool)
-> (TransformElement -> TransformElement -> Bool)
-> Eq TransformElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransformElement -> TransformElement -> Bool
$c/= :: TransformElement -> TransformElement -> Bool
== :: TransformElement -> TransformElement -> Bool
$c== :: TransformElement -> TransformElement -> Bool
Eq, Int -> TransformElement -> String -> String
[TransformElement] -> String -> String
TransformElement -> String
(Int -> TransformElement -> String -> String)
-> (TransformElement -> String)
-> ([TransformElement] -> String -> String)
-> Show TransformElement
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TransformElement] -> String -> String
$cshowList :: [TransformElement] -> String -> String
show :: TransformElement -> String
$cshow :: TransformElement -> String
showsPrec :: Int -> TransformElement -> String -> String
$cshowsPrec :: Int -> TransformElement -> String -> String
Show)

instance XP.XmlPickler TransformElement where
  xpickle :: PU TransformElement
xpickle = [XP.biCase|
      Left s  <-> TransformElementXPath s
      Right x <-> TransformElement x |]
    Bijection (->) (Either String Node) TransformElement
-> PU (Either String Node) -> PU TransformElement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String -> PU String -> PU String
forall a. String -> PU a -> PU a
xpElem String
"XPath" PU String
XS.xpString
      PU String -> PU Node -> PU (Either String Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
xpTrimAnyElem)

-- |§4.4.3.5
data DigestMethod = DigestMethod
  { DigestMethod -> IdentifiedURI DigestAlgorithm
digestAlgorithm :: IdentifiedURI DigestAlgorithm
  , DigestMethod -> Nodes
digest :: [Node]
  } deriving (DigestMethod -> DigestMethod -> Bool
(DigestMethod -> DigestMethod -> Bool)
-> (DigestMethod -> DigestMethod -> Bool) -> Eq DigestMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DigestMethod -> DigestMethod -> Bool
$c/= :: DigestMethod -> DigestMethod -> Bool
== :: DigestMethod -> DigestMethod -> Bool
$c== :: DigestMethod -> DigestMethod -> Bool
Eq, Int -> DigestMethod -> String -> String
[DigestMethod] -> String -> String
DigestMethod -> String
(Int -> DigestMethod -> String -> String)
-> (DigestMethod -> String)
-> ([DigestMethod] -> String -> String)
-> Show DigestMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DigestMethod] -> String -> String
$cshowList :: [DigestMethod] -> String -> String
show :: DigestMethod -> String
$cshow :: DigestMethod -> String
showsPrec :: Int -> DigestMethod -> String -> String
$cshowsPrec :: Int -> DigestMethod -> String -> String
Show)

instance XP.XmlPickler DigestMethod where
  xpickle :: PU DigestMethod
xpickle = String -> PU DigestMethod -> PU DigestMethod
forall a. String -> PU a -> PU a
xpElem String
"DigestMethod" (PU DigestMethod -> PU DigestMethod)
-> PU DigestMethod -> PU DigestMethod
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|(a, d) <-> DigestMethod a d|]
    Bijection (->) (IdentifiedURI DigestAlgorithm, Nodes) DigestMethod
-> PU (IdentifiedURI DigestAlgorithm, Nodes) -> PU DigestMethod
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String
-> PU (IdentifiedURI DigestAlgorithm)
-> PU (IdentifiedURI DigestAlgorithm)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Algorithm" PU (IdentifiedURI DigestAlgorithm)
forall a. XmlPickler a => PU a
XP.xpickle
      PU (IdentifiedURI DigestAlgorithm)
-> PU Nodes -> PU (IdentifiedURI DigestAlgorithm, Nodes)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Nodes
XP.xpAnyCont)

simpleDigest :: DigestAlgorithm -> DigestMethod
simpleDigest :: DigestAlgorithm -> DigestMethod
simpleDigest DigestAlgorithm
a = IdentifiedURI DigestAlgorithm -> Nodes -> DigestMethod
DigestMethod (DigestAlgorithm -> IdentifiedURI DigestAlgorithm
forall b a. a -> Identified b a
Identified DigestAlgorithm
a) []

-- |§4.5
data KeyInfo = KeyInfo
  { KeyInfo -> Maybe String
keyInfoId :: Maybe ID
  , KeyInfo -> List1 KeyInfoElement
keyInfoElements :: List1 KeyInfoElement
  } deriving (KeyInfo -> KeyInfo -> Bool
(KeyInfo -> KeyInfo -> Bool)
-> (KeyInfo -> KeyInfo -> Bool) -> Eq KeyInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyInfo -> KeyInfo -> Bool
$c/= :: KeyInfo -> KeyInfo -> Bool
== :: KeyInfo -> KeyInfo -> Bool
$c== :: KeyInfo -> KeyInfo -> Bool
Eq, Int -> KeyInfo -> String -> String
[KeyInfo] -> String -> String
KeyInfo -> String
(Int -> KeyInfo -> String -> String)
-> (KeyInfo -> String)
-> ([KeyInfo] -> String -> String)
-> Show KeyInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [KeyInfo] -> String -> String
$cshowList :: [KeyInfo] -> String -> String
show :: KeyInfo -> String
$cshow :: KeyInfo -> String
showsPrec :: Int -> KeyInfo -> String -> String
$cshowsPrec :: Int -> KeyInfo -> String -> String
Show)

xpKeyInfoType :: XP.PU KeyInfo
xpKeyInfoType :: PU KeyInfo
xpKeyInfoType = [XP.biCase|(i, l) <-> KeyInfo i l|] 
  Bijection (->) (Maybe String, List1 KeyInfoElement) KeyInfo
-> PU (Maybe String, List1 KeyInfoElement) -> PU KeyInfo
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
    PU (Maybe String)
-> PU (List1 KeyInfoElement)
-> PU (Maybe String, List1 KeyInfoElement)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU KeyInfoElement -> PU (List1 KeyInfoElement)
forall a. PU a -> PU (List1 a)
xpList1 PU KeyInfoElement
forall a. XmlPickler a => PU a
XP.xpickle)

instance XP.XmlPickler KeyInfo where
  xpickle :: PU KeyInfo
xpickle = String -> PU KeyInfo -> PU KeyInfo
forall a. String -> PU a -> PU a
xpElem String
"KeyInfo" PU KeyInfo
xpKeyInfoType

data KeyInfoElement
  = KeyName XString -- ^§4.5.1
  | KeyInfoKeyValue KeyValue -- ^§4.5.2
  | RetrievalMethod
    { KeyInfoElement -> URI
retrievalMethodURI :: URI
    , KeyInfoElement -> Maybe URI
retrievalMethodType :: Maybe URI
    , KeyInfoElement -> Maybe Transforms
retrievalMethodTransforms :: Maybe Transforms
    } -- ^§4.5.3
  | X509Data
    { KeyInfoElement -> List1 X509Element
x509Data :: List1 X509Element
    } -- ^§4.5.4
  | PGPData
    { KeyInfoElement -> Maybe Base64Binary
pgpKeyID :: Maybe XS.Base64Binary
    , KeyInfoElement -> Maybe Base64Binary
pgpKeyPacket :: Maybe XS.Base64Binary
    , KeyInfoElement -> Nodes
pgpData :: Nodes
    } -- ^§4.5.5
  | SPKIData 
    { KeyInfoElement -> List1 SPKIElement
spkiData :: List1 SPKIElement
    } -- ^§4.5.6
  | MgmtData XString -- ^§4.5.7
  | KeyInfoElement Node
  deriving (KeyInfoElement -> KeyInfoElement -> Bool
(KeyInfoElement -> KeyInfoElement -> Bool)
-> (KeyInfoElement -> KeyInfoElement -> Bool) -> Eq KeyInfoElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyInfoElement -> KeyInfoElement -> Bool
$c/= :: KeyInfoElement -> KeyInfoElement -> Bool
== :: KeyInfoElement -> KeyInfoElement -> Bool
$c== :: KeyInfoElement -> KeyInfoElement -> Bool
Eq, Int -> KeyInfoElement -> String -> String
[KeyInfoElement] -> String -> String
KeyInfoElement -> String
(Int -> KeyInfoElement -> String -> String)
-> (KeyInfoElement -> String)
-> ([KeyInfoElement] -> String -> String)
-> Show KeyInfoElement
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [KeyInfoElement] -> String -> String
$cshowList :: [KeyInfoElement] -> String -> String
show :: KeyInfoElement -> String
$cshow :: KeyInfoElement -> String
showsPrec :: Int -> KeyInfoElement -> String -> String
$cshowsPrec :: Int -> KeyInfoElement -> String -> String
Show)

instance XP.XmlPickler KeyInfoElement where
  xpickle :: PU KeyInfoElement
xpickle = [XP.biCase|
      Left (Left (Left (Left (Left (Left (Left n)))))) <-> KeyName n
      Left (Left (Left (Left (Left (Left (Right v)))))) <-> KeyInfoKeyValue v
      Left (Left (Left (Left (Left (Right ((u, t), f)))))) <-> RetrievalMethod u t f
      Left (Left (Left (Left (Right l)))) <-> X509Data l
      Left (Left (Left (Right ((i, p), x)))) <-> PGPData i p x
      Left (Left (Right l)) <-> SPKIData l
      Left (Right m) <-> MgmtData m
      Right x <-> KeyInfoElement x|]
    Bijection
  (->)
  (Either
     (Either
        (Either
           (Either
              (Either
                 (Either
                    (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
                 (List1 X509Element))
              ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
           (List1 SPKIElement))
        String)
     Node)
  KeyInfoElement
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either
                    (Either
                       (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
                    (List1 X509Element))
                 ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
              (List1 SPKIElement))
           String)
        Node)
-> PU KeyInfoElement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU String
forall a. String -> PU a -> PU a
xpElem String
"KeyName" PU String
XS.xpString
      PU String -> PU KeyValue -> PU (Either String KeyValue)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU KeyValue
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Either String KeyValue)
-> PU ((URI, Maybe URI), Maybe Transforms)
-> PU
     (Either
        (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String
-> PU ((URI, Maybe URI), Maybe Transforms)
-> PU ((URI, Maybe URI), Maybe Transforms)
forall a. String -> PU a -> PU a
xpElem String
"RetrievalMethod"
              (String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
XP.xpAttr String
"URI" PU URI
XS.xpAnyURI
        PU URI -> PU (Maybe URI) -> PU (URI, Maybe URI)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU URI -> PU (Maybe URI)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Type" PU URI
XS.xpAnyURI
        PU (URI, Maybe URI)
-> PU (Maybe Transforms) -> PU ((URI, Maybe URI), Maybe Transforms)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Transforms -> PU (Maybe Transforms)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU Transforms
forall a. XmlPickler a => PU a
XP.xpickle)
      PU
  (Either
     (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
-> PU (List1 X509Element)
-> PU
     (Either
        (Either
           (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
        (List1 X509Element))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU (List1 X509Element) -> PU (List1 X509Element)
forall a. String -> PU a -> PU a
xpElem String
"X509Data" (PU X509Element -> PU (List1 X509Element)
forall a. PU a -> PU (List1 a)
xpList1 PU X509Element
forall a. XmlPickler a => PU a
XP.xpickle)
      PU
  (Either
     (Either
        (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
     (List1 X509Element))
-> PU ((Maybe Base64Binary, Maybe Base64Binary), Nodes)
-> PU
     (Either
        (Either
           (Either
              (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
           (List1 X509Element))
        ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String
-> PU ((Maybe Base64Binary, Maybe Base64Binary), Nodes)
-> PU ((Maybe Base64Binary, Maybe Base64Binary), Nodes)
forall a. String -> PU a -> PU a
xpElem String
"PGPData"
              (PU Base64Binary -> PU (Maybe Base64Binary)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU Base64Binary -> PU Base64Binary
forall a. String -> PU a -> PU a
xpElem String
"PGPKeyID" PU Base64Binary
XS.xpBase64Binary)
        PU (Maybe Base64Binary)
-> PU (Maybe Base64Binary)
-> PU (Maybe Base64Binary, Maybe Base64Binary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Base64Binary -> PU (Maybe Base64Binary)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU Base64Binary -> PU Base64Binary
forall a. String -> PU a -> PU a
xpElem String
"PGPKeyPacket" PU Base64Binary
XS.xpBase64Binary)
        PU (Maybe Base64Binary, Maybe Base64Binary)
-> PU Nodes -> PU ((Maybe Base64Binary, Maybe Base64Binary), Nodes)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Node -> PU Nodes
forall a. PU a -> PU [a]
XP.xpList PU Node
xpTrimAnyElem)
      PU
  (Either
     (Either
        (Either
           (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
        (List1 X509Element))
     ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
-> PU (List1 SPKIElement)
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
              (List1 X509Element))
           ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
        (List1 SPKIElement))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU (List1 SPKIElement) -> PU (List1 SPKIElement)
forall a. String -> PU a -> PU a
xpElem String
"SPKIData" (PU SPKIElement -> PU (List1 SPKIElement)
forall a. PU a -> PU (List1 a)
xpList1 PU SPKIElement
forall a. XmlPickler a => PU a
XP.xpickle)
      PU
  (Either
     (Either
        (Either
           (Either
              (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
           (List1 X509Element))
        ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
     (List1 SPKIElement))
-> PU String
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either
                    (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
                 (List1 X509Element))
              ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
           (List1 SPKIElement))
        String)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU String -> PU String
forall a. String -> PU a -> PU a
xpElem String
"MgmtData" PU String
XS.xpString
      PU
  (Either
     (Either
        (Either
           (Either
              (Either
                 (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
              (List1 X509Element))
           ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
        (List1 SPKIElement))
     String)
-> PU Node
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either
                    (Either
                       (Either String KeyValue) ((URI, Maybe URI), Maybe Transforms))
                    (List1 X509Element))
                 ((Maybe Base64Binary, Maybe Base64Binary), Nodes))
              (List1 SPKIElement))
           String)
        Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
XP.xpTree)

-- |§4.5.2
data KeyValue
  = DSAKeyValue
    { KeyValue -> Maybe (CryptoBinary, CryptoBinary)
dsaKeyValuePQ :: Maybe (CryptoBinary, CryptoBinary)
    , KeyValue -> Maybe CryptoBinary
dsaKeyValueG :: Maybe CryptoBinary
    , KeyValue -> CryptoBinary
dsaKeyValueY :: CryptoBinary
    , KeyValue -> Maybe CryptoBinary
dsaKeyValueJ :: Maybe CryptoBinary
    , KeyValue -> Maybe (CryptoBinary, CryptoBinary)
dsaKeyValueSeedPgenCounter :: Maybe (CryptoBinary, CryptoBinary)
    } -- ^§4.5.2.1
  | RSAKeyValue
    { KeyValue -> CryptoBinary
rsaKeyValueModulus
    , KeyValue -> CryptoBinary
rsaKeyValueExponent :: CryptoBinary
    } -- ^§4.5.2.2
  | ECKeyValue
    { KeyValue -> Maybe String
ecKeyValueId :: Maybe XS.ID
    , KeyValue -> ECKeyValue
ecKeyValue :: ECKeyValue
    , KeyValue -> CryptoBinary
ecKeyValuePublicKey :: ECPoint
    } -- ^§4.5.2.3
  | KeyValue Node
  deriving (KeyValue -> KeyValue -> Bool
(KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool) -> Eq KeyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyValue -> KeyValue -> Bool
$c/= :: KeyValue -> KeyValue -> Bool
== :: KeyValue -> KeyValue -> Bool
$c== :: KeyValue -> KeyValue -> Bool
Eq, Int -> KeyValue -> String -> String
[KeyValue] -> String -> String
KeyValue -> String
(Int -> KeyValue -> String -> String)
-> (KeyValue -> String)
-> ([KeyValue] -> String -> String)
-> Show KeyValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [KeyValue] -> String -> String
$cshowList :: [KeyValue] -> String -> String
show :: KeyValue -> String
$cshow :: KeyValue -> String
showsPrec :: Int -> KeyValue -> String -> String
$cshowsPrec :: Int -> KeyValue -> String -> String
Show)

instance XP.XmlPickler KeyValue where
  xpickle :: PU KeyValue
xpickle = String -> PU KeyValue -> PU KeyValue
forall a. String -> PU a -> PU a
xpElem String
"KeyValue" (PU KeyValue -> PU KeyValue) -> PU KeyValue -> PU KeyValue
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|
      Left (Left (Left ((((pq, g), y), j), sp))) <-> DSAKeyValue pq g y j sp
      Left (Left (Right (m, e))) <-> RSAKeyValue m e
      Left (Right ((i, v), p)) <-> ECKeyValue i v p
      Right x <-> KeyValue x|]
    Bijection
  (->)
  (Either
     (Either
        (Either
           ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
              CryptoBinary),
             Maybe CryptoBinary),
            Maybe (CryptoBinary, CryptoBinary))
           (CryptoBinary, CryptoBinary))
        ((Maybe String, ECKeyValue), CryptoBinary))
     Node)
  KeyValue
-> PU
     (Either
        (Either
           (Either
              ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
                 CryptoBinary),
                Maybe CryptoBinary),
               Maybe (CryptoBinary, CryptoBinary))
              (CryptoBinary, CryptoBinary))
           ((Maybe String, ECKeyValue), CryptoBinary))
        Node)
-> PU KeyValue
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String
-> PU
     ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
        CryptoBinary),
       Maybe CryptoBinary),
      Maybe (CryptoBinary, CryptoBinary))
-> PU
     ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
        CryptoBinary),
       Maybe CryptoBinary),
      Maybe (CryptoBinary, CryptoBinary))
forall a. String -> PU a -> PU a
xpElem String
"DSAKeyValue" 
              (PU (CryptoBinary, CryptoBinary)
-> PU (Maybe (CryptoBinary, CryptoBinary))
forall a. PU a -> PU (Maybe a)
XP.xpOption
                (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"P" PU CryptoBinary
xpCryptoBinary
          PU CryptoBinary
-> PU CryptoBinary -> PU (CryptoBinary, CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"Q" PU CryptoBinary
xpCryptoBinary)
        PU (Maybe (CryptoBinary, CryptoBinary))
-> PU (Maybe CryptoBinary)
-> PU (Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU CryptoBinary -> PU (Maybe CryptoBinary)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"G" PU CryptoBinary
xpCryptoBinary)
        PU (Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary)
-> PU CryptoBinary
-> PU
     ((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
      CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"Y" PU CryptoBinary
xpCryptoBinary
        PU
  ((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
   CryptoBinary)
-> PU (Maybe CryptoBinary)
-> PU
     (((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
       CryptoBinary),
      Maybe CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU CryptoBinary -> PU (Maybe CryptoBinary)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"J" PU CryptoBinary
xpCryptoBinary)
        PU
  (((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
    CryptoBinary),
   Maybe CryptoBinary)
-> PU (Maybe (CryptoBinary, CryptoBinary))
-> PU
     ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
        CryptoBinary),
       Maybe CryptoBinary),
      Maybe (CryptoBinary, CryptoBinary))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< (PU (CryptoBinary, CryptoBinary)
-> PU (Maybe (CryptoBinary, CryptoBinary))
forall a. PU a -> PU (Maybe a)
XP.xpOption
                (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"Seed" PU CryptoBinary
xpCryptoBinary
          PU CryptoBinary
-> PU CryptoBinary -> PU (CryptoBinary, CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"PgenCounter" PU CryptoBinary
xpCryptoBinary)))
      PU
  ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
     CryptoBinary),
    Maybe CryptoBinary),
   Maybe (CryptoBinary, CryptoBinary))
-> PU (CryptoBinary, CryptoBinary)
-> PU
     (Either
        ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
           CryptoBinary),
          Maybe CryptoBinary),
         Maybe (CryptoBinary, CryptoBinary))
        (CryptoBinary, CryptoBinary))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String
-> PU (CryptoBinary, CryptoBinary)
-> PU (CryptoBinary, CryptoBinary)
forall a. String -> PU a -> PU a
xpElem String
"RSAKeyValue" 
              (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"Modulus" PU CryptoBinary
xpCryptoBinary
        PU CryptoBinary
-> PU CryptoBinary -> PU (CryptoBinary, CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem String
"Exponent" PU CryptoBinary
xpCryptoBinary)
      PU
  (Either
     ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
        CryptoBinary),
       Maybe CryptoBinary),
      Maybe (CryptoBinary, CryptoBinary))
     (CryptoBinary, CryptoBinary))
-> PU ((Maybe String, ECKeyValue), CryptoBinary)
-> PU
     (Either
        (Either
           ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
              CryptoBinary),
             Maybe CryptoBinary),
            Maybe (CryptoBinary, CryptoBinary))
           (CryptoBinary, CryptoBinary))
        ((Maybe String, ECKeyValue), CryptoBinary))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String
-> PU ((Maybe String, ECKeyValue), CryptoBinary)
-> PU ((Maybe String, ECKeyValue), CryptoBinary)
forall a. String -> PU a -> PU a
xpElem11 String
"ECKeyValue"
              (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
        PU (Maybe String) -> PU ECKeyValue -> PU (Maybe String, ECKeyValue)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU ECKeyValue
forall a. XmlPickler a => PU a
XP.xpickle
        PU (Maybe String, ECKeyValue)
-> PU CryptoBinary -> PU ((Maybe String, ECKeyValue), CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"PublicKey" PU CryptoBinary
xpCryptoBinary)
      PU
  (Either
     (Either
        ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
           CryptoBinary),
          Maybe CryptoBinary),
         Maybe (CryptoBinary, CryptoBinary))
        (CryptoBinary, CryptoBinary))
     ((Maybe String, ECKeyValue), CryptoBinary))
-> PU Node
-> PU
     (Either
        (Either
           (Either
              ((((Maybe (CryptoBinary, CryptoBinary), Maybe CryptoBinary),
                 CryptoBinary),
                Maybe CryptoBinary),
               Maybe (CryptoBinary, CryptoBinary))
              (CryptoBinary, CryptoBinary))
           ((Maybe String, ECKeyValue), CryptoBinary))
        Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
XP.xpTree)

data ECKeyValue
  = ECParameters
    { ECKeyValue -> ECFieldID
ecParametersFieldID :: ECFieldID
    , ECKeyValue -> ECCurve
ecParametersCurve :: ECCurve
    , ECKeyValue -> CryptoBinary
ecParametersBase :: ECPoint
    , ECKeyValue -> CryptoBinary
ecParametersOrder :: CryptoBinary
    , ECKeyValue -> Maybe CryptoBinary
ecParametersCoFactor :: Maybe Integer
    , ECKeyValue -> Maybe ECValidationData
ecParametersValidationData :: Maybe ECValidationData
    } -- ^§4.5.2.3.1
  | ECNamedCurve
    { ECKeyValue -> URI
ecNamedCurveURI :: XS.AnyURI
    }
  deriving (ECKeyValue -> ECKeyValue -> Bool
(ECKeyValue -> ECKeyValue -> Bool)
-> (ECKeyValue -> ECKeyValue -> Bool) -> Eq ECKeyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECKeyValue -> ECKeyValue -> Bool
$c/= :: ECKeyValue -> ECKeyValue -> Bool
== :: ECKeyValue -> ECKeyValue -> Bool
$c== :: ECKeyValue -> ECKeyValue -> Bool
Eq, Int -> ECKeyValue -> String -> String
[ECKeyValue] -> String -> String
ECKeyValue -> String
(Int -> ECKeyValue -> String -> String)
-> (ECKeyValue -> String)
-> ([ECKeyValue] -> String -> String)
-> Show ECKeyValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ECKeyValue] -> String -> String
$cshowList :: [ECKeyValue] -> String -> String
show :: ECKeyValue -> String
$cshow :: ECKeyValue -> String
showsPrec :: Int -> ECKeyValue -> String -> String
$cshowsPrec :: Int -> ECKeyValue -> String -> String
Show)

type ECPoint = CryptoBinary

instance XP.XmlPickler ECKeyValue where
  xpickle :: PU ECKeyValue
xpickle =
    [XP.biCase|
      Left (((((f, c), b), o), cf), vd) <-> ECParameters f c b o cf vd
      Right u <-> ECNamedCurve u|]
    Bijection
  (->)
  (Either
     (((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
       Maybe CryptoBinary),
      Maybe ECValidationData)
     URI)
  ECKeyValue
-> PU
     (Either
        (((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
          Maybe CryptoBinary),
         Maybe ECValidationData)
        URI)
-> PU ECKeyValue
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String
-> PU
     (((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
       Maybe CryptoBinary),
      Maybe ECValidationData)
-> PU
     (((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
       Maybe CryptoBinary),
      Maybe ECValidationData)
forall a. String -> PU a -> PU a
xpElem11 String
"ECParameters" 
              (PU ECFieldID
forall a. XmlPickler a => PU a
XP.xpickle
        PU ECFieldID -> PU ECCurve -> PU (ECFieldID, ECCurve)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU ECCurve
forall a. XmlPickler a => PU a
XP.xpickle
        PU (ECFieldID, ECCurve)
-> PU CryptoBinary -> PU ((ECFieldID, ECCurve), CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"Base" PU CryptoBinary
xpCryptoBinary
        PU ((ECFieldID, ECCurve), CryptoBinary)
-> PU CryptoBinary
-> PU (((ECFieldID, ECCurve), CryptoBinary), CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"Order" PU CryptoBinary
xpCryptoBinary
        PU (((ECFieldID, ECCurve), CryptoBinary), CryptoBinary)
-> PU (Maybe CryptoBinary)
-> PU
     ((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
      Maybe CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU CryptoBinary -> PU (Maybe CryptoBinary)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"CoFactor" PU CryptoBinary
XS.xpInteger)
        PU
  ((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
   Maybe CryptoBinary)
-> PU (Maybe ECValidationData)
-> PU
     (((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
       Maybe CryptoBinary),
      Maybe ECValidationData)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU ECValidationData -> PU (Maybe ECValidationData)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU ECValidationData
forall a. XmlPickler a => PU a
XP.xpickle)
      PU
  (((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
    Maybe CryptoBinary),
   Maybe ECValidationData)
-> PU URI
-> PU
     (Either
        (((((ECFieldID, ECCurve), CryptoBinary), CryptoBinary),
          Maybe CryptoBinary),
         Maybe ECValidationData)
        URI)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
xpElem11 String
"NamedCurve"
              (String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
XP.xpAttr String
"URI" PU URI
XS.xpAnyURI))

data ECFieldID
  = ECPrime
    { ECFieldID -> CryptoBinary
ecP :: CryptoBinary
    }
  | ECTnB
    { ECFieldID -> PositiveInteger
ecM :: XS.PositiveInteger
    , ECFieldID -> PositiveInteger
ecK :: XS.PositiveInteger
    }
  | ECPnB
    { ecM :: XS.PositiveInteger
    , ECFieldID -> PositiveInteger
ecK1, ECFieldID -> PositiveInteger
ecK2, ECFieldID -> PositiveInteger
ecK3 :: XS.PositiveInteger
    }
  | ECGnB
    { ecM :: XS.PositiveInteger
    }
  | ECFieldID Node
  deriving (ECFieldID -> ECFieldID -> Bool
(ECFieldID -> ECFieldID -> Bool)
-> (ECFieldID -> ECFieldID -> Bool) -> Eq ECFieldID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECFieldID -> ECFieldID -> Bool
$c/= :: ECFieldID -> ECFieldID -> Bool
== :: ECFieldID -> ECFieldID -> Bool
$c== :: ECFieldID -> ECFieldID -> Bool
Eq, Int -> ECFieldID -> String -> String
[ECFieldID] -> String -> String
ECFieldID -> String
(Int -> ECFieldID -> String -> String)
-> (ECFieldID -> String)
-> ([ECFieldID] -> String -> String)
-> Show ECFieldID
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ECFieldID] -> String -> String
$cshowList :: [ECFieldID] -> String -> String
show :: ECFieldID -> String
$cshow :: ECFieldID -> String
showsPrec :: Int -> ECFieldID -> String -> String
$cshowsPrec :: Int -> ECFieldID -> String -> String
Show)

instance XP.XmlPickler ECFieldID where
  xpickle :: PU ECFieldID
xpickle = String -> PU ECFieldID -> PU ECFieldID
forall a. String -> PU a -> PU a
xpElem11 String
"FieldID" (PU ECFieldID -> PU ECFieldID) -> PU ECFieldID -> PU ECFieldID
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|
      Left (Left (Left (Left p))) <-> ECPrime p
      Left (Left (Left (Right (m, k)))) <-> ECTnB m k
      Left (Left (Right (((m, k1), k2), k3))) <-> ECPnB m k1 k2 k3
      Left (Right m) <-> ECGnB m
      Right x <-> ECFieldID x|]
    Bijection
  (->)
  (Either
     (Either
        (Either
           (Either CryptoBinary (PositiveInteger, PositiveInteger))
           (((PositiveInteger, PositiveInteger), PositiveInteger),
            PositiveInteger))
        PositiveInteger)
     Node)
  ECFieldID
-> PU
     (Either
        (Either
           (Either
              (Either CryptoBinary (PositiveInteger, PositiveInteger))
              (((PositiveInteger, PositiveInteger), PositiveInteger),
               PositiveInteger))
           PositiveInteger)
        Node)
-> PU ECFieldID
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"Prime" 
              (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"P" PU CryptoBinary
xpCryptoBinary)
      PU CryptoBinary
-> PU (PositiveInteger, PositiveInteger)
-> PU (Either CryptoBinary (PositiveInteger, PositiveInteger))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String
-> PU (PositiveInteger, PositiveInteger)
-> PU (PositiveInteger, PositiveInteger)
forall a. String -> PU a -> PU a
xpElem11 String
"TnB" 
              (String -> PU PositiveInteger -> PU PositiveInteger
forall a. String -> PU a -> PU a
xpElem11 String
"M" PU PositiveInteger
XS.xpPositiveInteger
        PU PositiveInteger
-> PU PositiveInteger -> PU (PositiveInteger, PositiveInteger)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU PositiveInteger -> PU PositiveInteger
forall a. String -> PU a -> PU a
xpElem11 String
"K" PU PositiveInteger
XS.xpPositiveInteger)
      PU (Either CryptoBinary (PositiveInteger, PositiveInteger))
-> PU
     (((PositiveInteger, PositiveInteger), PositiveInteger),
      PositiveInteger)
-> PU
     (Either
        (Either CryptoBinary (PositiveInteger, PositiveInteger))
        (((PositiveInteger, PositiveInteger), PositiveInteger),
         PositiveInteger))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String
-> PU
     (((PositiveInteger, PositiveInteger), PositiveInteger),
      PositiveInteger)
-> PU
     (((PositiveInteger, PositiveInteger), PositiveInteger),
      PositiveInteger)
forall a. String -> PU a -> PU a
xpElem11 String
"PnB" 
              (String -> PU PositiveInteger -> PU PositiveInteger
forall a. String -> PU a -> PU a
xpElem11 String
"M" PU PositiveInteger
XS.xpPositiveInteger
        PU PositiveInteger
-> PU PositiveInteger -> PU (PositiveInteger, PositiveInteger)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU PositiveInteger -> PU PositiveInteger
forall a. String -> PU a -> PU a
xpElem11 String
"K1" PU PositiveInteger
XS.xpPositiveInteger
        PU (PositiveInteger, PositiveInteger)
-> PU PositiveInteger
-> PU ((PositiveInteger, PositiveInteger), PositiveInteger)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU PositiveInteger -> PU PositiveInteger
forall a. String -> PU a -> PU a
xpElem11 String
"K2" PU PositiveInteger
XS.xpPositiveInteger
        PU ((PositiveInteger, PositiveInteger), PositiveInteger)
-> PU PositiveInteger
-> PU
     (((PositiveInteger, PositiveInteger), PositiveInteger),
      PositiveInteger)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU PositiveInteger -> PU PositiveInteger
forall a. String -> PU a -> PU a
xpElem11 String
"K3" PU PositiveInteger
XS.xpPositiveInteger)
      PU
  (Either
     (Either CryptoBinary (PositiveInteger, PositiveInteger))
     (((PositiveInteger, PositiveInteger), PositiveInteger),
      PositiveInteger))
-> PU PositiveInteger
-> PU
     (Either
        (Either
           (Either CryptoBinary (PositiveInteger, PositiveInteger))
           (((PositiveInteger, PositiveInteger), PositiveInteger),
            PositiveInteger))
        PositiveInteger)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU PositiveInteger -> PU PositiveInteger
forall a. String -> PU a -> PU a
xpElem11 String
"GnB" 
              (String -> PU PositiveInteger -> PU PositiveInteger
forall a. String -> PU a -> PU a
xpElem11 String
"M" PU PositiveInteger
XS.xpPositiveInteger)
      PU
  (Either
     (Either
        (Either CryptoBinary (PositiveInteger, PositiveInteger))
        (((PositiveInteger, PositiveInteger), PositiveInteger),
         PositiveInteger))
     PositiveInteger)
-> PU Node
-> PU
     (Either
        (Either
           (Either
              (Either CryptoBinary (PositiveInteger, PositiveInteger))
              (((PositiveInteger, PositiveInteger), PositiveInteger),
               PositiveInteger))
           PositiveInteger)
        Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
xpTrimAnyElem)

data ECCurve = ECCurve
  { ECCurve -> CryptoBinary
ecCurveA, ECCurve -> CryptoBinary
ecCurveB :: CryptoBinary
  } deriving (ECCurve -> ECCurve -> Bool
(ECCurve -> ECCurve -> Bool)
-> (ECCurve -> ECCurve -> Bool) -> Eq ECCurve
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECCurve -> ECCurve -> Bool
$c/= :: ECCurve -> ECCurve -> Bool
== :: ECCurve -> ECCurve -> Bool
$c== :: ECCurve -> ECCurve -> Bool
Eq, Int -> ECCurve -> String -> String
[ECCurve] -> String -> String
ECCurve -> String
(Int -> ECCurve -> String -> String)
-> (ECCurve -> String)
-> ([ECCurve] -> String -> String)
-> Show ECCurve
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ECCurve] -> String -> String
$cshowList :: [ECCurve] -> String -> String
show :: ECCurve -> String
$cshow :: ECCurve -> String
showsPrec :: Int -> ECCurve -> String -> String
$cshowsPrec :: Int -> ECCurve -> String -> String
Show)

instance XP.XmlPickler ECCurve where
  xpickle :: PU ECCurve
xpickle = String -> PU ECCurve -> PU ECCurve
forall a. String -> PU a -> PU a
xpElem11 String
"Curve" (PU ECCurve -> PU ECCurve) -> PU ECCurve -> PU ECCurve
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|
      (a, b) <-> ECCurve a b|]
    Bijection (->) (CryptoBinary, CryptoBinary) ECCurve
-> PU (CryptoBinary, CryptoBinary) -> PU ECCurve
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"A" PU CryptoBinary
xpCryptoBinary
      PU CryptoBinary
-> PU CryptoBinary -> PU (CryptoBinary, CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"B" PU CryptoBinary
xpCryptoBinary)

data ECValidationData = ECValidationData
  { ECValidationData -> URI
ecValidationDataHashAlgorithm :: AnyURI
  , ECValidationData -> CryptoBinary
ecValidationDataSeed :: CryptoBinary
  } deriving (ECValidationData -> ECValidationData -> Bool
(ECValidationData -> ECValidationData -> Bool)
-> (ECValidationData -> ECValidationData -> Bool)
-> Eq ECValidationData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECValidationData -> ECValidationData -> Bool
$c/= :: ECValidationData -> ECValidationData -> Bool
== :: ECValidationData -> ECValidationData -> Bool
$c== :: ECValidationData -> ECValidationData -> Bool
Eq, Int -> ECValidationData -> String -> String
[ECValidationData] -> String -> String
ECValidationData -> String
(Int -> ECValidationData -> String -> String)
-> (ECValidationData -> String)
-> ([ECValidationData] -> String -> String)
-> Show ECValidationData
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ECValidationData] -> String -> String
$cshowList :: [ECValidationData] -> String -> String
show :: ECValidationData -> String
$cshow :: ECValidationData -> String
showsPrec :: Int -> ECValidationData -> String -> String
$cshowsPrec :: Int -> ECValidationData -> String -> String
Show)

instance XP.XmlPickler ECValidationData where
  xpickle :: PU ECValidationData
xpickle = String -> PU ECValidationData -> PU ECValidationData
forall a. String -> PU a -> PU a
xpElem11 String
"ValidationData" (PU ECValidationData -> PU ECValidationData)
-> PU ECValidationData -> PU ECValidationData
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|
      (a, s) <-> ECValidationData a s|]
    Bijection (->) (URI, CryptoBinary) ECValidationData
-> PU (URI, CryptoBinary) -> PU ECValidationData
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
XP.xpAttr String
"hashAlgorithm" PU URI
XS.xpAnyURI
      PU URI -> PU CryptoBinary -> PU (URI, CryptoBinary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU CryptoBinary -> PU CryptoBinary
forall a. String -> PU a -> PU a
xpElem11 String
"seed" PU CryptoBinary
xpCryptoBinary)

-- |§4.5.4.1
type X509DistinguishedName = XString

xpX509DistinguishedName :: XP.PU X509DistinguishedName
xpX509DistinguishedName :: PU String
xpX509DistinguishedName = PU String
XS.xpString

data X509Element
  = X509IssuerSerial
    { X509Element -> String
x509IssuerName :: X509DistinguishedName
    , X509Element -> Int
x509SerialNumber :: Int
    }
  | X509SKI XS.Base64Binary
  | X509SubjectName X509DistinguishedName
  | X509Certificate X509.SignedCertificate
  | X509CRL X509.SignedCRL
  | X509Digest
    { X509Element -> IdentifiedURI DigestAlgorithm
x509DigestAlgorithm :: IdentifiedURI DigestAlgorithm
    , X509Element -> Base64Binary
x509Digest :: XS.Base64Binary
    }
  | X509Element Node
  deriving (X509Element -> X509Element -> Bool
(X509Element -> X509Element -> Bool)
-> (X509Element -> X509Element -> Bool) -> Eq X509Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: X509Element -> X509Element -> Bool
$c/= :: X509Element -> X509Element -> Bool
== :: X509Element -> X509Element -> Bool
$c== :: X509Element -> X509Element -> Bool
Eq, Int -> X509Element -> String -> String
[X509Element] -> String -> String
X509Element -> String
(Int -> X509Element -> String -> String)
-> (X509Element -> String)
-> ([X509Element] -> String -> String)
-> Show X509Element
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [X509Element] -> String -> String
$cshowList :: [X509Element] -> String -> String
show :: X509Element -> String
$cshow :: X509Element -> String
showsPrec :: Int -> X509Element -> String -> String
$cshowsPrec :: Int -> X509Element -> String -> String
Show)

instance XP.XmlPickler X509Element where
  xpickle :: PU X509Element
xpickle = [XP.biCase|
      Left (Left (Left (Left (Left (Left (n, i)))))) <-> X509IssuerSerial n i
      Left (Left (Left (Left (Left (Right n))))) <-> X509SubjectName n
      Left (Left (Left (Left (Right b)))) <-> X509SKI b
      Left (Left (Left (Right b))) <-> X509Certificate b
      Left (Left (Right b)) <-> X509CRL b
      Left (Right (a, d)) <-> X509Digest a d
      Right x <-> X509Element x|]
    Bijection
  (->)
  (Either
     (Either
        (Either
           (Either
              (Either (Either (String, Int) String) Base64Binary)
              SignedCertificate)
           SignedCRL)
        (IdentifiedURI DigestAlgorithm, Base64Binary))
     Node)
  X509Element
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either (Either (String, Int) String) Base64Binary)
                 SignedCertificate)
              SignedCRL)
           (IdentifiedURI DigestAlgorithm, Base64Binary))
        Node)
-> PU X509Element
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String -> PU (String, Int) -> PU (String, Int)
forall a. String -> PU a -> PU a
xpElem String
"X509IssuerSerial"
              (String -> PU String -> PU String
forall a. String -> PU a -> PU a
xpElem String
"X509IssuerName" PU String
xpX509DistinguishedName
        PU String -> PU Int -> PU (String, Int)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU Int -> PU Int
forall a. String -> PU a -> PU a
xpElem String
"X509SerialNumber" PU Int
forall a. XmlPickler a => PU a
XP.xpickle)
      PU (String, Int) -> PU String -> PU (Either (String, Int) String)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU String -> PU String
forall a. String -> PU a -> PU a
xpElem String
"X509SubjectName" PU String
xpX509DistinguishedName
      PU (Either (String, Int) String)
-> PU Base64Binary
-> PU (Either (Either (String, Int) String) Base64Binary)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU Base64Binary -> PU Base64Binary
forall a. String -> PU a -> PU a
xpElem String
"X509SKI" PU Base64Binary
XS.xpBase64Binary
      PU (Either (Either (String, Int) String) Base64Binary)
-> PU SignedCertificate
-> PU
     (Either
        (Either (Either (String, Int) String) Base64Binary)
        SignedCertificate)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU SignedCertificate -> PU SignedCertificate
forall a. String -> PU a -> PU a
xpElem String
"X509Certificate" PU SignedCertificate
forall a. (Show a, Eq a, ASN1Object a) => PU (SignedExact a)
xpX509Signed
      PU
  (Either
     (Either (Either (String, Int) String) Base64Binary)
     SignedCertificate)
-> PU SignedCRL
-> PU
     (Either
        (Either
           (Either (Either (String, Int) String) Base64Binary)
           SignedCertificate)
        SignedCRL)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU SignedCRL -> PU SignedCRL
forall a. String -> PU a -> PU a
xpElem String
"X509CRL" PU SignedCRL
forall a. (Show a, Eq a, ASN1Object a) => PU (SignedExact a)
xpX509Signed
      PU
  (Either
     (Either
        (Either (Either (String, Int) String) Base64Binary)
        SignedCertificate)
     SignedCRL)
-> PU (IdentifiedURI DigestAlgorithm, Base64Binary)
-> PU
     (Either
        (Either
           (Either
              (Either (Either (String, Int) String) Base64Binary)
              SignedCertificate)
           SignedCRL)
        (IdentifiedURI DigestAlgorithm, Base64Binary))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String
-> PU (IdentifiedURI DigestAlgorithm, Base64Binary)
-> PU (IdentifiedURI DigestAlgorithm, Base64Binary)
forall a. String -> PU a -> PU a
xpElem11 String
"X509Digest"
              (String
-> PU (IdentifiedURI DigestAlgorithm)
-> PU (IdentifiedURI DigestAlgorithm)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Algorithm" PU (IdentifiedURI DigestAlgorithm)
forall a. XmlPickler a => PU a
XP.xpickle
        PU (IdentifiedURI DigestAlgorithm)
-> PU Base64Binary
-> PU (IdentifiedURI DigestAlgorithm, Base64Binary)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Base64Binary
XS.xpBase64Binary)
      PU
  (Either
     (Either
        (Either
           (Either (Either (String, Int) String) Base64Binary)
           SignedCertificate)
        SignedCRL)
     (IdentifiedURI DigestAlgorithm, Base64Binary))
-> PU Node
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either (Either (String, Int) String) Base64Binary)
                 SignedCertificate)
              SignedCRL)
           (IdentifiedURI DigestAlgorithm, Base64Binary))
        Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
xpTrimAnyElem)

-- |§4.4.6
data SPKIElement
  = SPKISexp XS.Base64Binary
  | SPKIElement Node
  deriving (SPKIElement -> SPKIElement -> Bool
(SPKIElement -> SPKIElement -> Bool)
-> (SPKIElement -> SPKIElement -> Bool) -> Eq SPKIElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SPKIElement -> SPKIElement -> Bool
$c/= :: SPKIElement -> SPKIElement -> Bool
== :: SPKIElement -> SPKIElement -> Bool
$c== :: SPKIElement -> SPKIElement -> Bool
Eq, Int -> SPKIElement -> String -> String
[SPKIElement] -> String -> String
SPKIElement -> String
(Int -> SPKIElement -> String -> String)
-> (SPKIElement -> String)
-> ([SPKIElement] -> String -> String)
-> Show SPKIElement
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SPKIElement] -> String -> String
$cshowList :: [SPKIElement] -> String -> String
show :: SPKIElement -> String
$cshow :: SPKIElement -> String
showsPrec :: Int -> SPKIElement -> String -> String
$cshowsPrec :: Int -> SPKIElement -> String -> String
Show)

instance XP.XmlPickler SPKIElement where
  xpickle :: PU SPKIElement
xpickle = [XP.biCase|
      Left b <-> SPKISexp b
      Right x <-> SPKIElement x|]
    Bijection (->) (Either Base64Binary Node) SPKIElement
-> PU (Either Base64Binary Node) -> PU SPKIElement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU Base64Binary -> PU Base64Binary
forall a. String -> PU a -> PU a
xpElem String
"SPKISexp" PU Base64Binary
XS.xpBase64Binary
      PU Base64Binary -> PU Node -> PU (Either Base64Binary Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
xpTrimAnyElem)

-- |§4.5
data Object = Object
  { Object -> Maybe String
objectId :: Maybe ID
  , Object -> Maybe String
objectMimeType :: Maybe XString
  , Object -> Maybe (IdentifiedURI EncodingAlgorithm)
objectEncoding :: Maybe (IdentifiedURI EncodingAlgorithm)
  , Object -> [ObjectElement]
objectXML :: [ObjectElement]
  } deriving (Object -> Object -> Bool
(Object -> Object -> Bool)
-> (Object -> Object -> Bool) -> Eq Object
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Object -> Object -> Bool
$c/= :: Object -> Object -> Bool
== :: Object -> Object -> Bool
$c== :: Object -> Object -> Bool
Eq, Int -> Object -> String -> String
[Object] -> String -> String
Object -> String
(Int -> Object -> String -> String)
-> (Object -> String)
-> ([Object] -> String -> String)
-> Show Object
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Object] -> String -> String
$cshowList :: [Object] -> String -> String
show :: Object -> String
$cshow :: Object -> String
showsPrec :: Int -> Object -> String -> String
$cshowsPrec :: Int -> Object -> String -> String
Show)

instance XP.XmlPickler Object where
  xpickle :: PU Object
xpickle = String -> PU Object -> PU Object
forall a. String -> PU a -> PU a
xpElem String
"Object" (PU Object -> PU Object) -> PU Object -> PU Object
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|(((i, m), e), x) <-> Object i m e x|] 
    Bijection
  (->)
  (((Maybe String, Maybe String),
    Maybe (IdentifiedURI EncodingAlgorithm)),
   [ObjectElement])
  Object
-> PU
     (((Maybe String, Maybe String),
       Maybe (IdentifiedURI EncodingAlgorithm)),
      [ObjectElement])
-> PU Object
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
      PU (Maybe String)
-> PU (Maybe String) -> PU (Maybe String, Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"MimeType" PU String
XS.xpString
      PU (Maybe String, Maybe String)
-> PU (Maybe (IdentifiedURI EncodingAlgorithm))
-> PU
     ((Maybe String, Maybe String),
      Maybe (IdentifiedURI EncodingAlgorithm))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String
-> PU (IdentifiedURI EncodingAlgorithm)
-> PU (Maybe (IdentifiedURI EncodingAlgorithm))
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Encoding" PU (IdentifiedURI EncodingAlgorithm)
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  ((Maybe String, Maybe String),
   Maybe (IdentifiedURI EncodingAlgorithm))
-> PU [ObjectElement]
-> PU
     (((Maybe String, Maybe String),
       Maybe (IdentifiedURI EncodingAlgorithm)),
      [ObjectElement])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU ObjectElement -> PU [ObjectElement]
forall a. PU a -> PU [a]
XP.xpList PU ObjectElement
forall a. XmlPickler a => PU a
XP.xpickle)

data ObjectElement
  = ObjectSignature Signature
  | ObjectSignatureProperties SignatureProperties
  | ObjectManifest Manifest
  | ObjectElement Node
  deriving (ObjectElement -> ObjectElement -> Bool
(ObjectElement -> ObjectElement -> Bool)
-> (ObjectElement -> ObjectElement -> Bool) -> Eq ObjectElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectElement -> ObjectElement -> Bool
$c/= :: ObjectElement -> ObjectElement -> Bool
== :: ObjectElement -> ObjectElement -> Bool
$c== :: ObjectElement -> ObjectElement -> Bool
Eq, Int -> ObjectElement -> String -> String
[ObjectElement] -> String -> String
ObjectElement -> String
(Int -> ObjectElement -> String -> String)
-> (ObjectElement -> String)
-> ([ObjectElement] -> String -> String)
-> Show ObjectElement
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ObjectElement] -> String -> String
$cshowList :: [ObjectElement] -> String -> String
show :: ObjectElement -> String
$cshow :: ObjectElement -> String
showsPrec :: Int -> ObjectElement -> String -> String
$cshowsPrec :: Int -> ObjectElement -> String -> String
Show)

instance XP.XmlPickler ObjectElement where
  xpickle :: PU ObjectElement
xpickle = [XP.biCase|
      Left (Left (Left s)) <-> ObjectSignature s
      Left (Left (Right p)) <-> ObjectSignatureProperties p
      Left (Right m) <-> ObjectManifest m
      Right x <-> ObjectElement x|]
    Bijection
  (->)
  (Either
     (Either (Either Signature SignatureProperties) Manifest) Node)
  ObjectElement
-> PU
     (Either
        (Either (Either Signature SignatureProperties) Manifest) Node)
-> PU ObjectElement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU Signature
forall a. XmlPickler a => PU a
XP.xpickle
      PU Signature
-> PU SignatureProperties
-> PU (Either Signature SignatureProperties)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU SignatureProperties
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Either Signature SignatureProperties)
-> PU Manifest
-> PU (Either (Either Signature SignatureProperties) Manifest)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Manifest
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Either (Either Signature SignatureProperties) Manifest)
-> PU Node
-> PU
     (Either
        (Either (Either Signature SignatureProperties) Manifest) Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
XP.xpTree)

-- |§5.1
data Manifest = Manifest
  { Manifest -> Maybe String
manifestId :: Maybe ID
  , Manifest -> List1 Reference
manifestReferences :: List1 Reference
  } deriving (Manifest -> Manifest -> Bool
(Manifest -> Manifest -> Bool)
-> (Manifest -> Manifest -> Bool) -> Eq Manifest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Manifest -> Manifest -> Bool
$c/= :: Manifest -> Manifest -> Bool
== :: Manifest -> Manifest -> Bool
$c== :: Manifest -> Manifest -> Bool
Eq, Int -> Manifest -> String -> String
[Manifest] -> String -> String
Manifest -> String
(Int -> Manifest -> String -> String)
-> (Manifest -> String)
-> ([Manifest] -> String -> String)
-> Show Manifest
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Manifest] -> String -> String
$cshowList :: [Manifest] -> String -> String
show :: Manifest -> String
$cshow :: Manifest -> String
showsPrec :: Int -> Manifest -> String -> String
$cshowsPrec :: Int -> Manifest -> String -> String
Show)

instance XP.XmlPickler Manifest where
  xpickle :: PU Manifest
xpickle = String -> PU Manifest -> PU Manifest
forall a. String -> PU a -> PU a
xpElem String
"Manifest" (PU Manifest -> PU Manifest) -> PU Manifest -> PU Manifest
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|(i, r) <-> Manifest i r|] 
    Bijection (->) (Maybe String, List1 Reference) Manifest
-> PU (Maybe String, List1 Reference) -> PU Manifest
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
      PU (Maybe String)
-> PU (List1 Reference) -> PU (Maybe String, List1 Reference)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Reference -> PU (List1 Reference)
forall a. PU a -> PU (List1 a)
xpList1 PU Reference
forall a. XmlPickler a => PU a
XP.xpickle)

-- |§5.2
data SignatureProperties = SignatureProperties
  { SignatureProperties -> Maybe String
signaturePropertiesId :: Maybe ID
  , SignatureProperties -> List1 SignatureProperty
signatureProperties :: List1 SignatureProperty
  } deriving (SignatureProperties -> SignatureProperties -> Bool
(SignatureProperties -> SignatureProperties -> Bool)
-> (SignatureProperties -> SignatureProperties -> Bool)
-> Eq SignatureProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureProperties -> SignatureProperties -> Bool
$c/= :: SignatureProperties -> SignatureProperties -> Bool
== :: SignatureProperties -> SignatureProperties -> Bool
$c== :: SignatureProperties -> SignatureProperties -> Bool
Eq, Int -> SignatureProperties -> String -> String
[SignatureProperties] -> String -> String
SignatureProperties -> String
(Int -> SignatureProperties -> String -> String)
-> (SignatureProperties -> String)
-> ([SignatureProperties] -> String -> String)
-> Show SignatureProperties
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SignatureProperties] -> String -> String
$cshowList :: [SignatureProperties] -> String -> String
show :: SignatureProperties -> String
$cshow :: SignatureProperties -> String
showsPrec :: Int -> SignatureProperties -> String -> String
$cshowsPrec :: Int -> SignatureProperties -> String -> String
Show)

instance XP.XmlPickler SignatureProperties where
  xpickle :: PU SignatureProperties
xpickle = String -> PU SignatureProperties -> PU SignatureProperties
forall a. String -> PU a -> PU a
xpElem String
"SignatureProperties" (PU SignatureProperties -> PU SignatureProperties)
-> PU SignatureProperties -> PU SignatureProperties
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|(i, p) <-> SignatureProperties i p|] 
    Bijection
  (->) (Maybe String, List1 SignatureProperty) SignatureProperties
-> PU (Maybe String, List1 SignatureProperty)
-> PU SignatureProperties
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
      PU (Maybe String)
-> PU (List1 SignatureProperty)
-> PU (Maybe String, List1 SignatureProperty)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU SignatureProperty -> PU (List1 SignatureProperty)
forall a. PU a -> PU (List1 a)
xpList1 PU SignatureProperty
forall a. XmlPickler a => PU a
XP.xpickle)

data SignatureProperty = SignatureProperty
  { SignatureProperty -> Maybe String
signaturePropertyId :: Maybe ID
  , SignatureProperty -> URI
signaturePropertyTarget :: AnyURI
  , SignatureProperty -> List1 Node
signatureProperty :: List1 Node
  } deriving (SignatureProperty -> SignatureProperty -> Bool
(SignatureProperty -> SignatureProperty -> Bool)
-> (SignatureProperty -> SignatureProperty -> Bool)
-> Eq SignatureProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureProperty -> SignatureProperty -> Bool
$c/= :: SignatureProperty -> SignatureProperty -> Bool
== :: SignatureProperty -> SignatureProperty -> Bool
$c== :: SignatureProperty -> SignatureProperty -> Bool
Eq, Int -> SignatureProperty -> String -> String
[SignatureProperty] -> String -> String
SignatureProperty -> String
(Int -> SignatureProperty -> String -> String)
-> (SignatureProperty -> String)
-> ([SignatureProperty] -> String -> String)
-> Show SignatureProperty
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SignatureProperty] -> String -> String
$cshowList :: [SignatureProperty] -> String -> String
show :: SignatureProperty -> String
$cshow :: SignatureProperty -> String
showsPrec :: Int -> SignatureProperty -> String -> String
$cshowsPrec :: Int -> SignatureProperty -> String -> String
Show)

instance XP.XmlPickler SignatureProperty where
  xpickle :: PU SignatureProperty
xpickle = String -> PU SignatureProperty -> PU SignatureProperty
forall a. String -> PU a -> PU a
xpElem String
"SignatureProperty" (PU SignatureProperty -> PU SignatureProperty)
-> PU SignatureProperty -> PU SignatureProperty
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|((i, t), x) <-> SignatureProperty i t x|] 
    Bijection (->) ((Maybe String, URI), List1 Node) SignatureProperty
-> PU ((Maybe String, URI), List1 Node) -> PU SignatureProperty
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Id" PU String
XS.xpID
      PU (Maybe String) -> PU URI -> PU (Maybe String, URI)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
XP.xpAttr String
"Target" PU URI
XS.xpAnyURI
      PU (Maybe String, URI)
-> PU (List1 Node) -> PU ((Maybe String, URI), List1 Node)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Node -> PU (List1 Node)
forall a. PU a -> PU (List1 a)
xpList1 PU Node
XP.xpTree)

-- |§6.1
data EncodingAlgorithm
  = EncodingBase64
  deriving (EncodingAlgorithm -> EncodingAlgorithm -> Bool
(EncodingAlgorithm -> EncodingAlgorithm -> Bool)
-> (EncodingAlgorithm -> EncodingAlgorithm -> Bool)
-> Eq EncodingAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncodingAlgorithm -> EncodingAlgorithm -> Bool
$c/= :: EncodingAlgorithm -> EncodingAlgorithm -> Bool
== :: EncodingAlgorithm -> EncodingAlgorithm -> Bool
$c== :: EncodingAlgorithm -> EncodingAlgorithm -> Bool
Eq, EncodingAlgorithm
EncodingAlgorithm -> EncodingAlgorithm -> Bounded EncodingAlgorithm
forall a. a -> a -> Bounded a
maxBound :: EncodingAlgorithm
$cmaxBound :: EncodingAlgorithm
minBound :: EncodingAlgorithm
$cminBound :: EncodingAlgorithm
Bounded, Int -> EncodingAlgorithm
EncodingAlgorithm -> Int
EncodingAlgorithm -> [EncodingAlgorithm]
EncodingAlgorithm -> EncodingAlgorithm
EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm]
EncodingAlgorithm
-> EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm]
(EncodingAlgorithm -> EncodingAlgorithm)
-> (EncodingAlgorithm -> EncodingAlgorithm)
-> (Int -> EncodingAlgorithm)
-> (EncodingAlgorithm -> Int)
-> (EncodingAlgorithm -> [EncodingAlgorithm])
-> (EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm])
-> (EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm])
-> (EncodingAlgorithm
    -> EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm])
-> Enum EncodingAlgorithm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EncodingAlgorithm
-> EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm]
$cenumFromThenTo :: EncodingAlgorithm
-> EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm]
enumFromTo :: EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm]
$cenumFromTo :: EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm]
enumFromThen :: EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm]
$cenumFromThen :: EncodingAlgorithm -> EncodingAlgorithm -> [EncodingAlgorithm]
enumFrom :: EncodingAlgorithm -> [EncodingAlgorithm]
$cenumFrom :: EncodingAlgorithm -> [EncodingAlgorithm]
fromEnum :: EncodingAlgorithm -> Int
$cfromEnum :: EncodingAlgorithm -> Int
toEnum :: Int -> EncodingAlgorithm
$ctoEnum :: Int -> EncodingAlgorithm
pred :: EncodingAlgorithm -> EncodingAlgorithm
$cpred :: EncodingAlgorithm -> EncodingAlgorithm
succ :: EncodingAlgorithm -> EncodingAlgorithm
$csucc :: EncodingAlgorithm -> EncodingAlgorithm
Enum, Int -> EncodingAlgorithm -> String -> String
[EncodingAlgorithm] -> String -> String
EncodingAlgorithm -> String
(Int -> EncodingAlgorithm -> String -> String)
-> (EncodingAlgorithm -> String)
-> ([EncodingAlgorithm] -> String -> String)
-> Show EncodingAlgorithm
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EncodingAlgorithm] -> String -> String
$cshowList :: [EncodingAlgorithm] -> String -> String
show :: EncodingAlgorithm -> String
$cshow :: EncodingAlgorithm -> String
showsPrec :: Int -> EncodingAlgorithm -> String -> String
$cshowsPrec :: Int -> EncodingAlgorithm -> String -> String
Show)

instance Identifiable URI EncodingAlgorithm where
  identifier :: EncodingAlgorithm -> URI
identifier EncodingAlgorithm
EncodingBase64 = String -> URI
nsFrag String
"base64"

-- |§6.2
data DigestAlgorithm
  = DigestSHA1 -- ^§6.2.1
  | DigestSHA224 -- ^§6.2.2
  | DigestSHA256 -- ^§6.2.3
  | DigestSHA384 -- ^§6.2.4
  | DigestSHA512 -- ^§6.2.5
  | DigestRIPEMD160 -- ^xmlenc §5.7.4
  deriving (DigestAlgorithm -> DigestAlgorithm -> Bool
(DigestAlgorithm -> DigestAlgorithm -> Bool)
-> (DigestAlgorithm -> DigestAlgorithm -> Bool)
-> Eq DigestAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DigestAlgorithm -> DigestAlgorithm -> Bool
$c/= :: DigestAlgorithm -> DigestAlgorithm -> Bool
== :: DigestAlgorithm -> DigestAlgorithm -> Bool
$c== :: DigestAlgorithm -> DigestAlgorithm -> Bool
Eq, DigestAlgorithm
DigestAlgorithm -> DigestAlgorithm -> Bounded DigestAlgorithm
forall a. a -> a -> Bounded a
maxBound :: DigestAlgorithm
$cmaxBound :: DigestAlgorithm
minBound :: DigestAlgorithm
$cminBound :: DigestAlgorithm
Bounded, Int -> DigestAlgorithm
DigestAlgorithm -> Int
DigestAlgorithm -> [DigestAlgorithm]
DigestAlgorithm -> DigestAlgorithm
DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm]
DigestAlgorithm
-> DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm]
(DigestAlgorithm -> DigestAlgorithm)
-> (DigestAlgorithm -> DigestAlgorithm)
-> (Int -> DigestAlgorithm)
-> (DigestAlgorithm -> Int)
-> (DigestAlgorithm -> [DigestAlgorithm])
-> (DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm])
-> (DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm])
-> (DigestAlgorithm
    -> DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm])
-> Enum DigestAlgorithm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DigestAlgorithm
-> DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm]
$cenumFromThenTo :: DigestAlgorithm
-> DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm]
enumFromTo :: DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm]
$cenumFromTo :: DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm]
enumFromThen :: DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm]
$cenumFromThen :: DigestAlgorithm -> DigestAlgorithm -> [DigestAlgorithm]
enumFrom :: DigestAlgorithm -> [DigestAlgorithm]
$cenumFrom :: DigestAlgorithm -> [DigestAlgorithm]
fromEnum :: DigestAlgorithm -> Int
$cfromEnum :: DigestAlgorithm -> Int
toEnum :: Int -> DigestAlgorithm
$ctoEnum :: Int -> DigestAlgorithm
pred :: DigestAlgorithm -> DigestAlgorithm
$cpred :: DigestAlgorithm -> DigestAlgorithm
succ :: DigestAlgorithm -> DigestAlgorithm
$csucc :: DigestAlgorithm -> DigestAlgorithm
Enum, Int -> DigestAlgorithm -> String -> String
[DigestAlgorithm] -> String -> String
DigestAlgorithm -> String
(Int -> DigestAlgorithm -> String -> String)
-> (DigestAlgorithm -> String)
-> ([DigestAlgorithm] -> String -> String)
-> Show DigestAlgorithm
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DigestAlgorithm] -> String -> String
$cshowList :: [DigestAlgorithm] -> String -> String
show :: DigestAlgorithm -> String
$cshow :: DigestAlgorithm -> String
showsPrec :: Int -> DigestAlgorithm -> String -> String
$cshowsPrec :: Int -> DigestAlgorithm -> String -> String
Show)

instance Identifiable URI DigestAlgorithm where
  identifier :: DigestAlgorithm -> URI
identifier DigestAlgorithm
DigestSHA1 = String -> URI
nsFrag String
"sha1"
  identifier DigestAlgorithm
DigestSHA224 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#sha224"
  identifier DigestAlgorithm
DigestSHA256 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmlenc" String
"" String
"#sha256"
  identifier DigestAlgorithm
DigestSHA384 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#sha384"
  identifier DigestAlgorithm
DigestSHA512 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmlenc" String
"" String
"#sha512"
  identifier DigestAlgorithm
DigestRIPEMD160 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmlenc" String
"" String
"#ripemd160"

-- |§6.3
data MACAlgorithm
  = MACHMAC_SHA1 -- ^§6.3.1
  deriving (MACAlgorithm -> MACAlgorithm -> Bool
(MACAlgorithm -> MACAlgorithm -> Bool)
-> (MACAlgorithm -> MACAlgorithm -> Bool) -> Eq MACAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MACAlgorithm -> MACAlgorithm -> Bool
$c/= :: MACAlgorithm -> MACAlgorithm -> Bool
== :: MACAlgorithm -> MACAlgorithm -> Bool
$c== :: MACAlgorithm -> MACAlgorithm -> Bool
Eq, MACAlgorithm
MACAlgorithm -> MACAlgorithm -> Bounded MACAlgorithm
forall a. a -> a -> Bounded a
maxBound :: MACAlgorithm
$cmaxBound :: MACAlgorithm
minBound :: MACAlgorithm
$cminBound :: MACAlgorithm
Bounded, Int -> MACAlgorithm
MACAlgorithm -> Int
MACAlgorithm -> [MACAlgorithm]
MACAlgorithm -> MACAlgorithm
MACAlgorithm -> MACAlgorithm -> [MACAlgorithm]
MACAlgorithm -> MACAlgorithm -> MACAlgorithm -> [MACAlgorithm]
(MACAlgorithm -> MACAlgorithm)
-> (MACAlgorithm -> MACAlgorithm)
-> (Int -> MACAlgorithm)
-> (MACAlgorithm -> Int)
-> (MACAlgorithm -> [MACAlgorithm])
-> (MACAlgorithm -> MACAlgorithm -> [MACAlgorithm])
-> (MACAlgorithm -> MACAlgorithm -> [MACAlgorithm])
-> (MACAlgorithm -> MACAlgorithm -> MACAlgorithm -> [MACAlgorithm])
-> Enum MACAlgorithm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MACAlgorithm -> MACAlgorithm -> MACAlgorithm -> [MACAlgorithm]
$cenumFromThenTo :: MACAlgorithm -> MACAlgorithm -> MACAlgorithm -> [MACAlgorithm]
enumFromTo :: MACAlgorithm -> MACAlgorithm -> [MACAlgorithm]
$cenumFromTo :: MACAlgorithm -> MACAlgorithm -> [MACAlgorithm]
enumFromThen :: MACAlgorithm -> MACAlgorithm -> [MACAlgorithm]
$cenumFromThen :: MACAlgorithm -> MACAlgorithm -> [MACAlgorithm]
enumFrom :: MACAlgorithm -> [MACAlgorithm]
$cenumFrom :: MACAlgorithm -> [MACAlgorithm]
fromEnum :: MACAlgorithm -> Int
$cfromEnum :: MACAlgorithm -> Int
toEnum :: Int -> MACAlgorithm
$ctoEnum :: Int -> MACAlgorithm
pred :: MACAlgorithm -> MACAlgorithm
$cpred :: MACAlgorithm -> MACAlgorithm
succ :: MACAlgorithm -> MACAlgorithm
$csucc :: MACAlgorithm -> MACAlgorithm
Enum, Int -> MACAlgorithm -> String -> String
[MACAlgorithm] -> String -> String
MACAlgorithm -> String
(Int -> MACAlgorithm -> String -> String)
-> (MACAlgorithm -> String)
-> ([MACAlgorithm] -> String -> String)
-> Show MACAlgorithm
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MACAlgorithm] -> String -> String
$cshowList :: [MACAlgorithm] -> String -> String
show :: MACAlgorithm -> String
$cshow :: MACAlgorithm -> String
showsPrec :: Int -> MACAlgorithm -> String -> String
$cshowsPrec :: Int -> MACAlgorithm -> String -> String
Show)

instance Identifiable URI MACAlgorithm where
  identifier :: MACAlgorithm -> URI
identifier MACAlgorithm
MACHMAC_SHA1 = String -> URI
nsFrag String
"hmac-sha1"

-- |§6.4
data SignatureAlgorithm
  = SignatureDSA_SHA1
  | SignatureDSA_SHA256
  | SignatureRSA_SHA1
  | SignatureRSA_SHA224
  | SignatureRSA_SHA256
  | SignatureRSA_SHA384
  | SignatureRSA_SHA512
  | SignatureECDSA_SHA1
  | SignatureECDSA_SHA224
  | SignatureECDSA_SHA256
  | SignatureECDSA_SHA384
  | SignatureECDSA_SHA512
  deriving (SignatureAlgorithm -> SignatureAlgorithm -> Bool
(SignatureAlgorithm -> SignatureAlgorithm -> Bool)
-> (SignatureAlgorithm -> SignatureAlgorithm -> Bool)
-> Eq SignatureAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureAlgorithm -> SignatureAlgorithm -> Bool
$c/= :: SignatureAlgorithm -> SignatureAlgorithm -> Bool
== :: SignatureAlgorithm -> SignatureAlgorithm -> Bool
$c== :: SignatureAlgorithm -> SignatureAlgorithm -> Bool
Eq, SignatureAlgorithm
SignatureAlgorithm
-> SignatureAlgorithm -> Bounded SignatureAlgorithm
forall a. a -> a -> Bounded a
maxBound :: SignatureAlgorithm
$cmaxBound :: SignatureAlgorithm
minBound :: SignatureAlgorithm
$cminBound :: SignatureAlgorithm
Bounded, Int -> SignatureAlgorithm
SignatureAlgorithm -> Int
SignatureAlgorithm -> [SignatureAlgorithm]
SignatureAlgorithm -> SignatureAlgorithm
SignatureAlgorithm -> SignatureAlgorithm -> [SignatureAlgorithm]
SignatureAlgorithm
-> SignatureAlgorithm -> SignatureAlgorithm -> [SignatureAlgorithm]
(SignatureAlgorithm -> SignatureAlgorithm)
-> (SignatureAlgorithm -> SignatureAlgorithm)
-> (Int -> SignatureAlgorithm)
-> (SignatureAlgorithm -> Int)
-> (SignatureAlgorithm -> [SignatureAlgorithm])
-> (SignatureAlgorithm
    -> SignatureAlgorithm -> [SignatureAlgorithm])
-> (SignatureAlgorithm
    -> SignatureAlgorithm -> [SignatureAlgorithm])
-> (SignatureAlgorithm
    -> SignatureAlgorithm
    -> SignatureAlgorithm
    -> [SignatureAlgorithm])
-> Enum SignatureAlgorithm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SignatureAlgorithm
-> SignatureAlgorithm -> SignatureAlgorithm -> [SignatureAlgorithm]
$cenumFromThenTo :: SignatureAlgorithm
-> SignatureAlgorithm -> SignatureAlgorithm -> [SignatureAlgorithm]
enumFromTo :: SignatureAlgorithm -> SignatureAlgorithm -> [SignatureAlgorithm]
$cenumFromTo :: SignatureAlgorithm -> SignatureAlgorithm -> [SignatureAlgorithm]
enumFromThen :: SignatureAlgorithm -> SignatureAlgorithm -> [SignatureAlgorithm]
$cenumFromThen :: SignatureAlgorithm -> SignatureAlgorithm -> [SignatureAlgorithm]
enumFrom :: SignatureAlgorithm -> [SignatureAlgorithm]
$cenumFrom :: SignatureAlgorithm -> [SignatureAlgorithm]
fromEnum :: SignatureAlgorithm -> Int
$cfromEnum :: SignatureAlgorithm -> Int
toEnum :: Int -> SignatureAlgorithm
$ctoEnum :: Int -> SignatureAlgorithm
pred :: SignatureAlgorithm -> SignatureAlgorithm
$cpred :: SignatureAlgorithm -> SignatureAlgorithm
succ :: SignatureAlgorithm -> SignatureAlgorithm
$csucc :: SignatureAlgorithm -> SignatureAlgorithm
Enum, Int -> SignatureAlgorithm -> String -> String
[SignatureAlgorithm] -> String -> String
SignatureAlgorithm -> String
(Int -> SignatureAlgorithm -> String -> String)
-> (SignatureAlgorithm -> String)
-> ([SignatureAlgorithm] -> String -> String)
-> Show SignatureAlgorithm
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SignatureAlgorithm] -> String -> String
$cshowList :: [SignatureAlgorithm] -> String -> String
show :: SignatureAlgorithm -> String
$cshow :: SignatureAlgorithm -> String
showsPrec :: Int -> SignatureAlgorithm -> String -> String
$cshowsPrec :: Int -> SignatureAlgorithm -> String -> String
Show)

instance Identifiable URI SignatureAlgorithm where
  identifier :: SignatureAlgorithm -> URI
identifier SignatureAlgorithm
SignatureDSA_SHA1 = String -> URI
nsFrag String
"dsa-sha1"
  identifier SignatureAlgorithm
SignatureDSA_SHA256 = String -> URI
nsFrag11 String
"dsa-sha256"
  identifier SignatureAlgorithm
SignatureRSA_SHA1 = String -> URI
nsFrag String
"rsa-sha1"
  identifier SignatureAlgorithm
SignatureRSA_SHA224 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#rsa-sha224"
  identifier SignatureAlgorithm
SignatureRSA_SHA256 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#rsa-sha256"
  identifier SignatureAlgorithm
SignatureRSA_SHA384 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#rsa-sha384"
  identifier SignatureAlgorithm
SignatureRSA_SHA512 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#rsa-sha512"
  identifier SignatureAlgorithm
SignatureECDSA_SHA1   = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#ecdsa-sha1"
  identifier SignatureAlgorithm
SignatureECDSA_SHA224 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#ecdsa-sha224"
  identifier SignatureAlgorithm
SignatureECDSA_SHA256 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#ecdsa-sha256"
  identifier SignatureAlgorithm
SignatureECDSA_SHA384 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#ecdsa-sha384"
  identifier SignatureAlgorithm
SignatureECDSA_SHA512 = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2001/04/xmldsig-more" String
"" String
"#ecdsa-sha512"

-- |§6.6
data TransformAlgorithm
  = TransformCanonicalization C14N.CanonicalizationAlgorithm -- ^§6.6.1
  | TransformBase64 -- ^§6.6.2
  | TransformXPath -- ^§6.6.3
  | TransformEnvelopedSignature -- ^§6.6.4
  | TransformXSLT -- ^§6.6.5
  deriving (TransformAlgorithm -> TransformAlgorithm -> Bool
(TransformAlgorithm -> TransformAlgorithm -> Bool)
-> (TransformAlgorithm -> TransformAlgorithm -> Bool)
-> Eq TransformAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransformAlgorithm -> TransformAlgorithm -> Bool
$c/= :: TransformAlgorithm -> TransformAlgorithm -> Bool
== :: TransformAlgorithm -> TransformAlgorithm -> Bool
$c== :: TransformAlgorithm -> TransformAlgorithm -> Bool
Eq, Int -> TransformAlgorithm -> String -> String
[TransformAlgorithm] -> String -> String
TransformAlgorithm -> String
(Int -> TransformAlgorithm -> String -> String)
-> (TransformAlgorithm -> String)
-> ([TransformAlgorithm] -> String -> String)
-> Show TransformAlgorithm
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TransformAlgorithm] -> String -> String
$cshowList :: [TransformAlgorithm] -> String -> String
show :: TransformAlgorithm -> String
$cshow :: TransformAlgorithm -> String
showsPrec :: Int -> TransformAlgorithm -> String -> String
$cshowsPrec :: Int -> TransformAlgorithm -> String -> String
Show)

instance Identifiable URI TransformAlgorithm where
  identifier :: TransformAlgorithm -> URI
identifier (TransformCanonicalization CanonicalizationAlgorithm
c) = CanonicalizationAlgorithm -> URI
forall b a. Identifiable b a => a -> b
identifier CanonicalizationAlgorithm
c
  identifier TransformAlgorithm
TransformBase64 = String -> URI
nsFrag String
"base64"
  identifier TransformAlgorithm
TransformXPath = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/TR/1999/REC-xpath-19991116" String
"" String
""
  identifier TransformAlgorithm
TransformEnvelopedSignature = String -> URI
nsFrag String
"enveloped-signature"
  identifier TransformAlgorithm
TransformXSLT = String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/TR/1999/REC-xslt-19991116" String
"" String
""
  identifiedValues :: [TransformAlgorithm]
identifiedValues =
    (CanonicalizationAlgorithm -> TransformAlgorithm)
-> [CanonicalizationAlgorithm] -> [TransformAlgorithm]
forall a b. (a -> b) -> [a] -> [b]
map CanonicalizationAlgorithm -> TransformAlgorithm
TransformCanonicalization [CanonicalizationAlgorithm]
forall b a. Identifiable b a => [a]
identifiedValues [TransformAlgorithm]
-> [TransformAlgorithm] -> [TransformAlgorithm]
forall a. [a] -> [a] -> [a]
++
    [ TransformAlgorithm
TransformBase64
    , TransformAlgorithm
TransformXSLT
    , TransformAlgorithm
TransformXPath
    , TransformAlgorithm
TransformEnvelopedSignature
    ]