<commit_before>{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}

-- | Description: Data types for OAuth2 server.
module Network.OAuth2.Server.Types where

import Control.Applicative
import Control.Monad
import Data.Aeson
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock

-- | A scope is a list of strings.
newtype Scope = Scope { unScope :: Set Text }
  deriving (Eq, Show, Monoid)

-- | Construct a 'Scope' from a space-separated list.
mkScope :: Text -> Scope
mkScope t = Scope . S.fromList . T.splitOn " " $ t

-- | A token is a unique piece of text.
newtype Token = Token { unToken :: Text }
  deriving (Eq, Ord, Show)

-- | Grant types for OAuth2 requests.
data GrantType
    = GrantRefreshToken
    | GrantCode
    | GrantAuthorizationCode
    | GrantToken
    | GrantPassword
    | GrantClient
    | GrantExtension { grantName :: Text }

instance ToJSON GrantType where
    toJSON grant = String $ case grant of
        GrantRefreshToken -> "refresh_token"
        GrantCode -> "code"
        GrantAuthorizationCode -> "authorization_code"
        GrantToken -> "token"
        GrantPassword -> "password"
        GrantClient -> "client_credentials"
        GrantExtension g -> g

grantType :: Text -> GrantType
grantType t = case t of
    "refresh_token" -> GrantRefreshToken
    "code" -> GrantCode
    "authorization_code" -> GrantAuthorizationCode
    "token" -> GrantToken
    "password" -> GrantPassword
    "client_credentials" -> GrantClient
    g -> GrantExtension g

instance FromJSON GrantType where
    parseJSON (String t) = return $ grantType t
    parseJSON _ = mzero

-- | A request to the token endpoint.
--
-- Each constructor represents a different type of supported request. Not all
-- request types represented by 'GrantType' are supported, so some expected
-- 'AccessRequest' constructors are not implemented.
data AccessRequest
    = RequestPassword
        -- ^ 'GrantPassword'
        { requestClientID     :: Maybe Text
        , requestClientSecret :: Maybe Text
        , requestUsername     :: Text
        , requestPassword     :: Text
        , requestScope        :: Maybe Scope
        }
    | RequestClient
        { requestClientIDReq     :: Text
        , requestClientSecretReq :: Text
        , requestScope           :: Maybe Scope
        }
    | RequestRefresh
        -- ^ 'GrantRefreshToken'
        { requestRefreshToken :: Token
        , requestClientID     :: Maybe Text
        , requestClientSecret :: Maybe Text
        , requestScope        :: Maybe Scope
        }

-- | A response containing an OAuth2 access token grant.
data AccessResponse = AccessResponse<commit_msg>Add a 'are these compatible' fn<commit_after>{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}

-- | Description: Data types for OAuth2 server.
module Network.OAuth2.Server.Types where

import Control.Applicative
import Control.Monad
import Data.Aeson
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock

-- | A scope is a list of strings.
newtype Scope = Scope { unScope :: Set Text }
  deriving (Eq, Show, Monoid)

-- | Construct a 'Scope' from a space-separated list.
mkScope :: Text -> Scope
mkScope t = Scope . S.fromList . T.splitOn " " $ t

-- | Check that a 'Scope' is compatible with another.
--
-- Essentially, scope1 less scope2 is the empty set.
compatibleScope
    :: Scope
    -> Scope
    -> Bool
compatibleScope (Scope s1) (Scope s2) =
    S.null $ s1 `S.difference` s2

-- | A token is a unique piece of text.
newtype Token = Token { unToken :: Text }
  deriving (Eq, Ord, Show)

-- | Grant types for OAuth2 requests.
data GrantType
    = GrantRefreshToken
    | GrantCode
    | GrantAuthorizationCode
    | GrantToken
    | GrantPassword
    | GrantClient
    | GrantExtension { grantName :: Text }

instance ToJSON GrantType where
    toJSON grant = String $ case grant of
        GrantRefreshToken -> "refresh_token"
        GrantCode -> "code"
        GrantAuthorizationCode -> "authorization_code"
        GrantToken -> "token"
        GrantPassword -> "password"
        GrantClient -> "client_credentials"
        GrantExtension g -> g

grantType :: Text -> GrantType
grantType t = case t of
    "refresh_token" -> GrantRefreshToken
    "code" -> GrantCode
    "authorization_code" -> GrantAuthorizationCode
    "token" -> GrantToken
    "password" -> GrantPassword
    "client_credentials" -> GrantClient
    g -> GrantExtension g

instance FromJSON GrantType where
    parseJSON (String t) = return $ grantType t
    parseJSON _ = mzero

-- | A request to the token endpoint.
--
-- Each constructor represents a different type of supported request. Not all
-- request types represented by 'GrantType' are supported, so some expected
-- 'AccessRequest' constructors are not implemented.
data AccessRequest
    = RequestPassword
        -- ^ 'GrantPassword'
        { requestClientID     :: Maybe Text
        , requestClientSecret :: Maybe Text
        , requestUsername     :: Text
        , requestPassword     :: Text
        , requestScope        :: Maybe Scope
        }
    | RequestClient
        { requestClientIDReq     :: Text
        , requestClientSecretReq :: Text
        , requestScope           :: Maybe Scope
        }
    | RequestRefresh
        -- ^ 'GrantRefreshToken'
        { requestClientID     :: Maybe Text
        , requestClientSecret :: Maybe Text
        , requestRefreshToken :: Token
        , requestScope        :: Maybe Scope
        }

-- | A response containing an OAuth2 access token grant.
data AccessResponse = AccessResponse
{'fraction_non_alphanumeric': 0.08765075590283676, 'fraction_numerical': 0.0023781212841854932, 'mean_word_length': 2.601223241590214, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3741843', 'n_tokens_mistral': 1606, 'n_tokens_neox': 1592, 'n_words': 531}