-- | Stability: experimental
-- | This module defines some types from the [Web IDL](https://webidl.spec.whatwg.org/) specification
module Crypto.WebAuthn.WebIDL
  ( DOMString,
    USVString,
    UnsignedLongLong,
    UnsignedLong,
    Long,
    UnsignedShort,
    Octet,
    Boolean,
    Crypto.WebAuthn.WebIDL.Double,
    BufferSource (..),
    ArrayBuffer,
  )
where

import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64.URL as Base64
import Data.Int (Int32)
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import Data.Word (Word16, Word32, Word64, Word8)

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-DOMString)
-- The `[DOMString](https://webidl.spec.whatwg.org/#idl-DOMString)` type
-- corresponds to the set of all possible sequences of
-- [code units](https://webidl.spec.whatwg.org/#dfn-code-unit). Such sequences
-- are commonly interpreted as UTF-16 encoded strings
-- [RFC2781](https://webidl.spec.whatwg.org/#biblio-rfc2781) although this is not required.
-- TODO: This implementation doesn't allow invalid UTF-16 codepoints, which
-- probably makes it not work regarding <https://www.w3.org/TR/webauthn-2/#sctn-strings>
-- Write a test case that doesn't work and find a better representation.
type DOMString = Text

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-USVString)
-- The `[USVString](https://webidl.spec.whatwg.org/#idl-USVString)` type
-- corresponds to the set of all possible sequences of
-- [Unicode scalar values](http://www.unicode.org/glossary/#unicode_scalar_value),
-- which are all of the Unicode code points apart from the surrogate code points.
-- TODO: This implementation allows for surrogate code points. Figure out if
-- this can violate the spec in any way.
type USVString = Text

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-long)
type UnsignedLong = Word32

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-long)
type UnsignedLongLong = Word64

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-long)
type Long = Int32

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-unsigned-short)
type UnsignedShort = Word16

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-octet)
type Octet = Word8

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-boolean)
type Boolean = Bool

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-double)
type Double = Prelude.Double

-- | [(spec)](https://webidl.spec.whatwg.org/#BufferSource)
newtype BufferSource = -- | base64url encoded buffersource as done by https://github.com/github/webauthn-json
  URLEncodedBase64 {BufferSource -> ByteString
unUrlEncodedBase64 :: BS.ByteString}
  deriving (Int -> BufferSource -> ShowS
[BufferSource] -> ShowS
BufferSource -> String
(Int -> BufferSource -> ShowS)
-> (BufferSource -> String)
-> ([BufferSource] -> ShowS)
-> Show BufferSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufferSource] -> ShowS
$cshowList :: [BufferSource] -> ShowS
show :: BufferSource -> String
$cshow :: BufferSource -> String
showsPrec :: Int -> BufferSource -> ShowS
$cshowsPrec :: Int -> BufferSource -> ShowS
Show, BufferSource -> BufferSource -> Bool
(BufferSource -> BufferSource -> Bool)
-> (BufferSource -> BufferSource -> Bool) -> Eq BufferSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufferSource -> BufferSource -> Bool
$c/= :: BufferSource -> BufferSource -> Bool
== :: BufferSource -> BufferSource -> Bool
$c== :: BufferSource -> BufferSource -> Bool
Eq)

instance Aeson.FromJSON BufferSource where
  parseJSON :: Value -> Parser BufferSource
parseJSON = String
-> (Text -> Parser BufferSource) -> Value -> Parser BufferSource
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"base64url" ((Text -> Parser BufferSource) -> Value -> Parser BufferSource)
-> (Text -> Parser BufferSource) -> Value -> Parser BufferSource
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    (String -> Parser BufferSource)
-> (ByteString -> Parser BufferSource)
-> Either String ByteString
-> Parser BufferSource
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser BufferSource
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (BufferSource -> Parser BufferSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BufferSource -> Parser BufferSource)
-> (ByteString -> BufferSource)
-> ByteString
-> Parser BufferSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BufferSource
URLEncodedBase64) (ByteString -> Either String ByteString
Base64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
t)

instance Aeson.ToJSON BufferSource where
  toJSON :: BufferSource -> Value
toJSON (URLEncodedBase64 ByteString
bs) = Text -> Value
Aeson.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
Base64.encodeUnpadded (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString
bs

-- | [(spec)](https://webidl.spec.whatwg.org/#idl-ArrayBuffer)
type ArrayBuffer = BufferSource