DeviceAuthorizationRequest.hs

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

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

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

instance FromJSON DeviceAuthorizationResponse where
  parseJSON :: Value -> Parser DeviceAuthorizationResponse
  parseJSON = withObject "parse DeviceAuthorizationResponse" $ \t -> do
    deviceCode <- t .: "device_code"
    userCode <- t .: "user_code"
    -- https://stackoverflow.com/questions/76696956/shall-it-be-verification-uri-instead-of-verification-url-in-the-device-autho
    verificationUri <- t .: "verification_uri" <|> t .: "verification_url"
    verificationUriComplete <- t .:? "verification_uri_complete"
    expiresIn <- t .: "expires_in"
    interval <- t .:? "interval"
    pure DeviceAuthorizationResponse {..}

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

instance ToQueryParam DeviceAuthorizationRequestParam where
  toQueryParam :: DeviceAuthorizationRequestParam -> Map Text Text
  toQueryParam DeviceAuthorizationRequestParam {..} =
    Map.unions
      [ toQueryParam darScope
      , toQueryParam darClientId
      , darExtraParams
      ]