{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}

-- | Manages the ~/.config/hercules-ci/credentials.json
module Hercules.CLI.Credentials where

import Control.Lens ((^?))
import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))
import Data.Aeson (FromJSON, ToJSON, eitherDecode)
import qualified Data.Aeson as A
import Data.Aeson.Lens (key, _String)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M
import qualified Data.Text as T
import Hercules.CLI.Client (determineDefaultApiBaseUrl)
import Hercules.CLI.JSON (writeJsonFile)
import Hercules.Error
import qualified Network.URI as URI
import Protolude
import System.Directory (XdgDirectory (XdgConfig), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
import qualified System.Environment
import System.FilePath (takeDirectory, (</>))

data Credentials = Credentials
  { Credentials -> Map Text DomainCredentials
domains :: Map Text DomainCredentials
  }
  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, (forall x. Credentials -> Rep Credentials x)
-> (forall x. Rep Credentials x -> Credentials)
-> Generic Credentials
forall x. Rep Credentials x -> Credentials
forall x. Credentials -> Rep Credentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Credentials -> Rep Credentials x
from :: forall x. Credentials -> Rep Credentials x
$cto :: forall x. Rep Credentials x -> Credentials
to :: forall x. Rep Credentials x -> Credentials
Generic, Value -> Parser [Credentials]
Value -> Parser Credentials
(Value -> Parser Credentials)
-> (Value -> Parser [Credentials]) -> FromJSON Credentials
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Credentials
parseJSON :: Value -> Parser Credentials
$cparseJSONList :: Value -> Parser [Credentials]
parseJSONList :: Value -> Parser [Credentials]
FromJSON, [Credentials] -> Value
[Credentials] -> Encoding
Credentials -> Value
Credentials -> Encoding
(Credentials -> Value)
-> (Credentials -> Encoding)
-> ([Credentials] -> Value)
-> ([Credentials] -> Encoding)
-> ToJSON Credentials
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Credentials -> Value
toJSON :: Credentials -> Value
$ctoEncoding :: Credentials -> Encoding
toEncoding :: Credentials -> Encoding
$ctoJSONList :: [Credentials] -> Value
toJSONList :: [Credentials] -> Value
$ctoEncodingList :: [Credentials] -> Encoding
toEncodingList :: [Credentials] -> Encoding
ToJSON)

data DomainCredentials = DomainCredentials
  { DomainCredentials -> Text
personalToken :: Text
  }
  deriving (DomainCredentials -> DomainCredentials -> Bool
(DomainCredentials -> DomainCredentials -> Bool)
-> (DomainCredentials -> DomainCredentials -> Bool)
-> Eq DomainCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DomainCredentials -> DomainCredentials -> Bool
== :: DomainCredentials -> DomainCredentials -> Bool
$c/= :: DomainCredentials -> DomainCredentials -> Bool
/= :: DomainCredentials -> DomainCredentials -> Bool
Eq, (forall x. DomainCredentials -> Rep DomainCredentials x)
-> (forall x. Rep DomainCredentials x -> DomainCredentials)
-> Generic DomainCredentials
forall x. Rep DomainCredentials x -> DomainCredentials
forall x. DomainCredentials -> Rep DomainCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DomainCredentials -> Rep DomainCredentials x
from :: forall x. DomainCredentials -> Rep DomainCredentials x
$cto :: forall x. Rep DomainCredentials x -> DomainCredentials
to :: forall x. Rep DomainCredentials x -> DomainCredentials
Generic, Value -> Parser [DomainCredentials]
Value -> Parser DomainCredentials
(Value -> Parser DomainCredentials)
-> (Value -> Parser [DomainCredentials])
-> FromJSON DomainCredentials
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser DomainCredentials
parseJSON :: Value -> Parser DomainCredentials
$cparseJSONList :: Value -> Parser [DomainCredentials]
parseJSONList :: Value -> Parser [DomainCredentials]
FromJSON, [DomainCredentials] -> Value
[DomainCredentials] -> Encoding
DomainCredentials -> Value
DomainCredentials -> Encoding
(DomainCredentials -> Value)
-> (DomainCredentials -> Encoding)
-> ([DomainCredentials] -> Value)
-> ([DomainCredentials] -> Encoding)
-> ToJSON DomainCredentials
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: DomainCredentials -> Value
toJSON :: DomainCredentials -> Value
$ctoEncoding :: DomainCredentials -> Encoding
toEncoding :: DomainCredentials -> Encoding
$ctoJSONList :: [DomainCredentials] -> Value
toJSONList :: [DomainCredentials] -> Value
$ctoEncodingList :: [DomainCredentials] -> Encoding
toEncodingList :: [DomainCredentials] -> Encoding
ToJSON)

data CredentialsParsingException = CredentialsParsingException
  { CredentialsParsingException -> String
filePath :: FilePath,
    CredentialsParsingException -> Text
message :: Text
  }
  deriving (Int -> CredentialsParsingException -> ShowS
[CredentialsParsingException] -> ShowS
CredentialsParsingException -> String
(Int -> CredentialsParsingException -> ShowS)
-> (CredentialsParsingException -> String)
-> ([CredentialsParsingException] -> ShowS)
-> Show CredentialsParsingException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CredentialsParsingException -> ShowS
showsPrec :: Int -> CredentialsParsingException -> ShowS
$cshow :: CredentialsParsingException -> String
show :: CredentialsParsingException -> String
$cshowList :: [CredentialsParsingException] -> ShowS
showList :: [CredentialsParsingException] -> ShowS
Show, CredentialsParsingException -> CredentialsParsingException -> Bool
(CredentialsParsingException
 -> CredentialsParsingException -> Bool)
-> (CredentialsParsingException
    -> CredentialsParsingException -> Bool)
-> Eq CredentialsParsingException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CredentialsParsingException -> CredentialsParsingException -> Bool
== :: CredentialsParsingException -> CredentialsParsingException -> Bool
$c/= :: CredentialsParsingException -> CredentialsParsingException -> Bool
/= :: CredentialsParsingException -> CredentialsParsingException -> Bool
Eq)

instance Exception CredentialsParsingException where
  displayException :: CredentialsParsingException -> String
displayException CredentialsParsingException
e = String
"Could not parse credentials file " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CredentialsParsingException -> String
filePath CredentialsParsingException
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertText a b => a -> b
toS (CredentialsParsingException -> Text
message CredentialsParsingException
e)

data NoCredentialException = NoCredentialException
  { NoCredentialException -> Text
noCredentialDomain :: Text
  }
  deriving (Int -> NoCredentialException -> ShowS
[NoCredentialException] -> ShowS
NoCredentialException -> String
(Int -> NoCredentialException -> ShowS)
-> (NoCredentialException -> String)
-> ([NoCredentialException] -> ShowS)
-> Show NoCredentialException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoCredentialException -> ShowS
showsPrec :: Int -> NoCredentialException -> ShowS
$cshow :: NoCredentialException -> String
show :: NoCredentialException -> String
$cshowList :: [NoCredentialException] -> ShowS
showList :: [NoCredentialException] -> ShowS
Show, NoCredentialException -> NoCredentialException -> Bool
(NoCredentialException -> NoCredentialException -> Bool)
-> (NoCredentialException -> NoCredentialException -> Bool)
-> Eq NoCredentialException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoCredentialException -> NoCredentialException -> Bool
== :: NoCredentialException -> NoCredentialException -> Bool
$c/= :: NoCredentialException -> NoCredentialException -> Bool
/= :: NoCredentialException -> NoCredentialException -> Bool
Eq)

instance Exception NoCredentialException where
  displayException :: NoCredentialException -> String
displayException NoCredentialException
e = String
"Could not find credentials for domain " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertText a b => a -> b
toS (NoCredentialException -> Text
noCredentialDomain NoCredentialException
e) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". Please run hci login."

data ApiBaseUrlParsingException = ApiBaseUrlParsingException
  { ApiBaseUrlParsingException -> Text
apiBaseUrlParsingMessage :: Text
  }
  deriving (Int -> ApiBaseUrlParsingException -> ShowS
[ApiBaseUrlParsingException] -> ShowS
ApiBaseUrlParsingException -> String
(Int -> ApiBaseUrlParsingException -> ShowS)
-> (ApiBaseUrlParsingException -> String)
-> ([ApiBaseUrlParsingException] -> ShowS)
-> Show ApiBaseUrlParsingException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApiBaseUrlParsingException -> ShowS
showsPrec :: Int -> ApiBaseUrlParsingException -> ShowS
$cshow :: ApiBaseUrlParsingException -> String
show :: ApiBaseUrlParsingException -> String
$cshowList :: [ApiBaseUrlParsingException] -> ShowS
showList :: [ApiBaseUrlParsingException] -> ShowS
Show, ApiBaseUrlParsingException -> ApiBaseUrlParsingException -> Bool
(ApiBaseUrlParsingException -> ApiBaseUrlParsingException -> Bool)
-> (ApiBaseUrlParsingException
    -> ApiBaseUrlParsingException -> Bool)
-> Eq ApiBaseUrlParsingException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApiBaseUrlParsingException -> ApiBaseUrlParsingException -> Bool
== :: ApiBaseUrlParsingException -> ApiBaseUrlParsingException -> Bool
$c/= :: ApiBaseUrlParsingException -> ApiBaseUrlParsingException -> Bool
/= :: ApiBaseUrlParsingException -> ApiBaseUrlParsingException -> Bool
Eq)

instance Exception ApiBaseUrlParsingException where
  displayException :: ApiBaseUrlParsingException -> String
displayException ApiBaseUrlParsingException
e = String
"Could not parse the api domain: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertText a b => a -> b
toS (ApiBaseUrlParsingException -> Text
apiBaseUrlParsingMessage ApiBaseUrlParsingException
e) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". Please correct the HERCULES_CI_API_BASE_URL environment variable."

getCredentialsFilePath :: IO FilePath
getCredentialsFilePath :: IO String
getCredentialsFilePath = do
  String
dir <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"hercules-ci"
  String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"credentials.json"

readCredentials :: IO Credentials
readCredentials :: IO Credentials
readCredentials = do
  String
filePath_ <- IO String
getCredentialsFilePath
  String -> IO Bool
doesFileExist String
filePath_ IO Bool -> (Bool -> IO Credentials) -> IO Credentials
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> Credentials -> IO Credentials
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text DomainCredentials -> Credentials
Credentials Map Text DomainCredentials
forall a. Monoid a => a
mempty)
    Bool
True -> do
      ByteString
bs <- String -> IO ByteString
BS.readFile String
filePath_
      Either CredentialsParsingException Credentials -> IO Credentials
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate (Either CredentialsParsingException Credentials -> IO Credentials)
-> Either CredentialsParsingException Credentials -> IO Credentials
forall a b. (a -> b) -> a -> b
$ String
-> ByteString -> Either CredentialsParsingException Credentials
parseCredentials String
filePath_ ByteString
bs

parseCredentials :: FilePath -> ByteString -> Either CredentialsParsingException Credentials
parseCredentials :: String
-> ByteString -> Either CredentialsParsingException Credentials
parseCredentials String
filePath_ ByteString
bs =
  case ByteString -> Either String Credentials
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
    Right Credentials
a -> Credentials -> Either CredentialsParsingException Credentials
forall a b. b -> Either a b
Right Credentials
a
    Left String
e -> CredentialsParsingException
-> Either CredentialsParsingException Credentials
forall a b. a -> Either a b
Left (CredentialsParsingException {filePath :: String
filePath = String
filePath_, message :: Text
message = String -> Text
forall a b. ConvertText a b => a -> b
toS String
e})

writeCredentials :: Credentials -> IO ()
writeCredentials :: Credentials -> IO ()
writeCredentials Credentials
credentials = do
  String
filePath_ <- IO String
getCredentialsFilePath
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory String
filePath_)
  String -> Credentials -> IO ()
forall a. ToJSON a => String -> a -> IO ()
writeJsonFile String
filePath_ Credentials
credentials

urlDomain :: Text -> Either Text Text
urlDomain :: Text -> Either Text Text
urlDomain Text
urlText = do
  URI
uri <- Text -> Maybe URI -> Either Text URI
forall e a. e -> Maybe a -> Either e a
maybeToEither Text
"could not parse HERCULES_CI_API_BASE_URL" (Maybe URI -> Either Text URI) -> Maybe URI -> Either Text URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
URI.parseAbsoluteURI (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
urlText)
  URIAuth
authority <- Text -> Maybe URIAuth -> Either Text URIAuth
forall e a. e -> Maybe a -> Either e a
maybeToEither Text
"HERCULES_CI_API_BASE_URL has no domain/authority part" (Maybe URIAuth -> Either Text URIAuth)
-> Maybe URIAuth -> Either Text URIAuth
forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
URI.uriAuthority URI
uri
  let name :: String
name = URIAuth -> String
URI.uriRegName URIAuth
authority
  Text -> Maybe () -> Either Text ()
forall e a. e -> Maybe a -> Either e a
maybeToEither Text
"HERCULES_CI_API_BASE_URL domain name must not be empty" (Maybe () -> Either Text ()) -> Maybe () -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"")
  Text -> Either Text Text
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
forall a b. ConvertText a b => a -> b
toS String
name)

determineDomain :: IO Text
determineDomain :: IO Text
determineDomain = do
  Text
baseUrl <- IO Text
determineDefaultApiBaseUrl
  (Text -> ApiBaseUrlParsingException) -> Either Text Text -> IO Text
forall exc (m :: * -> *) l a.
(Exception exc, MonadThrow m) =>
(l -> exc) -> Either l a -> m a
escalateAs Text -> ApiBaseUrlParsingException
ApiBaseUrlParsingException (Text -> Either Text Text
urlDomain Text
baseUrl)

writePersonalToken :: Text -> Text -> IO ()
writePersonalToken :: Text -> Text -> IO ()
writePersonalToken Text
domain Text
token = do
  Credentials
creds <- IO Credentials
readCredentials
  let creds' :: Credentials
creds' = Credentials
creds {domains :: Map Text DomainCredentials
domains = Credentials -> Map Text DomainCredentials
domains Credentials
creds Map Text DomainCredentials
-> (Map Text DomainCredentials -> Map Text DomainCredentials)
-> Map Text DomainCredentials
forall a b. a -> (a -> b) -> b
& Text
-> DomainCredentials
-> Map Text DomainCredentials
-> Map Text DomainCredentials
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
domain (Text -> DomainCredentials
DomainCredentials Text
token)}
  Credentials -> IO ()
writeCredentials Credentials
creds'

readPersonalToken :: Text -> IO Text
readPersonalToken :: Text -> IO Text
readPersonalToken Text
domain = do
  Credentials
creds <- IO Credentials
readCredentials
  case Text -> Map Text DomainCredentials -> Maybe DomainCredentials
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
domain (Credentials -> Map Text DomainCredentials
domains Credentials
creds) of
    Maybe DomainCredentials
Nothing -> NoCredentialException -> IO Text
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO NoCredentialException {noCredentialDomain :: Text
noCredentialDomain = Text
domain}
    Just DomainCredentials
cred -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DomainCredentials -> Text
personalToken DomainCredentials
cred)

-- | Try to get a token from the local environment.
--
-- 1. HERCULES_CI_API_TOKEN
-- 2. HERCULES_CI_SECRETS_JSON
tryReadEffectToken :: IO (Maybe Text)
tryReadEffectToken :: IO (Maybe Text)
tryReadEffectToken = MaybeT IO Text -> IO (Maybe Text)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Text -> IO (Maybe Text))
-> MaybeT IO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ MaybeT IO Text
tryReadEffectTokenFromEnv MaybeT IO Text -> MaybeT IO Text -> MaybeT IO Text
forall a. MaybeT IO a -> MaybeT IO a -> MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT IO Text
tryReadEffectTokenFromFile

tryReadEffectTokenFromEnv :: MaybeT IO Text
tryReadEffectTokenFromEnv :: MaybeT IO Text
tryReadEffectTokenFromEnv = String -> Text
T.pack (String -> Text) -> MaybeT IO String -> MaybeT IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (String -> IO (Maybe String)
System.Environment.lookupEnv String
"HERCULES_CI_API_TOKEN")

tryReadEffectTokenFromFile :: MaybeT IO Text
tryReadEffectTokenFromFile :: MaybeT IO Text
tryReadEffectTokenFromFile = do
  String
inEffect <- IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe String) -> MaybeT IO String)
-> IO (Maybe String) -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
System.Environment.lookupEnv String
"IN_HERCULES_CI_EFFECT"
  Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT IO ()) -> Bool -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ String
inEffect String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"true"
  String
secretsJsonPath <- IO (Maybe String) -> MaybeT IO String
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe String) -> MaybeT IO String)
-> IO (Maybe String) -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
System.Environment.lookupEnv String
"HERCULES_CI_SECRETS_JSON"
  IO Text -> MaybeT IO Text
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
    ByteString
bs <- String -> IO ByteString
BS.readFile String
secretsJsonPath
    Value
json <- case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
      Right Value
x -> Value -> IO Value
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
x :: A.Value)
      Left String
e -> FatalError -> IO Value
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FatalError -> IO Value) -> FatalError -> IO Value
forall a b. (a -> b) -> a -> b
$ Text -> FatalError
FatalError (Text -> FatalError) -> Text -> FatalError
forall a b. (a -> b) -> a -> b
$ Text
"HERCULES_CI_SECRETS_JSON, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
secretsJsonPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has invalid JSON: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e
    case Value
json Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"hercules-ci" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"data" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"token" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String of
      Just Text
x -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
      Maybe Text
Nothing -> FatalError -> IO Text
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FatalError -> IO Text) -> FatalError -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> FatalError
FatalError (Text -> FatalError) -> Text -> FatalError
forall a b. (a -> b) -> a -> b
$ Text
"HERCULES_CI_SECRETS_JSON, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
secretsJsonPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" doesn't have key hercules-ci.data.token"

readToken :: IO Text -> IO Text
readToken :: IO Text -> IO Text
readToken IO Text
getDomain = do
  IO (Maybe Text)
tryReadEffectToken IO (Maybe Text) -> (Maybe Text -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Text
x -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
    Maybe Text
Nothing -> Text -> IO Text
readPersonalToken (Text -> IO Text) -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text
getDomain