{-# LANGUAGE DerivingStrategies #-}

module Network.OAuth2.Experiment.Flows.DeviceAuthorizationRequest where

import Control.Applicative
import Data.Aeson.Types
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Text.Lazy (Text)
import Network.OAuth2.Experiment.Types
import URI.ByteString hiding (UserInfo)

-------------------------------------------------------------------------------
--                    Device Authorization Request                           --
-------------------------------------------------------------------------------
newtype DeviceCode = DeviceCode Text
  deriving newtype (Maybe DeviceCode
Value -> Parser [DeviceCode]
Value -> Parser DeviceCode
(Value -> Parser DeviceCode)
-> (Value -> Parser [DeviceCode])
-> Maybe DeviceCode
-> FromJSON DeviceCode
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DeviceCode
parseJSON :: Value -> Parser DeviceCode
$cparseJSONList :: Value -> Parser [DeviceCode]
parseJSONList :: Value -> Parser [DeviceCode]
$comittedField :: Maybe DeviceCode
omittedField :: Maybe DeviceCode
FromJSON)

instance ToQueryParam DeviceCode where
  toQueryParam :: DeviceCode -> Map Text Text
  toQueryParam :: DeviceCode -> Map Text Text
toQueryParam (DeviceCode Text
dc) = Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
"device_code" Text
dc

-- | https://www.rfc-editor.org/rfc/rfc8628#section-3.2
data DeviceAuthorizationResponse = DeviceAuthorizationResponse
  { DeviceAuthorizationResponse -> DeviceCode
deviceCode :: DeviceCode
  , DeviceAuthorizationResponse -> Text
userCode :: Text
  , DeviceAuthorizationResponse -> URI
verificationUri :: URI
  , DeviceAuthorizationResponse -> Maybe URI
verificationUriComplete :: Maybe URI
  , DeviceAuthorizationResponse -> Integer
expiresIn :: Integer
  , DeviceAuthorizationResponse -> Maybe Int
interval :: Maybe Int
  }

instance FromJSON DeviceAuthorizationResponse where
  parseJSON :: Value -> Parser DeviceAuthorizationResponse
  parseJSON :: Value -> Parser DeviceAuthorizationResponse
parseJSON = String
-> (Object -> Parser DeviceAuthorizationResponse)
-> Value
-> Parser DeviceAuthorizationResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"parse DeviceAuthorizationResponse" ((Object -> Parser DeviceAuthorizationResponse)
 -> Value -> Parser DeviceAuthorizationResponse)
-> (Object -> Parser DeviceAuthorizationResponse)
-> Value
-> Parser DeviceAuthorizationResponse
forall a b. (a -> b) -> a -> b
$ \Object
t -> do
    DeviceCode
deviceCode <- Object
t Object -> Key -> Parser DeviceCode
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"device_code"
    Text
userCode <- Object
t Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_code"
    -- https://stackoverflow.com/questions/76696956/shall-it-be-verification-uri-instead-of-verification-url-in-the-device-autho
    URI
verificationUri <- Object
t Object -> Key -> Parser URI
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"verification_uri" Parser URI -> Parser URI -> Parser URI
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
t Object -> Key -> Parser URI
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"verification_url"
    Maybe URI
verificationUriComplete <- Object
t Object -> Key -> Parser (Maybe URI)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verification_uri_complete"
    Integer
expiresIn <- Object
t Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expires_in"
    Maybe Int
interval <- Object
t Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"interval"
    DeviceAuthorizationResponse -> Parser DeviceAuthorizationResponse
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeviceAuthorizationResponse {Integer
Maybe Int
Maybe URI
Text
URI
DeviceCode
deviceCode :: DeviceCode
userCode :: Text
verificationUri :: URI
verificationUriComplete :: Maybe URI
expiresIn :: Integer
interval :: Maybe Int
deviceCode :: DeviceCode
userCode :: Text
verificationUri :: URI
verificationUriComplete :: Maybe URI
expiresIn :: Integer
interval :: Maybe Int
..}

data DeviceAuthorizationRequestParam = DeviceAuthorizationRequestParam
  { DeviceAuthorizationRequestParam -> Set Scope
darScope :: Set Scope
  , DeviceAuthorizationRequestParam -> Maybe ClientId
darClientId :: Maybe ClientId
  , DeviceAuthorizationRequestParam -> Map Text Text
darExtraParams :: Map Text Text
  }

instance ToQueryParam DeviceAuthorizationRequestParam where
  toQueryParam :: DeviceAuthorizationRequestParam -> Map Text Text
  toQueryParam :: DeviceAuthorizationRequestParam -> Map Text Text
toQueryParam DeviceAuthorizationRequestParam {Maybe ClientId
Map Text Text
Set Scope
darScope :: DeviceAuthorizationRequestParam -> Set Scope
darClientId :: DeviceAuthorizationRequestParam -> Maybe ClientId
darExtraParams :: DeviceAuthorizationRequestParam -> Map Text Text
darScope :: Set Scope
darClientId :: Maybe ClientId
darExtraParams :: Map Text Text
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ Set Scope -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
darScope
      , Maybe ClientId -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Maybe ClientId
darClientId
      , Map Text Text
darExtraParams
      ]