{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Stability: internal
-- This module contain some useful orphan 'ToJSON' instances for pretty-printing values from third-party libraries
module Crypto.WebAuthn.Internal.ToJSONOrphans () 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

instance ToJSON BS.ByteString where
  toJSON :: ByteString -> 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

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
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
        ]