module Data.X509.Signed
(
Signed(..)
, SignedExact
, getSigned
, getSignedData
, encodeSignedObject
, decodeSignedObject
, objectToSignedExact
, objectToSignedExactF
, objectToSigned
, signedToExact
) where
import Control.Arrow (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.X509.AlgorithmIdentifier
import Data.ASN1.Types
import Data.ASN1.Encoding
import Data.ASN1.BinaryEncoding
import Data.ASN1.Stream
import Data.ASN1.BitArray
import qualified Data.ASN1.BinaryEncoding.Raw as Raw (toByteString)
data (Show a, Eq a, ASN1Object a) => Signed a = Signed
{ forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject :: a
, forall a. (Show a, Eq a, ASN1Object a) => Signed a -> SignatureALG
signedAlg :: SignatureALG
, forall a. (Show a, Eq a, ASN1Object a) => Signed a -> ByteString
signedSignature :: B.ByteString
} deriving (Int -> Signed a -> ShowS
forall a. (Show a, Eq a, ASN1Object a) => Int -> Signed a -> ShowS
forall a. (Show a, Eq a, ASN1Object a) => [Signed a] -> ShowS
forall a. (Show a, Eq a, ASN1Object a) => Signed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signed a] -> ShowS
$cshowList :: forall a. (Show a, Eq a, ASN1Object a) => [Signed a] -> ShowS
show :: Signed a -> String
$cshow :: forall a. (Show a, Eq a, ASN1Object a) => Signed a -> String
showsPrec :: Int -> Signed a -> ShowS
$cshowsPrec :: forall a. (Show a, Eq a, ASN1Object a) => Int -> Signed a -> ShowS
Show, Signed a -> Signed a -> Bool
forall a.
(Show a, Eq a, ASN1Object a) =>
Signed a -> Signed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signed a -> Signed a -> Bool
$c/= :: forall a.
(Show a, Eq a, ASN1Object a) =>
Signed a -> Signed a -> Bool
== :: Signed a -> Signed a -> Bool
$c== :: forall a.
(Show a, Eq a, ASN1Object a) =>
Signed a -> Signed a -> Bool
Eq)
data (Show a, Eq a, ASN1Object a) => SignedExact a = SignedExact
{ forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned :: Signed a
, forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
exactObjectRaw :: B.ByteString
, forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
encodeSignedObject :: B.ByteString
} deriving (Int -> SignedExact a -> ShowS
forall a.
(Show a, Eq a, ASN1Object a) =>
Int -> SignedExact a -> ShowS
forall a. (Show a, Eq a, ASN1Object a) => [SignedExact a] -> ShowS
forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignedExact a] -> ShowS
$cshowList :: forall a. (Show a, Eq a, ASN1Object a) => [SignedExact a] -> ShowS
show :: SignedExact a -> String
$cshow :: forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> String
showsPrec :: Int -> SignedExact a -> ShowS
$cshowsPrec :: forall a.
(Show a, Eq a, ASN1Object a) =>
Int -> SignedExact a -> ShowS
Show, SignedExact a -> SignedExact a -> Bool
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> SignedExact a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignedExact a -> SignedExact a -> Bool
$c/= :: forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> SignedExact a -> Bool
== :: SignedExact a -> SignedExact a -> Bool
$c== :: forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> SignedExact a -> Bool
Eq)
getSignedData :: (Show a, Eq a, ASN1Object a)
=> SignedExact a
-> B.ByteString
getSignedData :: forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
getSignedData = forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
exactObjectRaw
signedToExact :: (Show a, Eq a, ASN1Object a)
=> Signed a
-> SignedExact a
signedToExact :: forall a. (Show a, Eq a, ASN1Object a) => Signed a -> SignedExact a
signedToExact Signed a
signed = SignedExact a
sExact
where (SignedExact a
sExact, ()) = forall a r.
(Show a, Eq a, ASN1Object a) =>
(ByteString -> (ByteString, SignatureALG, r))
-> a -> (SignedExact a, r)
objectToSignedExact forall {p}. p -> (ByteString, SignatureALG, ())
fakeSigFunction (forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject Signed a
signed)
fakeSigFunction :: p -> (ByteString, SignatureALG, ())
fakeSigFunction p
_ = (forall a. (Show a, Eq a, ASN1Object a) => Signed a -> ByteString
signedSignature Signed a
signed, forall a. (Show a, Eq a, ASN1Object a) => Signed a -> SignatureALG
signedAlg Signed a
signed, ())
objectToSignedExact :: (Show a, Eq a, ASN1Object a)
=> (ByteString -> (ByteString, SignatureALG, r))
-> a
-> (SignedExact a, r)
objectToSignedExact :: forall a r.
(Show a, Eq a, ASN1Object a) =>
(ByteString -> (ByteString, SignatureALG, r))
-> a -> (SignedExact a, r)
objectToSignedExact ByteString -> (ByteString, SignatureALG, r)
signatureFunction a
object = (SignedExact a
signedExact, r
val)
where
(r
val, SignedExact a
signedExact) = forall (f :: * -> *) a.
(Functor f, Show a, Eq a, ASN1Object a) =>
(ByteString -> f (ByteString, SignatureALG))
-> a -> f (SignedExact a)
objectToSignedExactF (forall {a} {b} {a}. (a, b, a) -> (a, (a, b))
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, SignatureALG, r)
signatureFunction) a
object
wrap :: (a, b, a) -> (a, (a, b))
wrap (a
b, b
s, a
r) = (a
r, (a
b, b
s))
objectToSignedExactF :: (Functor f, Show a, Eq a, ASN1Object a)
=> (ByteString -> f (ByteString, SignatureALG))
-> a
-> f (SignedExact a)
objectToSignedExactF :: forall (f :: * -> *) a.
(Functor f, Show a, Eq a, ASN1Object a) =>
(ByteString -> f (ByteString, SignatureALG))
-> a -> f (SignedExact a)
objectToSignedExactF ByteString -> f (ByteString, SignatureALG)
signatureFunction a
object = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, SignatureALG) -> SignedExact a
buildSignedExact (ByteString -> f (ByteString, SignatureALG)
signatureFunction ByteString
objRaw)
where buildSignedExact :: (ByteString, SignatureALG) -> SignedExact a
buildSignedExact (ByteString
sigBits,SignatureALG
sigAlg) =
let signed :: Signed a
signed = Signed { signedObject :: a
signedObject = a
object
, signedAlg :: SignatureALG
signedAlg = SignatureALG
sigAlg
, signedSignature :: ByteString
signedSignature = ByteString
sigBits
}
signedRaw :: ByteString
signedRaw = forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER [ASN1]
signedASN1
signedASN1 :: [ASN1]
signedASN1 = ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
forall a. a -> [a] -> [a]
: [ASN1] -> [ASN1]
objASN1
(forall a. ASN1Object a => a -> [ASN1] -> [ASN1]
toASN1 SignatureALG
sigAlg
(BitArray -> ASN1
BitString (ByteString -> Int -> BitArray
toBitArray ByteString
sigBits Int
0)
forall a. a -> [a] -> [a]
: ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
forall a. a -> [a] -> [a]
: []))
in forall a. Signed a -> ByteString -> ByteString -> SignedExact a
SignedExact Signed a
signed ByteString
objRaw ByteString
signedRaw
objASN1 :: [ASN1] -> [ASN1]
objASN1 = \[ASN1]
xs -> ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence forall a. a -> [a] -> [a]
: forall a. ASN1Object a => a -> [ASN1] -> [ASN1]
toASN1 a
object (ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence forall a. a -> [a] -> [a]
: [ASN1]
xs)
objRaw :: ByteString
objRaw = forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER ([ASN1] -> [ASN1]
objASN1 [])
objectToSigned :: (Show a, Eq a, ASN1Object a)
=> (ByteString
-> (ByteString, SignatureALG, r))
-> a
-> (Signed a, r)
objectToSigned :: forall a r.
(Show a, Eq a, ASN1Object a) =>
(ByteString -> (ByteString, SignatureALG, r)) -> a -> (Signed a, r)
objectToSigned ByteString -> (ByteString, SignatureALG, r)
signatureFunction a
object = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned forall a b. (a -> b) -> a -> b
$ forall a r.
(Show a, Eq a, ASN1Object a) =>
(ByteString -> (ByteString, SignatureALG, r))
-> a -> (SignedExact a, r)
objectToSignedExact ByteString -> (ByteString, SignatureALG, r)
signatureFunction a
object
decodeSignedObject :: (Show a, Eq a, ASN1Object a)
=> ByteString
-> Either String (SignedExact a)
decodeSignedObject :: forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
decodeSignedObject ByteString
b = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall {a}.
(Show a, Eq a, ASN1Object a) =>
[ASN1Repr] -> Either String (SignedExact a)
parseSigned forall a b. (a -> b) -> a -> b
$ forall a.
ASN1DecodingRepr a =>
a -> ByteString -> Either ASN1Error [ASN1Repr]
decodeASN1Repr' BER
BER ByteString
b
where
parseSigned :: [ASN1Repr] -> Either String (SignedExact a)
parseSigned [ASN1Repr]
l = forall {b} {b}. [(ASN1, b)] -> ([(ASN1, b)] -> b) -> b
onContainer (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr [ASN1Repr]
l) forall a b. (a -> b) -> a -> b
$ \[ASN1Repr]
l2 ->
let ([ASN1Repr]
objRepr,[ASN1Repr]
rem1) = [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr [ASN1Repr]
l2
([ASN1Repr]
sigAlgSeq,[ASN1Repr]
rem2) = [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr [ASN1Repr]
rem1
([ASN1Repr]
sigSeq,[ASN1Repr]
_) = [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr [ASN1Repr]
rem2
obj :: Either String (a, [ASN1])
obj = forall {b} {b}. [(ASN1, b)] -> ([(ASN1, b)] -> b) -> b
onContainer [ASN1Repr]
objRepr (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst)
in case (Either String (a, [ASN1])
obj, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [ASN1Repr]
sigSeq) of
(Right (a
o,[]), [BitString BitArray
signature]) ->
let rawObj :: ByteString
rawObj = [ASN1Event] -> ByteString
Raw.toByteString forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [ASN1Repr]
objRepr
in case forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [ASN1Repr]
sigAlgSeq of
Left String
s -> forall a b. a -> Either a b
Left (String
"signed object error sigalg: " forall a. [a] -> [a] -> [a]
++ String
s)
Right (SignatureALG
sigAlg,[ASN1]
_) ->
let signed :: Signed a
signed = Signed
{ signedObject :: a
signedObject = a
o
, signedAlg :: SignatureALG
signedAlg = SignatureALG
sigAlg
, signedSignature :: ByteString
signedSignature = BitArray -> ByteString
bitArrayGetData BitArray
signature
}
in forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SignedExact
{ getSigned :: Signed a
getSigned = Signed a
signed
, exactObjectRaw :: ByteString
exactObjectRaw = ByteString
rawObj
, encodeSignedObject :: ByteString
encodeSignedObject = ByteString
b
}
(Right (a
_,[ASN1]
remObj), [ASN1]
_) ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ (String
"signed object error: remaining stream in object: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [ASN1]
remObj)
(Left String
err, [ASN1]
_) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ (String
"signed object error: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
err)
onContainer :: [(ASN1, b)] -> ([(ASN1, b)] -> b) -> b
onContainer ((Start ASN1ConstructionType
_, b
_) : [(ASN1, b)]
l) [(ASN1, b)] -> b
f =
case forall a. [a] -> [a]
reverse [(ASN1, b)]
l of
((End ASN1ConstructionType
_, b
_) : [(ASN1, b)]
l2) -> [(ASN1, b)] -> b
f forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [(ASN1, b)]
l2
[(ASN1, b)]
_ -> [(ASN1, b)] -> b
f []
onContainer [(ASN1, b)]
_ [(ASN1, b)] -> b
f = [(ASN1, b)] -> b
f []