{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards #-}

module Unison.Auth.Types
  ( DiscoveryDoc (..),
    Tokens (..),
    Credentials (..),
    Code,
    AccessToken,
    RefreshToken,
    IDToken,
    OAuthState,
    PKCEVerifier,
    PKCEChallenge,
    ProfileName,
    CredentialFailure (..),
    CodeserverCredentials (..),
    UserInfo (..),
    getCodeserverCredentials,
    setCodeserverCredentials,
    codeserverCredentials,
    emptyCredentials,
  )
where

import Control.Lens hiding ((.=))
import Data.Aeson (FromJSON (..), KeyValue ((.=)), ToJSON (..), (.:), (.:?))
import Data.Aeson qualified as Aeson
import Data.Map qualified as Map
import Data.Text qualified as Text
import Data.Time (NominalDiffTime, UTCTime)
import Network.URI
import Network.URI qualified as URI
import Unison.Prelude
import Unison.Share.Types

defaultProfileName :: ProfileName
defaultProfileName :: ProfileName
defaultProfileName = ProfileName
"default"

data CredentialFailure
  = ReauthRequired CodeserverId
  | CredentialParseFailure FilePath Text
  | InvalidDiscoveryDocument URI Text
  | InvalidJWT Text
  | RefreshFailure Text
  | InvalidTokenResponse URI Text
  | InvalidHost CodeserverURI
  | FailedToFetchUserInfo URI Text
  deriving stock (Int -> CredentialFailure -> ShowS
[CredentialFailure] -> ShowS
CredentialFailure -> String
(Int -> CredentialFailure -> ShowS)
-> (CredentialFailure -> String)
-> ([CredentialFailure] -> ShowS)
-> Show CredentialFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CredentialFailure -> ShowS
showsPrec :: Int -> CredentialFailure -> ShowS
$cshow :: CredentialFailure -> String
show :: CredentialFailure -> String
$cshowList :: [CredentialFailure] -> ShowS
showList :: [CredentialFailure] -> ShowS
Show, CredentialFailure -> CredentialFailure -> Bool
(CredentialFailure -> CredentialFailure -> Bool)
-> (CredentialFailure -> CredentialFailure -> Bool)
-> Eq CredentialFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CredentialFailure -> CredentialFailure -> Bool
== :: CredentialFailure -> CredentialFailure -> Bool
$c/= :: CredentialFailure -> CredentialFailure -> Bool
/= :: CredentialFailure -> CredentialFailure -> Bool
Eq)
  deriving anyclass (Show CredentialFailure
Typeable CredentialFailure
(Typeable CredentialFailure, Show CredentialFailure) =>
(CredentialFailure -> SomeException)
-> (SomeException -> Maybe CredentialFailure)
-> (CredentialFailure -> String)
-> Exception CredentialFailure
SomeException -> Maybe CredentialFailure
CredentialFailure -> String
CredentialFailure -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: CredentialFailure -> SomeException
toException :: CredentialFailure -> SomeException
$cfromException :: SomeException -> Maybe CredentialFailure
fromException :: SomeException -> Maybe CredentialFailure
$cdisplayException :: CredentialFailure -> String
displayException :: CredentialFailure -> String
Exception)

type Code = Text

type OAuthState = ByteString

type PKCEVerifier = ByteString

type PKCEChallenge = ByteString

type AccessToken = Text

type RefreshToken = Text

type IDToken = Text

type TokenType = Text

newtype Scopes = Scopes [Text]
  deriving stock (Int -> Scopes -> ShowS
[Scopes] -> ShowS
Scopes -> String
(Int -> Scopes -> ShowS)
-> (Scopes -> String) -> ([Scopes] -> ShowS) -> Show Scopes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scopes -> ShowS
showsPrec :: Int -> Scopes -> ShowS
$cshow :: Scopes -> String
show :: Scopes -> String
$cshowList :: [Scopes] -> ShowS
showList :: [Scopes] -> ShowS
Show, Scopes -> Scopes -> Bool
(Scopes -> Scopes -> Bool)
-> (Scopes -> Scopes -> Bool) -> Eq Scopes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scopes -> Scopes -> Bool
== :: Scopes -> Scopes -> Bool
$c/= :: Scopes -> Scopes -> Bool
/= :: Scopes -> Scopes -> Bool
Eq, Eq Scopes
Eq Scopes =>
(Scopes -> Scopes -> Ordering)
-> (Scopes -> Scopes -> Bool)
-> (Scopes -> Scopes -> Bool)
-> (Scopes -> Scopes -> Bool)
-> (Scopes -> Scopes -> Bool)
-> (Scopes -> Scopes -> Scopes)
-> (Scopes -> Scopes -> Scopes)
-> Ord Scopes
Scopes -> Scopes -> Bool
Scopes -> Scopes -> Ordering
Scopes -> Scopes -> Scopes
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scopes -> Scopes -> Ordering
compare :: Scopes -> Scopes -> Ordering
$c< :: Scopes -> Scopes -> Bool
< :: Scopes -> Scopes -> Bool
$c<= :: Scopes -> Scopes -> Bool
<= :: Scopes -> Scopes -> Bool
$c> :: Scopes -> Scopes -> Bool
> :: Scopes -> Scopes -> Bool
$c>= :: Scopes -> Scopes -> Bool
>= :: Scopes -> Scopes -> Bool
$cmax :: Scopes -> Scopes -> Scopes
max :: Scopes -> Scopes -> Scopes
$cmin :: Scopes -> Scopes -> Scopes
min :: Scopes -> Scopes -> Scopes
Ord)

instance ToJSON Scopes where
  toJSON :: Scopes -> Value
toJSON (Scopes [ProfileName]
scopes) = ProfileName -> Value
Aeson.String (ProfileName -> Value) -> ProfileName -> Value
forall a b. (a -> b) -> a -> b
$ [ProfileName] -> ProfileName
Text.unwords [ProfileName]
scopes

instance FromJSON Scopes where
  parseJSON :: Value -> Parser Scopes
parseJSON = String -> (ProfileName -> Parser Scopes) -> Value -> Parser Scopes
forall a. String -> (ProfileName -> Parser a) -> Value -> Parser a
Aeson.withText String
"Scopes" ((ProfileName -> Parser Scopes) -> Value -> Parser Scopes)
-> (ProfileName -> Parser Scopes) -> Value -> Parser Scopes
forall a b. (a -> b) -> a -> b
$ \ProfileName
txt -> do
    Scopes -> Parser Scopes
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scopes -> Parser Scopes)
-> ([ProfileName] -> Scopes) -> [ProfileName] -> Parser Scopes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ProfileName] -> Scopes
Scopes ([ProfileName] -> Parser Scopes) -> [ProfileName] -> Parser Scopes
forall a b. (a -> b) -> a -> b
$ ProfileName -> [ProfileName]
Text.words ProfileName
txt

data DiscoveryDoc = DiscoveryDoc
  { DiscoveryDoc -> URI
issuer :: URI,
    DiscoveryDoc -> URI
authorizationEndpoint :: URI,
    DiscoveryDoc -> URI
tokenEndpoint :: URI,
    DiscoveryDoc -> URI
userInfoEndpoint :: URI
  }
  deriving (Int -> DiscoveryDoc -> ShowS
[DiscoveryDoc] -> ShowS
DiscoveryDoc -> String
(Int -> DiscoveryDoc -> ShowS)
-> (DiscoveryDoc -> String)
-> ([DiscoveryDoc] -> ShowS)
-> Show DiscoveryDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiscoveryDoc -> ShowS
showsPrec :: Int -> DiscoveryDoc -> ShowS
$cshow :: DiscoveryDoc -> String
show :: DiscoveryDoc -> String
$cshowList :: [DiscoveryDoc] -> ShowS
showList :: [DiscoveryDoc] -> ShowS
Show)

data Tokens = Tokens
  { Tokens -> ProfileName
accessToken :: AccessToken,
    Tokens -> Maybe ProfileName
idToken :: Maybe IDToken,
    Tokens -> Maybe ProfileName
refreshToken :: Maybe RefreshToken,
    Tokens -> ProfileName
tokenType :: TokenType,
    Tokens -> NominalDiffTime
expiresIn :: NominalDiffTime,
    Tokens -> Scopes
scopes :: Scopes
  }
  deriving (Tokens -> Tokens -> Bool
(Tokens -> Tokens -> Bool)
-> (Tokens -> Tokens -> Bool) -> Eq Tokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tokens -> Tokens -> Bool
== :: Tokens -> Tokens -> Bool
$c/= :: Tokens -> Tokens -> Bool
/= :: Tokens -> Tokens -> Bool
Eq, Int -> Tokens -> ShowS
[Tokens] -> ShowS
Tokens -> String
(Int -> Tokens -> ShowS)
-> (Tokens -> String) -> ([Tokens] -> ShowS) -> Show Tokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tokens -> ShowS
showsPrec :: Int -> Tokens -> ShowS
$cshow :: Tokens -> String
show :: Tokens -> String
$cshowList :: [Tokens] -> ShowS
showList :: [Tokens] -> ShowS
Show)

instance Aeson.FromJSON Tokens where
  parseJSON :: Value -> Parser Tokens
parseJSON =
    String -> (Object -> Parser Tokens) -> Value -> Parser Tokens
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Tokens" ((Object -> Parser Tokens) -> Value -> Parser Tokens)
-> (Object -> Parser Tokens) -> Value -> Parser Tokens
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      ProfileName
accessToken <- Object
obj Object -> Key -> Parser ProfileName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"access_token"
      Maybe ProfileName
idToken <- Object
obj Object -> Key -> Parser (Maybe ProfileName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id_token"
      Maybe ProfileName
refreshToken <- Object
obj Object -> Key -> Parser (Maybe ProfileName)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"refresh_token"
      ProfileName
tokenType <- Object
obj Object -> Key -> Parser ProfileName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token_type"
      NominalDiffTime
expiresIn <- Object
obj Object -> Key -> Parser NominalDiffTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expires_in"
      Scopes
scopes <- Object
obj Object -> Key -> Parser Scopes
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scope"
      pure (Tokens {Maybe ProfileName
ProfileName
NominalDiffTime
Scopes
$sel:accessToken:Tokens :: ProfileName
$sel:idToken:Tokens :: Maybe ProfileName
$sel:refreshToken:Tokens :: Maybe ProfileName
$sel:tokenType:Tokens :: ProfileName
$sel:expiresIn:Tokens :: NominalDiffTime
$sel:scopes:Tokens :: Scopes
accessToken :: ProfileName
idToken :: Maybe ProfileName
refreshToken :: Maybe ProfileName
tokenType :: ProfileName
expiresIn :: NominalDiffTime
scopes :: Scopes
..})

instance Aeson.ToJSON Tokens where
  toJSON :: Tokens -> Value
toJSON (Tokens ProfileName
accessToken Maybe ProfileName
idToken Maybe ProfileName
refreshToken ProfileName
tokenType NominalDiffTime
expiresIn Scopes
scopes) =
    [Pair] -> Value
Aeson.object
      [ Key
"access_token" Key -> ProfileName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProfileName
accessToken,
        Key
"id_token" Key -> Maybe ProfileName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe ProfileName
idToken,
        Key
"refresh_token" Key -> Maybe ProfileName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe ProfileName
refreshToken,
        Key
"token_type" Key -> ProfileName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProfileName
tokenType,
        Key
"expires_in" Key -> NominalDiffTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NominalDiffTime
expiresIn,
        Key
"scope" Key -> Scopes -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Scopes
scopes
      ]

newtype URIParam = URIParam URI

instance Aeson.FromJSON URIParam where
  parseJSON :: Value -> Parser URIParam
parseJSON = String
-> (ProfileName -> Parser URIParam) -> Value -> Parser URIParam
forall a. String -> (ProfileName -> Parser a) -> Value -> Parser a
Aeson.withText String
"URI" ((ProfileName -> Parser URIParam) -> Value -> Parser URIParam)
-> (ProfileName -> Parser URIParam) -> Value -> Parser URIParam
forall a b. (a -> b) -> a -> b
$ \ProfileName
txt ->
    Parser URIParam
-> (URI -> Parser URIParam) -> Maybe URI -> Parser URIParam
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser URIParam
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid URI") (URIParam -> Parser URIParam
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URIParam -> Parser URIParam)
-> (URI -> URIParam) -> URI -> Parser URIParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> URIParam
URIParam) (Maybe URI -> Parser URIParam) -> Maybe URI -> Parser URIParam
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
URI.parseURI (ProfileName -> String
Text.unpack ProfileName
txt)

instance Aeson.FromJSON DiscoveryDoc where
  parseJSON :: Value -> Parser DiscoveryDoc
parseJSON = String
-> (Object -> Parser DiscoveryDoc) -> Value -> Parser DiscoveryDoc
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Discovery Document" ((Object -> Parser DiscoveryDoc) -> Value -> Parser DiscoveryDoc)
-> (Object -> Parser DiscoveryDoc) -> Value -> Parser DiscoveryDoc
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    URIParam URI
issuer <- Object
obj Object -> Key -> Parser URIParam
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issuer"
    URIParam URI
authorizationEndpoint <- Object
obj Object -> Key -> Parser URIParam
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"authorization_endpoint"
    URIParam URI
tokenEndpoint <- Object
obj Object -> Key -> Parser URIParam
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token_endpoint"
    URIParam URI
userInfoEndpoint <- Object
obj Object -> Key -> Parser URIParam
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"userinfo_endpoint"
    DiscoveryDoc -> Parser DiscoveryDoc
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiscoveryDoc {URI
$sel:issuer:DiscoveryDoc :: URI
$sel:authorizationEndpoint:DiscoveryDoc :: URI
$sel:tokenEndpoint:DiscoveryDoc :: URI
$sel:userInfoEndpoint:DiscoveryDoc :: URI
issuer :: URI
authorizationEndpoint :: URI
tokenEndpoint :: URI
userInfoEndpoint :: URI
..})

type ProfileName = Text

data Credentials = Credentials
  { Credentials
-> Map ProfileName (Map CodeserverId CodeserverCredentials)
credentials :: Map ProfileName (Map CodeserverId CodeserverCredentials),
    Credentials -> ProfileName
activeProfile :: ProfileName
  }
  deriving (Credentials -> Credentials -> Bool
(Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool) -> Eq Credentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Credentials -> Credentials -> Bool
== :: Credentials -> Credentials -> Bool
$c/= :: Credentials -> Credentials -> Bool
/= :: Credentials -> Credentials -> Bool
Eq)

instance Aeson.ToJSON Credentials where
  toJSON :: Credentials -> Value
toJSON (Credentials Map ProfileName (Map CodeserverId CodeserverCredentials)
credMap ProfileName
activeProfile) =
    [Pair] -> Value
Aeson.object
      [ Key
"credentials" Key
-> Map ProfileName (Map CodeserverId CodeserverCredentials) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Map ProfileName (Map CodeserverId CodeserverCredentials)
credMap,
        Key
"active_profile" Key -> ProfileName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProfileName
activeProfile
      ]

instance Aeson.FromJSON Credentials where
  parseJSON :: Value -> Parser Credentials
parseJSON = String
-> (Object -> Parser Credentials) -> Value -> Parser Credentials
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Credentials" ((Object -> Parser Credentials) -> Value -> Parser Credentials)
-> (Object -> Parser Credentials) -> Value -> Parser Credentials
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Map ProfileName (Map CodeserverId CodeserverCredentials)
credentials <- Object
obj Object
-> Key
-> Parser
     (Map ProfileName (Map CodeserverId CodeserverCredentials))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"credentials"
    ProfileName
activeProfile <- Object
obj Object -> Key -> Parser ProfileName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_profile"
    pure Credentials {Map ProfileName (Map CodeserverId CodeserverCredentials)
ProfileName
$sel:credentials:Credentials :: Map ProfileName (Map CodeserverId CodeserverCredentials)
$sel:activeProfile:Credentials :: ProfileName
credentials :: Map ProfileName (Map CodeserverId CodeserverCredentials)
activeProfile :: ProfileName
..}

data UserInfo = UserInfo
  { UserInfo -> ProfileName
userId :: Text, -- E.g. U-1234-5678
    UserInfo -> Maybe ProfileName
name :: Maybe Text,
    UserInfo -> ProfileName
handle :: Text -- The user's handle, no @ sign, e.g. "JohnSmith"
  }
  deriving (Int -> UserInfo -> ShowS
[UserInfo] -> ShowS
UserInfo -> String
(Int -> UserInfo -> ShowS)
-> (UserInfo -> String) -> ([UserInfo] -> ShowS) -> Show UserInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserInfo -> ShowS
showsPrec :: Int -> UserInfo -> ShowS
$cshow :: UserInfo -> String
show :: UserInfo -> String
$cshowList :: [UserInfo] -> ShowS
showList :: [UserInfo] -> ShowS
Show, UserInfo -> UserInfo -> Bool
(UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool) -> Eq UserInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserInfo -> UserInfo -> Bool
== :: UserInfo -> UserInfo -> Bool
$c/= :: UserInfo -> UserInfo -> Bool
/= :: UserInfo -> UserInfo -> Bool
Eq, (forall x. UserInfo -> Rep UserInfo x)
-> (forall x. Rep UserInfo x -> UserInfo) -> Generic UserInfo
forall x. Rep UserInfo x -> UserInfo
forall x. UserInfo -> Rep UserInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserInfo -> Rep UserInfo x
from :: forall x. UserInfo -> Rep UserInfo x
$cto :: forall x. Rep UserInfo x -> UserInfo
to :: forall x. Rep UserInfo x -> UserInfo
Generic)

instance ToJSON UserInfo where
  toJSON :: UserInfo -> Value
toJSON (UserInfo ProfileName
userId Maybe ProfileName
name ProfileName
handle) =
    [Pair] -> Value
Aeson.object
      [ Key
"user_id" Key -> ProfileName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProfileName
userId,
        Key
"name" Key -> Maybe ProfileName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe ProfileName
name,
        Key
"handle" Key -> ProfileName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProfileName
handle
      ]

instance FromJSON UserInfo where
  parseJSON :: Value -> Parser UserInfo
parseJSON = String -> (Object -> Parser UserInfo) -> Value -> Parser UserInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"UserInfo" ((Object -> Parser UserInfo) -> Value -> Parser UserInfo)
-> (Object -> Parser UserInfo) -> Value -> Parser UserInfo
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    ProfileName
userId <- Object
obj Object -> Key -> Parser ProfileName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id"
    Maybe ProfileName
name <- Object
obj Object -> Key -> Parser (Maybe ProfileName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
    ProfileName
handle <- Object
obj Object -> Key -> Parser ProfileName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"handle"
    pure (UserInfo {Maybe ProfileName
ProfileName
$sel:userId:UserInfo :: ProfileName
$sel:name:UserInfo :: Maybe ProfileName
$sel:handle:UserInfo :: ProfileName
userId :: ProfileName
name :: Maybe ProfileName
handle :: ProfileName
..})

-- | Credentials for a specific codeserver
data CodeserverCredentials = CodeserverCredentials
  { -- The most recent set of authentication tokens
    CodeserverCredentials -> Tokens
tokens :: Tokens,
    -- When the auth tokens were fetched
    CodeserverCredentials -> UTCTime
fetchTime :: UTCTime,
    -- URI where the discovery document for this codeserver can be fetched.
    CodeserverCredentials -> URI
discoveryURI :: URI,
    CodeserverCredentials -> UserInfo
userInfo :: UserInfo
  }
  deriving (CodeserverCredentials -> CodeserverCredentials -> Bool
(CodeserverCredentials -> CodeserverCredentials -> Bool)
-> (CodeserverCredentials -> CodeserverCredentials -> Bool)
-> Eq CodeserverCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeserverCredentials -> CodeserverCredentials -> Bool
== :: CodeserverCredentials -> CodeserverCredentials -> Bool
$c/= :: CodeserverCredentials -> CodeserverCredentials -> Bool
/= :: CodeserverCredentials -> CodeserverCredentials -> Bool
Eq)

instance ToJSON CodeserverCredentials where
  toJSON :: CodeserverCredentials -> Value
toJSON (CodeserverCredentials Tokens
tokens UTCTime
fetchTime URI
discoveryURI UserInfo
userInfo) =
    [Pair] -> Value
Aeson.object
      [ Key
"tokens" Key -> Tokens -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Tokens
tokens,
        Key
"fetch_time" Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= UTCTime
fetchTime,
        Key
"discovery_uri" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= URI -> String
forall a. Show a => a -> String
show URI
discoveryURI,
        Key
"user_info" Key -> UserInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= UserInfo
userInfo
      ]

instance FromJSON CodeserverCredentials where
  parseJSON :: Value -> Parser CodeserverCredentials
parseJSON =
    String
-> (Object -> Parser CodeserverCredentials)
-> Value
-> Parser CodeserverCredentials
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"CodeserverCredentials" ((Object -> Parser CodeserverCredentials)
 -> Value -> Parser CodeserverCredentials)
-> (Object -> Parser CodeserverCredentials)
-> Value
-> Parser CodeserverCredentials
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      do
        Tokens
tokens <- Object
v Object -> Key -> Parser Tokens
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tokens"
        UTCTime
fetchTime <- Object
v Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fetch_time"
        String
discoveryURIString <- Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"discovery_uri"
        URI
discoveryURI <- case String -> Maybe URI
parseURI String
discoveryURIString of
          Maybe URI
Nothing -> String -> Parser URI
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"discovery_uri is not a valid URI"
          Just URI
uri -> URI -> Parser URI
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URI
uri
        UserInfo
userInfo <- Object
v Object -> Key -> Parser UserInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_info"
        pure $ CodeserverCredentials {UTCTime
URI
UserInfo
Tokens
$sel:tokens:CodeserverCredentials :: Tokens
$sel:fetchTime:CodeserverCredentials :: UTCTime
$sel:discoveryURI:CodeserverCredentials :: URI
$sel:userInfo:CodeserverCredentials :: UserInfo
tokens :: Tokens
fetchTime :: UTCTime
discoveryURI :: URI
userInfo :: UserInfo
..}

emptyCredentials :: Credentials
emptyCredentials :: Credentials
emptyCredentials = Map ProfileName (Map CodeserverId CodeserverCredentials)
-> ProfileName -> Credentials
Credentials Map ProfileName (Map CodeserverId CodeserverCredentials)
forall a. Monoid a => a
mempty ProfileName
defaultProfileName

codeserverCredentials :: URI -> Tokens -> UTCTime -> UserInfo -> CodeserverCredentials
codeserverCredentials :: URI -> Tokens -> UTCTime -> UserInfo -> CodeserverCredentials
codeserverCredentials URI
discoveryURI Tokens
tokens UTCTime
fetchTime UserInfo
userInfo = CodeserverCredentials {URI
$sel:discoveryURI:CodeserverCredentials :: URI
discoveryURI :: URI
discoveryURI, UTCTime
$sel:fetchTime:CodeserverCredentials :: UTCTime
fetchTime :: UTCTime
fetchTime, Tokens
$sel:tokens:CodeserverCredentials :: Tokens
tokens :: Tokens
tokens, UserInfo
$sel:userInfo:CodeserverCredentials :: UserInfo
userInfo :: UserInfo
userInfo}

getCodeserverCredentials :: CodeserverId -> Credentials -> Either CredentialFailure CodeserverCredentials
getCodeserverCredentials :: CodeserverId
-> Credentials -> Either CredentialFailure CodeserverCredentials
getCodeserverCredentials CodeserverId
host (Credentials {Map ProfileName (Map CodeserverId CodeserverCredentials)
$sel:credentials:Credentials :: Credentials
-> Map ProfileName (Map CodeserverId CodeserverCredentials)
credentials :: Map ProfileName (Map CodeserverId CodeserverCredentials)
credentials, ProfileName
$sel:activeProfile:Credentials :: Credentials -> ProfileName
activeProfile :: ProfileName
activeProfile}) =
  CredentialFailure
-> Maybe CodeserverCredentials
-> Either CredentialFailure CodeserverCredentials
forall a b. a -> Maybe b -> Either a b
maybeToEither (CodeserverId -> CredentialFailure
ReauthRequired CodeserverId
host) (Maybe CodeserverCredentials
 -> Either CredentialFailure CodeserverCredentials)
-> Maybe CodeserverCredentials
-> Either CredentialFailure CodeserverCredentials
forall a b. (a -> b) -> a -> b
$
    Map ProfileName (Map CodeserverId CodeserverCredentials)
credentials Map ProfileName (Map CodeserverId CodeserverCredentials)
-> Getting
     (First CodeserverCredentials)
     (Map ProfileName (Map CodeserverId CodeserverCredentials))
     CodeserverCredentials
-> Maybe CodeserverCredentials
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Map ProfileName (Map CodeserverId CodeserverCredentials))
-> Traversal'
     (Map ProfileName (Map CodeserverId CodeserverCredentials))
     (IxValue
        (Map ProfileName (Map CodeserverId CodeserverCredentials)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix ProfileName
Index (Map ProfileName (Map CodeserverId CodeserverCredentials))
activeProfile ((Map CodeserverId CodeserverCredentials
  -> Const
       (First CodeserverCredentials)
       (Map CodeserverId CodeserverCredentials))
 -> Map ProfileName (Map CodeserverId CodeserverCredentials)
 -> Const
      (First CodeserverCredentials)
      (Map ProfileName (Map CodeserverId CodeserverCredentials)))
-> ((CodeserverCredentials
     -> Const (First CodeserverCredentials) CodeserverCredentials)
    -> Map CodeserverId CodeserverCredentials
    -> Const
         (First CodeserverCredentials)
         (Map CodeserverId CodeserverCredentials))
-> Getting
     (First CodeserverCredentials)
     (Map ProfileName (Map CodeserverId CodeserverCredentials))
     CodeserverCredentials
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map CodeserverId CodeserverCredentials)
-> Traversal'
     (Map CodeserverId CodeserverCredentials)
     (IxValue (Map CodeserverId CodeserverCredentials))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map CodeserverId CodeserverCredentials)
CodeserverId
host

setCodeserverCredentials :: CodeserverId -> CodeserverCredentials -> Credentials -> Credentials
setCodeserverCredentials :: CodeserverId -> CodeserverCredentials -> Credentials -> Credentials
setCodeserverCredentials CodeserverId
host CodeserverCredentials
codeserverCreds creds :: Credentials
creds@(Credentials {Map ProfileName (Map CodeserverId CodeserverCredentials)
$sel:credentials:Credentials :: Credentials
-> Map ProfileName (Map CodeserverId CodeserverCredentials)
credentials :: Map ProfileName (Map CodeserverId CodeserverCredentials)
credentials, ProfileName
$sel:activeProfile:Credentials :: Credentials -> ProfileName
activeProfile :: ProfileName
activeProfile}) =
  let newCredMap :: Map ProfileName (Map CodeserverId CodeserverCredentials)
newCredMap =
        Map ProfileName (Map CodeserverId CodeserverCredentials)
credentials
          Map ProfileName (Map CodeserverId CodeserverCredentials)
-> (Map ProfileName (Map CodeserverId CodeserverCredentials)
    -> Map ProfileName (Map CodeserverId CodeserverCredentials))
-> Map ProfileName (Map CodeserverId CodeserverCredentials)
forall a b. a -> (a -> b) -> b
& Index (Map ProfileName (Map CodeserverId CodeserverCredentials))
-> Lens'
     (Map ProfileName (Map CodeserverId CodeserverCredentials))
     (Maybe
        (IxValue
           (Map ProfileName (Map CodeserverId CodeserverCredentials))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at ProfileName
Index (Map ProfileName (Map CodeserverId CodeserverCredentials))
activeProfile ((Maybe (Map CodeserverId CodeserverCredentials)
  -> Identity (Maybe (Map CodeserverId CodeserverCredentials)))
 -> Map ProfileName (Map CodeserverId CodeserverCredentials)
 -> Identity
      (Map ProfileName (Map CodeserverId CodeserverCredentials)))
-> ((Maybe (IxValue (Map CodeserverId CodeserverCredentials))
     -> Identity (Maybe CodeserverCredentials))
    -> Maybe (Map CodeserverId CodeserverCredentials)
    -> Identity (Maybe (Map CodeserverId CodeserverCredentials)))
-> (Maybe (IxValue (Map CodeserverId CodeserverCredentials))
    -> Identity (Maybe CodeserverCredentials))
-> Map ProfileName (Map CodeserverId CodeserverCredentials)
-> Identity
     (Map ProfileName (Map CodeserverId CodeserverCredentials))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CodeserverId CodeserverCredentials
-> Iso'
     (Maybe (Map CodeserverId CodeserverCredentials))
     (Map CodeserverId CodeserverCredentials)
forall a. Eq a => a -> Iso' (Maybe a) a
non Map CodeserverId CodeserverCredentials
forall k a. Map k a
Map.empty ((Map CodeserverId CodeserverCredentials
  -> Identity (Map CodeserverId CodeserverCredentials))
 -> Maybe (Map CodeserverId CodeserverCredentials)
 -> Identity (Maybe (Map CodeserverId CodeserverCredentials)))
-> ((Maybe (IxValue (Map CodeserverId CodeserverCredentials))
     -> Identity (Maybe CodeserverCredentials))
    -> Map CodeserverId CodeserverCredentials
    -> Identity (Map CodeserverId CodeserverCredentials))
-> (Maybe (IxValue (Map CodeserverId CodeserverCredentials))
    -> Identity (Maybe CodeserverCredentials))
-> Maybe (Map CodeserverId CodeserverCredentials)
-> Identity (Maybe (Map CodeserverId CodeserverCredentials))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map CodeserverId CodeserverCredentials)
-> Lens'
     (Map CodeserverId CodeserverCredentials)
     (Maybe (IxValue (Map CodeserverId CodeserverCredentials)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map CodeserverId CodeserverCredentials)
CodeserverId
host ((Maybe (IxValue (Map CodeserverId CodeserverCredentials))
  -> Identity (Maybe CodeserverCredentials))
 -> Map ProfileName (Map CodeserverId CodeserverCredentials)
 -> Identity
      (Map ProfileName (Map CodeserverId CodeserverCredentials)))
-> Maybe CodeserverCredentials
-> Map ProfileName (Map CodeserverId CodeserverCredentials)
-> Map ProfileName (Map CodeserverId CodeserverCredentials)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CodeserverCredentials -> Maybe CodeserverCredentials
forall a. a -> Maybe a
Just CodeserverCredentials
codeserverCreds
   in Credentials
creds {credentials = newCredMap}