ToJSONOrphans.hs

{-# 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 (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

-- | This type holds a bytestring and has no restrictions to its contents. Its main purpose is to simplify debugging:
-- its 'Aeson.ToJSON' and 'Show' instances convert it to base16 (hexadecimal).
newtype PrettyHexByteString = PrettyHexByteString BS.ByteString
  deriving newtype (Eq)

instance ToJSON PrettyHexByteString where
  toJSON (PrettyHexByteString bytes) = String . Text.decodeUtf8 . Base16.encode $ bytes

instance Show PrettyHexByteString where
  show (PrettyHexByteString bytes) = Text.unpack . Text.decodeUtf8 . Base16.encode $ bytes

instance ToJSON (Digest h) where
  toJSON = String . Text.decodeUtf8 . Base16.encode . convert

instance (Eq a, Show a, ASN1Object a, ToJSON a) => ToJSON (X509.SignedExact a) where
  toJSON = toJSON . X509.signedObject . X509.getSigned

instance ToJSON X509.Certificate where
  toJSON X509.Certificate {..} =
    object
      [ "certIssuerDN" .= certIssuerDN,
        "certValidity"
          .= object
            [ "notBefore" .= fst certValidity,
              "notAfter" .= snd certValidity
            ],
        "certSubjectDN" .= certSubjectDN,
        "certExtensions" .= certExtensions
      ]

instance ToJSON X509.FailedReason where
  toJSON = String . Text.pack . show

instance ToJSON X509.Extensions where
  toJSON (X509.Extensions raws) = toJSON $ fromMaybe [] raws

instance ToJSON X509.ExtensionRaw where
  toJSON X509.ExtensionRaw {..} =
    object
      [ "extRawOID" .= oidToJSON extRawOID,
        "extRawContent" .= PrettyHexByteString extRawContent
      ]

instance ToJSON ECC.CurveName where
  toJSON = String . Text.pack . show

oidToJSON :: ASN1.OID -> Value
oidToJSON oid = String $ Text.pack $ intercalate "." $ map show oid

instance ToJSON HG.DateTime where
  toJSON = String . Text.pack . HG.timePrint HG.ISO8601_DateAndTime

instance ToJSON HG.Date where
  toJSON = String . Text.pack . HG.timePrint HG.ISO8601_Date

instance ToJSON X509.DistinguishedName where
  toJSON dn = object $ mapMaybe getPair dnElements
    where
      getPair :: X509.DnElement -> Maybe Pair
      getPair el = do
        asnStr <- X509.getDnElement el dn
        str <- ASN1.asn1CharacterToString asnStr
        let key = fromString $ show el
            value = String $ Text.pack str
        pure (key, value)

      dnElements :: [X509.DnElement]
      dnElements =
        [ X509.DnCommonName,
          X509.DnCountry,
          X509.DnOrganization,
          X509.DnOrganizationUnit,
          X509.DnEmailAddress
        ]