diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,10 @@ `icloud-auth` uses [PVP Versioning][1]. +## 0.2.0.0 -- 2026-07-30 + +* Remove `hstratus-auth-cli` sublibrary; move `Network.HStratus.Http.Cli` into the main library. + ## 0.1.0.1 -- 2026-07-28 * Update package metadata. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ `hstratus-auth` authenticates with iCloud using Apple ID credentials stored on disk. The full sign-in flow — SRP credential exchange followed by any required two-factor (2FA) or legacy two-step (2SA) challenge — runs automatically, -prompting the terminal for verification codes when needed. On success it caches +prompting the user for verification codes when needed. On success, it caches a session token for use with other iCloud services. @@ -83,7 +83,6 @@ A command-line interface using this behaviour is provided by the [`hstratus`](https://github.com/adetokunbo/hstratus/tree/main/hstratus/#readme) package. Use [`hstratus auth init`](https://github.com/adetokunbo/hstratus/tree/main/hstratus/#hstratus-auth-init) and [`hstratus auth login`](https://github.com/adetokunbo/hstratus/tree/main/hstratus/#hstratus-auth-login) to save credentials and authenticate. - --- diff --git a/hstratus-auth.cabal b/hstratus-auth.cabal --- a/hstratus-auth.cabal +++ b/hstratus-auth.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hstratus-auth -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Authenticate with iCloud description: Authenticate with iCloud using Apple ID credentials stored on disk. @@ -36,23 +36,9 @@ location: https://github.com/adetokunbo/hstratus.git subdir: hstratus-auth -library hstratus-auth-cli - visibility: public - exposed-modules: Network.HStratus.Http.Cli - hs-source-dirs: src-cli - build-depends: - , base >=4.12 && <5 - , directory >=1.3 && <1.4 - , filepath >=1.4 && <1.6 - , http-client-tls >=0.3 && <0.4 - , hstratus-auth - , optparse-applicative >=0.18 && <0.19 - , xdg-basedir >=0.2 && <0.3 - default-language: Haskell2010 - ghc-options: -Wall -Wincomplete-uni-patterns -Wpartial-fields -fwarn-tabs - library exposed-modules: Network.HStratus.Http + Network.HStratus.Http.Cli Network.HStratus.Http.Endpoints Network.HStratus.Http.Common Network.HStratus.Session @@ -131,7 +117,6 @@ autogen-modules: Paths_hstratus_auth other-modules: HStratus.ApiLoggerSpec HStratus.Examples - HStratus.Http.CliSpec HStratus.HttpMockSpec HStratus.HttpSpec HStratus.Http.EndpointsSpec @@ -164,8 +149,6 @@ , QuickCheck >= 2.13 && < 2.16 , temporary >= 1.2 && < 1.4 , hstratus-auth - , hstratus-auth:hstratus-auth-cli - , optparse-applicative >=0.18 && <0.19 , silently >= 1.2 && < 1.3 , string-conv , text diff --git a/src-cli/Network/HStratus/Http/Cli.hs b/src-cli/Network/HStratus/Http/Cli.hs deleted file mode 100644 --- a/src-cli/Network/HStratus/Http/Cli.hs +++ /dev/null @@ -1,131 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} - -module Network.HStratus.Http.Cli - ( -- * Common CLI options - CommonOpts (..) - , commonOptsParser - - -- * Log target resolution - , resolveLogTarget - , defaultLogFile - - -- * Logger selection - , mkLoggerFor - - -- * Authenticated API runner - , runWithApi - - -- * Error handler - , onServiceError - ) -where - -import Control.Exception (catch, displayException) -import Network.HStratus.Http - ( Api - , ApiLogger - , AuthError - , AuthState (..) - , HStratusError - , fileLogger - , login - , mkApiWith - , redactingLogger - , verboseLogger - , withLogger - ) -import Network.HStratus.Http.Endpoints (Realm (..), realmEndpoints) -import Network.HStratus.Session (AccountData, Session, loadSession) -import Network.HTTP.Client.TLS (newTlsManager) -import Options.Applicative -import System.Directory (createDirectoryIfMissing) -import System.Environment.XDG.BaseDir (getUserCacheDir) -import System.Exit (exitFailure) -import System.FilePath (()) -import System.IO (Handle, IOMode (..), stdout, withFile) - - --- | Options shared by all icloud CLI commands. -data CommonOpts = CommonOpts - { optChina :: Bool - -- ^ Use mainland China endpoints instead of the worldwide endpoints. - , optLog :: Bool - -- ^ Append HTTP exchanges to the default log file. - , optLogFile :: Maybe FilePath - -- ^ Append HTTP exchanges to this file instead of the default. - , optLogBodies :: Bool - -- ^ Include request bodies in the HTTP exchange log. - , optRedact :: Bool - -- ^ Redact sensitive headers (tokens, cookies) in the log. - } - deriving (Eq, Show) - - --- | Parser for 'CommonOpts'. -commonOptsParser :: Parser CommonOpts -commonOptsParser = - CommonOpts - <$> switch (long "china" <> help "Use mainland China endpoints") - <*> switch (long "log" <> help "Append HTTP exchanges to the default log file") - <*> optional - (strOption (long "log-file" <> metavar "FILE" <> help "Append HTTP exchanges to FILE")) - <*> switch (long "log-bodies" <> help "Include request bodies in the HTTP exchange log") - <*> switch (long "redact" <> help "Redact sensitive headers (tokens, cookies) in the log") - - --- | Resolve the log file path from 'CommonOpts', or 'Nothing' if logging is disabled. -resolveLogTarget :: CommonOpts -> IO (Maybe FilePath) -resolveLogTarget CommonOpts{optLogFile = Just fp} = pure (Just fp) -resolveLogTarget CommonOpts{optLog = True} = Just <$> defaultLogFile -resolveLogTarget _ = pure Nothing - - --- | Default log file path: @~\/.cache\/hs-icloud\/requests.log@. -defaultLogFile :: IO FilePath -defaultLogFile = do - dir <- getUserCacheDir "hs-icloud" - createDirectoryIfMissing True dir - pure (dir "requests.log") - - --- | Select the appropriate logger constructor from 'CommonOpts'. -mkLoggerFor :: CommonOpts -> Handle -> ApiLogger -mkLoggerFor CommonOpts{optRedact = True} = redactingLogger -mkLoggerFor CommonOpts{optLogBodies = True} = verboseLogger -mkLoggerFor _ = fileLogger - - -{- | Authenticate and run an action with the resulting 'Api'. - -Handles session loading, TLS manager creation, logger wiring, and catches -'AuthError'. Additional error types should be caught by the caller. --} -runWithApi - :: CommonOpts - -> (AccountData -> Session -> Api -> IO ()) - -> IO () -runWithApi opts runAction = do - session <- loadSession - mgr <- newTlsManager - let realm = if optChina opts then China else Usual - api0 <- mkApiWith session (realmEndpoints realm) mgr - mbLogPath <- resolveLogTarget opts - let mkLogger' = mkLoggerFor opts - run api = do - result <- login api - case result of - Authenticated sess ad -> runAction ad sess api - _ -> putStrLn "Not authenticated — run 'hstratus-auth login' first." >> exitFailure - go = case mbLogPath of - Just fp -> withFile fp AppendMode $ \h -> run (withLogger (mkLogger' h) api0) - Nothing - | optLogBodies opts && not (optRedact opts) -> run (withLogger (mkLogger' stdout) api0) - | otherwise -> run api0 - go `catch` onServiceError @AuthError - - --- | Print a service error and exit. Use as the catch handler in CLI wrappers. -onServiceError :: (HStratusError e) => e -> IO a -onServiceError e = putStrLn ("Error: " <> displayException e) >> exitFailure diff --git a/src/Network/HStratus/Http/Cli.hs b/src/Network/HStratus/Http/Cli.hs new file mode 100644 --- /dev/null +++ b/src/Network/HStratus/Http/Cli.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} + +{- | +Module : Network.HStratus.Http.Cli +Copyright : (c) 2026 Tim Emiola +Maintainer : Tim Emiola +SPDX-License-Identifier: BSD-3-Clause + +CLI helpers shared by iCloud service commands: common options, log target +resolution, logger construction, and the authenticated API runner. +-} +module Network.HStratus.Http.Cli + ( -- * Common CLI options + CommonOpts (..) + + -- * Log target resolution + , resolveLogTarget + , defaultLogFile + + -- * Logger selection + , mkLoggerFor + + -- * Authenticated API runner + , runWithApi + + -- * Error handler + , onServiceError + ) +where + +import Control.Exception (catch, displayException) +import Network.HStratus.Http + ( Api + , ApiLogger + , AuthError + , AuthState (..) + , HStratusError + , fileLogger + , login + , mkApiWith + , redactingLogger + , verboseLogger + , withLogger + ) +import Network.HStratus.Http.Endpoints (Realm (..), realmEndpoints) +import Network.HStratus.Session (AccountData, Session, loadSession) +import Network.HTTP.Client.TLS (newTlsManager) +import System.Directory (createDirectoryIfMissing) +import System.Environment.XDG.BaseDir (getUserCacheDir) +import System.Exit (exitFailure) +import System.FilePath (()) +import System.IO (Handle, IOMode (..), stdout, withFile) + + +-- | Options shared by all icloud CLI commands. +data CommonOpts = CommonOpts + { optChina :: Bool + -- ^ Use mainland China endpoints instead of the worldwide endpoints. + , optLog :: Bool + -- ^ Append HTTP exchanges to the default log file. + , optLogFile :: Maybe FilePath + -- ^ Append HTTP exchanges to this file instead of the default. + , optLogBodies :: Bool + -- ^ Include request bodies in the HTTP exchange log. + , optRedact :: Bool + -- ^ Redact sensitive headers (tokens, cookies) in the log. + } + deriving (Eq, Show) + + +-- | Resolve the log file path from 'CommonOpts', or 'Nothing' if logging is disabled. +resolveLogTarget :: CommonOpts -> IO (Maybe FilePath) +resolveLogTarget CommonOpts{optLogFile = Just fp} = pure (Just fp) +resolveLogTarget CommonOpts{optLog = True} = Just <$> defaultLogFile +resolveLogTarget _ = pure Nothing + + +-- | Default log file path: @~\/.cache\/hs-icloud\/requests.log@. +defaultLogFile :: IO FilePath +defaultLogFile = do + dir <- getUserCacheDir "hs-icloud" + createDirectoryIfMissing True dir + pure (dir "requests.log") + + +-- | Select the appropriate logger constructor from 'CommonOpts'. +mkLoggerFor :: CommonOpts -> Handle -> ApiLogger +mkLoggerFor CommonOpts{optRedact = True} = redactingLogger +mkLoggerFor CommonOpts{optLogBodies = True} = verboseLogger +mkLoggerFor _ = fileLogger + + +{- | Authenticate and run an action with the resulting 'Api'. + +Handles session loading, TLS manager creation, logger wiring, and catches +'AuthError'. Additional error types should be caught by the caller. +-} +runWithApi + :: CommonOpts + -> (AccountData -> Session -> Api -> IO ()) + -> IO () +runWithApi opts runAction = do + session <- loadSession + mgr <- newTlsManager + let realm = if optChina opts then China else Usual + api0 <- mkApiWith session (realmEndpoints realm) mgr + mbLogPath <- resolveLogTarget opts + let mkLogger' = mkLoggerFor opts + run api = do + result <- login api + case result of + Authenticated sess ad -> runAction ad sess api + _ -> putStrLn "Not authenticated — run 'hstratus-auth login' first." >> exitFailure + go = case mbLogPath of + Just fp -> withFile fp AppendMode $ \h -> run (withLogger (mkLogger' h) api0) + Nothing + | optLogBodies opts && not (optRedact opts) -> run (withLogger (mkLogger' stdout) api0) + | otherwise -> run api0 + go `catch` onServiceError @AuthError + + +-- | Print a service error and exit. Use as the catch handler in CLI wrappers. +onServiceError :: (HStratusError e) => e -> IO a +onServiceError e = putStrLn ("Error: " <> displayException e) >> exitFailure diff --git a/test/HStratus/Http/CliSpec.hs b/test/HStratus/Http/CliSpec.hs deleted file mode 100644 --- a/test/HStratus/Http/CliSpec.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- | -Module : HStratus.Http.CliSpec -Copyright : (c) 2026 Tim Emiola -Maintainer : Tim Emiola -SPDX-License-Identifier: BSD-3-Clause - -Tests for the CLI options parser in 'Network.HStratus.Http.Cli'. --} -module HStratus.Http.CliSpec (spec) where - -import Network.HStratus.Http.Cli (CommonOpts (..), commonOptsParser) -import Options.Applicative (ParserResult (..), defaultPrefs, execParserPure, fullDesc, info, renderFailure) -import Test.Hspec -import Test.Hspec.Benri (endsRight) - - -defaultOpts :: CommonOpts -defaultOpts = CommonOpts False False Nothing False False - - -spec :: Spec -spec = describe "Network.HStratus.Http.Cli.commonOptsParser" $ do - it "defaults all flags to False with no log file" $ - pure (parseOpts []) `endsRight` defaultOpts - - it "sets optChina when --china is given" $ - fmap optChina (parseOpts ["--china"]) `shouldBe` Right True - - it "sets optLog when --log is given" $ - fmap optLog (parseOpts ["--log"]) `shouldBe` Right True - - it "sets optLogFile when --log-file is given" $ - fmap optLogFile (parseOpts ["--log-file", "/tmp/test.log"]) - `shouldBe` Right (Just "/tmp/test.log") - - it "sets optLogBodies when --log-bodies is given" $ - fmap optLogBodies (parseOpts ["--log-bodies"]) `shouldBe` Right True - - it "sets optRedact when --redact is given" $ - fmap optRedact (parseOpts ["--redact"]) `shouldBe` Right True - - it "accepts multiple flags together" $ - pure (parseOpts ["--log", "--redact", "--china"]) - `endsRight` defaultOpts{optChina = True, optLog = True, optRedact = True} - - -parseOpts :: [String] -> Either String CommonOpts -parseOpts args = - case execParserPure defaultPrefs (info commonOptsParser fullDesc) args of - Success opts -> Right opts - Failure failure -> Left (fst (renderFailure failure "test")) - CompletionInvoked _ -> Left "completion invoked" diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -11,7 +11,6 @@ module Main where import qualified HStratus.ApiLoggerSpec as ApiLogger -import qualified HStratus.Http.CliSpec as HttpCli import qualified HStratus.Http.EndpointsSpec as HttpEndpoints import qualified HStratus.Http.ErrorsSpec as HttpErrors import qualified HStratus.Http.HeadersSpec as HttpHeaders @@ -38,7 +37,6 @@ Session.spec Http.spec ApiLogger.spec - HttpCli.spec HttpEndpoints.spec HttpErrors.spec HttpHeaders.spec