{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrettyHexByteString -> PrettyHexByteString -> Bool
$c/= :: PrettyHexByteString -> PrettyHexByteString -> Bool
== :: PrettyHexByteString -> PrettyHexByteString -> Bool
$c== :: PrettyHexByteString -> PrettyHexByteString -> Bool
Eq)
instance ToJSON PrettyHexByteString where
toJSON :: PrettyHexByteString -> Value
toJSON (PrettyHexByteString ByteString
bytes) = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode forall a b. (a -> b) -> a -> b
$ ByteString
bytes
instance Show PrettyHexByteString where
show :: PrettyHexByteString -> String
show (PrettyHexByteString ByteString
bytes) = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode forall a b. (a -> b) -> a -> b
$ ByteString
bytes
instance ToJSON (Digest h) where
toJSON :: Digest h -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
X509.signedObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
PubKey
DistinguishedName
Extensions
SignatureALG
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
certExtensions :: Extensions
certPubKey :: PubKey
certSubjectDN :: DistinguishedName
certValidity :: (DateTime, DateTime)
certIssuerDN :: DistinguishedName
certSignatureAlg :: SignatureALG
certSerial :: Integer
certVersion :: Int
..} =
[Pair] -> Value
object
[ Key
"certIssuerDN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DistinguishedName
certIssuerDN,
Key
"certValidity"
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
[ Key
"notBefore" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a, b) -> a
fst (DateTime, DateTime)
certValidity,
Key
"notAfter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a, b) -> b
snd (DateTime, DateTime)
certValidity
],
Key
"certSubjectDN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DistinguishedName
certSubjectDN,
Key
"certExtensions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Extensions
certExtensions
]
instance ToJSON X509.FailedReason where
toJSON :: FailedReason -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance ToJSON X509.Extensions where
toJSON :: Extensions -> Value
toJSON (X509.Extensions Maybe [ExtensionRaw]
raws) = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ 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 :: ExtensionRaw -> OID
extRawCritical :: ExtensionRaw -> Bool
extRawContent :: ExtensionRaw -> ByteString
extRawContent :: ByteString
extRawCritical :: Bool
extRawOID :: OID
..} =
[Pair] -> Value
object
[ Key
"extRawOID" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OID -> Value
oidToJSON OID
extRawOID,
Key
"extRawContent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> PrettyHexByteString
PrettyHexByteString ByteString
extRawContent
]
instance ToJSON ECC.CurveName where
toJSON :: CurveName -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
oidToJSON :: ASN1.OID -> Value
oidToJSON :: OID -> Value
oidToJSON OID
oid = Text -> Value
String forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show OID
oid
instance ToJSON HG.DateTime where
toJSON :: DateTime -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ 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 = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show DnElement
el
value :: Value
value = Text -> Value
String forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
str
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
]