{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Crypto.WebAuthn.Internal.ToJSONOrphans (PrettyHexByteString (..)) where
import Crypto.Hash (Digest)
import qualified Crypto.PubKey.ECC.Types as ECC
import Data.ASN1.Types (ASN1Object)
import qualified Data.ASN1.Types as ASN1
import Data.Aeson (ToJSON, Value (String), object, toJSON, (.=))
import Data.Aeson.Types (Pair)
import Data.ByteArray (convert)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.Hourglass as HG
import Data.List (intercalate)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.String (fromString)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.X509 as X509
import qualified Data.X509.Validation as X509
newtype PrettyHexByteString = PrettyHexByteString BS.ByteString
deriving newtype (PrettyHexByteString -> PrettyHexByteString -> Bool
(PrettyHexByteString -> PrettyHexByteString -> Bool)
-> (PrettyHexByteString -> PrettyHexByteString -> Bool)
-> Eq PrettyHexByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrettyHexByteString -> PrettyHexByteString -> Bool
== :: PrettyHexByteString -> PrettyHexByteString -> Bool
$c/= :: PrettyHexByteString -> PrettyHexByteString -> Bool
/= :: PrettyHexByteString -> PrettyHexByteString -> Bool
Eq)
instance ToJSON PrettyHexByteString where
toJSON :: PrettyHexByteString -> Value
toJSON (PrettyHexByteString ByteString
bytes) = Text -> Value
String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString
bytes
instance Show PrettyHexByteString where
show :: PrettyHexByteString -> String
show (PrettyHexByteString ByteString
bytes) = Text -> String
Text.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
bytes
instance ToJSON (Digest h) where
toJSON :: Digest h -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Digest h -> Text) -> Digest h -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (Digest h -> ByteString) -> Digest h -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (Digest h -> ByteString) -> Digest h -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest h -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert
instance (Eq a, Show a, ASN1Object a, ToJSON a) => ToJSON (X509.SignedExact a) where
toJSON :: SignedExact a -> Value
toJSON = a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> (SignedExact a -> a) -> SignedExact a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed a -> a
forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
X509.signedObject (Signed a -> a)
-> (SignedExact a -> Signed a) -> SignedExact a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedExact a -> Signed a
forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
X509.getSigned
instance ToJSON X509.Certificate where
toJSON :: Certificate -> Value
toJSON X509.Certificate {Int
Integer
(DateTime, DateTime)
SignatureALG
Extensions
DistinguishedName
PubKey
certVersion :: Int
certSerial :: Integer
certSignatureAlg :: SignatureALG
certIssuerDN :: DistinguishedName
certValidity :: (DateTime, DateTime)
certSubjectDN :: DistinguishedName
certPubKey :: PubKey
certExtensions :: Extensions
certVersion :: Certificate -> Int
certSerial :: Certificate -> Integer
certSignatureAlg :: Certificate -> SignatureALG
certIssuerDN :: Certificate -> DistinguishedName
certValidity :: Certificate -> (DateTime, DateTime)
certSubjectDN :: Certificate -> DistinguishedName
certPubKey :: Certificate -> PubKey
certExtensions :: Certificate -> Extensions
..} =
[Pair] -> Value
object
[ Key
"certIssuerDN" Key -> DistinguishedName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DistinguishedName
certIssuerDN,
Key
"certValidity"
Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
object
[ Key
"notBefore" Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (DateTime, DateTime) -> DateTime
forall a b. (a, b) -> a
fst (DateTime, DateTime)
certValidity,
Key
"notAfter" Key -> DateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (DateTime, DateTime) -> DateTime
forall a b. (a, b) -> b
snd (DateTime, DateTime)
certValidity
],
Key
"certSubjectDN" Key -> DistinguishedName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DistinguishedName
certSubjectDN,
Key
"certExtensions" Key -> Extensions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Extensions
certExtensions
]
instance ToJSON X509.FailedReason where
toJSON :: FailedReason -> Value
toJSON = Text -> Value
String (Text -> Value) -> (FailedReason -> Text) -> FailedReason -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text)
-> (FailedReason -> String) -> FailedReason -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailedReason -> String
forall a. Show a => a -> String
show
instance ToJSON X509.Extensions where
toJSON :: Extensions -> Value
toJSON (X509.Extensions Maybe [ExtensionRaw]
raws) = [ExtensionRaw] -> Value
forall a. ToJSON a => a -> Value
toJSON ([ExtensionRaw] -> Value) -> [ExtensionRaw] -> Value
forall a b. (a -> b) -> a -> b
$ [ExtensionRaw] -> Maybe [ExtensionRaw] -> [ExtensionRaw]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ExtensionRaw]
raws
instance ToJSON X509.ExtensionRaw where
toJSON :: ExtensionRaw -> Value
toJSON X509.ExtensionRaw {Bool
OID
ByteString
extRawOID :: OID
extRawCritical :: Bool
extRawContent :: ByteString
extRawOID :: ExtensionRaw -> OID
extRawCritical :: ExtensionRaw -> Bool
extRawContent :: ExtensionRaw -> ByteString
..} =
[Pair] -> Value
object
[ Key
"extRawOID" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= OID -> Value
oidToJSON OID
extRawOID,
Key
"extRawContent" Key -> PrettyHexByteString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ByteString -> PrettyHexByteString
PrettyHexByteString ByteString
extRawContent
]
instance ToJSON ECC.CurveName where
toJSON :: CurveName -> Value
toJSON = Text -> Value
String (Text -> Value) -> (CurveName -> Text) -> CurveName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (CurveName -> String) -> CurveName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurveName -> String
forall a. Show a => a -> String
show
oidToJSON :: ASN1.OID -> Value
oidToJSON :: OID -> Value
oidToJSON OID
oid = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Integer -> String) -> OID -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show OID
oid
instance ToJSON HG.DateTime where
toJSON :: DateTime -> Value
toJSON = Text -> Value
String (Text -> Value) -> (DateTime -> Text) -> DateTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (DateTime -> String) -> DateTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO8601_DateAndTime -> DateTime -> String
forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> String
HG.timePrint ISO8601_DateAndTime
HG.ISO8601_DateAndTime
instance ToJSON HG.Date where
toJSON :: Date -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Date -> Text) -> Date -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Date -> String) -> Date -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO8601_Date -> Date -> String
forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> String
HG.timePrint ISO8601_Date
HG.ISO8601_Date
instance ToJSON X509.DistinguishedName where
toJSON :: DistinguishedName -> Value
toJSON DistinguishedName
dn = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (DnElement -> Maybe Pair) -> [DnElement] -> [Pair]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DnElement -> Maybe Pair
getPair [DnElement]
dnElements
where
getPair :: X509.DnElement -> Maybe Pair
getPair :: DnElement -> Maybe Pair
getPair DnElement
el = do
ASN1CharacterString
asnStr <- DnElement -> DistinguishedName -> Maybe ASN1CharacterString
X509.getDnElement DnElement
el DistinguishedName
dn
String
str <- ASN1CharacterString -> Maybe String
ASN1.asn1CharacterToString ASN1CharacterString
asnStr
let key :: Key
key = String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ DnElement -> String
forall a. Show a => a -> String
show DnElement
el
value :: Value
value = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
str
Pair -> Maybe Pair
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key
key, Value
value)
dnElements :: [X509.DnElement]
dnElements :: [DnElement]
dnElements =
[ DnElement
X509.DnCommonName,
DnElement
X509.DnCountry,
DnElement
X509.DnOrganization,
DnElement
X509.DnOrganizationUnit,
DnElement
X509.DnEmailAddress
]