hstratus-auth (empty) → 0.1.0.0

raw patch · 48 files changed

+11428/−0 lines, 48 filesdep +QuickCheckdep +aesondep +aeson-casingsetup-changed

Dependencies added: QuickCheck, aeson, aeson-casing, base, base16-bytestring, base64-bytestring, benri-hspec, bytestring, case-insensitive, containers, crypto-srp, cryptohash-sha1, cryptohash-sha256, cryptohash-sha512, directory, filepath, hspec, hstratus-auth, http-client, http-client-tls, http-types, main-tester, optparse-applicative, random, silently, simple-prompt, string-conv, temporary, text, time, transformers, unix, uuid, wai, warp, web-cookiejar, xdg-basedir

Files

• ChangeLog.md +9/−0
• LICENSE +30/−0
• README.md +92/−0
• Setup.hs +4/−0
• hstratus-auth.cabal +175/−0
• src-cli/Network/HStratus/Http/Cli.hs +131/−0
• src-internal/Network/HStratus/Internal/Endpoints.hs +296/−0
• src-internal/Network/HStratus/Internal/Http.hs +144/−0
• src-internal/Network/HStratus/Internal/HttpErrors.hs +134/−0
• src-internal/Network/HStratus/Internal/LoginFSM.hs +348/−0
• src-internal/Network/HStratus/Internal/PBKDF2.hs +166/−0
• src-internal/Network/HStratus/Internal/Session.hs +572/−0
• src-internal/Network/HStratus/Internal/Trust.hs +336/−0
• src/Network/HStratus/Http.hs +97/−0
• src/Network/HStratus/Http/Common.hs +34/−0
• src/Network/HStratus/Http/Endpoints.hs +42/−0
• src/Network/HStratus/Internal/Http/Api.hs +458/−0
• src/Network/HStratus/Internal/Http/Login.hs +336/−0
• src/Network/HStratus/Internal/Http/Signin.hs +420/−0
• src/Network/HStratus/Session.hs +90/−0
• src/Network/HStratus/Trust.hs +92/−0
• test/HStratus/ApiLoggerSpec.hs +122/−0
• test/HStratus/Examples.hs +55/−0
• test/HStratus/Http/CliSpec.hs +54/−0
• test/HStratus/Http/EndpointsSpec.hs +44/−0
• test/HStratus/Http/ErrorsSpec.hs +131/−0
• test/HStratus/Http/HeadersSpec.hs +273/−0
• test/HStratus/HttpMockSpec.hs +223/−0
• test/HStratus/HttpSpec.hs +178/−0
• test/HStratus/LoginFSMSpec.hs +294/−0
• test/HStratus/Mock.hs +213/−0
• test/HStratus/PBKDF2Spec.hs +119/−0
• test/HStratus/SessionSpec.hs +530/−0
• test/HStratus/TrustSpec.hs +263/−0
• test/Spec.hs +48/−0
• testdata/auth_ok_test.json +3/−0
• testdata/login_2fa_test.json +244/−0
• testdata/login_2sa_test.json +6/−0
• testdata/login_working_test.json +244/−0
• testdata/pbkdf2_hmacsha1_test.json +937/−0
• testdata/pbkdf2_hmacsha224_test.json +844/−0
• testdata/pbkdf2_hmacsha256_test.json +876/−0
• testdata/pbkdf2_hmacsha384_test.json +844/−0
• testdata/pbkdf2_hmacsha512_test.json +844/−0
• testdata/srp_init_ok_test.json +7/−0
• testdata/trust_data_test.json +13/−0
• testdata/trusted_devices_test.json +10/−0
• testdata/verification_code_ok_test.json +3/−0

@@ -0,0 +1,9 @@+# Revision history for icloud-auth++`icloud-auth` uses [PVP Versioning][1].++## 0.1.0.0 -- 2026-07-20++* Initial version.++[1]: https://pvp.haskell.org

@@ -0,0 +1,30 @@+Copyright (c) 2023, Tim Emiola++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tim Emiola nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,92 @@+# hstratus-auth — unofficial authentication for iCloud services++`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+a session token for use with other iCloud services.+++## Disclaimer — use at your own risk++- This library is **unofficial** and not supported by Apple.+- The iCloud authentication protocol it uses is undocumented and may change+  without notice.++## Usage++The same two steps — saving credentials and authenticating — are available+programmatically.++### Saving credentials++Write a `credentials.json` file directly, or call `saveCredentials`:++```haskell+import Network.HStratus.Session (Credentials (..), saveCredentials)++saveCreds :: IO ()+saveCreds =+  saveCredentials $ Credentials+    { accountName = "your-apple-id@example.com"+    , password    = "your-password"+    }+```++### Authenticating++Create an `Api` handle with `mkApi`, then call `login`:++```haskell+import Network.HStratus.Http (mkApi, login, AuthState (..))+import Network.HStratus.Http.Endpoints (Realm (..))++example :: IO ()+example = do+  api <- mkApi Usual  -- or China for mainland China accounts+  result <- login api+  case result of+    Authenticated _session _accountData -> putStrLn "Authenticated!"+    _                                   -> putStrLn "Unexpected result"+```++### Injectable callbacks++Pass your own callbacks to `loginWith` to replace the interactive prompts —+useful in automation or tests.  The snippet below shows the code-reader; the+phone-selector and device-selector arguments follow the same pattern.++```haskell+import Network.HStratus.Http (loginWith)+import qualified Data.Text.IO as Text++exampleWith :: Api -> IO AuthState+exampleWith api = loginWith readCode (\_ -> pure Nothing) chooseDevice api+ where+  readCode codeLen = do+    Text.putStrLn $ "Enter the " <> Text.pack (show codeLen) <> "-digit code:"+    Text.getLine+  chooseDevice (d :| _) = pure d+```++If you already hold a `Requires2FA` or `Requires2SA` value from a prior call,+resume with `completeTwoFactor` / `completeTwoFactorWith` or `complete2SA` /+`complete2SAWith`.++## Reauthentication++The session token expires after a period set by iCloud (approximately two months+at the time of writing).  When it does, authenticate again to refresh it.+++## CLI usage++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.++++---++Apple and the Apple logo are trademarks of Apple Inc., registered in the U.S. and other countries and regions.+iCloud is a service mark of Apple Inc., registered in the U.S. and other countries and regions.

@@ -0,0 +1,4 @@+import Distribution.Simple+++main = defaultMain

@@ -0,0 +1,175 @@+cabal-version:      3.0+name:               hstratus-auth+version:            0.1.0.0+synopsis:           Authenticate with iCloud+description:+  Authenticate 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 — is handled by a+  single login call. On success the library caches a session token for use+  with other iCloud services.++  This library is unofficial and not supported by Apple. It may break+  without warning if Apple changes their authentication protocol.+license:            BSD-3-Clause+license-file:       LICENSE+maintainer:         Tim Emiola <adetokunbo@emio.la>+category:           Network+build-type:         Simple+tested-with:+    GHC == 9.2.8+  , GHC == 9.4.8+  , GHC == 9.6.7+  , GHC == 9.8.4+  , GHC == 9.10.2+  , GHC == 9.12.1+extra-doc-files:+  ChangeLog.md+  README.md+data-files:         testdata/*.json++source-repository head+  type:     git+  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.Endpoints+                    Network.HStratus.Http.Common+                    Network.HStratus.Session+                    Network.HStratus.Trust+  other-modules:    Network.HStratus.Internal.Http.Api+                    Network.HStratus.Internal.Http.Login+                    Network.HStratus.Internal.Http.Signin+  hs-source-dirs:   src+  build-depends:+    , aeson                >=2.0 && <2.3+    , aeson-casing         >=0.1 && <0.3+    , base                 >=4.12 && <5+    , base16-bytestring    >=1.0 && <1.1+    , base64-bytestring    >=1.0 && <2.1+    , bytestring           >=0.10.8 && <0.11 || >=0.11.3 && <0.13+    , case-insensitive     >=1.2 && <1.3+    , containers           >=0.6 && <0.8+    , crypto-srp           >=0.1 && <0.2+    , cryptohash-sha256    >=0.11 && <0.12+    , directory            >=1.3 && <1.4+    , filepath             >=1.4 && <1.6+    , http-client          >=0.5 && <0.8+    , http-client-tls      >=0.3 && <0.4+    , http-types           >=0.12.1 && <0.13+    , random               >=1.1 && <1.4+    , simple-prompt        >=0.2 && <0.3+    , string-conv          >=0.1 && <0.3+    , text                 >=1.2.3 && <2.2+    , time                 >=1.8 && <1.15+    , transformers         >=0.5 && <0.7+    , unix                 >=2.7 && <2.9+    , uuid                 >=1.3 && <1.4+    , web-cookiejar        >=0.1.3 && <0.2+    , xdg-basedir          >=0.2 && <0.3+    , hstratus-auth:hstratus-auth-internal+  default-language: Haskell2010+  ghc-options:      -Wall -Wincomplete-uni-patterns -Wpartial-fields -fwarn-tabs+++library hstratus-auth-internal+  exposed-modules:  Network.HStratus.Internal.Endpoints+                    Network.HStratus.Internal.Http+                    Network.HStratus.Internal.HttpErrors+                    Network.HStratus.Internal.LoginFSM+                    Network.HStratus.Internal.PBKDF2+                    Network.HStratus.Internal.Session+                    Network.HStratus.Internal.Trust+  hs-source-dirs:   src-internal+  build-depends:+    , aeson                >=2.0   && <2.3+    , aeson-casing         >=0.1 && <0.3+    , base                 >=4.12 && <5+    , base16-bytestring    >=1.0 && <1.1+    , bytestring           >=0.10.8 && <0.11 || >=0.11.3 && <0.13+    , case-insensitive     >=1.2 && <1.3+    , containers           >=0.6 && <0.8+    , crypto-srp           >=0.1 && <0.2+    , directory            >=1.3 && <1.4+    , filepath             >=1.4 && <1.6+    , http-client          >=0.5 && <0.8+    , http-types           >=0.12.1 && <0.13+    , simple-prompt        >=0.2 && <0.3+    , string-conv          >=0.1 && <0.3+    , text                 >=1.2.3 && <2.2+    , unix                 >=2.7 && <2.9+    , uuid                 >=1.3 && <1.4+    , xdg-basedir          >=0.2 && <0.3+  default-language: Haskell2010+  ghc-options:      -Wall -Wincomplete-uni-patterns -Wpartial-fields -fwarn-tabs+++test-suite test+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs+  hs-source-dirs:   test+  autogen-modules:  Paths_hstratus_auth+  other-modules:    HStratus.ApiLoggerSpec+                    HStratus.Examples+                    HStratus.Http.CliSpec+                    HStratus.HttpMockSpec+                    HStratus.HttpSpec+                    HStratus.Http.EndpointsSpec+                    HStratus.Http.ErrorsSpec+                    HStratus.Http.HeadersSpec+                    HStratus.LoginFSMSpec+                    HStratus.Mock+                    HStratus.PBKDF2Spec+                    HStratus.SessionSpec+                    HStratus.TrustSpec+                    Paths_hstratus_auth+  default-language: Haskell2010+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs+  build-depends:+    , aeson+    , base+    , base16-bytestring+    , bytestring+    , containers+    , cryptohash-sha1      >=0.11 && <0.12+    , cryptohash-sha256    >=0.11 && <0.12+    , cryptohash-sha512    >=0.11 && <0.12+    , crypto-srp           >=0.1 && <0.2+    , directory            >=1.3.6  && <1.5+    , filepath             >=1.4 && <1.6+    , benri-hspec          >=0.1 && <0.3+    , hspec                >=2.1 && < 3.0+    , http-client          >=0.5 && <0.8+    , http-types+    , 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+    , wai                  >=3.2 && <3.3+    , warp                 >=3.2 && <3.5+    , main-tester          >= 0.2 && < 0.3+    , unix                 >=2.7 && <2.9+    , hstratus-auth:hstratus-auth-internal+

@@ -0,0 +1,131 @@+{-# 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

@@ -0,0 +1,296 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.HStratus.Internal.Endpoints+Copyright   : (c) 2025 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module Network.HStratus.Internal.Endpoints+  ( -- * Types+    Endpoints (..)+  , Realm (..)++    -- * Region selection+  , realmEndpoints++    -- * Request builders+  , signinInitBase+  , signinCompleteBase+  , validateBase+  , accountLoginBase+  , twoSvTrust+  , twoFaOptionsBase+  , verifySecurityCodeReq+  , validateVerification+  , sendVerification+  , listDevices++    -- * Request modifiers+  , extendPath+  , toPut+  , withHeaders+  , withBody+  , withAcceptJson+  , withWidgetKey+  , withAppleOauthHeaders++    -- * Header helpers+  , homeHeaders+  , icloudBrowserHeaders++    -- * Shared service utilities+  , icloudHome+  , stripTrailingSlash+  , lookupWebservice+  )+where++import Control.Exception (throwIO)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as LBS+import Data.CaseInsensitive (mk)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.String.Conv (toS)+import Data.Text (Text)+import Network.HStratus.Internal.HttpErrors (AuthError (..))+import Network.HStratus.Internal.Session (Webservice (..))+import Network.HTTP.Client+  ( Request (..)+  , RequestBody (..)+  , defaultRequest+  , parseRequest+  )+import Network.HTTP.Types+  ( Header+  , HeaderName+  , RequestHeaders+  , hAccept+  , hReferer+  , hUserAgent+  , methodGet+  , methodPost+  , methodPut+  )+++-- | @RequestHeaders@ that include the @Endpoint@ @home@+homeHeaders :: Endpoints -> RequestHeaders+homeHeaders ep = [(hOrigin, epHome ep), (hReferer, epHome ep <> "/")]+++commonHeaders :: Endpoints -> RequestHeaders+commonHeaders ep = userAgent : homeHeaders ep+++-- | Construct a new @Request@ with that path changed by adding a suffix+extendPath :: Request -> ByteString -> Request+extendPath req suffix = req{path = path req <> suffix}+++-- | Construct a new @Request@ with the method changed to @GET@+toGet :: Request -> Request+toGet req = req{method = methodGet}+++-- | Construct a new @Request@ with the method changed to @PUT@+toPut :: Request -> Request+toPut req = req{method = methodPut}+++data Endpoints = Endpoints+  { epHome :: !ByteString+  -- ^ home origin, e.g. @https://www.icloud.com@; used in @Origin@ and @Referer@ headers+  , epAuth :: !Request+  -- ^ base request for the authentication endpoint (@idmsa.apple.com@)+  , epSetup :: !Request+  -- ^ base request for the setup\/account endpoint (@setup.icloud.com@)+  , epWidgetKey :: !ByteString+  -- ^ value sent as @X-Apple-Widget-Key@ and @X-Apple-OAuth-Client-Id@; override if Apple rotates it+  }+++data Realm = China | Usual+  deriving (Eq, Show)+++realmEndpoints :: Realm -> Endpoints+realmEndpoints China = chinaEndpoints+realmEndpoints Usual = usualEndpoints+++-- | The iCloud home origin used in @Origin@ and @Referer@ headers.+icloudHome :: ByteString+icloudHome = "https://www.icloud.com"+++usualEndpoints :: Endpoints+usualEndpoints =+  Endpoints+    { epHome = icloudHome+    , epAuth = authReq+    , epSetup = setupReq+    , epWidgetKey = iCloudKey+    }+++chinaEndpoints :: Endpoints+chinaEndpoints =+  Endpoints+    { epHome = "https://www.icloud.com.cn"+    , epAuth = authReq -- idmsa.apple.com is Apple's global SRP endpoint; not region-specific+    , epSetup = setupReq{host = "setup.icloud.com.cn"}+    , epWidgetKey = iCloudKey+    }+++apiRequest :: Request+apiRequest =+  defaultRequest+    { secure = True+    , port = 443+    , method = methodPost+    }+++authReq :: Request+authReq = apiRequest{host = "idmsa.apple.com", path = "/appleauth/auth"}+++setupReq :: Request+setupReq = apiRequest{host = "setup.icloud.com", path = "/setup/ws/1"}+++appleOauthHeaders :: ByteString -> [Header]+appleOauthHeaders key =+  [ ("X-Apple-OAuth-Client-Id", key)+  , ("X-Apple-OAuth-Client-Type", "firstPartyAuth")+  , ("X-Apple-OAuth-Redirect-URI", "https://www.icloud.com")+  , ("X-Apple-OAuth-Require-Grant-Code", "true")+  , ("X-Apple-OAuth-Response-Mode", "web_message")+  , ("X-Apple-OAuth-Response-Type", "code")+  , ("X-Apple-Widget-Key", key)+  ]+++iCloudKey :: ByteString+iCloudKey = "d39ba9916b7251055b22c7f910e2ea796ee65e98b2ddecea8f5dde8d9d1a815d"+++browserAgent :: ByteString+browserAgent = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/109.0.0.0 Safari/537.36"+++userAgent :: Header+userAgent = (hUserAgent, browserAgent)+++acceptJson :: Header+acceptJson = (hAccept, "application/json")+++-- | build the basic @Request@ to make the initiate signin+signinInitBase :: Endpoints -> Request+signinInitBase = (`extendPath` "/signin/init") . epAuth+++-- | build the basic @Request@ to complete signin+signinCompleteBase :: Endpoints -> Request+signinCompleteBase =+  let+    withQuery x = x{queryString = "isRememberMeEnabled=true"}+   in+    withQuery . (`extendPath` "/signin/complete") . epAuth+++-- | build the basic @Request@ to that validates user credentials+validateBase :: Endpoints -> Request+validateBase ep = withHeaders (commonHeaders ep) $ (`extendPath` "/validate") $ epSetup ep+++-- | build the basic @Request@ to that performs login+accountLoginBase :: Endpoints -> Request+accountLoginBase = (`extendPath` "/accountLogin") . epSetup+++-- | build the basic @Request@ to that makes the saved credentials trusted+twoSvTrust :: Endpoints -> Request+twoSvTrust = (`extendPath` "/2sv/trust") . toGet . epAuth+++-- | build the @Request@ to fetch the 2FA options after the 409 from signin/complete+twoFaOptionsBase :: Endpoints -> Request+twoFaOptionsBase = toGet . epAuth+++-- | build the @Request@ to that verifies makes a security code+verifySecurityCodeReq :: Text -> Endpoints -> Request+verifySecurityCodeReq codeType =+  (`extendPath` ("/verify/" <> toS codeType <> "/securitycode")) . epAuth+++validateVerification :: Endpoints -> Request+validateVerification = (`extendPath` "/validateVerificationCode") . epSetup+++sendVerification :: Endpoints -> Request+sendVerification = (`extendPath` "/sendVerificationCode") . epSetup+++listDevices :: Endpoints -> Request+listDevices = (`extendPath` "/listDevices") . toGet . epSetup+++withHeaders :: RequestHeaders -> Request -> Request+withHeaders newHeaders req = req{requestHeaders = newHeaders <> requestHeaders req}+++withBody :: LBS.LazyByteString -> Request -> Request+withBody b req = req{requestBody = RequestBodyLBS b}+++hOrigin :: HeaderName+hOrigin = mk "Origin"+++withAcceptJson :: RequestHeaders -> RequestHeaders+withAcceptJson = (acceptJson :)+++withWidgetKey :: ByteString -> RequestHeaders -> RequestHeaders+withWidgetKey key = (("X-Apple-Widget-Key", key) :)+++withAppleOauthHeaders :: ByteString -> RequestHeaders -> RequestHeaders+withAppleOauthHeaders key = (appleOauthHeaders key <>)+++-- | Standard browser-style headers sent with every iCloud service request.+icloudBrowserHeaders :: RequestHeaders+icloudBrowserHeaders =+  [ acceptJson+  , userAgent+  , (hOrigin, icloudHome)+  , (hReferer, icloudHome <> "/")+  ]+++-- | Strip a trailing @/@ from a strict 'ByteString' path.+stripTrailingSlash :: ByteString -> ByteString+stripTrailingSlash bs+  | not (BS8.null bs) && BS8.last bs == '/' = BS8.init bs+  | otherwise = bs+++{- | Look up a service URL by key in the webservices map and parse it into a+'Request'.  Fails with an informative message if the key is absent.+-}+lookupWebservice :: Text -> Map Text Webservice -> IO Request+lookupWebservice key ws =+  case Map.lookup key ws of+    Nothing -> throwIO $ WebserviceNotFound key+    Just (Webservice _ (Just "inactive")) -> throwIO $ WebserviceNotFound key+    Just (Webservice url _) -> parseRequest (toS url)

@@ -0,0 +1,144 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module      : Network.HStratus.Internal.Http+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Internal HTTP request body builders and SRP authentication context types.+-}+module Network.HStratus.Internal.Http+  ( validateSetupBody+  , phoneCodeBody+  , phoneTriggerBody+  , needsRetry+  , PasswordProtocol (..)+  , KeyDeriver (..)+  , SrpContext (..)+  , hCounter+  , hCountry+  , hSessionId+  , hSessionToken+  , hTrustToken+  )+where++import Crypto.SRP+  ( FromClient (..)+  , FromServer (..)+  , XCalculator (..)+  , hashMany+  , hashText+  )+import Data.Aeson (FromJSON (..), Value (..), withText)+import Data.Aeson.KeyMap (fromList)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import Data.CaseInsensitive (mk)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Word (Word64)+import Network.HStratus.Internal.PBKDF2 (FancyPseudoRandomF, deriveKey)+import Network.HStratus.Internal.Trust (Setup2SADevice (..), TrustedPhone (..))+import Network.HTTP.Types.Header (HeaderName)+++-- | Models the known values of password protocol+data PasswordProtocol+  = -- | legacy @s2k_fo@ protocol: password is hex-encoded before hashing+    Old+  | -- | current @s2k@ protocol: password is hashed directly+    New+  deriving (Eq, Show)+++instance FromJSON PasswordProtocol where+  parseJSON =+    let fromText "s2k" = Right New+        fromText "s2k_fo" = Right Old+        fromText alt = Left $ "unknown PasswordProtocol: " ++ show alt+     in withText "PasswordProtocol" $ either fail pure . fromText+++-- | Data used during key derivation and verification+data KeyDeriver = KeyDeriver+  { kdTag :: !Text+  -- ^ SRP session tag from Apple's server response+  , kdIterations :: !Word64+  -- ^ PBKDF2 iteration count from Apple's server response+  , kdProtocol :: !PasswordProtocol+  -- ^ password hashing protocol in use for this session+  , kdWrappedF :: !FancyPseudoRandomF+  -- ^ PBKDF2 pseudo-random function, pre-wrapped with the negotiated hash algorithm+  }+++instance XCalculator KeyDeriver where+  calcX = calcXUsingKeyDeriver+++calcXUsingKeyDeriver :: KeyDeriver -> FromClient -> FromServer -> BS.ByteString+calcXUsingKeyDeriver kd fc fs =+  let FromServer{fsSalt, fsKnownAlgorithm = hashAlgo} = fs+      h = hashMany hashAlgo+      KeyDeriver{kdIterations = count, kdWrappedF, kdProtocol} = kd+      useProtocol Old = Base16.encode+      useProtocol New = id+      hashed = useProtocol kdProtocol $ hashText hashAlgo $ fcPassword fc+      reallyHashed = deriveKey kdWrappedF hashed fsSalt count+   in h [fsSalt, h [":", reallyHashed]]+++-- | Bundles the SRP client\/server data and key deriver for a single auth attempt+data SrpContext = SrpContext+  { srpFromClient :: !FromClient+  -- ^ client-side SRP values (public key, password verifier input)+  , srpFromServer :: !FromServer+  -- ^ server-side SRP values (salt, public key, hash algorithm)+  , srpKeyDeriver :: !KeyDeriver+  -- ^ key derivation parameters negotiated during SRP init+  }+++-- | @HeaderName@s used to capture session info from HTTP responses+hCountry, hSessionId, hSessionToken, hTrustToken, hCounter :: HeaderName+hCountry = mk "X-Apple-ID-Account-Country"+hSessionId = mk "X-Apple-ID-Session-Id"+hSessionToken = mk "X-Apple-Session-Token"+hTrustToken = mk "X-Apple-TwoSV-Trust-Token"+hCounter = mk "scnt"+++-- | Build the JSON body to submit a legacy 2SA verification code for a given device.+validateSetupBody :: Setup2SADevice -> Text -> Value+validateSetupBody (Setup2SADevice fields) code =+  Object $ fields <> fromList [("verificationCode", String code), ("trustBrowser", Bool True)]+++-- | Build the JSON body to trigger an SMS code to the given phone+phoneTriggerBody :: TrustedPhone -> Value+phoneTriggerBody tp =+  Object $+    fromList+      [ ("phoneNumber", Object $ fromList [("id", Number $ fromIntegral $ tpnId tp)])+      , ("mode", String $ fromMaybe "sms" $ tpnPushMode tp)+      ]+++-- | @True@ when the HTTP status code warrants a single automatic retry (421, 450, or 500).+needsRetry :: Int -> Bool+needsRetry status = status == 421 || status == 450 || status == 500+++-- | Build the JSON body to verify an SMS code received on the given phone+phoneCodeBody :: TrustedPhone -> Text -> Value+phoneCodeBody tp code =+  Object $+    fromList+      [ ("phoneNumber", Object $ fromList [("id", Number $ fromIntegral $ tpnId tp)])+      , ("securityCode", Object $ fromList [("code", String code)])+      , ("mode", String $ fromMaybe "sms" $ tpnPushMode tp)+      ]

@@ -0,0 +1,134 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.HStratus.Internal.HttpErrors+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Datatypes that model the structured errors returned by the iCloud API.+-}+module Network.HStratus.Internal.HttpErrors+  ( -- * API response wrapper+    ApiResponse (..)++    -- * API error embedded in 'ApiResponse'+  , ApiError (..)++    -- * Public exception type+  , AuthError (..)++    -- * Common service-error marker+  , HStratusError++    -- * Extracting results+  , extractOr+  )+where++import Control.Applicative (Alternative (..), (<|>))+import Control.Exception (Exception, throwIO)+import Data.Aeson+  ( FromJSON (..)+  , Object+  , withObject+  , (.:)+  , (.:?)+  )+import Data.Aeson.KeyMap (member)+import Data.Aeson.Types (Parser)+import Data.Text (Text)+++-- | Represents an API response that may succeed or fail with @ApiError@+data ApiResponse a = Failed !ApiError | Succeeded !a+  deriving (Eq, Show)+++instance (FromJSON a) => FromJSON (ApiResponse a) where+  parseJSON v = (Failed <$> parseJSON v) <|> (Succeeded <$> parseJSON v)+++-- | Represents an API response that reports a failure.+data ApiError+  = ApiError+  { aeReason :: !Text+  , aeCode :: !(Maybe Text)+  }+  deriving (Eq, Show)+++instance FromJSON ApiError where+  parseJSON = withObject "ApiError" parseApiError+++-- | Structured errors thrown by the iCloud authentication layer+data AuthError+  = -- | The supplied credentials were rejected.+    InvalidCredentials+  | -- | The account has been locked due to too many failed sign-in attempts.+    AccountLocked+  | -- | The server requires the user to accept updated privacy terms before continuing.+    PrivacyAgreementRequired+  | -- | Session credentials were absent when the login flow required them.+    CredentialsMissing+  | -- | The artifact directory could not be created; the 'FilePath' names the directory.+    ArtifactDirCreationFailed !FilePath+  | -- | The SRP key exchange failed due to an invalid server public value.+    SrpProtocolError+  | -- | Two-factor authentication is locked after too many incorrect code attempts.+    TwoFactorLocked+  | -- | Two-factor authentication is still required after a verification attempt.+    TwoFactorStillRequired+  | -- | A required iCloud webservice URL was absent from 'AccountData'; the 'Text' is the service key.+    WebserviceNotFound !Text+  | -- | The API returned a structured service error with a reason and an optional error code.+    ServiceError !Text !(Maybe Text)+  | -- | An HTTP response that could not be interpreted; the 'Text' describes the failure.+    UnexpectedResponse !Text+  deriving (Eq, Show)+++instance Exception AuthError+++{- | Marker class for exceptions thrown by iCloud service libraries.++Declare an instance for each library-level error type so that 'onServiceError'+in "Network.HStratus.Http.Cli" can be used as a uniform catch handler.+-}+class (Exception e) => HStratusError e+++instance HStratusError AuthError+++-- | Extract the result from an 'ApiResponse', throwing 'ServiceError' on failure.+extractOr :: ApiResponse a -> IO a+extractOr (Succeeded x) = pure x+extractOr (Failed x) = throwIO $ ServiceError (aeReason x) (aeCode x)+++{-+In python, this looks like:++   if isinstance(data, dict):+       reason = data.get("errorMessage")+       reason = reason or data.get("reason")+       reason = reason or data.get("errorReason")+       if not reason and isinstance(data.get("error"), str):+           reason = data.get("error")+       if not reason and data.get("error"):+           reason = "Unknown reason"++       code = data.get("errorCode")+       if not code and data.get("serverErrorCode"):+           code = data.get("serverErrorCode")+-}+parseApiError :: Object -> Parser ApiError+parseApiError o =+  let reason = o .: "errorMessage" <|> o .: "reason" <|> o .: "errorReason" <|> orError+      hasError = member "error" o+      orError = o .: "error" <|> (if hasError then pure "unknown error" else empty)+      code = o .: "errorCode" <|> o .:? "serverErrorCode"+   in ApiError <$> reason <*> code

@@ -0,0 +1,348 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module      : Network.HStratus.Internal.LoginFSM+Copyright   : (c) 2025 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Provides datatypes that represent the Finite State Machine that specifies the+Login process+-}+module Network.HStratus.Internal.LoginFSM where++import Data.Functor ((<&>))+import Data.Kind (Type)+import Data.List.NonEmpty (NonEmpty)+import Data.Text (Text)+import Data.Word (Word8)+import Network.HStratus.Internal.Http (SrpContext (..))+import Network.HStratus.Internal.Session (AccountData, Credentials, SavedHeaders)+import Network.HStratus.Internal.Trust (Setup2SADevice, TrustData, TrustedPhone)+++-- | Configuration for the 2FA challenge process.+data TwoFaConfig = TwoFaConfig+  { tfcPickPhone :: TrustData -> IO (Maybe TrustedPhone)+  -- ^ select a phone to receive an SMS code, or 'Nothing' to use a trusted device push+  , tfcReadCode :: Word8 -> IO Text+  -- ^ prompt the user for the verification code; receives the expected digit count+  }+++-- | Configuration for the 2SA challenge process.+data TwoSaConfig = TwoSaConfig+  { tscPickDevice :: NonEmpty Setup2SADevice -> IO Setup2SADevice+  -- ^ select the device to receive a verification code+  , tscReadCode :: IO Text+  -- ^ prompt the user for the verification code+  }+++{- | @LoginEvent@ represents the valid events of the Login FSM.++Each event is represent by a typeclass function that is constrained+to go between valid states+-}+class LoginEvent m where+  -- | Represents valid finite states at the endpoints of a 'LoginEvent'+  type State m :: Type -> Type+++  initial :: m (State m RatifyCredentials)+  ratifyCreds :: State m RatifyCredentials -> m (AfterCredentials (State m))+  ratifyArtifactDir :: State m RatifyArtifactDir -> m (AfterArtifactDir (State m))+  mkArtifactDir :: State m MkArtifactDir -> m (AfterMkArtifactDir (State m))+  loadSession :: State m LoadLastSession -> m (AfterLoadLastSession (State m))+  validateSession :: State m HasSavedSession -> m (AfterValidateSession (State m))+  srpInit :: State m ReadyToAuth -> m (State m SrpInitDone)+  srpComplete :: State m SrpInitDone -> m (AfterSrpComplete (State m))+  acctLogin :: State m DoAccountLogin -> m (AfterAcctLogin (State m))+  listTwoSaDevices :: State m NeedsTwoSa -> m (State m TwoSaReady)+  beginTwoFa :: State m ReadyForTwoFa -> TwoFaConfig -> m (State m TwoFaVerifying)+  verifyTwoFa :: State m TwoFaVerifying -> TwoFaConfig -> m (AfterTwoFaVerify (State m))+  doTrust :: State m DoTrust -> m (State m DoAccountLogin)+  beginTwoSa :: State m ReadyForTwoSa -> TwoSaConfig -> m (State m TwoSaVerifying)+  verifyTwoSa :: State m TwoSaVerifying -> TwoSaConfig -> m (AfterTwoSaVerify (State m))+++-- | The outcome of 'loginProcess'.+data LoginOutcome f+  = LoginAuthenticated (f AuthComplete)+  | LoginNeedsTwoFa (f NeedsTwoFa)+  | LoginNeedsTwoSa (f TwoSaReady)+  | LoginHaltCreds (f HaltMissingCredentials)+  | LoginHaltDir (f HaltCannotMkArtifactDir)+  | LoginHaltSrp (f HaltInvalidSrp)+  | LoginHaltTwoFaLocked (f HaltTwoFaLocked)+++-- | The outcome of 'twoFaProcess' and 'twoSaProcess'.+data CompletionOutcome f+  = CompletionAuthenticated (f AuthComplete)+  | CompletionNeedsTwoFa (f NeedsTwoFa)+  | CompletionNeedsTwoSa (f TwoSaReady)+  | CompletionTwoFaLocked (f HaltTwoFaLocked)+++-- | The canonical login process using events from 'LoginEvent'.+loginProcess+  :: ( LoginEvent m+     , Monad m+     )+  => m (LoginOutcome (State m))+loginProcess =+  initial >>= ratifyCreds >>= \case+    NoCreds e -> pure $ LoginHaltCreds e+    GotCreds x -> onCredsLoaded x+++onCredsLoaded+  :: (Monad m, LoginEvent m)+  => State m RatifyArtifactDir+  -> m (LoginOutcome (State m))+onCredsLoaded s =+  ratifyArtifactDir s >>= \case+    DirPresent x -> onArtifactDirPresent x+    DirAbsent a ->+      mkArtifactDir a >>= \case+        NotMade e -> pure $ LoginHaltDir e+        DirMade x -> onArtifactDirPresent x+++onArtifactDirPresent+  :: (Monad m, LoginEvent m)+  => State m LoadLastSession+  -> m (LoginOutcome (State m))+onArtifactDirPresent s =+  loadSession s >>= \case+    HasClientId x -> onReadyToAuth x+    HasPriorSession x ->+      validateSession x >>= \case+        SessionStillValid y -> pure $ LoginAuthenticated y+        SessionStale y -> onReadyToAuth y+++onReadyToAuth+  :: (Monad m, LoginEvent m)+  => State m ReadyToAuth+  -> m (LoginOutcome (State m))+onReadyToAuth s =+  srpInit s >>= srpComplete >>= \case+    SrpCompleteOk x -> acctLogin x >>= fmap completionToLogin . onAcctLoginDone+    SrpCompleteInvalidKey x -> pure $ LoginHaltSrp x+++onAcctLoginDone+  :: (Monad m, LoginEvent m)+  => AfterAcctLogin (State m)+  -> m (CompletionOutcome (State m))+onAcctLoginDone = \case+  AcctLoginOk y -> pure $ CompletionAuthenticated y+  AcctLogin2FA y -> pure $ CompletionNeedsTwoFa y+  AcctLogin2SA y -> listTwoSaDevices y <&> CompletionNeedsTwoSa+++completionToLogin :: CompletionOutcome f -> LoginOutcome f+completionToLogin (CompletionAuthenticated x) = LoginAuthenticated x+completionToLogin (CompletionNeedsTwoFa x) = LoginNeedsTwoFa x+completionToLogin (CompletionNeedsTwoSa x) = LoginNeedsTwoSa x+completionToLogin (CompletionTwoFaLocked x) = LoginHaltTwoFaLocked x+++-- | The 2FA completion process using events from 'LoginEvent'.+twoFaProcess+  :: (LoginEvent m, Monad m)+  => State m ReadyForTwoFa+  -> TwoFaConfig+  -> m (CompletionOutcome (State m))+twoFaProcess s cfg =+  beginTwoFa s cfg >>= flip verifyTwoFa cfg >>= \case+    TwoFaOk x -> doTrust x >>= acctLogin >>= onAcctLoginDone+    TwoFaRetry x -> twoFaProcess x cfg+    TwoFaLocked x -> pure $ CompletionTwoFaLocked x+++-- | The 2SA completion process using events from 'LoginEvent'.+twoSaProcess+  :: (LoginEvent m, Monad m)+  => State m ReadyForTwoSa+  -> TwoSaConfig+  -> m (CompletionOutcome (State m))+twoSaProcess s cfg =+  beginTwoSa s cfg >>= flip verifyTwoSa cfg >>= \case+    TwoSaOk x -> acctLogin x >>= onAcctLoginDone+    TwoSaRetry x -> twoSaProcess x cfg+++{- | The states of FSM defining the login process.++Each constructor specifies the concrete data required by the process in that+state, and is tagged with a distinct phantom type.+-}+data LoginFSM s where+  RatifyCredentials :: LoginFSM RatifyCredentials+  HaltMissingCredentials :: LoginFSM HaltMissingCredentials+  RatifyArtifactDir :: Credentials -> LoginFSM RatifyArtifactDir+  MkArtifactDir :: Credentials -> LoginFSM MkArtifactDir+  HaltCannotMkArtifactDir :: Credentials -> LoginFSM HaltCannotMkArtifactDir+  LoadLastSession :: Credentials -> LoginFSM LoadLastSession+  HasSavedSession :: Credentials -> SavedHeaders -> LoginFSM HasSavedSession+  ReadyToAuth :: Credentials -> SavedHeaders -> LoginFSM ReadyToAuth+  SrpInitDone :: Credentials -> SrpContext -> LoginFSM SrpInitDone+  DoAccountLogin :: Credentials -> LoginFSM DoAccountLogin+  AuthComplete :: Credentials -> AccountData -> LoginFSM AuthComplete+  NeedsTwoFa :: Credentials -> LoginFSM NeedsTwoFa+  ReadyForTwoFa :: Credentials -> TrustData -> LoginFSM ReadyForTwoFa+  TwoFaVerifying :: Credentials -> TrustData -> Maybe TrustedPhone -> LoginFSM TwoFaVerifying+  DoTrust :: Credentials -> LoginFSM DoTrust+  NeedsTwoSa :: Credentials -> LoginFSM NeedsTwoSa+  TwoSaReady :: Credentials -> NonEmpty Setup2SADevice -> LoginFSM TwoSaReady+  ReadyForTwoSa :: Credentials -> NonEmpty Setup2SADevice -> LoginFSM ReadyForTwoSa+  TwoSaVerifying :: Credentials -> Setup2SADevice -> NonEmpty Setup2SADevice -> LoginFSM TwoSaVerifying+  HaltInvalidSrp :: Credentials -> LoginFSM HaltInvalidSrp+  HaltTwoFaLocked :: Credentials -> LoginFSM HaltTwoFaLocked+++-- | Phantom type linked to a unique state in 'LoginFSM'+data RatifyCredentials+++-- | Phantom type linked to a unique state in 'LoginFSM'+data HaltMissingCredentials+++-- | Phantom type linked to a unique state in 'LoginFSM'+data RatifyArtifactDir+++-- | Phantom type linked to a unique state in 'LoginFSM'+data MkArtifactDir+++-- | Phantom type linked to a unique state in 'LoginFSM'+data HaltCannotMkArtifactDir+++-- | Phantom type linked to a unique state in 'LoginFSM'+data LoadLastSession+++-- | Phantom type linked to a unique state in 'LoginFSM'+data HasSavedSession+++-- | Phantom type linked to a unique state in 'LoginFSM'+data ReadyToAuth+++-- | Phantom type linked to a unique state in 'LoginFSM'+data SrpInitDone+++-- | Phantom type linked to a unique state in 'LoginFSM'+data DoAccountLogin+++-- | Phantom type linked to a unique state in 'LoginFSM'+data AuthComplete+++-- | Phantom type linked to a unique state in 'LoginFSM'+data NeedsTwoFa+++-- | Phantom type linked to a unique state in 'LoginFSM'+data ReadyForTwoFa+++-- | Phantom type linked to a unique state in 'LoginFSM'+data TwoFaVerifying+++-- | Phantom type linked to a unique state in 'LoginFSM'+data DoTrust+++-- | Phantom type linked to a unique state in 'LoginFSM'+data NeedsTwoSa+++-- | Phantom type linked to a unique state in 'LoginFSM'+data TwoSaReady+++-- | Phantom type linked to a unique state in 'LoginFSM'+data ReadyForTwoSa+++-- | Phantom type linked to a unique state in 'LoginFSM'+data TwoSaVerifying+++-- | Phantom type linked to a unique state in 'LoginFSM'+data HaltInvalidSrp+++-- | Phantom type linked to a unique state in 'LoginFSM'+data HaltTwoFaLocked+++-- | The valid states after 'loadSession'+data AfterLoadLastSession f+  = HasClientId (f ReadyToAuth)+  | HasPriorSession (f HasSavedSession)+++-- | The valid states after 'validateSession'+data AfterValidateSession f+  = SessionStillValid (f AuthComplete)+  | SessionStale (f ReadyToAuth)+++-- | The valid states after 'mkArtifactDir'+data AfterMkArtifactDir f+  = NotMade (f HaltCannotMkArtifactDir)+  | DirMade (f LoadLastSession)+++-- | The valid states after 'ratifyArtifactDir'+data AfterArtifactDir f+  = DirPresent (f LoadLastSession)+  | DirAbsent (f MkArtifactDir)+++-- | The valid states after 'ratifyCreds'+data AfterCredentials f+  = NoCreds (f HaltMissingCredentials)+  | GotCreds (f RatifyArtifactDir)+++-- | The valid states after 'srpComplete'+data AfterSrpComplete f+  = SrpCompleteOk (f DoAccountLogin)+  | SrpCompleteInvalidKey (f HaltInvalidSrp)+++-- | The valid states after 'acctLogin'+data AfterAcctLogin f+  = AcctLoginOk (f AuthComplete)+  | AcctLogin2FA (f NeedsTwoFa)+  | AcctLogin2SA (f NeedsTwoSa)+++-- | The valid states after 'verifyTwoFa'+data AfterTwoFaVerify f+  = TwoFaOk (f DoTrust)+  | TwoFaRetry (f ReadyForTwoFa)+  | TwoFaLocked (f HaltTwoFaLocked)+++-- | The valid states after 'verifyTwoSa'+data AfterTwoSaVerify f+  = TwoSaOk (f DoAccountLogin)+  | TwoSaRetry (f ReadyForTwoSa)

@@ -0,0 +1,166 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BinaryLiterals #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module      : Network.HStratus.PBKDF2+Copyright   : (c) 2025 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Copied then modified from an implementation in the package+[ppad-pbkdf](https://git.ppad.tech/pbkdf/file/lib/Crypto/KDF/PBKDF.hs.html)++Re-implemented here rather than making it direct dependency, because:+    - 1 fewer dependency => less future dependency-related maintenance+    - faster route for this package to stackage+        - as of (2025/04/01, ppad-ppbkdf was not on stackage)+-}+module Network.HStratus.Internal.PBKDF2+  ( -- * specify a pseudorandom function and derived key length+    FancyPseudoRandomF+  , wrap+  , wrapIO+  , PseudoRandomF+  , BadKeyLength (..)++    -- * perform PBKDF2 derivation+  , deriveKey++    -- * re-export+  , ByteString+  )+where++import Control.Exception (Exception, throwIO)+import Data.Bits (shiftR, xor, (.&.))+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Builder (byteString, toLazyByteString)+import Data.ByteString.Builder.Extra+  ( safeStrategy+  , smallChunkSize+  , toLazyByteStringWith+  )+import Data.Word (Word32, Word64)+++{- | A pseudorandom function for use in PBKDF2++See+[PBKDF-RFC/section5.2](https://datatracker.ietf.org/doc/html/rfc2898#section-5.2)+-}+type PseudoRandomF = ByteString -> ByteString -> ByteString+++-- | Indicates the derived key length is too long+data BadKeyLength = TooLong+  deriving (Eq, Show)+++instance Exception BadKeyLength+++{- | A 'PseudoRandomF' wrapped up with @dkLen@ and @hLen@'++where @dkLen@ the required length in octets of the derived key+and @hLen@ is the length of the output of the 'PseudoRandomF'++As per+[PBKDF-RFC/section5.2](https://datatracker.ietf.org/doc/html/rfc2898#section-5.2)++@dkLen@ must be at most 2^32 - 1 * @hLen@++The constructor `wrap` enforces this constraint+-}+newtype FancyPseudoRandomF = Fancy (PseudoRandomF, Word32, Word32)+++-- | Construct a 'FancyPseudoRandomF'+wrap :: PseudoRandomF -> Word32 -> Either BadKeyLength FancyPseudoRandomF+wrap f dkLen =+  let !hLen = toNum $ BS.length $ f mempty mempty+   in if dkLen > 0xffffffff * hLen+        then Left TooLong+        else Right $ Fancy (f, dkLen, hLen)+++-- | Like 'wrap', but fails by throwing 'BadKeyLength' in IO+wrapIO :: PseudoRandomF -> Word32 -> IO FancyPseudoRandomF+wrapIO f = either throwIO pure . wrap f+++blockInfoOf :: FancyPseudoRandomF -> (Word32, Int)+blockInfoOf (Fancy (_f, !dkLen, hLen)) =+  let numBlocks = ceiling (toNum dkLen / toNum hLen :: Double)+      lastBlockSize = toNum $ dkLen - (numBlocks - 1) * hLen+   in (numBlocks, lastBlockSize)+++{- | Derive a key from a secret using PBKDF2++Implements the key derivation algorithm described in+[PBKDF-RFC](https://datatracker.ietf.org/doc/html/rfc2898)++Usage - this example uses the SHA256 hmac function as the pseudorandom function++  >>> :set -XOverloadedStrings+  >>> import qualified Crypto.Hash.SHA256 as SHA256+  >>> pseudoF <- wrapIO SHA256.hmac 64+  >>> deriveKey pseudoF "passwd" "salt" 1000+-}+deriveKey+  :: FancyPseudoRandomF+  -- ^ a 'FancyPseudoRandomF'+  -> ByteString+  -- ^ the password from which to derive a key+  -> ByteString+  -- ^ the salt used in key derivation+  -> Word64+  -- ^ the iteration count+  -> ByteString+deriveKey fancy password salt count =+  let Fancy (!pseudoRandomF, !dkLen, !_notUsed) = fancy+      (!numBlocks, !lastBlockSize) = blockInfoOf fancy+      xorSum i =+        let initial = pseudoRandomF password $ salt <> asBytes i+            go j !current !_ignored | j == count = current+            go j !current !previous =+              let latest = pseudoRandomF password previous+               in go (j + 1) (current `xorBytes` latest) latest+         in go 1 initial initial+      {-# INLINE xorSum #-}++      smaller = safeStrategy 128 smallChunkSize+      strictBS =+        if dkLen <= 128+          then BS.toStrict . toLazyByteStringWith smaller mempty+          else BS.toStrict . toLazyByteString+      {-# INLINE strictBS #-}++      genBlocks i acc =+        if i < numBlocks+          then genBlocks (i + 1) (acc <> byteString (xorSum i))+          else strictBS $ acc <> byteString (BS.take lastBlockSize $ xorSum i)+   in genBlocks 1 mempty+++toNum :: (Integral a, Num b) => a -> b+toNum = fromIntegral+{-# INLINE toNum #-}+++asBytes :: Word32 -> ByteString+asBytes x =+  let !mask = 0b00000000000000000000000011111111+      !word0 = toNum (x `shiftR` 24) .&. mask+      !word1 = toNum (x `shiftR` 16) .&. mask+      !word2 = toNum (x `shiftR` 08) .&. mask+      !word3 = toNum x .&. mask+   in BS.cons word0 $ BS.cons word1 $ BS.cons word2 $ BS.singleton word3+{-# INLINE asBytes #-}+++xorBytes :: ByteString -> ByteString -> ByteString+xorBytes = BS.packZipWith xor+{-# INLINE xorBytes #-}

@@ -0,0 +1,572 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_HADDOCK prune #-}++module Network.HStratus.Internal.Session+  ( -- * Credentials+    Credentials (..)++    -- ** paths related to @Credentials@+  , cookiePath+  , clientIdPath+  , credentialsPath+  , savedHeadersPath+  , loginMsgPath++    -- * Session+  , Session (..)+  , SavedHeaders (..)+  , loadSession+  , saveCredentials+  , saveCredentialsTo+  , loadSavedHeaders+  , updateSessionSavedHeaders+  , updateSavedHeaders+  , pristine+  , saveLoginMsg++    -- * AccountData+  , Webservice (..)+  , AccountData (..)+  , accountDataRequires2FA+  , accountDataRequires2SA+  , unknownAccountData+  , accountDataPath+  , saveAccountData+  , loadAccountData++    -- * path components+  , appBase+  , (</>)++    -- * Utilities+  , encodeFileAtomic++    -- * File security+  , checkSecureMode+  , requireSecureFile+  , checkSessionFiles+  )+where++import Control.Applicative ((<|>))+import Control.Exception (bracketOnError, throwIO)+import Control.Monad (forM, when, (>=>))+import Data.Aeson+  ( FromJSON (..)+  , KeyValue (..)+  , Options (..)+  , ToJSON (..)+  , Value+  , eitherDecodeFileStrict+  , encode+  , genericParseJSON+  , genericToEncoding+  , genericToJSON+  , object+  , withObject+  , (.:)+  , (.:?)+  )+import Data.Aeson.Casing (aesonPrefix, snakeCase)+import qualified Data.Aeson.Key as AesonKey+import qualified Data.Aeson.KeyMap as KeyMap+import Data.Bits ((.&.))+import qualified Data.ByteString.Lazy as LBS+import Data.Char (isAlphaNum)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes)+import Data.String.Conv (toS)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Data.UUID (toText)+import Data.UUID.V4 (nextRandom)+import GHC.Generics (Generic)+import Network.HStratus.Internal.Http+  ( hCounter+  , hCountry+  , hSessionId+  , hSessionToken+  , hTrustToken+  )+import Network.HTTP.Types.Header (Header)+import Numeric (showOct)+import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile, renameFile)+import System.Environment.XDG.BaseDir (getUserConfigDir)+import System.FilePath (takeDirectory, (</>))+import System.IO (hClose, openTempFile)+import System.Posix.Files (fileMode, getFileStatus, setFileMode)+import System.Posix.Types (FileMode)+++-- | Update the @SavedHeaders@ using some response headers+updateSavedHeaders :: [Header] -> SavedHeaders -> SavedHeaders+updateSavedHeaders hs sd =+  sd+    { shCountry = (toS <$> lookup hCountry hs) <|> shCountry sd+    , shSessionId = (toS <$> lookup hSessionId hs) <|> shSessionId sd+    , shSessionToken = (toS <$> lookup hSessionToken hs) <|> shSessionToken sd+    , shTrustToken = (toS <$> lookup hTrustToken hs) <|> shTrustToken sd+    , shCounter = (toS <$> lookup hCounter hs) <|> shCounter sd+    }+++data Session = Session+  { sessionCreds :: !Credentials+  -- ^ the credentials used to authenticate+  , sessionTopDir :: !FilePath+  -- ^ directory where session files (cookies, headers, account data) are stored+  , sessionClientId :: !Text+  -- ^ per-client OAuth state identifier sent with each request+  }+  deriving+    ( Eq+      -- ^ don't derive Show to avoid the risk of logging a password+    )+++-- | Generates a new client ID.+newClientId :: IO Text+newClientId = ("auth-" <>) . toText <$> nextRandom+++{- | Determine the path of file containing the HTTP response headers to be+preserved to maintain a user's authentication state+-}+savedHeadersPath :: FilePath -> Credentials -> FilePath+savedHeadersPath topDir creds = topDir </> Text.unpack (sessionBase creds)+++-- | Determine the Cookie Jar file for user with the given credentials+cookiePath :: FilePath -> Credentials -> FilePath+cookiePath topDir creds = topDir </> Text.unpack (cookieBase creds)+++{- | Determine the path of file containing the client ID for user with the given+credentials+-}+clientIdPath :: FilePath -> Credentials -> FilePath+clientIdPath topDir creds = topDir </> Text.unpack (clientIdBase creds)+++-- | Determine the path of file to save the message the api returns on logon+loginMsgPath :: FilePath -> Credentials -> FilePath+loginMsgPath topDir creds = topDir </> Text.unpack (loginMsgBase creds)+++-- | Save the login message to user specific filepath+saveLoginMsg :: Session -> Value -> IO ()+saveLoginMsg Session{sessionCreds = creds, sessionTopDir = topDir} = saveValue (loginMsgPath topDir creds)+++-- | Metadata for a single iCloud webservice entry.+data Webservice = Webservice+  { wsUrl :: !Text+  -- ^ the base URL for the service+  , wsStatus :: !(Maybe Text)+  -- ^ service status, e.g. @"active"@ or @"inactive"@; @Nothing@ if absent+  }+  deriving (Eq, Show)+++data AccountData = AccountData+  { adHsaVersion :: !Int+  -- ^ HSA protocol version; drives the two-factor flow selection+  , adHsaChallengeRequired :: !Bool+  -- ^ @True@ when a 2FA challenge must be completed before access is granted+  , adHsaTrustedBrowser :: !(Maybe Bool)+  {- ^ @Just True@ when this session is already trusted; @Just False@ when explicitly+  untrusted; @Nothing@ when the key was absent from Apple's response (treated as trusted)+  -}+  , adWebservices :: !(Map Text Webservice)+  -- ^ map of webservice name to service info; use 'lookupWebservice' to resolve a URL+  , adRaw :: !Value+  -- ^ the original JSON value from Apple; preserved so serialisation round-trips losslessly+  }+  deriving (Eq, Show)+++instance FromJSON AccountData where+  parseJSON v = withObject "AccountData" go v+   where+    go o = do+      dsInfo <- o .: "dsInfo"+      adHsaVersion <- withObject "dsInfo" (.: "hsaVersion") dsInfo+      adHsaChallengeRequired <- o .:? "hsaChallengeRequired" >>= maybe (pure False) pure+      adHsaTrustedBrowser <- o .:? "hsaTrustedBrowser"+      adWebservices <- do+        mbWs <- o .:? "webservices"+        maybe (pure Map.empty) (withObject "webservices" parseWebservices) mbWs+      pure AccountData{adHsaVersion, adHsaChallengeRequired, adHsaTrustedBrowser, adWebservices, adRaw = v}+    parseWebservices obj = do+      let pairs = KeyMap.toAscList obj+      wsPairs <- forM pairs $ \(k, wsVal) ->+        withObject+          "webservice"+          ( \sv -> do+              mbUrl <- sv .:? "url"+              mbStatus <- sv .:? "status"+              pure $ fmap (\u -> (AesonKey.toText k, Webservice u mbStatus)) mbUrl+          )+          wsVal+      pure $ Map.fromList $ catMaybes wsPairs+++instance ToJSON AccountData where+  toJSON AccountData{adRaw} = adRaw+  toEncoding AccountData{adRaw} = toEncoding adRaw+++-- | True when full 2FA (auth-endpoint) challenge is required+accountDataRequires2FA :: AccountData -> Bool+accountDataRequires2FA ad =+  adHsaVersion ad == 2+    && (adHsaChallengeRequired ad || adHsaTrustedBrowser ad == Just False)+++-- | True when legacy 2SA (setup-endpoint) challenge is required+accountDataRequires2SA :: AccountData -> Bool+accountDataRequires2SA ad = adHsaVersion ad == 1+++-- | Sentinel used when no saved @AccountData@ is available+unknownAccountData :: AccountData+unknownAccountData =+  AccountData+    { adHsaVersion = 0+    , adHsaChallengeRequired = False+    , adHsaTrustedBrowser = Nothing+    , adWebservices = Map.empty+    , adRaw = object []+    }+++accountDataBase :: Credentials -> Text+accountDataBase = (<> ".account-data.json") . sprucedName+++-- | Determine the path of the saved account-data file for the given credentials+accountDataPath :: FilePath -> Credentials -> FilePath+accountDataPath topDir creds = topDir </> Text.unpack (accountDataBase creds)+++-- | Persist @AccountData@ to the session's filesystem location+saveAccountData :: Session -> AccountData -> IO ()+saveAccountData Session{sessionCreds = creds, sessionTopDir = topDir} =+  secureEncodeFileAtomic (accountDataPath topDir creds)+++-- | Load persisted @AccountData@; returns @Nothing@ if the file is absent+loadAccountData :: Session -> IO (Maybe AccountData)+loadAccountData Session{sessionCreds = creds, sessionTopDir = topDir} = do+  let path = accountDataPath topDir creds+  requireSecureFile path+  exists <- doesFileExist path+  if not exists+    then pure Nothing+    else eitherDecodeFileStrict path >>= either (const (pure Nothing)) (pure . Just)+++{- | Determine the path of file containing the credentials in the configuration+   directory+-}+credentialsPath :: FilePath -> FilePath+credentialsPath topDir = topDir </> "credentials.json"+++saveCredentials :: Credentials -> IO ()+saveCredentials creds = getUserConfigDir appBase >>= (`saveCredentialsTo` creds)+++-- | Write 'Credentials' to @credentials.json@ inside @topDir@, creating @topDir@ if absent.+saveCredentialsTo :: FilePath -> Credentials -> IO ()+saveCredentialsTo topDir creds = do+  createDirectoryIfMissing True topDir+  secureEncodeFileAtomic (credentialsPath topDir) creds+++data Credentials = Credentials+  { credAccountName :: !Text+  -- ^ the account ID; typically an email address+  , credPassword :: !Text+  -- ^ the iCloud account password+  }+  deriving+    ( Eq+      -- ^ don't derive Show to avoid the risk of logging a password+    )+++instance FromJSON Credentials where+  parseJSON = withObject "Credentials" $ \o ->+    let accountName = o .: "accountName"+        password = o .: "password"+     in Credentials <$> accountName <*> password+++instance ToJSON Credentials where+  toJSON c =+    object+      [ "password" .= credPassword c+      , "accountName" .= credAccountName c+      ]+++sprucedName :: Credentials -> Text+sprucedName =+  let p aChar = isAlphaNum aChar || aChar == '@'+      replaceAt = Text.replace "@" "-"+   in replaceAt . Text.filter p . credAccountName+++cookieBase :: Credentials -> Text+cookieBase = (<> ".cookies.txt") . sprucedName+++sessionBase :: Credentials -> Text+sessionBase = (<> ".session.json") . sprucedName+++clientIdBase :: Credentials -> Text+clientIdBase = (<> ".client-id.txt") . sprucedName+++loginMsgBase :: Credentials -> Text+loginMsgBase = (<> ".last-logon.json") . sprucedName+++-- | Data obtained from HTTP response headers that define a user session+data SavedHeaders = SavedHeaders+  { shCountry :: !(Maybe Text)+  -- ^ X-Apple-ID-Country value from the last response+  , shSessionId :: !(Maybe Text)+  -- ^ X-Apple-ID-Session-Id value from the last response+  , shSessionToken :: !(Maybe Text)+  -- ^ X-Apple-Session-Token value from the last response+  , shTrustToken :: !(Maybe Text)+  -- ^ X-Apple-TwoSV-Trust-Token value from the last response+  , shCounter :: !(Maybe Text)+  -- ^ X-Apple-HC-Bits value from the last response; used to derive hashcash proofs+  }+  deriving (Eq, Show, Generic)+++instance FromJSON SavedHeaders where+  parseJSON = genericParseJSON simpleOptions+++instance ToJSON SavedHeaders where+  toJSON = genericToJSON simpleOptions+  toEncoding = genericToEncoding simpleOptions+++-- | A @SavedHeaders@ with nothing set+pristine :: SavedHeaders+pristine = SavedHeaders Nothing Nothing Nothing Nothing Nothing+++{- | Update the stored saved headers++if the sessionData file exists+then+  load it.+  update the session data from the headers+  save the updated data+else+  ensure its parent directory exists+  create the session data from the headers+  save it++not handled (thrown as IOException):+  cannot create directory+  cannot write due to permissions+  file exists, but data cannot be parsed+-}+updateSessionSavedHeaders+  :: Session+  -> (SavedHeaders -> SavedHeaders)+  -- ^ a function that modifies the session's saved headers+  -> IO ()+updateSessionSavedHeaders s modSavedHeaders = do+  let dataPath = savedHeadersPath (sessionTopDir s) (sessionCreds s)+      updateAndSave = secureEncodeFileAtomic dataPath . modSavedHeaders+      loadLast False = pure pristine+      loadLast True = eitherDecodeFileStrict dataPath >>= either (fail . show) pure++  doesFileExist dataPath >>= loadLast >>= updateAndSave+++loadSession :: IO Session+loadSession = do+  sessionTopDir <- getUserConfigDir appBase+  createDirectoryIfMissing True sessionTopDir+  s <-+    loadSessionOr sessionTopDir+      >>= orFail "Credentials are missing or corrupt; run 'hstratus auth login' to authenticate"+  checkSessionFiles s+  pure s+++-- | Saves a JSON @Value@ to @filepath@+saveValue :: FilePath -> Value -> IO ()+saveValue fp v = LBS.writeFile fp $ encode v+++orFail :: String -> Either String a -> IO a+orFail hint = either (\e -> fail (hint <> " (" <> e <> ")")) pure+++-- | Write a JSON-encodable value to @path@ atomically via a temp file and rename.+encodeFileAtomic :: (ToJSON a) => FilePath -> a -> IO ()+encodeFileAtomic path value =+  bracketOnError+    (openTempFile (takeDirectory path) ".tmp")+    (\(tmpPath, h) -> hClose h >> removeFile tmpPath)+    ( \(tmpPath, h) -> do+        LBS.hPut h (encode value)+        hClose h+        renameFile tmpPath path+    )+++{- | Like 'encodeFileAtomic' but sets mode @0o600@ on the temp file before+renaming, so the file is never visible at a more permissive mode.+-}+secureEncodeFileAtomic :: (ToJSON a) => FilePath -> a -> IO ()+secureEncodeFileAtomic path value =+  bracketOnError+    (openTempFile (takeDirectory path) ".tmp")+    (\(tmpPath, h) -> hClose h >> removeFile tmpPath)+    ( \(tmpPath, h) -> do+        LBS.hPut h (encode value)+        hClose h+        setFileMode tmpPath 0o600+        renameFile tmpPath path+    )+++-- | Write text to @path@ atomically, setting mode @0o600@ before renaming.+secureWriteTextFileAtomic :: FilePath -> Text -> IO ()+secureWriteTextFileAtomic path content =+  bracketOnError+    (openTempFile (takeDirectory path) ".tmp")+    (\(tmpPath, h) -> hClose h >> removeFile tmpPath)+    ( \(tmpPath, h) -> do+        Text.hPutStr h content+        hClose h+        setFileMode tmpPath 0o600+        renameFile tmpPath path+    )+++{- | Pure permission check using the SSH convention: no group or world bits may+be set.  Returns @Left@ with a descriptive message (including a @chmod 600@ hint)+when the mode is too permissive.+-}+checkSecureMode :: FileMode -> FilePath -> Either String ()+checkSecureMode mode path+  | mode .&. 0o077 /= 0 =+      Left $+        path+          <> " has unsafe permissions ("+          <> showOct (fromIntegral mode :: Int) ""+          <> "); fix with: chmod 600 "+          <> path+  | otherwise = Right ()+++{- | Verify that a file has secure permissions before it is read.  Does nothing+if the file does not exist; absence is handled by the caller.  Throws an+'IOError' when the file exists but its mode has group or world bits set.+-}+requireSecureFile :: FilePath -> IO ()+requireSecureFile path = do+  exists <- doesFileExist path+  when exists $ do+    mode <- fileMode <$> getFileStatus path+    either (throwIO . userError) pure (checkSecureMode mode path)+++{- | Check that every session file that exists has secure permissions.  Absent+files are skipped silently.  Throws an 'IOError' for the first file found with+group or world bits set.++Covers all five session paths: credentials, saved headers, client ID, account+data, and the cookie jar.+-}+checkSessionFiles :: Session -> IO ()+checkSessionFiles sess = do+  let topDir = sessionTopDir sess+      creds = sessionCreds sess+  mapM_+    requireSecureFile+    [ credentialsPath topDir+    , savedHeadersPath topDir creds+    , clientIdPath topDir creds+    , accountDataPath topDir creds+    , cookiePath topDir creds+    ]+++loadCredentials :: FilePath -> IO (Either String Credentials)+loadCredentials topDir = do+  let path = credentialsPath topDir+  requireSecureFile path+  eitherDecodeFileStrict path+++loadCredentials' :: FilePath -> IO (Either String (FilePath, Credentials))+loadCredentials' topDir = fmap (topDir,) <$> loadCredentials topDir+++loadSession' :: Either String (FilePath, Credentials) -> IO (Either String Session)+loadSession' (Left err) = pure $ Left err+loadSession' (Right (sessionTopDir, sessionCreds)) = do+  sessionClientId <- loadClientId sessionTopDir sessionCreds+  pure $ Right Session{sessionClientId, sessionCreds, sessionTopDir}+++loadSessionOr :: FilePath -> IO (Either String Session)+loadSessionOr = loadCredentials' >=> loadSession'+++-- | Load the @SavedHeaders@ for this session+loadSavedHeaders :: Session -> IO SavedHeaders+loadSavedHeaders Session{sessionTopDir, sessionCreds} =+  loadSavedHeaders' sessionTopDir sessionCreds+    >>= orFail "Session state is corrupt; run 'hstratus auth login' to re-authenticate"+++loadSavedHeaders' :: FilePath -> Credentials -> IO (Either String SavedHeaders)+loadSavedHeaders' topDir creds = do+  let dataPath = savedHeadersPath topDir creds+  requireSecureFile dataPath+  pathExists <- doesFileExist dataPath+  if not pathExists+    then pure $ Right pristine+    else eitherDecodeFileStrict dataPath+++loadClientId :: FilePath -> Credentials -> IO Text+loadClientId topDir creds = do+  let dataPath = clientIdPath topDir creds+  requireSecureFile dataPath+  pathExists <- doesFileExist dataPath+  if pathExists+    then Text.readFile dataPath+    else do+      anId <- newClientId+      secureWriteTextFileAtomic dataPath anId+      pure anId+++simpleOptions :: Options+simpleOptions = aesonPrefix snakeCase+++appBase :: FilePath+appBase = "hstratus"

@@ -0,0 +1,336 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module      : Network.HStratus.Internal.Trust+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Internal types and functions for two-factor authentication trust management.+-}+module Network.HStratus.Internal.Trust+  ( -- * data types+    CodeStatus (..)+  , TrustedPhone (..)+  , TrustedDevice (..)+  , TrustedList (..)+  , TrustData (..)+  , Setup2SADevice (..)++    -- * functions+  , withSelectedPhoneOrDevice+  , pleaseReadCode+  , pleaseChooseN+  , selectPhone+  , selectDevice+  , selectTwoFaPhone+  , setup2SADeviceLabel+  , selectSetupDevice+  )+where++import Control.Applicative ((<|>))+import Control.Exception (IOException, catch, throwIO)+import Data.Aeson+  ( FromJSON (..)+  , KeyValue (..)+  , Object+  , Options (..)+  , SumEncoding (ObjectWithSingleField)+  , ToJSON (..)+  , Value (..)+  , genericParseJSON+  , genericToEncoding+  , genericToJSON+  , object+  , withObject+  , (.:)+  , (.:?)+  )+import Data.Aeson.Casing (aesonPrefix, camelCase)+import Data.Aeson.KeyMap (filterWithKey)+import qualified Data.Aeson.KeyMap as KeyMap+import Data.Aeson.Types (Parser)+import Data.List.NonEmpty (NonEmpty (..), toList)+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Data.Word (Word8)+import GHC.Generics (Generic)+import SimplePrompt (promptNonEmpty)+import System.IO.Error (isEOFError)+import Text.Read (readMaybe)+++putDeviceChoice :: (Int, TrustedDevice) -> IO ()+putDeviceChoice (i, td)+  | tdModelName td == "" =+      Text.putStrLn $ Text.pack (show i) <> ") " <> tdName td <> "\tSMS\t" <> tdId td+  | otherwise =+      Text.putStrLn $ Text.pack (show i) <> ") " <> tdName td <> "\t" <> tdModelName td <> "\t" <> tdId td+++-- idx is 1-based and in [1, length xs], as enforced by pleaseChooseN+nthOf :: NonEmpty a -> Int -> a+nthOf xs idx = toList xs !! (idx - 1)+++-- | Prompt the user to choose one device from a non-empty list of trusted devices.+selectDevice :: NonEmpty TrustedDevice -> IO TrustedDevice+selectDevice xs = do+  Text.putStrLn "Please select a trusted device to send a code to"+  mapM_ putDeviceChoice $ zip ([1 ..] :: [Int]) (toList xs)+  idx <- pleaseChooseN 1 (length xs)+  pure (nthOf xs idx)+++-- | Prompt the user to choose one phone number from a non-empty list of trusted phones.+selectPhone :: NonEmpty TrustedPhone -> IO TrustedPhone+selectPhone xs = do+  let putPhoneChoice (i, x) = Text.putStrLn $ Text.pack (show i) <> ") " <> tpnNumberWithDialCode x+  Text.putStrLn "Please select a trusted phone number to send a code to"+  mapM_ putPhoneChoice $ zip ([1 ..] :: [Int]) (toList xs)+  idx <- pleaseChooseN 1 (length xs)+  pure (nthOf xs idx)+++-- | Prompt the user to enter an integer in the inclusive range @[low, high]@, retrying on invalid input.+pleaseChooseN :: Int -> Int -> IO Int+pleaseChooseN low high = do+  let prefix = "Please choose an option between " <> show low <> " and " <> show high+  result <- (readMaybe <$> promptNonEmpty prefix) `catch` onEof+  case result of+    Nothing -> pleaseChooseN low high+    Just x | x < low || x > high -> pleaseChooseN low high+    Just x -> pure x+ where+  onEof :: IOException -> IO (Maybe Int)+  onEof e+    | isEOFError e = throwIO (userError "unexpected end of input")+    | otherwise = throwIO e+++-- | Prompt the user to enter a security code of the given length.+pleaseReadCode :: Word8 -> IO Text+pleaseReadCode len = do+  let prefix = "Please enter the " <> show len <> "-digit code you just received"+  Text.pack <$> promptNonEmpty prefix+++-- | Information describing the status of the security code verification+data CodeStatus = CodeStatus+  { scLength :: !Word8+  -- ^ expected number of digits in the security code+  , scTooManyCodesSent :: !Bool+  -- ^ @True@ when Apple has refused to send further codes+  , scTooManyCodesValidated :: !Bool+  -- ^ @True@ when the verification attempt limit has been reached+  , scSecurityCodeLocked :: !Bool+  -- ^ @True@ when the security code gate is locked+  , scSecurityCodeCooldown :: !Bool+  -- ^ @True@ when a cooldown period is active before a new code can be sent+  }+  deriving (Eq, Show, Generic)+++instance FromJSON CodeStatus where+  parseJSON = withObject "CodeStatus" $ \o ->+    CodeStatus+      <$> o .: "length"+      <*> (fromMaybe False <$> o .:? "tooManyCodesSent")+      <*> (fromMaybe False <$> o .:? "tooManyCodesValidated")+      <*> (fromMaybe False <$> o .:? "securityCodeLocked")+      <*> (fromMaybe False <$> o .:? "securityCodeCooldown")+++instance ToJSON CodeStatus where+  toJSON = genericToJSON simpleOptions+  toEncoding = genericToEncoding simpleOptions+++-- | A trusted phone number registered for two-factor verification+data TrustedPhone = TrustedPhone+  { tpnId :: !Word8+  -- ^ Apple's internal identifier for this phone number+  , tpnNumberWithDialCode :: !Text+  -- ^ display string including the country dial code, e.g. @"+1 (•••) •••-1234"@+  , tpnPushMode :: !(Maybe Text)+  -- ^ push delivery mode (e.g. @"sms"@); @Nothing@ when absent+  }+  deriving (Eq, Show, Generic)+++instance FromJSON TrustedPhone where+  parseJSON = genericParseJSON simpleOptions+++instance ToJSON TrustedPhone where+  toJSON = genericToJSON simpleOptions+  toEncoding = genericToEncoding simpleOptions+++-- | Information about a trusted device+data TrustedDevice = TrustedDevice+  { tdId :: !Text+  -- ^ Apple's internal identifier for this device+  , tdName :: !Text+  -- ^ human-readable device name, e.g. @"Tim's iPhone"@+  , tdModelName :: !Text+  -- ^ model string, e.g. @"iPhone 15 Pro"@; empty string when absent+  }+  deriving (Eq, Show, Generic)+++instance FromJSON TrustedDevice where+  parseJSON = withObject "TrustedDevice" $ \o ->+    TrustedDevice+      <$> o .: "id"+      <*> o .: "name"+      <*> (fromMaybe "" <$> o .:? "modelName")+++instance ToJSON TrustedDevice where+  toJSON = genericToJSON simpleOptions+  toEncoding = genericToEncoding simpleOptions+++-- | A non-empty list of @TrustedPhone@ or @TrustedDevice@+data TrustedList+  = -- | the account has trusted phone numbers but no trusted devices+    TrustedPhoneNumbers !(NonEmpty TrustedPhone)+  | -- | the account has trusted devices (and may also have trusted phone numbers)+    TrustedDevices !(NonEmpty TrustedDevice)+  deriving (Eq, Show, Generic)+++instance FromJSON TrustedList where+  parseJSON = genericParseJSON trustedListOptions+++instance ToJSON TrustedList where+  toJSON = genericToJSON trustedListOptions+  toEncoding = genericToEncoding trustedListOptions+++trustedListOptions :: Options+trustedListOptions =+  ( simpleOptions+      { sumEncoding = ObjectWithSingleField+      , constructorTagModifier = camelCase+      }+  )+++data TrustData = TrustData+  { tdList :: !TrustedList+  -- ^ trusted phones or devices that can receive a verification code+  , tdSecurityCode :: !CodeStatus+  -- ^ current status of the security-code gate (length, lockout flags)+  , tdNoTrustedDevices :: !Bool+  -- ^ @True@ when no trusted devices are registered; only phone numbers available+  }+  deriving (Eq, Show)+++-- | Selects a phone/device and applies the appropriate handler+withSelectedPhoneOrDevice+  :: (TrustedPhone -> IO a) -> (TrustedDevice -> IO a) -> TrustData -> IO a+withSelectedPhoneOrDevice handlePhone handleDevice = do+  let ikou (TrustedDevices ys) = selectDevice ys >>= handleDevice+      ikou (TrustedPhoneNumbers (y :| [])) = handlePhone y+      ikou (TrustedPhoneNumbers ys) = selectPhone ys >>= handlePhone+  ikou . tdList+++toJSONTrustData :: TrustData -> Value+toJSONTrustData td =+  let asPairs (Object o) = KeyMap.toList o+      asPairs _other = []+      fromOthers =+        [ "securityCode" .= tdSecurityCode td+        , "noTrustedDevices" .= tdNoTrustedDevices td+        ]+      fromTrustedList = asPairs $ toJSON $ tdList td+   in object $ fromOthers <> fromTrustedList+++parseJSONTrustData :: Value -> Parser TrustData+parseJSONTrustData = withObject "TrustData" $ \o ->+  let securityCode = o .: "securityCode"+      noTrustedDevices = fromMaybe False <$> o .:? "noTrustedDevices"+      isListKey key _ignored = key == "trustedPhoneNumbers" || key == "trustedDevices"+      theList = parseJSON (Object $ filterWithKey isListKey o)+   in TrustData <$> theList <*> securityCode <*> noTrustedDevices+++instance ToJSON TrustData where+  toJSON = toJSONTrustData+++instance FromJSON TrustData where+  parseJSON = parseJSONTrustData+++-- | An opaque device record used in the legacy 2SA flow; fields are Apple-defined JSON.+newtype Setup2SADevice = Setup2SADevice {setup2SAFields :: Object}+  deriving (Eq, Show)+++instance FromJSON Setup2SADevice where+  parseJSON = withObject "Setup2SADevice" (pure . Setup2SADevice)+++instance ToJSON Setup2SADevice where+  toJSON (Setup2SADevice o) = Object o+++-- | Extract a human-readable label from a 2SA setup device, falling back to @"(unknown)"@.+setup2SADeviceLabel :: Setup2SADevice -> Text+setup2SADeviceLabel (Setup2SADevice o) = fromMaybe "(unknown)" $ do+  v <- lookup "phoneNumber" pairs <|> lookup "name" pairs+  case v of+    String t -> Just t+    _ -> Nothing+ where+  pairs = KeyMap.toList o+++-- | Select a trusted phone from 'TrustData' for 2FA, prompting the user when multiple phones are available.  Returns 'Nothing' when the user opts for a trusted device instead.+selectTwoFaPhone :: TrustData -> IO (Maybe TrustedPhone)+selectTwoFaPhone td =+  let phones = case tdList td of+        TrustedPhoneNumbers ps -> toList ps+        TrustedDevices _ -> []+   in if tdNoTrustedDevices td+        then pure (listToMaybe phones)+        else pickPhoneOrDevice phones+ where+  pickPhoneOrDevice [] = pure Nothing+  pickPhoneOrDevice phones = do+    mapM_+      (\(i, p) -> Text.putStrLn $ Text.pack (show (i :: Int)) <> ") " <> tpnNumberWithDialCode p)+      (zip [1 ..] phones)+    Text.putStrLn "Press Enter to use a trusted device, or select a phone number by its index to receive an SMS:"+    response <- Text.getLine+    if Text.null response+      then pure Nothing+      else case readMaybe (Text.unpack response) of+        Just n | n >= (1 :: Int) && n <= length phones -> pure $ listToMaybe $ drop (n - 1) phones+        _ -> pickPhoneOrDevice phones+++-- | Prompt the user to choose a trusted device to receive a legacy 2SA verification code.+selectSetupDevice :: NonEmpty Setup2SADevice -> IO Setup2SADevice+selectSetupDevice xs = do+  Text.putStrLn "Please select a trusted device to receive a verification code"+  mapM_ (\(i, d) -> Text.putStrLn $ Text.pack (show (i :: Int)) <> ") " <> setup2SADeviceLabel d) (zip [1 ..] (toList xs))+  idx <- pleaseChooseN 1 (length xs)+  pure (nthOf xs idx)+++simpleOptions :: Options+simpleOptions = aesonPrefix camelCase

@@ -0,0 +1,97 @@+{- |+Module      : Network.HStratus.Http+Copyright   : (c) 2025 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++High-level HTTP client for the iCloud authentication API.++= Typical usage++Create an 'Api' handle with 'mkApi', choosing the 'Realm' that matches the+user's region.  Then call 'login' to run the full sign-in flow: SRP credential+exchange followed by any required two-factor ('completeTwoFactor') or two-step+('complete2SA') challenge, then the account-login request.  On success 'login'+returns 'Authenticated' carrying the refreshed 'Session' and 'AccountData'.++= Injectable alternatives++'login' resolves 2FA and 2SA challenges interactively using the prompts from+"Network.HStratus.Trust".  Pass your own code-reader and device-selector to+'loginWith' to bypass the interactive prompts — useful in tests or automation.++If you already hold a 'Requires2FA' or 'Requires2SA' result from a prior call,+resume the flow with 'completeTwoFactor' \/ 'completeTwoFactorWith' or+'complete2SA' \/ 'complete2SAWith'.+-}+module Network.HStratus.Http+  ( -- * API handle+    mkApi+  , mkApiWith++    -- * Login+  , login+  , loginWith++    -- * Fetching two-factor options+  , fetchTrustData++    -- * SMS phone code+  , requestSmsCode+  , verifySmsCode++    -- * Completing two-factor challenges+  , completeTwoFactor+  , completeTwoFactorWith++    -- * Completing two-step challenges+  , complete2SA+  , complete2SAWith++    -- * Types+  , Api+  , AuthState (..)+  , ApiLogger++    -- * Authenticated HTTP+  , rawRequest++    -- * Logging+  , withLogger+  , fileLogger+  , verboseLogger+  , redactingLogger++    -- * Errors+  , AuthError (..)+  , HStratusError+  )+where++import Network.HStratus.Internal.Http.Api+  ( Api+  , ApiLogger+  , fileLogger+  , mkApi+  , mkApiWith+  , rawRequest+  , redactingLogger+  , verboseLogger+  , withLogger+  )+import Network.HStratus.Internal.Http.Login+  ( AuthState (..)+  , complete2SA+  , complete2SAWith+  , completeTwoFactor+  , completeTwoFactorWith+  , login+  , loginWith+  )+import Network.HStratus.Internal.Http.Signin+  ( fetchTrustData+  , requestSmsCode+  , verifySmsCode+  )+import Network.HStratus.Internal.HttpErrors (AuthError (..), HStratusError)+

@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.HStratus.Http.Common+Copyright   : (c) 2025 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Shared HTTP utilities for iCloud service clients.++Re-exported from "Network.HStratus.Internal.Endpoints" for use by downstream+libraries (@hstratus-drive@, @hstratus-notes@, etc.) that need to build+authenticated service requests.+-}+module Network.HStratus.Http.Common+  ( -- * Headers+    icloudHome+  , icloudBrowserHeaders+  , withHeaders++    -- * Request helpers+  , stripTrailingSlash+  , lookupWebservice+  )+where++import Network.HStratus.Internal.Endpoints+  ( icloudBrowserHeaders+  , icloudHome+  , lookupWebservice+  , stripTrailingSlash+  , withHeaders+  )+

@@ -0,0 +1,42 @@+{- |+Module      : Network.HStratus.Http.Endpoints+Copyright   : (c) 2025 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Base URLs for the iCloud HTTP API, selected by region.++iCloud operates two endpoint sets depending on the user's region:++* 'Usual' — targets @icloud.com@; for users outside mainland China.+* 'China' — targets @icloud.com.cn@; required for mainland China accounts.++Use 'realmEndpoints' to obtain the 'Endpoints' for the appropriate 'Realm',+then pass the result to 'Network.HStratus.Http.mkApi' or supply it directly to+'Network.HStratus.Http.mkApiWith'.+-}+module Network.HStratus.Http.Endpoints+  ( -- * Region selection++    {- | The two regional iCloud endpoint sets.++    * 'Usual' — @icloud.com@ family; for users outside mainland China.+    * 'China' — @icloud.com.cn@ family; required for mainland China accounts.+    -}+    Realm (..)+    -- | Return the 'Endpoints' for the given 'Realm'.+  , realmEndpoints++    -- * Endpoint bundle++    {- | Base URLs and default request templates for the iCloud HTTP API.++    Passed to 'Network.HStratus.Http.mkApi' or 'Network.HStratus.Http.mkApiWith'+    to construct properly-targeted API calls.+    -}+  , Endpoints (..)+  )+where++import Network.HStratus.Internal.Endpoints (Endpoints (..), Realm (..), realmEndpoints)+

@@ -0,0 +1,458 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune #-}++module Network.HStratus.Internal.Http.Api+  ( -- * API handle+    ApiLogger (..)+  , Api (..)+  , mkApi+  , mkApiWith+  , withLogger+  , fileLogger+  , verboseLogger+  , redactingLogger++    -- * Authenticated HTTP+  , rawRequest+  , rawRequest'+  , callApi+  , asJson+  , extractOr'+  , showStatusOf++    -- * Header helpers+  , authHeaders+  , requiredHeaders+  , callRequiredHeaders++    -- * Request builders+  , maybeValue+  , asObject+  , mkJsonRequest+  , withJsonRequestHeaders+  , callHandlingResponse++    -- * Constants+  , hClientId++    -- * Types+  , AuthCode+  )+where++import Control.Exception (throwIO)+import Control.Monad (unless, when)+import qualified Crypto.Hash.SHA256 as SHA256+import Crypto.SRP+  ( KnownAlgorithm (SHA256)+  , PrimeGroup (G2048)+  , digestSize+  )+import Data.Aeson+  ( FromJSON (..)+  , Key+  , eitherDecode+  , encode+  )+import Data.Aeson.KeyMap (fromList)+import Data.Aeson.Types (Value (..))+import Data.ByteString (ByteString, isPrefixOf)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.CaseInsensitive (mk, original)+import Data.Maybe (catMaybes)+import qualified Data.Set as Set+import Data.String.Conv (toS)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Time (getCurrentTime)+import Network.HStratus.Http.Endpoints (Endpoints (..), Realm, realmEndpoints)+import Network.HStratus.Internal.Endpoints+  ( homeHeaders+  , withAcceptJson+  , withAppleOauthHeaders+  , withBody+  , withHeaders+  , withWidgetKey+  )+import Network.HStratus.Internal.Http+  ( hCounter+  , hSessionId+  , needsRetry+  )+import Network.HStratus.Internal.HttpErrors+  ( ApiResponse+  , AuthError (..)+  , extractOr+  )+import Network.HStratus.Internal.PBKDF2 (FancyPseudoRandomF, wrapIO)+import Network.HStratus.Internal.Session+  ( SavedHeaders (..)+  , cookiePath+  , loadSavedHeaders+  , updateSavedHeaders+  , updateSessionSavedHeaders+  )+import Network.HStratus.Session (Session (..))+import qualified Network.HStratus.Session as Session+import Network.HTTP.Client+  ( Manager+  , Request (..)+  , RequestBody (..)+  , Response (..)+  , httpLbs+  )+import Network.HTTP.Client.TLS (newTlsManager)+import Network.HTTP.Types+  ( HeaderName+  , RequestHeaders+  , Status (..)+  , hAccept+  , hContentType+  )+import System.Directory (doesFileExist)+import System.IO (Handle, hPutStrLn)+import System.Posix.Files (setFileMode)+import Web.Cookie.Jar (usingCookiesFromFile)+++-- | A hook called after every HTTP response; receives the outgoing 'Request' and the 'Response'.+newtype ApiLogger = ApiLogger (Request -> Response LBS.ByteString -> IO ())+++{- | Bundles the HTTP manager, session state, and endpoint configuration+needed to call the iCloud API.  Created by 'mkApi' or 'mkApiWith'.+-}+data Api = Api+  { apiManager :: !Manager+  -- ^ shared TLS manager used for all requests+  , apiSession :: !Session+  -- ^ credentials and on-disk session paths+  , apiEndpoints :: !Endpoints+  -- ^ iCloud service URLs and the widget key+  , apiHashAlgorithm :: !KnownAlgorithm+  -- ^ hash algorithm used for SRP (always SHA-256 in practice)+  , apiWrappedPseudoRF :: !FancyPseudoRandomF+  -- ^ PBKDF2 pseudo-random function, pre-wrapped with the hash algorithm+  , apiGroup :: !PrimeGroup+  -- ^ SRP prime group (always G2048 in practice)+  , apiLogger :: !(Maybe ApiLogger)+  -- ^ optional logger invoked after every HTTP response+  }+++{- | Create an 'Api' using the endpoint set for the given 'Realm'.++Loads credentials and session state from disk via 'Network.HStratus.Session.loadSession'+and creates a new TLS manager.  Use 'mkApiWith' to supply a pre-built manager+and endpoint set — for example in tests.+-}+mkApi :: Realm -> IO Api+mkApi realm = do+  let apiHashAlgorithm = SHA256+      apiGroup = G2048+      apiEndpoints = realmEndpoints realm+      apiLogger = Nothing+  apiManager <- newTlsManager+  apiSession <- Session.loadSession+  apiWrappedPseudoRF <- wrapIO SHA256.hmac $ digestSize apiHashAlgorithm+  pure+    Api+      { apiGroup+      , apiEndpoints+      , apiManager+      , apiHashAlgorithm+      , apiSession+      , apiWrappedPseudoRF+      , apiLogger+      }+++-- | Create an 'Api' from a pre-built 'Session', 'Endpoints', and 'Manager'. Use this when you need to supply your own HTTP manager or a custom endpoint set — for example in tests.+mkApiWith :: Session -> Endpoints -> Manager -> IO Api+mkApiWith apiSession apiEndpoints apiManager = do+  let apiHashAlgorithm = SHA256+      apiGroup = G2048+      apiLogger = Nothing+  apiWrappedPseudoRF <- wrapIO SHA256.hmac $ digestSize apiHashAlgorithm+  pure+    Api+      { apiGroup+      , apiEndpoints+      , apiManager+      , apiHashAlgorithm+      , apiSession+      , apiWrappedPseudoRF+      , apiLogger+      }+++-- | Attach a logger to an 'Api'; it is called after every HTTP response.+withLogger :: ApiLogger -> Api -> Api+withLogger logger api = api{apiLogger = Just logger}+++{- | Build an 'ApiLogger' that appends one entry per response to a 'Handle'.++Each entry contains:++* a summary line: @TIMESTAMP METHOD URL STATUS@+* one response header per line: @Name: value@+* the raw response body+* a @---@ separator++__Security warning:__ all request and response headers are written verbatim,+including @Set-Cookie@, @X-Apple-Session-Token@, @X-Apple-TwoSV-Trust-Token@,+and @scnt@. Log files produced by this logger may contain live session tokens.+Use 'redactingLogger' when the log destination is not fully trusted.++Not safe for concurrent use from multiple threads against the same handle.+-}+fileLogger :: Handle -> ApiLogger+fileLogger h = ApiLogger $ \req resp -> do+  now <- getCurrentTime+  let scheme = if secure req then "https" else "http" :: String+      uri = scheme <> "://" <> toS (host req) <> toS (path req)+      status = statusCode (responseStatus resp)+      summary = show now <> " " <> toS (method req) <> " " <> uri <> " " <> show status+      fmtHdr (name, val) = toS (original name) <> ": " <> toS val+  hPutStrLn h summary+  mapM_ (hPutStrLn h . fmtHdr) (requestHeaders req)+  hPutStrLn h ""+  mapM_ (hPutStrLn h . fmtHdr) (responseHeaders resp)+  hPutStrLn h ""+  LBS.hPutStr h (responseBody resp)+  hPutStrLn h "\n---"+++{- | Like 'fileLogger' but also logs the query string in the URL and the+request body when present.++__Security warning:__ carries the same token-exposure risk as 'fileLogger' and+additionally logs request bodies, which may contain passwords or SRP parameters.+Use 'redactingLogger' when the log destination is not fully trusted.+-}+verboseLogger :: Handle -> ApiLogger+verboseLogger h = ApiLogger $ \req resp -> do+  now <- getCurrentTime+  let scheme = if secure req then "https" else "http" :: String+      qs = if BS.null (queryString req) then "" else "?" <> toS (queryString req)+      uri = scheme <> "://" <> toS (host req) <> toS (path req) <> qs+      status = statusCode (responseStatus resp)+      summary = show now <> " " <> toS (method req) <> " " <> uri <> " " <> show status+      fmtHdr (name, val) = toS (original name) <> ": " <> toS val+  hPutStrLn h summary+  mapM_ (hPutStrLn h . fmtHdr) (requestHeaders req)+  logReqBody (requestBody req)+  hPutStrLn h ""+  mapM_ (hPutStrLn h . fmtHdr) (responseHeaders resp)+  hPutStrLn h ""+  LBS.hPutStr h (responseBody resp)+  hPutStrLn h "\n---"+ where+  logReqBody (RequestBodyLBS lbs)+    | not (LBS.null lbs) = hPutStrLn h "" >> LBS.hPutStr h lbs+  logReqBody (RequestBodyBS bs)+    | not (BS.null bs) = hPutStrLn h "" >> LBS.hPutStr h (LBS.fromStrict bs)+  logReqBody _ = pure ()+++{- | Like 'fileLogger' but replaces the values of sensitive headers with+@\<redacted\>@ before writing.++The following headers are redacted in both request and response:+@Set-Cookie@, @Cookie@, @X-Apple-Session-Token@, @X-Apple-TwoSV-Trust-Token@,+@scnt@, @Authorization@.++Safe to write to shared or untrusted log destinations.+-}+redactingLogger :: Handle -> ApiLogger+redactingLogger h = ApiLogger $ \req resp -> do+  now <- getCurrentTime+  let scheme = if secure req then "https" else "http" :: String+      uri = scheme <> "://" <> toS (host req) <> toS (path req)+      status = statusCode (responseStatus resp)+      summary = show now <> " " <> toS (method req) <> " " <> uri <> " " <> show status+      fmtHdr (name, val) = toS (original name) <> ": " <> toS val+  hPutStrLn h summary+  mapM_ (hPutStrLn h . fmtHdr . redactHeader) (requestHeaders req)+  hPutStrLn h ""+  mapM_ (hPutStrLn h . fmtHdr . redactHeader) (responseHeaders resp)+  hPutStrLn h ""+  LBS.hPutStr h (responseBody resp)+  hPutStrLn h "\n---"+++sensitiveHeaderNames :: Set.Set HeaderName+sensitiveHeaderNames =+  Set.fromList+    [ mk "Set-Cookie"+    , mk "Cookie"+    , mk "X-Apple-Session-Token"+    , mk "X-Apple-TwoSV-Trust-Token"+    , mk "scnt"+    , mk "Authorization"+    ]+++redactHeader :: (HeaderName, BS.ByteString) -> (HeaderName, BS.ByteString)+redactHeader (name, val)+  | name `Set.member` sensitiveHeaderNames = (name, "<redacted>")+  | otherwise = (name, val)+++-- | Make a session request and obtain the raw byte results+rawRequest :: Api -> Request -> IO (Response LBS.ByteString)+rawRequest = rawRequest' True+++-- | Make a session request and obtain the raw byte results+rawRequest' :: Bool -> Api -> Request -> IO (Response LBS.ByteString)+rawRequest' mayRetry api req = do+  let Api{apiManager = mgr, apiSession = s, apiLogger = mbLogger} = api+      jarPath = cookiePath (sessionTopDir s) (sessionCreds s)+  resp <- usingCookiesFromFile jarPath req $ flip httpLbs mgr+  jarExists <- doesFileExist jarPath+  when jarExists $ setFileMode jarPath 0o600+  updateSessionSavedHeaders s $ updateSavedHeaders $ responseHeaders resp+  mapM_ (\(ApiLogger logFn) -> logFn req resp) mbLogger+  if mayRetry && needsRetry (statusCode (responseStatus resp))+    then rawRequest' False api req+    else pure resp+++{- | Make a session request to obtain a JSON payload++call api with request, obtain response+save the sessionData from the response headers+save any cookies from the response headers+if the response is JSON, parse it, and see if it parses as an ApiError+if JSON parsing fails, log to stderr+if it parses as an ApiError, indicate that++if the response is not JSON, use 'rawRequest' instead+-}+callApi+  :: (FromJSON a) => Api -> Request -> IO (Response (ApiResponse a))+callApi api req = do+  let isJsonType ct = "application/json" `isPrefixOf` ct || "text/json" `isPrefixOf` ct+  raw <- rawRequest api req+  let code = statusCode (responseStatus raw)+      theType = lookup hContentType $ responseHeaders raw+      isJson = maybe False isJsonType theType+  when (code >= 400 && LBS.null (responseBody raw)) $+    throwIO $+      UnexpectedResponse $+        showStatusOf raw+  unless (code >= 400 || isJson) $+    throwIO $+      UnexpectedResponse $+        "response was not JSON: " <> toS (show theType)+  mapM asJson raw+++-- confirm the content-type of the response before attempting to parse+-- if it's wrong, throw  InvalidContentType+-- try to parse, if that fails, throw WrongDataType+asJson :: (FromJSON a) => LBS.ByteString -> IO a+asJson resp = case eitherDecode resp of+  Left _err -> throwIO $ UnexpectedResponse "did not decode JSON response correctly"+  Right x -> pure x+++-- | Extract the successful value from a response, throwing 'UnexpectedResponse' for 4xx\/5xx status codes.+extractOr' :: Response (ApiResponse a) -> IO a+extractOr' r | statusCode (responseStatus r) >= 400 = throwIO $ UnexpectedResponse $ showStatusOf r+extractOr' r = extractOr $ responseBody r+++-- | Format the HTTP status of a response as a human-readable 'Text' string.+showStatusOf :: Response a -> Text+showStatusOf resp =+  let showResponse' x s | x >= 500 = "server error:" <> Text.pack (show s)+      showResponse' x s | x >= 400 = "bad request:" <> Text.pack (show s)+      showResponse' _x s = "ok:" <> Text.pack (show s)+      theStatus = responseStatus resp+      theCode = statusCode theStatus+   in showResponse' theCode theStatus+++-- | Build the full set of Apple OAuth request headers for an authenticated call.+authHeaders :: Api -> SavedHeaders -> RequestHeaders+authHeaders api savedHdrs =+  let Api{apiSession = session, apiEndpoints = ep} = api+      Session{sessionClientId = cid} = session+      headerOf name x = (name, toS x)+      maybeHeaderOf name = fmap (headerOf name)+      cidHeader = [(hClientId, toS cid)]+      sdHeaders =+        catMaybes+          [ maybeHeaderOf hCounter $ shCounter savedHdrs+          , maybeHeaderOf hSessionId $ shSessionId savedHdrs+          ]+   in withAppleOauthHeaders (epWidgetKey ep) $ homeHeaders ep <> sdHeaders <> cidHeader+++-- | Build the minimal request headers required by the iCloud API: the widget key, session counter, and session ID.+requiredHeaders :: ByteString -> SavedHeaders -> RequestHeaders+requiredHeaders key savedHdrs =+  let headerOf name x = (name, toS x)+      maybeHeaderOf name = fmap (headerOf name)+      sdHeaders =+        catMaybes+          [ maybeHeaderOf hCounter $ shCounter savedHdrs+          , maybeHeaderOf hSessionId $ shSessionId savedHdrs+          ]+   in withAcceptJson . withWidgetKey key $ sdHeaders+++-- | Make an authenticated API call with the required session headers, returning the decoded response body or throwing on error.+callRequiredHeaders :: (FromJSON a) => Api -> Request -> IO a+callRequiredHeaders api@Api{apiSession = s, apiEndpoints = ep} req = do+  savedHdrs <- loadSavedHeaders s+  callApi api (withHeaders (requiredHeaders (epWidgetKey ep) savedHdrs) req) >>= extractOr'+++-- | Convert a @Maybe@ to a JSON 'Value', using 'Null' for 'Nothing'.+maybeValue :: (a -> Value) -> Maybe a -> Value+maybeValue = maybe Null+++-- | Build a JSON 'Object' 'Value' from a list of key-value pairs.+asObject :: [(Key, Value)] -> Value+asObject = Object . fromList+++-- | Build a JSON request by combining a base-request builder, a body encoder, and their respective inputs.+mkJsonRequest :: (a -> Request) -> (b -> Value) -> a -> b -> Request+mkJsonRequest mkBase mkBody baseSrc bodySrc =+  withJsonRequestHeaders . withBody (encode $ mkBody bodySrc) $ mkBase baseSrc+++-- | Set @Accept: application/json@ and @Content-Type: application/json@ on a request.+withJsonRequestHeaders :: Request -> Request+withJsonRequestHeaders = withHeaders [(hAccept, "application/json"), (hContentType, "application/json")]+++-- | Build and execute an authenticated API call, applying an optional request modifier, and decode the response.+callHandlingResponse+  :: (FromJSON a)+  => (Endpoints -> b -> Request)+  -> (Request -> Request)+  -> Api+  -> b+  -> IO a+callHandlingResponse mkReq modReq api@Api{apiEndpoints} x =+  callApi api (modReq $ mkReq apiEndpoints x) >>= extractOr'+++-- | @HeaderName@ used to represent API session data+hClientId :: HeaderName+hClientId = mk "X-Apple-OAuth-State"+++{- | The code sent to a user device that the user must enter to confirm+authenticity+-}+type AuthCode = Text

@@ -0,0 +1,336 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_HADDOCK prune #-}++module Network.HStratus.Internal.Http.Login+  ( -- * Login state+    AuthState (..)++    -- * Login+  , login+  , loginWith++    -- * Completing two-factor challenges+  , completeTwoFactor+  , completeTwoFactorWith++    -- * Completing two-step challenges+  , complete2SA+  , complete2SAWith+  )+where++import Control.Exception (IOException, catch, throwIO)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Reader (ReaderT, runReaderT)+import qualified Control.Monad.Trans.Reader as Reader+import Crypto.SRP (calcResults, mkFromClient)+import Data.Aeson (FromJSON (..))+import Data.Aeson.Types (Value (..), parseEither)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.Text as Text+import Data.Word (Word8)+import Network.HStratus.Internal.Http (SrpContext (..))+import Network.HStratus.Internal.Http.Api+  ( Api (..)+  , AuthCode+  )+import Network.HStratus.Internal.Http.Signin+  ( accountLogin+  , doTrustStep+  , fetchTrustData+  , listSetupDevices+  , requestSmsCode+  , runSigninComplete+  , runSigninInit+  , sendSetupVerification+  , triggerTwoFaPush+  , validate+  , validateSetupVerification+  , verifySmsCode+  , verifyTwoFaCode+  )+import Network.HStratus.Internal.HttpErrors (AuthError (..))+import Network.HStratus.Internal.LoginFSM+  ( AfterAcctLogin (..)+  , AfterArtifactDir (..)+  , AfterCredentials (..)+  , AfterLoadLastSession (..)+  , AfterMkArtifactDir (..)+  , AfterSrpComplete (..)+  , AfterTwoFaVerify (..)+  , AfterTwoSaVerify (..)+  , AfterValidateSession (..)+  , CompletionOutcome (..)+  , LoginEvent (..)+  , LoginFSM (..)+  , LoginOutcome (..)+  , TwoFaConfig (..)+  , TwoSaConfig (..)+  , loginProcess+  , twoFaProcess+  , twoSaProcess+  )+import Network.HStratus.Internal.Session+  ( accountDataRequires2FA+  , accountDataRequires2SA+  , loadAccountData+  , loadSavedHeaders+  , pristine+  , saveAccountData+  , saveLoginMsg+  , unknownAccountData+  )+import Network.HStratus.Internal.Trust+  ( CodeStatus (..)+  , TrustData (..)+  , TrustedPhone+  , pleaseReadCode+  , selectSetupDevice+  , selectTwoFaPhone+  )+import Network.HStratus.Session (AccountData (..), Credentials (..), Session (..))+import Network.HStratus.Trust (Setup2SADevice (..))+import System.Directory (createDirectoryIfMissing, doesDirectoryExist)+++newtype LoginM a = LoginM {runLoginM :: ReaderT Api IO a}+  deriving (Functor, Applicative, Monad, MonadIO)+++ask :: LoginM Api+ask = LoginM Reader.ask+++asks :: (Api -> b) -> LoginM b+asks = LoginM . Reader.asks+++{- | The result of a login attempt.++'login' and 'loginWith' return only 'Authenticated'; 2FA and 2SA challenges+are resolved internally.  'Requires2FA' and 'Requires2SA' are only produced by+'completeTwoFactor', 'completeTwoFactorWith', 'complete2SA', and 'complete2SAWith'.+-}+data AuthState+  = -- | Sign-in succeeded; the 'Session' is refreshed and 'AccountData' is available.+    Authenticated Session AccountData+  | -- | Sign-in requires a two-factor code; use 'completeTwoFactor' or 'completeTwoFactorWith' to proceed.+    Requires2FA Session+  | -- | Sign-in requires a legacy two-step code; use 'complete2SA' or 'complete2SAWith' to proceed.+    Requires2SA Session (NonEmpty Setup2SADevice)+++instance Show AuthState where+  show (Authenticated _ ad) = "Authenticated <session> " ++ show ad+  show (Requires2FA _) = "Requires2FA <session>"+  show (Requires2SA _ ds) = "Requires2SA <session> " ++ show ds+++-- | Logs into ICloud, completing any 2FA or 2SA challenge automatically+login :: Api -> IO AuthState+login = loginWith pleaseReadCode selectTwoFaPhone selectSetupDevice+++-- | Like 'login' with injectable code prompt, phone selector, and device selector, for testing+loginWith+  :: (Word8 -> IO AuthCode)+  -> (TrustData -> IO (Maybe TrustedPhone))+  -> (NonEmpty Setup2SADevice -> IO Setup2SADevice)+  -> Api+  -> IO AuthState+loginWith readCode pickPhone pickDevice api =+  runReaderT (runLoginM loginProcess) api >>= \case+    LoginAuthenticated (AuthComplete _ ad) -> pure $ Authenticated (apiSession api) ad+    LoginNeedsTwoFa (NeedsTwoFa _) -> completeTwoFactorWith readCode pickPhone api+    LoginNeedsTwoSa (TwoSaReady _ ds) -> complete2SAWith pickDevice (readCode 6) api ds+    LoginHaltCreds _ -> throwIO CredentialsMissing+    LoginHaltDir _ -> throwIO $ ArtifactDirCreationFailed (sessionTopDir (apiSession api))+    LoginHaltSrp _ -> throwIO SrpProtocolError+    LoginHaltTwoFaLocked _ -> throwIO TwoFactorLocked+++instance LoginEvent LoginM where+  type State LoginM = LoginFSM+++  initial = pure RatifyCredentials+++  ratifyCreds RatifyCredentials =+    asks (GotCreds . RatifyArtifactDir . sessionCreds . apiSession)+++  ratifyArtifactDir (RatifyArtifactDir creds) = do+    dir <- sessionTopDir . apiSession <$> ask+    exists <- liftIO $ doesDirectoryExist dir+    pure $+      if exists+        then DirPresent $ LoadLastSession creds+        else DirAbsent $ MkArtifactDir creds+++  mkArtifactDir (MkArtifactDir creds) = do+    dir <- sessionTopDir . apiSession <$> ask+    ok <- liftIO $ (createDirectoryIfMissing True dir >> pure True) `catch` (\(_ :: IOException) -> pure False)+    pure $+      if ok+        then DirMade $ LoadLastSession creds+        else NotMade $ HaltCannotMkArtifactDir creds+++  loadSession (LoadLastSession creds) = do+    savedHdrs <- ask >>= liftIO . loadSavedHeaders . apiSession+    pure $+      if savedHdrs == pristine+        then HasClientId $ ReadyToAuth creds savedHdrs+        else HasPriorSession $ HasSavedSession creds savedHdrs+++  validateSession (HasSavedSession creds savedHdrs) = do+    valid <- ask >>= liftIO . validate+    if not valid+      then pure $ SessionStale $ ReadyToAuth creds savedHdrs+      else do+        mbAd <- ask >>= liftIO . loadAccountData . apiSession+        pure $ case mbAd of+          Just ad | accountDataRequires2FA ad -> SessionStale $ ReadyToAuth creds savedHdrs+          Just ad | accountDataRequires2SA ad -> SessionStale $ ReadyToAuth creds savedHdrs+          Just ad -> SessionStillValid $ AuthComplete creds ad+          Nothing -> SessionStillValid $ AuthComplete creds unknownAccountData+++  srpInit (ReadyToAuth creds _) = do+    api <- ask+    let user = credAccountName creds+        pass = credPassword creds+    fc <- liftIO $ mkFromClient user pass (apiGroup api)+    (fs, kd) <- liftIO $ runSigninInit api fc+    pure $ SrpInitDone creds (SrpContext fc fs kd)+++  srpComplete (SrpInitDone creds ctx) = do+    api <- ask+    let SrpContext{srpFromClient = fc, srpFromServer = fs, srpKeyDeriver = kd} = ctx+    case calcResults kd fc fs of+      Nothing -> pure $ SrpCompleteInvalidKey $ HaltInvalidSrp creds+      Just results -> do+        liftIO $ runSigninComplete api kd results+        pure $ SrpCompleteOk $ DoAccountLogin creds+++  acctLogin (DoAccountLogin creds) = do+    api <- ask+    loginReply <- liftIO $ accountLogin api+    ad <- liftIO $ parseAccountData loginReply+    liftIO $ saveLoginMsg (apiSession api) loginReply+    liftIO $ saveAccountData (apiSession api) ad+    pure $+      if+        | accountDataRequires2SA ad -> AcctLogin2SA $ NeedsTwoSa creds+        | accountDataRequires2FA ad -> AcctLogin2FA $ NeedsTwoFa creds+        | otherwise -> AcctLoginOk $ AuthComplete creds ad+++  listTwoSaDevices (NeedsTwoSa creds) = do+    ask >>= fmap (TwoSaReady creds) . liftIO . listSetupDevices+++  beginTwoFa (ReadyForTwoFa creds td) TwoFaConfig{tfcPickPhone} = do+    mbPhone <- liftIO $ tfcPickPhone td+    case mbPhone of+      Nothing -> ask >>= liftIO . triggerTwoFaPush+      Just phone -> ask >>= liftIO . flip requestSmsCode phone+    pure $ TwoFaVerifying creds td mbPhone+++  verifyTwoFa (TwoFaVerifying creds td mbPhone) TwoFaConfig{tfcReadCode} = do+    api <- ask+    code <- liftIO $ tfcReadCode (scLength (tdSecurityCode td))+    ok <- liftIO $ case mbPhone of+      Nothing -> verifyTwoFaCode api code+      Just phone -> verifySmsCode api phone code+    if ok+      then pure $ TwoFaOk $ DoTrust creds+      else do+        freshTd <- liftIO $ fetchTrustData api+        let cs = tdSecurityCode freshTd+        pure $+          if scTooManyCodesValidated cs || scSecurityCodeLocked cs || scSecurityCodeCooldown cs+            then TwoFaLocked $ HaltTwoFaLocked creds+            else TwoFaRetry $ ReadyForTwoFa creds freshTd+++  doTrust (DoTrust creds) = do+    ask >>= liftIO . doTrustStep+    pure $ DoAccountLogin creds+++  beginTwoSa (ReadyForTwoSa creds devices) TwoSaConfig{tscPickDevice} = do+    api <- ask+    device <- liftIO $ tscPickDevice devices+    liftIO $ sendSetupVerification api device+    pure $ TwoSaVerifying creds device devices+++  verifyTwoSa (TwoSaVerifying creds device devices) TwoSaConfig{tscReadCode} = do+    api <- ask+    code <- liftIO tscReadCode+    ok <- liftIO $ validateSetupVerification api device code+    pure $+      if ok+        then TwoSaOk $ DoAccountLogin creds+        else TwoSaRetry $ ReadyForTwoSa creds devices+++parseAccountData :: Value -> IO AccountData+parseAccountData v =+  either (throwIO . UnexpectedResponse . Text.pack) pure $+    parseEither parseJSON v+++-- | Complete a pending 2FA (auth-endpoint) challenge+completeTwoFactor :: Api -> IO AuthState+completeTwoFactor = completeTwoFactorWith pleaseReadCode (\_ -> pure Nothing)+++-- | Like 'completeTwoFactor' with an injectable code prompt and phone selector, for testing+completeTwoFactorWith :: (Word8 -> IO AuthCode) -> (TrustData -> IO (Maybe TrustedPhone)) -> Api -> IO AuthState+completeTwoFactorWith readCode pickPhone api = do+  td <- fetchTrustData api+  let start = ReadyForTwoFa (sessionCreds (apiSession api)) td+      cfg = TwoFaConfig{tfcPickPhone = pickPhone, tfcReadCode = readCode}+  runReaderT (runLoginM (twoFaProcess start cfg)) api >>= \case+    CompletionAuthenticated (AuthComplete _ ad) -> pure $ Authenticated (apiSession api) ad+    CompletionNeedsTwoFa _ -> throwIO TwoFactorStillRequired+    CompletionNeedsTwoSa (TwoSaReady _ ds) -> pure $ Requires2SA (apiSession api) ds+    CompletionTwoFaLocked _ -> throwIO TwoFactorLocked+++-- | Used when already holding a 'Requires2SA' result from 'completeTwoFactor' or 'completeTwoFactorWith'+complete2SA :: Api -> NonEmpty Setup2SADevice -> IO AuthState+complete2SA = complete2SAWith selectSetupDevice (pleaseReadCode 6)+++-- | Like 'complete2SA' with injectable device selector and code prompt, for testing+complete2SAWith+  :: (NonEmpty Setup2SADevice -> IO Setup2SADevice)+  -> IO AuthCode+  -> Api+  -> NonEmpty Setup2SADevice+  -> IO AuthState+complete2SAWith pickDevice readCode api devices = do+  let start = ReadyForTwoSa (sessionCreds (apiSession api)) devices+      cfg = TwoSaConfig{tscPickDevice = pickDevice, tscReadCode = readCode}+  runReaderT (runLoginM (twoSaProcess start cfg)) api >>= \case+    CompletionAuthenticated (AuthComplete _ ad) -> pure $ Authenticated (apiSession api) ad+    CompletionNeedsTwoFa _ -> throwIO TwoFactorStillRequired+    CompletionNeedsTwoSa (TwoSaReady _ ds) -> pure $ Requires2SA (apiSession api) ds+    CompletionTwoFaLocked _ -> throwIO TwoFactorLocked

@@ -0,0 +1,420 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK prune #-}++{- |+Module      : Network.HStratus.Internal.Http.Signin+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Implements the iCloud two-factor sign-in flow: fetching trust data, requesting and verifying SMS codes, and completing sign-in.+-}+module Network.HStratus.Internal.Http.Signin+  ( -- * Trust data+    fetchTrustData++    -- * SMS code+  , requestSmsCode+  , verifySmsCode++    -- * Session validation+  , validate++    -- * SRP sign-in+  , runSigninInit+  , runSigninComplete++    -- * Account login+  , accountLogin++    -- * 2FA helpers+  , triggerTwoFaPush+  , doTrustStep+  , verifyTwoFaCode++    -- * 2SA helpers+  , listSetupDevices+  , sendSetupVerification+  , validateSetupVerification+  )+where++import Control.Exception (IOException, catch, throwIO)+import Control.Monad (unless, void)+import Crypto.SRP+  ( FromClient (..)+  , FromServer (..)+  , Results (..)+  )+import Data.Aeson+  ( FromJSON (..)+  , Object+  , encode+  , withObject+  , (.:)+  )+import Data.Aeson.Types (Parser, Value (..))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base64 as B64+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (fromMaybe)+import Data.String.Conv (toS)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Word (Word64)+import Network.HStratus.Http.Endpoints (Endpoints (..))+import Network.HStratus.Internal.Endpoints+  ( accountLoginBase+  , extendPath+  , homeHeaders+  , listDevices+  , sendVerification+  , signinCompleteBase+  , signinInitBase+  , toPut+  , twoFaOptionsBase+  , twoSvTrust+  , validateBase+  , validateVerification+  , verifySecurityCodeReq+  , withAcceptJson+  , withBody+  , withHeaders+  )+import Network.HStratus.Internal.Http+  ( KeyDeriver (..)+  , PasswordProtocol (..)+  , phoneCodeBody+  , phoneTriggerBody+  , validateSetupBody+  )+import Network.HStratus.Internal.Http.Api+  ( Api (..)+  , AuthCode+  , asObject+  , authHeaders+  , callApi+  , callHandlingResponse+  , callRequiredHeaders+  , extractOr'+  , maybeValue+  , mkJsonRequest+  , rawRequest+  , requiredHeaders+  , showStatusOf+  , withJsonRequestHeaders+  )+import Network.HStratus.Internal.HttpErrors+  ( ApiResponse+  , AuthError (..)+  )+import Network.HStratus.Internal.Session+  ( SavedHeaders (..)+  , loadSavedHeaders+  )+import Network.HStratus.Internal.Trust (TrustData (..), TrustedPhone)+import Network.HStratus.Session (Credentials (..), Session (..))+import Network.HStratus.Trust (Setup2SADevice (..))+import Network.HTTP.Client (Request (..), Response (..))+import Network.HTTP.Types (Status (..))+++-- | Fetch the 2FA options immediately after the 409 from signin/complete+fetchTrustData :: Api -> IO TrustData+fetchTrustData api = do+  savedHdrs <- loadSavedHeaders (apiSession api)+  let req = withHeaders (withAcceptJson $ authHeaders api savedHdrs) (twoFaOptionsBase (apiEndpoints api))+  callApi api req >>= extractOr'+++-- | POST to phone/securitycode to request an SMS code to the given phone+requestSmsCode :: Api -> TrustedPhone -> IO ()+requestSmsCode api@Api{apiEndpoints = ep} tp = do+  savedHdrs <- loadSavedHeaders (apiSession api)+  let req =+        withHeaders (authHeaders api savedHdrs) $+          withJsonRequestHeaders $+            withBody (encode $ phoneTriggerBody tp) $+              toPut (extendPath (epAuth ep) "/verify/phone")+  resp <- rawRequest api req+  unless (statusCode (responseStatus resp) < 400) $+    throwIO $+      UnexpectedResponse $+        showStatusOf resp+++-- | POST to phone/securitycode to verify an SMS code; returns True when accepted+verifySmsCode :: Api -> TrustedPhone -> AuthCode -> IO Bool+verifySmsCode api@Api{apiEndpoints = ep} tp code = do+  savedHdrs <- loadSavedHeaders (apiSession api)+  let req =+        withHeaders (authHeaders api savedHdrs) $+          withJsonRequestHeaders $+            withBody (encode $ phoneCodeBody tp code) $+              verifySecurityCodeReq "phone" ep+  resp <- rawRequest api req+  let c = statusCode (responseStatus resp)+  if+    | c < 400 -> pure True+    | c == 400 -> pure False+    | otherwise -> throwIO $ UnexpectedResponse $ showStatusOf resp+++data SigninInitReply = SigninInitReply+  { sirTag :: !Text+  , sirProtocol :: !PasswordProtocol+  , sirPublicBytes :: !ByteString+  , sirIterations :: !Word64+  , sirSalt :: !ByteString+  }+  deriving (Eq, Show)+++instance FromJSON SigninInitReply where+  parseJSON = withObject "SigninInitReply" parseSigninInitReply+++parseSigninInitReply :: Object -> Parser SigninInitReply+parseSigninInitReply o =+  let tag = o .: "c"+      iterations = o .: "iteration"+      protocol = o .: "protocol"+      publicBytes = o .: "b" >>= parseBase64Bytes+      salt = o .: "salt" >>= parseBase64Bytes+      parseBase64Bytes s = case B64.decode (encodeUtf8 s) of+        Left err -> fail err+        Right b -> pure b+   in SigninInitReply+        <$> tag+        <*> protocol+        <*> publicBytes+        <*> iterations+        <*> salt+++signinInit :: Api -> FromClient -> IO SigninInitReply+signinInit api other = do+  savedHdrs <- loadSavedHeaders (apiSession api)+  callHandlingResponse signinInitReq (withHeaders (authHeaders api savedHdrs)) api other+++-- | Execute the SRP init step, returning the server's public values and a 'KeyDeriver' for the completion step.+runSigninInit :: Api -> FromClient -> IO (FromServer, KeyDeriver)+runSigninInit api fc = do+  r <- signinInit api fc+  let fromServer =+        FromServer+          { fsPublicBytes = sirPublicBytes r+          , fsSalt = sirSalt r+          , fsPrimeGroup = apiGroup api+          , fsKnownAlgorithm = apiHashAlgorithm api+          }+      keyDeriver =+        KeyDeriver+          { kdTag = sirTag r+          , kdIterations = sirIterations r+          , kdWrappedF = apiWrappedPseudoRF api+          , kdProtocol = sirProtocol r+          }+  pure (fromServer, keyDeriver)+++signinInitReq :: Endpoints -> FromClient -> Request+signinInitReq = mkJsonRequest signinInitBase signinInitValue+++signinInitValue :: FromClient -> Value+signinInitValue fc =+  let a = decodeUtf8 $ B64.encode $ fcPublicBytes fc+   in asObject+        [ ("a", String a)+        , ("accountName", String (fcUser fc))+        , ("protocols", Array ["s2k", "s2k_fo"])+        ]+++data SigninCompletion = SigninCompletion+  { siTag :: !Text+  , siAccountName :: !Text+  , siSavedHeaders :: !SavedHeaders+  , siResults :: !Results+  }+++-- | Execute the SRP completion step, sending the client and server proofs to Apple.+runSigninComplete :: Api -> KeyDeriver -> Results -> IO ()+runSigninComplete api@Api{apiSession = session} kd results = do+  siSavedHeaders <- loadSavedHeaders session+  let siAccountName = credAccountName $ sessionCreds session+      completion =+        SigninCompletion+          { siTag = kdTag kd+          , siAccountName+          , siResults = results+          , siSavedHeaders+          }+  signinComplete api completion+++signinComplete :: Api -> SigninCompletion -> IO ()+signinComplete api sc = do+  savedHdrs <- loadSavedHeaders (apiSession api)+  let req = withHeaders (authHeaders api savedHdrs) $ signinCompleteReq (apiEndpoints api) sc+  resp <- callApi api req :: IO (Response (ApiResponse ()))+  handleSigninComplete resp+++signinCompleteReq :: Endpoints -> SigninCompletion -> Request+signinCompleteReq = mkJsonRequest signinCompleteBase signinCompleteValue+++signinCompleteValue :: SigninCompletion -> Value+signinCompleteValue sc =+  let Results{rClientProof, rServerProof} = siResults sc+      toBase64 = decodeUtf8 . B64.encode+      singleElem x = Array [String x]+      maybeArray = maybe (Array []) singleElem+   in asObject+        [ ("m1", String (toBase64 rClientProof))+        , ("m2", String (toBase64 rServerProof))+        , ("trustTokens", maybeArray (shTrustToken (siSavedHeaders sc)))+        , ("rememberMe", Bool True)+        , ("accountName", String (siAccountName sc))+        , ("c", String (siTag sc))+        ]+++handleSigninComplete :: Response (ApiResponse ()) -> IO ()+handleSigninComplete resp = do+  let code = statusCode $ responseStatus resp+  if+    | code == 401 -> throwIO InvalidCredentials+    | code == 403 -> throwIO AccountLocked+    | code == 412 -> throwIO PrivacyAgreementRequired+    | code == 409 -> pure () -- 2FA required; accountLogin will detect it+    | code >= 400 -> throwIO $ UnexpectedResponse $ showStatusOf resp+    | otherwise -> pure ()+++-- | Check whether the current session is still valid; returns @False@ on 401, throws on other errors.+validate :: Api -> IO Bool+validate api@Api{apiEndpoints} = do+  resp <- rawRequest api (validateReq apiEndpoints)+  let code = statusCode (responseStatus resp)+  if+    | code == 401 -> pure False+    | code >= 400 -> throwIO $ UnexpectedResponse $ showStatusOf resp+    | otherwise -> pure True+++validateReq :: Endpoints -> Request+validateReq = withJsonRequestHeaders . withBody (encode Null) . validateBase+++-- | POST to the account-login endpoint and return the raw JSON response (used to obtain 'AccountData').+accountLogin :: Api -> IO Value+accountLogin api@Api{apiEndpoints = ep} = do+  savedHdrs <- loadSavedHeaders $ apiSession api+  let hdrs = homeHeaders ep+  callHandlingResponse accountLoginReq (withHeaders hdrs) api savedHdrs+++accountLoginReq :: Endpoints -> SavedHeaders -> Request+accountLoginReq = mkJsonRequest accountLoginBase accountLoginValue+++-- | Trigger a 2FA push notification to the user's trusted device.+triggerTwoFaPush :: Api -> IO ()+triggerTwoFaPush api@Api{apiEndpoints = ep} = do+  savedHdrs <- loadSavedHeaders (apiSession api)+  let req =+        withHeaders+          (withAcceptJson $ authHeaders api savedHdrs)+          (toPut (extendPath (epAuth ep) "/verify/trusteddevice/securitycode"))+  void (rawRequest api req) `catch` \(e :: IOException) ->+    throwIO (UnexpectedResponse ("2FA push failed: " <> toS (show e)))+++-- | POST to the two-step-verification trust endpoint to mark this session as trusted.+doTrustStep :: Api -> IO ()+doTrustStep api@Api{apiEndpoints = ep} = do+  savedHdrs <- loadSavedHeaders (apiSession api)+  let req = withHeaders (withAcceptJson $ authHeaders api savedHdrs) (twoSvTrust ep)+  resp <- rawRequest api req+  unless (statusCode (responseStatus resp) < 400) $+    throwIO $+      UnexpectedResponse $+        showStatusOf resp+++-- | Submit a 2FA code entered by the user; returns @True@ when accepted, @False@ on a 400 rejection.+verifyTwoFaCode :: Api -> AuthCode -> IO Bool+verifyTwoFaCode api@Api{apiEndpoints = ep} code = do+  savedHdrs <- loadSavedHeaders (apiSession api)+  let body = encode $ Object [("securityCode", Object [("code", String code)])]+      req =+        withHeaders (authHeaders api savedHdrs) $+          withJsonRequestHeaders $+            withBody body $+              verifySecurityCodeReq "trusteddevice" ep+  resp <- rawRequest api req+  let c = statusCode (responseStatus resp)+  if+    | c < 400 -> pure True+    | c == 400 -> pure False+    | otherwise -> throwIO $ UnexpectedResponse $ showStatusOf resp+++accountLoginValue :: SavedHeaders -> Value+accountLoginValue hs =+  asObject+    [ ("accountCountryCode", maybeValue String (shCountry hs))+    , ("dsWebAuthToken", maybeValue String (shSessionToken hs))+    , ("trustToken", String $ fromMaybe "" $ shTrustToken hs)+    , ("extended_login", Bool True)+    ]+++newtype ListDevicesReply = ListDevicesReply {ldrDevices :: [Setup2SADevice]}+++instance FromJSON ListDevicesReply where+  parseJSON = withObject "ListDevicesReply" $ \o -> ListDevicesReply <$> o .: "devices"+++-- | Fetch the list of trusted devices available for legacy 2SA verification; throws when the server returns none.+listSetupDevices :: Api -> IO (NonEmpty Setup2SADevice)+listSetupDevices api@Api{apiEndpoints = ep} = do+  devices <- ldrDevices <$> callRequiredHeaders api (listDevices ep)+  maybe (throwIO (UnexpectedResponse "2SA: server returned no trusted devices")) pure (NE.nonEmpty devices)+++-- | Send a 2SA verification code to the given device.+sendSetupVerification :: Api -> Setup2SADevice -> IO ()+sendSetupVerification api@Api{apiSession = s, apiEndpoints = ep} device = do+  savedHdrs <- loadSavedHeaders s+  let req =+        withHeaders (requiredHeaders (epWidgetKey ep) savedHdrs) $+          withJsonRequestHeaders $+            withBody (encode device) $+              sendVerification ep+  resp <- rawRequest api req+  unless (statusCode (responseStatus resp) < 400) $ throwIO $ UnexpectedResponse $ showStatusOf resp+++-- | Submit a 2SA verification code for the given device; returns @True@ when accepted.+validateSetupVerification :: Api -> Setup2SADevice -> AuthCode -> IO Bool+validateSetupVerification api@Api{apiSession = s, apiEndpoints = ep} device code = do+  savedHdrs <- loadSavedHeaders s+  let req =+        withHeaders (requiredHeaders (epWidgetKey ep) savedHdrs) $+          withJsonRequestHeaders $+            withBody (encode $ validateSetupBody device code) $+              validateVerification ep+  resp <- rawRequest api req+  pure $ statusCode (responseStatus resp) < 400

@@ -0,0 +1,90 @@+{-# OPTIONS_GHC -Wno-missing-home-modules #-}++{- |+Module      : Network.HStratus.Session+Copyright   : (c) 2025 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Provides the core types for an iCloud authentication session.++'Credentials' holds the account ID and password used to sign in. A 'Session'+combines those credentials with a filesystem working directory (where cookies,+session tokens, and account state are persisted between runs) and a per-client+identifier. 'AccountData' carries the account information returned by the+account-login endpoint, including the HSA version that determines which+two-factor challenge flow applies.++Use 'loadSession' to initialise a session from the local filesystem. The+credentials file is read from @$XDG_CONFIG_HOME\/hstratus\/credentials.json@;+other session state is created in the same directory on first use.++The session value is then passed to 'Network.HStratus.Http.mkApiWith' (or+'Network.HStratus.Http.mkApi' for the default configuration) to construct an+'Network.HStratus.Http.Api' handle for making authenticated requests.+-}+module Network.HStratus.Session+  ( -- * Credentials++    {- | The account ID and password used to sign in to iCloud.++    Expected to be read from+    @$XDG_CONFIG_HOME\/hstratus\/credentials.json@ with the fields+    @accountName@ and @password@.+    -}+    Credentials (..)++    -- * Session++    {- | Persistent data identifying a user and their local authentication state.++    Holds the credentials used to authenticate, the directory where session files+    are stored (cookies, saved headers, account data), and the per-client OAuth+    state identifier.+    -}+  , Session (..)++    -- * AccountData++    {- | Structured account information returned by the account-login endpoint.++    The 'adHsaVersion' field determines which two-factor flow applies:++    * @0@ — unknown (used as a sentinel when no account data is available)+    * @1@ — legacy two-step authentication (2SA); handled via the setup endpoint+    * @2@ — modern two-factor authentication (2FA); handled via the auth endpoint+    -}+  , Webservice (..)+  , AccountData (..)++    -- * Loading a session++    {- | Load a 'Session' from the local filesystem.++    Reads 'Credentials' from+    @$XDG_CONFIG_HOME\/hstratus\/credentials.json@ and initialises the+    session working directory (creating it if absent). A per-client ID is read+    from disk if one exists, or generated and saved for future runs.++    Throws an 'IOError' if the credentials file is absent or cannot be parsed.+    -}+  , loadSession++    -- * Saving credentials++    {- | Write 'Credentials' to @$XDG_CONFIG_HOME\/hstratus\/credentials.json@,+    creating the directory if it does not exist.+    -}+  , saveCredentials+  )+where++import Network.HStratus.Internal.Session+  ( AccountData (..)+  , Credentials (..)+  , Session (..)+  , Webservice (..)+  , loadSession+  , saveCredentials+  )+

@@ -0,0 +1,92 @@+{- |+Module      : Network.HStratus.Trust+Copyright   : (c) 2025 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Types and utilities for handling iCloud two-factor trust challenges.++After a successful SRP sign-in, iCloud may require an additional verification+step. 'TrustData' describes the challenge: which trusted phones or devices are+available to receive a code, and the current state of the security-code gate.++Two challenge flows exist:++* __2FA__ (modern, HSA version ≥ 2): the auth endpoint issues a 'TrustData'+  challenge; the user enters a code sent to a trusted phone or device.++* __2SA__ (legacy, HSA version 1): the setup endpoint lists registered+  'Setup2SADevice' values; the user selects one to receive a code.++'pleaseReadCode' and 'selectSetupDevice' are interactive prompts used as+defaults in 'Network.HStratus.Http.login' and 'Network.HStratus.Http.complete2SA'.+Supply your own alternatives via 'Network.HStratus.Http.loginWith' and+'Network.HStratus.Http.complete2SAWith' for testing or automation.+-}+module Network.HStratus.Trust+  ( -- * Two-factor challenge data++    {- | The two-factor challenge data returned by the auth endpoint after SRP sign-in.++    Describes which trusted contacts are available to receive a verification code+    ('tdList'), the current state of the security-code gate ('tdSecurityCode'),+    and whether any trusted devices are registered ('tdNoTrustedDevices').+    -}+    TrustData (..)+    -- | Information about a trusted phone number.+  , TrustedPhone (..)++    -- * Legacy two-step device++    {- | A 2SA device from the setup endpoint.++    Stored as the raw JSON object so the entire dict can be echoed back to+    @sendVerificationCode@ and augmented for @validateVerificationCode@.+    -}+  , Setup2SADevice (..)+    {- | Extract a human-readable label from a 'Setup2SADevice', preferring+    @phoneNumber@ then @name@.+    -}+  , setup2SADeviceLabel++    -- * Interactive prompts++    {- | Interactively prompt the user to enter the verification code sent to+    their trusted phone or device. The first argument is the expected code+    length, used to make the prompt more specific (e.g. @"6-digit"@).++    Used as the default code-reading action in 'Network.HStratus.Http.login'.+    Supply an alternative via 'Network.HStratus.Http.loginWith' for testing or+    automation.+    -}+  , pleaseReadCode+    {- | Interactively prompt the user to choose between device push and SMS+    for HSA2 2FA.++    If no trusted devices are registered ('tdNoTrustedDevices' is @True@), the+    first trusted phone is selected automatically. Otherwise, the user is+    prompted to press Enter for device push or enter a number to receive an SMS+    code.+    -}+  , selectTwoFaPhone+    {- | Interactively prompt the user to select a device from a list of 2SA+    setup devices.++    Used as the default device-selection action in+    'Network.HStratus.Http.complete2SA'. Supply an alternative via+    'Network.HStratus.Http.complete2SAWith' for testing or automation.+    -}+  , selectSetupDevice+  )+where++import Network.HStratus.Internal.Trust+  ( Setup2SADevice (..)+  , TrustData (..)+  , TrustedPhone (..)+  , pleaseReadCode+  , selectSetupDevice+  , selectTwoFaPhone+  , setup2SADeviceLabel+  )+

@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}++module HStratus.ApiLoggerSpec (spec) where++import Data.Aeson (Value, decode)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy.Char8 as LBS8+import Data.List (isPrefixOf)+import HStratus.Mock (defaultScenario, withMockApp)+import Network.HStratus.Http (ApiLogger, fileLogger, login, mkApiWith, redactingLogger, withLogger)+import Network.HStratus.Http.Endpoints (Endpoints (..))+import Network.HStratus.Session (Credentials (..), Session (..))+import Network.HTTP.Client (Request (..), defaultManagerSettings, defaultRequest, newManager)+import Network.HTTP.Types (methodPost)+import System.FilePath ((</>))+import System.IO (Handle, IOMode (..), withFile)+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec (Spec, describe, it, shouldContain, shouldNotBe, shouldNotContain, shouldSatisfy)+++spec :: Spec+spec = describe "Network.HStratus.Http.fileLogger" $ do+  it "writes a log entry for each HTTP request during login" $+    withSystemTempDirectory "icloud-auth-log" $ \tmpDir -> do+      let logPath = tmpDir </> "requests.log"+      withLoginLog tmpDir logPath $ \contents ->+        filter (== "---") (lines contents) `shouldSatisfy` (not . null)++  it "each entry contains the HTTP method, URI and response status" $+    withSystemTempDirectory "icloud-auth-log" $ \tmpDir -> do+      let logPath = tmpDir </> "requests.log"+      withLoginLog tmpDir logPath $ \contents -> do+        contents `shouldContain` "POST"+        contents `shouldContain` "signin/init"+        contents `shouldContain` "200"++  it "response bodies are valid JSON" $+    withSystemTempDirectory "icloud-auth-log" $ \tmpDir -> do+      let logPath = tmpDir </> "requests.log"+      withLoginLog tmpDir logPath $ \contents -> do+        let body = firstBody contents+        (decode (LBS8.pack body) :: Maybe Value) `shouldNotBe` Nothing++  describe "redactingLogger" $ do+    it "replaces sensitive header values with <redacted>" $+      withSystemTempDirectory "icloud-auth-redact" $ \tmpDir -> do+        let logPath = tmpDir </> "requests.log"+        withLoginLogUsing redactingLogger tmpDir logPath $ \contents ->+          contents `shouldContain` "<redacted>"+    it "preserves the method, URI and status line" $+      withSystemTempDirectory "icloud-auth-redact" $ \tmpDir -> do+        let logPath = tmpDir </> "requests.log"+        withLoginLogUsing redactingLogger tmpDir logPath $ \contents -> do+          contents `shouldContain` "POST"+          contents `shouldContain` "signin/init"+          contents `shouldContain` "200"+    it "does not write raw Set-Cookie values" $+      withSystemTempDirectory "icloud-auth-redact" $ \tmpDir -> do+        let logPath = tmpDir </> "requests.log"+        withLoginLogUsing fileLogger tmpDir logPath $ \verboseContents ->+          withLoginLogUsing redactingLogger tmpDir (logPath <> ".redacted") $ \redactedContents -> do+            let cookieLines = filter ("Set-Cookie:" `isPrefixOf`) (lines verboseContents)+            case cookieLines of+              [] -> pure ()+              (firstLine : _) -> redactedContents `shouldNotContain` drop (length ("Set-Cookie: " :: String)) firstLine+++{- | Extract the body of the first log entry.+Format: summary line, request headers, blank line, response headers, blank line, body, "---".+-}+firstBody :: String -> String+firstBody contents =+  let skipSection = drop 1 . dropWhile (not . null)+      bodyLines = takeWhile (/= "---") $ skipSection $ skipSection $ drop 1 (lines contents)+   in unlines bodyLines+++withLoginLog :: FilePath -> FilePath -> (String -> IO a) -> IO a+withLoginLog = withLoginLogUsing fileLogger+++withLoginLogUsing :: (Handle -> ApiLogger) -> FilePath -> FilePath -> (String -> IO a) -> IO a+withLoginLogUsing mkLogger tmpDir logPath action = do+  let sessionDir = tmpDir </> "session"+  withFile logPath WriteMode $ \logHandle ->+    withMockApp defaultScenario $ \serverPort -> do+      mgr <- newManager defaultManagerSettings+      api <-+        withLogger (mkLogger logHandle)+          <$> mkApiWith (testSession sessionDir) (testEndpoints serverPort) mgr+      _ <- login api+      pure ()+  contents <- readFile logPath+  action contents+++testSession :: FilePath -> Session+testSession topDir =+  Session+    { sessionCreds = Credentials "alice@example.com" "password123"+    , sessionTopDir = topDir+    , sessionClientId = "test-client-id"+    }+++testEndpoints :: Int -> Endpoints+testEndpoints serverPort =+  Endpoints+    { epHome = "http://127.0.0.1:" <> BS8.pack (show serverPort)+    , epAuth = mockReq "/appleauth/auth"+    , epSetup = mockReq "/setup/ws/1"+    , epWidgetKey = "test-widget-key"+    }+ where+  mockReq reqPath =+    defaultRequest+      { host = "127.0.0.1"+      , port = serverPort+      , secure = False+      , method = methodPost+      , path = reqPath+      }

@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.Examples+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Shared example data used across hstratus-auth test suites.+-}+module HStratus.Examples+  ( byteStrings+  , wordz+  , errorKeys+  , codeKeys+  )+where++import Data.ByteString (ByteString)+import Data.String.Conv (toS)+import Data.Text (Text)+++byteStrings :: [ByteString]+byteStrings =+  [ "Good"+  , "King"+  , "Wenceslas"+  , "looked"+  , "out"+  , "on"+  , "feast"+  , "of"+  , "stephen"+  , "when"+  , "snow"+  , "lay"+  , "round"+  , "about"+  , "bright"+  , "crisp"+  , "even"+  ]+++wordz :: [Text]+wordz = map toS byteStrings+++errorKeys :: [Text]+errorKeys = ["errorMessage", "reason", "errorReason", "error"]+++codeKeys :: [Text]+codeKeys = ["errorCode", "serverErrorCode"]

@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.Http.CliSpec+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+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"

@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.Http.EndpointsSpec+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Tests for the iCloud endpoint builders in 'Network.HStratus.Internal.Endpoints'.+-}+module HStratus.Http.EndpointsSpec (spec) where++import qualified Data.Map.Strict as Map+import Network.HStratus.Internal.Endpoints (Realm (..), lookupWebservice, realmEndpoints, signinCompleteBase)+import Network.HStratus.Internal.HttpErrors (AuthError (..))+import Network.HStratus.Internal.Session (Webservice (..))+import Network.HTTP.Client (Request (..))+import Test.Hspec (Spec, describe, it, shouldBe, shouldThrow)+++spec :: Spec+spec = describe "Network.HStratus.Internal.Endpoints" $ do+  it "signinCompleteBase queryString has no leading ?" $+    queryString (signinCompleteBase (realmEndpoints Usual)) `shouldBe` "isRememberMeEnabled=true"++  describe "lookupWebservice" $ do+    it "resolves an active service to a Request" $ do+      let ws = Map.fromList [("findme", Webservice "https://p01-fmipweb.icloud.com" (Just "active"))]+      req <- lookupWebservice "findme" ws+      host req `shouldBe` "p01-fmipweb.icloud.com"++    it "resolves a service with no status to a Request" $ do+      let ws = Map.fromList [("findme", Webservice "https://p01-fmipweb.icloud.com" Nothing)]+      req <- lookupWebservice "findme" ws+      host req `shouldBe` "p01-fmipweb.icloud.com"++    it "throws WebserviceNotFound for an absent key" $+      lookupWebservice "missing" Map.empty+        `shouldThrow` (== WebserviceNotFound "missing")++    it "throws WebserviceNotFound for an inactive service" $ do+      let ws = Map.fromList [("findme", Webservice "https://p01-fmipweb.icloud.com" (Just "inactive"))]+      lookupWebservice "findme" ws+        `shouldThrow` (== WebserviceNotFound "findme")

@@ -0,0 +1,131 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module HStratus.Http.ErrorsSpec+  ( spec+  )+where++import Control.Exception (throwIO, try)+import Data.Aeson (Value (..), decode, encode, object)+import Data.Aeson.Key (fromText)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Maybe (catMaybes)+import Data.Text (Text)+import qualified HStratus.Examples as Examples+import Network.HStratus.Internal.HttpErrors+  ( ApiError (..)+  , ApiResponse (..)+  , AuthError (..)+  , extractOr+  )+import Test.Hspec (Spec, context, describe, it, shouldBe, shouldReturn)+import Test.Hspec.Benri (endsLeft, endsRight)+import Test.QuickCheck+  ( Gen+  , Property+  , elements+  , forAll+  , frequency+  )+++spec :: Spec+spec = describe "module Network.HStratus.Http.Error" $ do+  apiErrorSpec+  authErrorSpec+++apiErrorSpec :: Spec+apiErrorSpec = describe "ApiError" $ do+  context "parsing it from JSON" $ do+    it "should succeed" prop_parseJSONApiError+++prop_parseJSONApiError :: Property+prop_parseJSONApiError = forAll genApiErrorWithJsonEncoding $ \(encoded, ae) ->+  decode (BS.fromStrict encoded) == Just ae+++genApiErrorWithJsonEncoding :: Gen (ByteString, ApiError)+genApiErrorWithJsonEncoding = do+  reasonKV <- genKeyValue $ elements Examples.errorKeys+  mbCodeKV <- genKeyValueMb $ elements Examples.codeKeys+  let ae =+        ApiError+          { aeReason = snd reasonKV+          , aeCode = snd <$> mbCodeKV+          }+      asKV (x, y) = (fromText x, String y)+      objectParts = catMaybes [Just reasonKV, mbCodeKV]+      encoded = BS.toStrict $ encode $ object $ map asKV objectParts+  pure (encoded, ae)+++{- |+generate a value or Nothing as the value of field+when there is a value, generate the value of the key+-}+genKeyValueMb :: Gen Text -> Gen (Maybe (Text, Text))+genKeyValueMb keyGen = do+  valueMb <-+    frequency+      [ (1, Just <$> elements Examples.wordz)+      , (2, pure Nothing)+      ]+  case valueMb of+    Nothing -> pure Nothing+    Just x -> do+      key <- keyGen+      pure (Just (key, x))+++genKeyValue :: Gen Text -> Gen (Text, Text)+genKeyValue keyGen = do+  value <- elements Examples.wordz+  key <- keyGen+  pure (key, value)+++authErrorSpec :: Spec+authErrorSpec = describe "AuthError" $ do+  context "is catchable with try @AuthError" $ do+    it "catches InvalidCredentials" $+      catchAuthError InvalidCredentials `endsLeft` InvalidCredentials+    it "catches AccountLocked" $+      catchAuthError AccountLocked `endsLeft` AccountLocked+    it "catches PrivacyAgreementRequired" $+      catchAuthError PrivacyAgreementRequired `endsLeft` PrivacyAgreementRequired+    it "catches ServiceError" $+      catchAuthError (ServiceError "reason" (Just "code")) `endsLeft` ServiceError "reason" (Just "code")+    it "catches UnexpectedResponse" $+      catchAuthError (UnexpectedResponse "oops") `endsLeft` UnexpectedResponse "oops"++  context "extractOr on a Failed ApiResponse" $ do+    it "throws ServiceError with the ApiError reason and code" $+      catchAuthError' (extractOr (Failed (ApiError "bad" (Just "E1"))))+        `endsRight` ServiceError "bad" (Just "E1")++  context "extractOr on a Succeeded ApiResponse" $ do+    it "returns the wrapped value" $+      extractOr (Succeeded (42 :: Int)) `shouldReturn` 42++  context "ApiResponse FromJSON" $ do+    it "parses a success body as Succeeded" $+      (decode "{\"length\":6}" :: Maybe (ApiResponse Value))+        `shouldBe` Just (Succeeded (object [("length", Number 6)]))+    it "parses an error body as Failed" $+      (decode "{\"errorMessage\":\"oops\"}" :: Maybe (ApiResponse Value))+        `shouldBe` Just (Failed (ApiError "oops" Nothing))+++catchAuthError :: AuthError -> IO (Either AuthError AuthError)+catchAuthError e = try (throwIO e)+++catchAuthError' :: IO a -> IO (Either AuthError AuthError)+catchAuthError' action =+  try action >>= \case+    Left e -> pure (Right e)+    Right _ -> pure (Left (UnexpectedResponse "expected AuthError but got success"))

@@ -0,0 +1,273 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.Http.HeadersSpec+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Tests for HTTP header handling in the iCloud authentication flow.+-}+module HStratus.Http.HeadersSpec (spec) where++import Data.Aeson (decode, encodeFile)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import Data.IORef (readIORef)+import Data.List (find)+import Data.Maybe (fromJust)+import HStratus.Mock (Scenario (..), defaultScenario, withMockAppCapturing)+import Network.HStratus.Http (fetchTrustData, login, loginWith, mkApiWith, requestSmsCode, verifySmsCode)+import Network.HStratus.Http.Endpoints (Endpoints (..))+import Network.HStratus.Internal.Session (SavedHeaders (..), savedHeadersPath)+import Network.HStratus.Session (Credentials (..), Session (..))+import Network.HStratus.Trust (Setup2SADevice, TrustedPhone (..))+import Network.HTTP.Client (Request (..), defaultManagerSettings, defaultRequest, newManager)+import Network.HTTP.Types (RequestHeaders, hAccept, hContentType, methodPost)+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files (setFileMode)+import Test.Hspec (Spec, describe, it, shouldSatisfy)+++spec :: Spec+spec = describe "Network.HStratus.Http request headers" $ do+  it "signin/init sends Content-Type and Accept: application/json" $+    withCapturedLogin (\_ -> pure ()) $ \captured ->+      headersFor "/appleauth/auth/signin/init" captured+        `shouldSatisfy` hasJsonContentHeaders++  it "signin/complete sends Content-Type and Accept: application/json" $+    withCapturedLogin (\_ -> pure ()) $ \captured ->+      headersFor "/appleauth/auth/signin/complete" captured+        `shouldSatisfy` hasJsonContentHeaders++  it "2sv/trust sends Accept: application/json" $+    withCapturedTwoFa $ \captured ->+      headersFor "/appleauth/auth/2sv/trust" captured+        `shouldSatisfy` hasJsonAccept++  it "validate sends Content-Type and Accept: application/json" $+    withCapturedLogin writeSavedHeaders $ \captured ->+      headersFor "/setup/ws/1/validate" captured+        `shouldSatisfy` hasJsonContentHeaders++  it "accountLogin sends Content-Type and Accept: application/json" $+    withCapturedLogin (\_ -> pure ()) $ \captured ->+      headersFor "/setup/ws/1/accountLogin" captured+        `shouldSatisfy` hasJsonContentHeaders++  it "accountLogin sends Origin and Referer" $+    withCapturedLogin (\_ -> pure ()) $ \captured ->+      headersFor "/setup/ws/1/accountLogin" captured+        `shouldSatisfy` hasOrigin++  it "signin/init sends X-Apple-Widget-Key" $+    withCapturedLogin (\_ -> pure ()) $ \captured ->+      headersFor "/appleauth/auth/signin/init" captured+        `shouldSatisfy` hasWidgetKey++  it "2sv/trust sends X-Apple-Widget-Key" $+    withCapturedTwoFa $ \captured ->+      headersFor "/appleauth/auth/2sv/trust" captured+        `shouldSatisfy` hasWidgetKey++  it "verify/trusteddevice/securitycode sends Content-Type, Accept: application/json, and X-Apple-Widget-Key" $+    withCapturedTwoFa $ \captured ->+      headersFor "/appleauth/auth/verify/trusteddevice/securitycode" captured+        `shouldSatisfy` (\hs -> hasJsonContentHeaders hs && hasWidgetKey hs)++  it "listDevices sends Accept: application/json and X-Apple-Widget-Key" $+    withCapturedTwoSa $ \captured ->+      headersFor "/setup/ws/1/listDevices" captured+        `shouldSatisfy` (\hs -> hasJsonAccept hs && hasWidgetKey hs)++  it "sendVerificationCode sends Content-Type, Accept: application/json, and X-Apple-Widget-Key" $+    withCapturedTwoSa $ \captured ->+      headersFor "/setup/ws/1/sendVerificationCode" captured+        `shouldSatisfy` (\hs -> hasJsonContentHeaders hs && hasWidgetKey hs)++  it "validateVerificationCode sends Content-Type, Accept: application/json, and X-Apple-Widget-Key" $+    withCapturedTwoSa $ \captured ->+      headersFor "/setup/ws/1/validateVerificationCode" captured+        `shouldSatisfy` (\hs -> hasJsonContentHeaders hs && hasWidgetKey hs)++  it "GET /appleauth/auth sends scnt, X-Apple-ID-Session-Id, and X-Apple-Widget-Key" $+    withCapturedFetchTrustData $ \captured ->+      headersFor "/appleauth/auth" captured+        `shouldSatisfy` (\hs -> hasWidgetKey hs && hasScnt hs && hasSessionId hs)++  it "requestSmsCode sends Content-Type, Accept, Widget-Key, scnt, and X-Apple-ID-Session-Id" $+    withCapturedRequestSms $ \captured ->+      headersFor "/appleauth/auth/verify/phone" captured+        `shouldSatisfy` (\hs -> hasJsonContentHeaders hs && hasWidgetKey hs && hasScnt hs && hasSessionId hs)++  it "verifySmsCode sends Content-Type, Accept, Widget-Key, scnt, and X-Apple-ID-Session-Id" $+    withCapturedVerifySms $ \captured ->+      headersFor "/verify/phone/securitycode" captured+        `shouldSatisfy` (\hs -> hasJsonContentHeaders hs && hasWidgetKey hs && hasScnt hs && hasSessionId hs)+++withCapturedLogin :: (FilePath -> IO ()) -> ([(ByteString, RequestHeaders)] -> IO ()) -> IO ()+withCapturedLogin setup action =+  withSystemTempDirectory "icloud-auth-headers" $ \tmpDir -> do+    setup tmpDir+    withMockAppCapturing defaultScenario $ \serverPort capturedRef -> do+      mgr <- newManager defaultManagerSettings+      api <- mkApiWith (testSession tmpDir) (testEndpoints serverPort) mgr+      _ <- login api+      captured <- readIORef capturedRef+      action captured+++withCapturedTwoFa :: ([(ByteString, RequestHeaders)] -> IO ()) -> IO ()+withCapturedTwoFa action =+  withSystemTempDirectory "icloud-auth-headers-2fa" $ \tmpDir ->+    withMockAppCapturing defaultScenario{snAccountLoginNeeds2FA = 1} $ \serverPort capturedRef -> do+      mgr <- newManager defaultManagerSettings+      api <- mkApiWith (testSession tmpDir) (testEndpoints serverPort) mgr+      _ <- loginWith (\_ -> pure "123456") (\_ -> pure Nothing) (\_ -> pure testDevice) api+      captured <- readIORef capturedRef+      action captured+++withCapturedTwoSa :: ([(ByteString, RequestHeaders)] -> IO ()) -> IO ()+withCapturedTwoSa action =+  withSystemTempDirectory "icloud-auth-headers-2sa" $ \tmpDir ->+    withMockAppCapturing defaultScenario{snAccountLoginNeeds2SA = True} $ \serverPort capturedRef -> do+      mgr <- newManager defaultManagerSettings+      api <- mkApiWith (testSession tmpDir) (testEndpoints serverPort) mgr+      _ <- loginWith (\_ -> pure "0") (\_ -> pure Nothing) (\_ -> pure testDevice) api+      captured <- readIORef capturedRef+      action captured+++withCapturedFetchTrustData :: ([(ByteString, RequestHeaders)] -> IO ()) -> IO ()+withCapturedFetchTrustData action =+  withSystemTempDirectory "icloud-auth-headers-trustdata" $ \tmpDir -> do+    writeSavedHeadersWithSession tmpDir+    withMockAppCapturing defaultScenario $ \serverPort capturedRef -> do+      mgr <- newManager defaultManagerSettings+      api <- mkApiWith (testSession tmpDir) (testEndpoints serverPort) mgr+      _ <- fetchTrustData api+      captured <- readIORef capturedRef+      action captured+++writeSavedHeaders :: FilePath -> IO ()+writeSavedHeaders tmpDir = do+  let creds = Credentials "alice@example.com" "password123"+      shPath = savedHeadersPath tmpDir creds+      hdrs = SavedHeaders Nothing Nothing (Just "test-token") Nothing Nothing+  encodeFile shPath hdrs+  setFileMode shPath 0o600+++writeSavedHeadersWithSession :: FilePath -> IO ()+writeSavedHeadersWithSession tmpDir = do+  let creds = Credentials "alice@example.com" "password123"+      shPath = savedHeadersPath tmpDir creds+      hdrs = SavedHeaders Nothing (Just "test-session-id") Nothing Nothing (Just "test-scnt")+  encodeFile shPath hdrs+  setFileMode shPath 0o600+++withCapturedRequestSms :: ([(ByteString, RequestHeaders)] -> IO ()) -> IO ()+withCapturedRequestSms action =+  withSystemTempDirectory "icloud-auth-headers-req-sms" $ \tmpDir -> do+    writeSavedHeadersWithSession tmpDir+    withMockAppCapturing defaultScenario $ \serverPort capturedRef -> do+      mgr <- newManager defaultManagerSettings+      api <- mkApiWith (testSession tmpDir) (testEndpoints serverPort) mgr+      requestSmsCode api testPhone+      captured <- readIORef capturedRef+      action captured+++withCapturedVerifySms :: ([(ByteString, RequestHeaders)] -> IO ()) -> IO ()+withCapturedVerifySms action =+  withSystemTempDirectory "icloud-auth-headers-verify-sms" $ \tmpDir -> do+    writeSavedHeadersWithSession tmpDir+    withMockAppCapturing defaultScenario $ \serverPort capturedRef -> do+      mgr <- newManager defaultManagerSettings+      api <- mkApiWith (testSession tmpDir) (testEndpoints serverPort) mgr+      _ <- verifySmsCode api testPhone "654321"+      captured <- readIORef capturedRef+      action captured+++testPhone :: TrustedPhone+testPhone = TrustedPhone 1 "+81 test" (Just "sms")+++headersFor :: ByteString -> [(ByteString, RequestHeaders)] -> Maybe RequestHeaders+headersFor pathFragment captured =+  fmap snd $ find (\(p, _) -> pathFragment `BS8.isSuffixOf` p) captured+++hasJsonAccept :: Maybe RequestHeaders -> Bool+hasJsonAccept Nothing = False+hasJsonAccept (Just hs) = any (\(n, v) -> n == hAccept && v == "application/json") hs+++hasJsonContentType :: Maybe RequestHeaders -> Bool+hasJsonContentType Nothing = False+hasJsonContentType (Just hs) = any (\(n, v) -> n == hContentType && v == "application/json") hs+++hasWidgetKey :: Maybe RequestHeaders -> Bool+hasWidgetKey Nothing = False+hasWidgetKey (Just hs) = any (\(n, _) -> n == "X-Apple-Widget-Key") hs+++hasOrigin :: Maybe RequestHeaders -> Bool+hasOrigin Nothing = False+hasOrigin (Just hs) = any (\(n, _) -> n == "Origin") hs+++hasJsonContentHeaders :: Maybe RequestHeaders -> Bool+hasJsonContentHeaders hs = hasJsonAccept hs && hasJsonContentType hs+++hasScnt :: Maybe RequestHeaders -> Bool+hasScnt Nothing = False+hasScnt (Just hs) = any (\(n, _) -> n == "scnt") hs+++hasSessionId :: Maybe RequestHeaders -> Bool+hasSessionId Nothing = False+hasSessionId (Just hs) = any (\(n, _) -> n == "X-Apple-ID-Session-Id") hs+++testSession :: FilePath -> Session+testSession topDir =+  Session+    { sessionCreds = Credentials "alice@example.com" "password123"+    , sessionTopDir = topDir+    , sessionClientId = "test-client-id"+    }+++testEndpoints :: Int -> Endpoints+testEndpoints serverPort =+  Endpoints+    { epHome = "http://127.0.0.1:" <> BS8.pack (show serverPort)+    , epAuth = mockReq "/appleauth/auth"+    , epSetup = mockReq "/setup/ws/1"+    , epWidgetKey = "test-widget-key"+    }+ where+  mockReq reqPath =+    defaultRequest+      { host = "127.0.0.1"+      , port = serverPort+      , secure = False+      , method = methodPost+      , path = reqPath+      }+++testDevice :: Setup2SADevice+testDevice =+  fromJust $+    decode+      "{\"deviceType\":\"SMS\",\"areaCode\":\"\",\"phoneNumber\":\"*******58\",\"deviceId\":\"1\"}"

@@ -0,0 +1,223 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.HttpMockSpec+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Tests for the iCloud HTTP client using a mock server.+-}+module HStratus.HttpMockSpec (spec) where++import Control.Exception (try)+import Data.Aeson (decode, encodeFile)+import Data.Bits ((.&.))+import qualified Data.ByteString.Char8 as BS8+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (fromJust)+import qualified Data.Text as Text+import HStratus.Mock (Scenario (..), SrpOutcome (..), defaultScenario, withMockApp, withMockAppCapturing)+import Network.HStratus.Http+  ( Api+  , AuthState (..)+  , complete2SAWith+  , login+  , loginWith+  , mkApiWith+  )+import Network.HStratus.Http.Endpoints (Endpoints (..))+import Network.HStratus.Internal.HttpErrors (AuthError (..))+import Network.HStratus.Internal.Session (SavedHeaders (..), cookiePath, savedHeadersPath)+import Network.HStratus.Session (Credentials (..), Session (..))+import Network.HStratus.Trust (Setup2SADevice, TrustedPhone (..))+import Network.HTTP.Client (Request (..), defaultManagerSettings, defaultRequest, newManager)+import Network.HTTP.Types (methodPost)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files (fileMode, getFileStatus, setFileMode)+import Test.Hspec (Spec, describe, it, shouldBe, shouldReturn, shouldSatisfy)+++spec :: Spec+spec = describe "Network.HStratus.Http.login" $ do+  it "returns Authenticated on fresh login" $+    loginShouldAuthenticate defaultScenario++  it "creates the session directory when absent then returns Authenticated" $+    withSystemTempDirectory "icloud-auth-mock" $ \tmpDir ->+      withMockApi (tmpDir </> "session") defaultScenario $ \api -> do+        isAuthenticated <$> login api `shouldReturn` True++  it "returns Authenticated when saved headers are valid" $+    withSystemTempDirectory "icloud-auth-mock" $ \tmpDir -> do+      writeSavedHeaders tmpDir+      withMockApi tmpDir defaultScenario $ \api -> do+        isAuthenticated <$> login api `shouldReturn` True++  it "falls through to fresh login when validate returns 401" $+    withSystemTempDirectory "icloud-auth-mock" $ \tmpDir -> do+      writeSavedHeaders tmpDir+      withMockApi tmpDir defaultScenario{snValidate = False} $ \api -> do+        isAuthenticated <$> login api `shouldReturn` True++  it "completes 2FA automatically when accountLogin requires 2FA" $+    withFreshMockApi "icloud-auth-mock" defaultScenario{snAccountLoginNeeds2FA = 1} $ \api -> do+      isAuthenticated <$> loginWith (\_ -> pure "123456") (\_ -> pure Nothing) (\_ -> pure testDevice) api `shouldReturn` True++  it "complete2SA returns Authenticated after 2SA challenge" $+    withFreshMockApi "icloud-auth-2sa" defaultScenario $ \api -> do+      result <- complete2SAWith (\_ -> pure testDevice) (pure "0") api (testDevice :| [])+      isAuthenticated result `shouldBe` True++  it "completes 2SA automatically when account login signals 2SA required" $+    withFreshMockApi "icloud-auth-2sa-login" defaultScenario{snAccountLoginNeeds2SA = True} $ \api -> do+      isAuthenticated <$> loginWith (\_ -> pure "0") (\_ -> pure Nothing) (\_ -> pure testDevice) api `shouldReturn` True++  it "throws UnexpectedResponse with HTTP status when error response has no body" $+    withFreshMockApi "icloud-auth-empty-err" defaultScenario{snSrpCompleteEmptyError = True} $ \api -> do+      let throwsBadRequest (Left (UnexpectedResponse msg)) = "bad request" `Text.isPrefixOf` msg+          throwsBadRequest _otherwise = False+      result <- try (login api) :: IO (Either AuthError AuthState)+      result `shouldSatisfy` throwsBadRequest++  it "complete2SA retries when the first verification code is wrong" $ do+    codeRef <- newIORef ["wrongcode", "0"]+    let readCode = do+          codes <- readIORef codeRef+          case codes of+            [] -> fail "no more codes"+            (c : rest) -> writeIORef codeRef rest >> pure c+    withFreshMockApi "icloud-auth-2sa-retry" defaultScenario{snValidateCodeFails = True} $ \api -> do+      result <- complete2SAWith (\_ -> pure testDevice) readCode api (testDevice :| [])+      isAuthenticated result `shouldBe` True++  it "completes 2FA via SMS when phone selector returns a phone" $+    withFreshMockApi "icloud-auth-2fa-sms" defaultScenario{snAccountLoginNeeds2FA = 1} $ \api -> do+      isAuthenticated <$> loginWith (\_ -> pure "654321") (\_ -> pure (Just testPhone)) (\_ -> pure testDevice) api+        `shouldReturn` True++  it "calls GET /appleauth/auth when accountLogin requires 2FA" $+    withSystemTempDirectory "icloud-auth-fetches-trust" $ \tmpDir -> do+      let scenario = defaultScenario{snSrpOutcome = SrpNeeds2FA, snAccountLoginNeeds2FA = 1}+      withMockAppCapturing scenario $ \serverPort capturedRef -> do+        mgr <- newManager defaultManagerSettings+        api <- mkApiWith (testSession tmpDir) (testEndpoints serverPort) mgr+        _ <- loginWith (\_ -> pure "123456") (\_ -> pure Nothing) (\_ -> pure testDevice) api+        captured <- readIORef capturedRef+        map fst captured `shouldSatisfy` elem "/appleauth/auth"++  it "completes 2FA via device push after retrying when the first code is wrong" $ do+    codeRef <- newIORef ["wrongcode", "123456"]+    let readCode = do+          codes <- readIORef codeRef+          case codes of+            [] -> fail "no more codes"+            (c : rest) -> writeIORef codeRef rest >> pure c+    withFreshMockApi "icloud-auth-2fa-retry" defaultScenario{snAccountLoginNeeds2FA = 1, snVerifyDeviceCodeFails = True} $ \api ->+      isAuthenticated <$> loginWith (const readCode) (\_ -> pure Nothing) (\_ -> pure testDevice) api+        `shouldReturn` True++  it "retries signin/init and completes login when first response is 421" $+    loginShouldAuthenticate defaultScenario{snSrpInitReturnsRetryCode = Just 421}++  it "retries signin/init and completes login when first response is 450" $+    loginShouldAuthenticate defaultScenario{snSrpInitReturnsRetryCode = Just 450}++  it "retries signin/init and completes login when first response is 500" $+    loginShouldAuthenticate defaultScenario{snSrpInitReturnsRetryCode = Just 500}++  it "throws TwoFactorLocked when the server signals the account is locked" $+    withFreshMockApi "icloud-auth-2fa-locked" defaultScenario{snAccountLoginNeeds2FA = 1, snVerifyCodeLocks = True} $ \api -> do+      result <- try (loginWith (\_ -> pure "wrongcode") (\_ -> pure Nothing) (\_ -> pure testDevice) api) :: IO (Either AuthError AuthState)+      result `shouldSatisfy` (\case Left TwoFactorLocked -> True; _ -> False)++  it "sets cookie jar mode to 0o600 after login" $+    withSystemTempDirectory "icloud-auth-cookie-perms" $ \tmpDir ->+      withMockApi tmpDir defaultScenario $ \api -> do+        _ <- login api+        let creds = Credentials "alice@example.com" "password123"+            jarPath = cookiePath tmpDir creds+        shouldHaveMode600 jarPath+++shouldHaveMode600 :: FilePath -> IO ()+shouldHaveMode600 filePath = do+  mode <- fileMode <$> getFileStatus filePath+  (mode .&. 0o777) `shouldBe` 0o600+++withMockApi :: FilePath -> Scenario -> (Api -> IO a) -> IO a+withMockApi tmpDir scenario action =+  withMockApp scenario $ \serverPort -> do+    mgr <- newManager defaultManagerSettings+    api <- mkApiWith (testSession tmpDir) (testEndpoints serverPort) mgr+    action api+++withFreshMockApi :: String -> Scenario -> (Api -> IO a) -> IO a+withFreshMockApi prefix scenario action =+  withSystemTempDirectory prefix $ \tmpDir ->+    withMockApi tmpDir scenario action+++loginShouldAuthenticate :: Scenario -> IO ()+loginShouldAuthenticate scenario =+  withFreshMockApi "icloud-auth-mock" scenario $ \api -> do+    result <- login api+    isAuthenticated result `shouldBe` True+++testSession :: FilePath -> Session+testSession topDir =+  Session+    { sessionCreds = Credentials "alice@example.com" "password123"+    , sessionTopDir = topDir+    , sessionClientId = "test-client-id"+    }+++testEndpoints :: Int -> Endpoints+testEndpoints serverPort =+  Endpoints+    { epHome = "http://127.0.0.1:" <> BS8.pack (show serverPort)+    , epAuth = mockReq "/appleauth/auth"+    , epSetup = mockReq "/setup/ws/1"+    , epWidgetKey = "test-widget-key"+    }+ where+  mockReq reqPath =+    defaultRequest+      { host = "127.0.0.1"+      , port = serverPort+      , secure = False+      , method = methodPost+      , path = reqPath+      }+++writeSavedHeaders :: FilePath -> IO ()+writeSavedHeaders tmpDir = do+  let creds = Credentials "alice@example.com" "password123"+      hdrsPath = savedHeadersPath tmpDir creds+      hdrs = SavedHeaders Nothing Nothing (Just "test-token") Nothing Nothing+  encodeFile hdrsPath hdrs+  setFileMode hdrsPath 0o600+++isAuthenticated :: AuthState -> Bool+isAuthenticated (Authenticated _ _) = True+isAuthenticated _ = False+++testDevice :: Setup2SADevice+testDevice =+  fromJust $+    decode+      "{\"deviceType\":\"SMS\",\"areaCode\":\"\",\"phoneNumber\":\"*******58\",\"deviceId\":\"1\"}"+++testPhone :: TrustedPhone+testPhone = TrustedPhone 1 "+81 test" (Just "sms")

@@ -0,0 +1,178 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.HttpSpec+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Tests for the iCloud HTTP client request and response handling.+-}+module HStratus.HttpSpec+  ( spec+  )+where++import Crypto.SRP.Hashing (KnownAlgorithm (SHA256), hashText)+import Data.Aeson (Value (..), decode, withObject, (.:))+import Data.Aeson.KeyMap (fromList)+import Data.Aeson.Types (parseMaybe)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base16 as Base16+import Data.String.Conv (toS)+import Data.Text (Text)+import qualified HStratus.Examples as Examples+import Network.HStratus.Internal.Http+  ( PasswordProtocol (..)+  , hCounter+  , hCountry+  , hSessionId+  , hSessionToken+  , hTrustToken+  , needsRetry+  , phoneCodeBody+  , phoneTriggerBody+  , validateSetupBody+  )+import Network.HStratus.Internal.Session+  ( SavedHeaders (..)+  , pristine+  , updateSavedHeaders+  )+import Network.HStratus.Trust (Setup2SADevice (..), TrustedPhone (..))+import Network.HTTP.Types (HeaderName)+import Test.Hspec (Spec, context, describe, it, shouldBe)+import Test.QuickCheck+  ( Gen+  , Property+  , elements+  , forAll+  , forAllBlind+  , sublistOf+  , vectorOf+  )+++spec :: Spec+spec = describe "module Network.HStratus.Http" $ do+  updateSavedHeadersSpec+  needsRetrySpec+  passwordProtocolSpec+  validateSetupBodySpec+  phoneCodeBodySpec+  phoneTriggerBodySpec+++updateSavedHeadersSpec :: Spec+updateSavedHeadersSpec = describe "updateSavedHeaders" $ do+  context "using generated headers" $ do+    it "should generated the expected value" prop_updateSavedHeaders+++prop_updateSavedHeaders :: Property+prop_updateSavedHeaders = forAllBlind genHdrsAndExpectedSavedHeaders $ \(hdrs, f) ->+  f $ updateSavedHeaders hdrs pristine+++genHdrsAndExpectedSavedHeaders :: Gen ([(HeaderName, ByteString)], SavedHeaders -> Bool)+genHdrsAndExpectedSavedHeaders = do+  checks <- sublistOf sdChecks+  values <- vectorOf (length checks) (elements Examples.byteStrings)+  let headers = zip (map fst checks) values+      asPred getter want sd = Just (toS want) == getter sd+      preds = zipWith asPred (map snd checks) values+      combine xs sd = all ($ sd) xs+  pure (headers, combine preds)+++sdChecks :: [(HeaderName, SavedHeaders -> Maybe Text)]+sdChecks =+  [ (hCountry, shCountry)+  , (hSessionId, shSessionId)+  , (hSessionToken, shSessionToken)+  , (hTrustToken, shTrustToken)+  , (hCounter, shCounter)+  ]+++needsRetrySpec :: Spec+needsRetrySpec = describe "needsRetry" $ do+  it "is True for 421" $ needsRetry 421 `shouldBe` True+  it "is True for 450" $ needsRetry 450 `shouldBe` True+  it "is True for 500" $ needsRetry 500 `shouldBe` True+  it "is False for 200" $ needsRetry 200 `shouldBe` False+  it "is False for 400" $ needsRetry 400 `shouldBe` False+++passwordProtocolSpec :: Spec+passwordProtocolSpec = describe "PasswordProtocol" $ do+  context "parsing from JSON" $ do+    it "parses 's2k' as New" $+      (decode "\"s2k\"" :: Maybe PasswordProtocol) `shouldBe` Just New+    it "parses 's2k_fo' as Old" $+      (decode "\"s2k_fo\"" :: Maybe PasswordProtocol) `shouldBe` Just Old+    it "fails on unknown strings" $+      (decode "\"unknown\"" :: Maybe PasswordProtocol) `shouldBe` Nothing+  context "key derivation" $ do+    it "Old (Base16-encoded hash) always differs from New (raw hash)" $+      prop_oldNewHashesDiffer+++prop_oldNewHashesDiffer :: Property+prop_oldNewHashesDiffer = forAll (elements Examples.wordz) $ \pwd ->+  let hashed = hashText SHA256 pwd+   in Base16.encode hashed /= hashed+++validateSetupBodySpec :: Spec+validateSetupBodySpec = describe "validateSetupBody" $ do+  it "includes verificationCode from the code argument" $+    field "verificationCode" `shouldBe` Just (String "123456")+  it "includes trustBrowser set to True" $+    field "trustBrowser" `shouldBe` Just (Bool True)+  it "preserves original device fields" $+    field "deviceId" `shouldBe` Just (String "abc")+ where+  device = Setup2SADevice $ fromList [("deviceId", String "abc")]+  body = validateSetupBody device "123456"+  field k = parseMaybe (withObject "body" (.: k)) body+++phoneCodeBodySpec :: Spec+phoneCodeBodySpec = describe "phoneCodeBody" $ do+  it "sets phoneNumber.id to the TrustedPhone id" $+    phoneField verifyBody "id" `shouldBe` Just (Number 1)+  it "sets securityCode.code to the supplied code" $+    codeField verifyBody "code" `shouldBe` Just (String "654321")+  it "sets mode to sms" $+    field verifyBody "mode" `shouldBe` Just (String "sms")+  it "sets securityCode.code to empty string when requesting SMS" $+    codeField requestBody "code" `shouldBe` Just (String "")+  it "defaults mode to sms when tpnPushMode is Nothing" $+    field (phoneCodeBody noModePhone "123") "mode" `shouldBe` Just (String "sms")+ where+  phone = TrustedPhone 1 "+81 test" (Just "sms")+  noModePhone = TrustedPhone 1 "+81 test" Nothing+  verifyBody = phoneCodeBody phone "654321"+  requestBody = phoneCodeBody phone ""+  field b k = parseMaybe (withObject "body" (.: k)) b+  phoneField b k = field b "phoneNumber" >>= parseMaybe (withObject "phoneNumber" (.: k))+  codeField b k = field b "securityCode" >>= parseMaybe (withObject "securityCode" (.: k))+++phoneTriggerBodySpec :: Spec+phoneTriggerBodySpec = describe "phoneTriggerBody" $ do+  it "sets phoneNumber.id to the TrustedPhone id" $+    phoneField triggerBody "id" `shouldBe` Just (Number 1)+  it "sets mode to the tpnPushMode value" $+    field triggerBody "mode" `shouldBe` Just (String "sms")+  it "defaults mode to sms when tpnPushMode is Nothing" $+    field (phoneTriggerBody noModePhone) "mode" `shouldBe` Just (String "sms")+  it "does not include a securityCode field" $+    field triggerBody "securityCode" `shouldBe` (Nothing :: Maybe Value)+ where+  phone = TrustedPhone 1 "+81 test" (Just "sms")+  noModePhone = TrustedPhone 1 "+81 test" Nothing+  triggerBody = phoneTriggerBody phone+  field b k = parseMaybe (withObject "body" (.: k)) b+  phoneField b k = field b "phoneNumber" >>= parseMaybe (withObject "phoneNumber" (.: k))

@@ -0,0 +1,294 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : HStratus.LoginFSMSpec+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Tests for the iCloud login finite state machine in 'Network.HStratus.Internal.LoginFSM'.+-}+module HStratus.LoginFSMSpec+  ( spec+  )+where++import Data.List.NonEmpty (NonEmpty (..))+import Network.HStratus.Internal.LoginFSM+import Test.Hspec (Spec, describe, it, shouldBe)+++newtype TestState s = TestState ()+++data Script = Script+  { scriptCreds :: !Bool+  , scriptDir :: !Bool+  , scriptMkDir :: !Bool+  , scriptHasSavedSession :: !Bool+  , scriptSessionValid :: !Bool+  , scriptSrpInvalidKey :: !Bool+  , scriptAcct :: !Bool+  , scriptAcctTwoFa :: !Bool+  , scriptTwoFa :: ![Bool]+  , scriptTwoSa :: ![Bool]+  , scriptNoTrustedDevices :: !Bool+  , scriptTwoFaLocked :: !Bool+  }+++allTrue :: Script+allTrue =+  Script+    { scriptCreds = True+    , scriptDir = True+    , scriptMkDir = True+    , scriptHasSavedSession = False+    , scriptSessionValid = False+    , scriptSrpInvalidKey = False+    , scriptAcct = True+    , scriptAcctTwoFa = False+    , scriptTwoFa = [True]+    , scriptTwoSa = [True]+    , scriptNoTrustedDevices = False+    , scriptTwoFaLocked = False+    }+++popTwoFa :: TestM Bool+popTwoFa = TestM $ \s -> case scriptTwoFa s of+  (b : bs) -> (b, s{scriptTwoFa = bs})+  [] -> (True, s)+++popTwoSa :: TestM Bool+popTwoSa = TestM $ \s -> case scriptTwoSa s of+  (b : bs) -> (b, s{scriptTwoSa = bs})+  [] -> (True, s)+++instance LoginEvent TestM where+  type State TestM = TestState+++  initial = pure (TestState ())+++  ratifyCreds (TestState ()) = asksScript $ \s ->+    if scriptCreds s+      then GotCreds (TestState ())+      else NoCreds (TestState ())+++  ratifyArtifactDir (TestState ()) = asksScript $ \s ->+    if scriptDir s+      then DirPresent (TestState ())+      else DirAbsent (TestState ())+++  mkArtifactDir (TestState ()) = asksScript $ \s ->+    if scriptMkDir s+      then DirMade (TestState ())+      else NotMade (TestState ())+++  loadSession (TestState ()) = asksScript $ \s ->+    if scriptHasSavedSession s+      then HasPriorSession (TestState ())+      else HasClientId (TestState ())+++  validateSession (TestState ()) = asksScript $ \s ->+    if scriptSessionValid s+      then SessionStillValid (TestState ())+      else SessionStale (TestState ())+++  srpInit (TestState ()) = pure (TestState ())+++  srpComplete (TestState ()) = asksScript $ \s ->+    if scriptSrpInvalidKey s+      then SrpCompleteInvalidKey (TestState ())+      else SrpCompleteOk (TestState ())+++  acctLogin (TestState ()) = asksScript $ \s ->+    if scriptAcctTwoFa s+      then AcctLogin2FA (TestState ())+      else+        if scriptAcct s+          then AcctLoginOk (TestState ())+          else AcctLogin2SA (TestState ())+++  listTwoSaDevices (TestState ()) = pure (TestState ())+++  beginTwoFa (TestState ()) _cfg = pure (TestState ())+++  doTrust (TestState ()) = pure (TestState ())+++  verifyTwoFa (TestState ()) _cfg = do+    result <- popTwoFa+    if result+      then pure $ TwoFaOk (TestState ())+      else asksScript $ \s ->+        if scriptTwoFaLocked s+          then TwoFaLocked (TestState ())+          else TwoFaRetry (TestState ())+++  beginTwoSa (TestState ()) _cfg = pure (TestState ())+++  verifyTwoSa (TestState ()) _cfg = do+    result <- popTwoSa+    pure $ if result then TwoSaOk (TestState ()) else TwoSaRetry (TestState ())+++data Outcome+  = Authenticated+  | TwoFa+  | TwoSa+  | HaltCreds+  | HaltMkDir+  | HaltSrp+  | LockedByTwoFa+  deriving (Eq, Show)+++outcomeOf :: LoginOutcome TestState -> Outcome+outcomeOf = \case+  LoginAuthenticated _ -> Authenticated+  LoginNeedsTwoFa _ -> TwoFa+  LoginNeedsTwoSa _ -> TwoSa+  LoginHaltCreds _ -> HaltCreds+  LoginHaltDir _ -> HaltMkDir+  LoginHaltSrp _ -> HaltSrp+  LoginHaltTwoFaLocked _ -> LockedByTwoFa+++completionOutcomeOf :: CompletionOutcome TestState -> Outcome+completionOutcomeOf = \case+  CompletionAuthenticated _ -> Authenticated+  CompletionNeedsTwoFa _ -> TwoFa+  CompletionNeedsTwoSa _ -> TwoSa+  CompletionTwoFaLocked _ -> LockedByTwoFa+++runScript :: Script -> Outcome+runScript s = outcomeOf $ runTestM loginProcess s+++runTwoFaScript :: Script -> Outcome+runTwoFaScript s = completionOutcomeOf $ runTestM (twoFaProcess (TestState ()) dummyTwoFaConfig) s+++runTwoSaScript :: Script -> Outcome+runTwoSaScript s = completionOutcomeOf $ runTestM (twoSaProcess (TestState ()) dummyTwoSaConfig) s+++dummyTwoFaConfig :: TwoFaConfig+dummyTwoFaConfig = TwoFaConfig{tfcPickPhone = \_ -> pure Nothing, tfcReadCode = \_ -> pure ""}+++dummyTwoSaConfig :: TwoSaConfig+dummyTwoSaConfig =+  TwoSaConfig+    { tscPickDevice = \(d :| _) -> pure d+    , tscReadCode = pure ""+    }+++spec :: Spec+spec = do+  describe "LoginFSM.loginProcess" $ do+    it "halts when credentials are missing" $+      runScript (allTrue{scriptCreds = False}) `shouldBe` HaltCreds++    it "halts when the artifact directory cannot be created" $+      runScript (allTrue{scriptDir = False, scriptMkDir = False}) `shouldBe` HaltMkDir++    it "halts with invalid SRP key when the server public value is bad" $+      runScript (allTrue{scriptSrpInvalidKey = True}) `shouldBe` HaltSrp++    it "reaches Authenticated on the happy path" $+      runScript allTrue `shouldBe` Authenticated++    it "produces LoginNeedsTwoFa when account login signals 2FA required" $+      runScript (allTrue{scriptAcctTwoFa = True}) `shouldBe` TwoFa++    it "reaches Requires2SA when account login signals 2SA required" $+      runScript (allTrue{scriptAcct = False}) `shouldBe` TwoSa++    it "creates the artifact directory when absent then reaches Authenticated" $+      runScript (allTrue{scriptDir = False}) `shouldBe` Authenticated++    it "returns Authenticated immediately when the saved session is still valid" $+      runScript (allTrue{scriptHasSavedSession = True, scriptSessionValid = True}) `shouldBe` Authenticated++    it "falls through to SRP when the saved session is stale" $+      runScript (allTrue{scriptHasSavedSession = True, scriptSessionValid = False}) `shouldBe` Authenticated++  describe "LoginFSM.twoFaProcess" $ do+    it "reaches Authenticated when 2FA verification succeeds on the first attempt" $+      runTwoFaScript allTrue `shouldBe` Authenticated++    it "retries and reaches Authenticated after a failed 2FA verification" $+      runTwoFaScript (allTrue{scriptTwoFa = [False, True]}) `shouldBe` Authenticated++    it "reaches Requires2SA when account login signals 2SA required after 2FA" $+      runTwoFaScript (allTrue{scriptAcct = False}) `shouldBe` TwoSa++    it "still reaches Authenticated when noTrustedDevices is True" $+      runTwoFaScript (allTrue{scriptNoTrustedDevices = True}) `shouldBe` Authenticated++    it "halts with TwoFaLocked when the code is rejected and the server signals the account is locked" $+      runTwoFaScript (allTrue{scriptTwoFa = [False], scriptTwoFaLocked = True}) `shouldBe` LockedByTwoFa++  describe "LoginFSM.twoSaProcess" $ do+    it "reaches Authenticated when 2SA verification succeeds on the first attempt" $+      runTwoSaScript allTrue `shouldBe` Authenticated++    it "retries and reaches Authenticated after a failed 2SA verification" $+      runTwoSaScript (allTrue{scriptTwoSa = [False, True]}) `shouldBe` Authenticated++    it "reaches Requires2SA when account login signals 2SA required after 2SA" $+      runTwoSaScript (allTrue{scriptAcct = False}) `shouldBe` TwoSa+++newtype TestM a = TestM (Script -> (a, Script))+++instance Functor TestM where+  fmap f (TestM m) = TestM $ \s -> let (a, s') = m s in (f a, s')+++instance Applicative TestM where+  pure a = TestM (a,)+  TestM mf <*> TestM ma = TestM $ \s ->+    let (f, s') = mf s+        (a, s'') = ma s'+     in (f a, s'')+++instance Monad TestM where+  return = pure+  TestM ma >>= f = TestM $ \s ->+    let (a, s') = ma s+        TestM mb = f a+     in mb s'+++runTestM :: TestM a -> Script -> a+runTestM (TestM m) s = fst (m s)+++asksScript :: (Script -> a) -> TestM a+asksScript f = TestM $ \s -> (f s, s)

@@ -0,0 +1,213 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.Mock+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++A configurable mock iCloud server for hstratus-auth integration tests.+-}+module HStratus.Mock+  ( Scenario (..)+  , SrpOutcome (..)+  , defaultScenario+  , withMockApp+  , withMockAppCapturing+  )+where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LBS+import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)+import Network.HTTP.Types (HeaderName, RequestHeaders, hContentType, mkStatus, status200, status204, status400, status401, status404, status409)+import Network.Wai (Application, pathInfo, rawPathInfo, requestHeaders, requestMethod, responseLBS)+import Network.Wai.Handler.Warp (testWithApplication)+import Paths_hstratus_auth (getDataFileName)+++data SrpOutcome = SrpOk | SrpNeeds2FA+  deriving (Eq, Show)+++data Scenario = Scenario+  { snValidate :: Bool+  , snSrpOutcome :: SrpOutcome+  , snValidateCodeFails :: Bool+  -- ^ when True, the first validateVerificationCode call returns 400+  , snAccountLoginNeeds2SA :: Bool+  -- ^ when True, the first accountLogin call returns a 2SA-required response+  , snAccountLoginNeeds2FA :: Int+  -- ^ countdown: serve login_2fa_test.json while > 0, then loginWorking+  , snSrpCompleteEmptyError :: Bool+  -- ^ when True, signin/complete returns 401 with no body or Content-Type+  , snVerifyCodeLocks :: Bool+  -- ^ when True, POST verify/trusteddevice/securitycode returns 400 and GET /appleauth/auth returns locked trust data+  , snVerifyDeviceCodeFails :: Bool+  -- ^ when True, the first POST verify/trusteddevice/securitycode returns 400 (non-locking retry)+  , snSrpInitReturnsRetryCode :: Maybe Int+  -- ^ when Just n, signin/init returns status n on the first call, then succeeds+  }+++defaultScenario :: Scenario+defaultScenario =+  Scenario+    { snValidate = True+    , snSrpOutcome = SrpOk+    , snValidateCodeFails = False+    , snAccountLoginNeeds2SA = False+    , snAccountLoginNeeds2FA = 0+    , snSrpCompleteEmptyError = False+    , snVerifyCodeLocks = False+    , snVerifyDeviceCodeFails = False+    , snSrpInitReturnsRetryCode = Nothing+    }+++jsonHeaders :: [(HeaderName, ByteString)]+jsonHeaders = [(hContentType, "application/json"), ("X-Apple-Session-Token", "mock-session-token-value")]+++lockedTrustData :: LBS.ByteString+lockedTrustData =+  "{\"securityCode\":{\"length\":6,\"tooManyCodesSent\":false,\"tooManyCodesValidated\":false\+  \,\"securityCodeLocked\":true,\"securityCodeCooldown\":false}\+  \,\"trustedPhoneNumbers\":[{\"id\":1,\"numberWithDialCode\":\"+1 test\",\"pushMode\":null}]\+  \,\"noTrustedDevices\":false}"+++withMockApp :: Scenario -> (Int -> IO a) -> IO a+withMockApp scenario action =+  withMockAppCapturing scenario $ \port _ -> action port+++withMockAppCapturing :: Scenario -> (Int -> IORef [(ByteString, RequestHeaders)] -> IO a) -> IO a+withMockAppCapturing scenario action = do+  srpInit <- LBS.readFile =<< getDataFileName "testdata/srp_init_ok_test.json"+  login2fa <- LBS.readFile =<< getDataFileName "testdata/login_2fa_test.json"+  login2sa <- LBS.readFile =<< getDataFileName "testdata/login_2sa_test.json"+  loginWorking <- LBS.readFile =<< getDataFileName "testdata/login_working_test.json"+  listDevices <- LBS.readFile =<< getDataFileName "testdata/trusted_devices_test.json"+  trustData <- LBS.readFile =<< getDataFileName "testdata/trust_data_test.json"+  codeAttemptsRef <- newIORef (0 :: Int)+  deviceCodeAttemptsRef <- newIORef (0 :: Int)+  accountLoginRef <- newIORef (0 :: Int)+  srpInitRetryRef <- newIORef (0 :: Int)+  capturedRef <- newIORef []+  testWithApplication+    ( pure $+        mockApp+          scenario+          capturedRef+          srpInit+          login2fa+          login2sa+          loginWorking+          listDevices+          trustData+          codeAttemptsRef+          deviceCodeAttemptsRef+          accountLoginRef+          srpInitRetryRef+    )+    (\port -> action port capturedRef)+++mockApp+  :: Scenario+  -> IORef [(ByteString, RequestHeaders)]+  -> LBS.ByteString+  -> LBS.ByteString+  -> LBS.ByteString+  -> LBS.ByteString+  -> LBS.ByteString+  -> LBS.ByteString+  -> IORef Int+  -> IORef Int+  -> IORef Int+  -> IORef Int+  -> Application+mockApp+  scenario+  capturedRef+  srpInit+  login2fa+  login2sa+  loginWorking+  listDevices+  trustData+  codeAttemptsRef+  deviceCodeAttemptsRef+  accountLoginRef+  srpInitRetryRef+  req+  respond = do+    modifyIORef' capturedRef ((rawPathInfo req, requestHeaders req) :)+    let method = requestMethod req+        segs = pathInfo req+        json st body = responseLBS st jsonHeaders body+    resp <- case (method, segs) of+      ("GET", ["appleauth", "auth"]) ->+        pure $+          json status200 $+            if snVerifyCodeLocks scenario then lockedTrustData else trustData+      ("POST", ["appleauth", "auth", "signin", "init"]) -> do+        n <- readIORef srpInitRetryRef+        writeIORef srpInitRetryRef (n + 1)+        pure $ case snSrpInitReturnsRetryCode scenario of+          Just code | n == 0 -> responseLBS (mkStatus code "") [] ""+          _ -> json status200 srpInit+      ("POST", ["appleauth", "auth", "signin", "complete"]) ->+        pure $+          if snSrpCompleteEmptyError scenario+            then responseLBS status401 [] ""+            else case snSrpOutcome scenario of+              SrpOk -> json status200 "{}"+              SrpNeeds2FA -> responseLBS status409 jsonHeaders "{}"+      ("GET", ["appleauth", "auth", "2sv", "trust"]) ->+        pure $ json status200 "{}"+      ("PUT", ["appleauth", "auth", "verify", "trusteddevice", "securitycode"]) ->+        pure $ responseLBS status204 [] ""+      ("POST", ["appleauth", "auth", "verify", "trusteddevice", "securitycode"]) -> do+        n <- readIORef deviceCodeAttemptsRef+        writeIORef deviceCodeAttemptsRef (n + 1)+        pure $+          if snVerifyCodeLocks scenario+            then responseLBS status400 [] ""+            else+              if snVerifyDeviceCodeFails scenario && n == 0+                then responseLBS status400 [] ""+                else json status200 "{}"+      ("PUT", ["appleauth", "auth", "verify", "phone"]) ->+        pure $ json status200 "{}"+      ("POST", ["appleauth", "auth", "verify", "phone", "securitycode"]) ->+        pure $ json status200 "true"+      ("GET", ["setup", "ws", "1", "listDevices"]) ->+        pure $ json status200 listDevices+      ("POST", ["setup", "ws", "1", "sendVerificationCode"]) ->+        pure $ json status200 "{}"+      ("POST", ["setup", "ws", "1", "validateVerificationCode"]) -> do+        n <- readIORef codeAttemptsRef+        writeIORef codeAttemptsRef (n + 1)+        pure $+          if snValidateCodeFails scenario && n == 0+            then responseLBS status400 [] ""+            else json status200 "{}"+      ("POST", ["setup", "ws", "1", "validate"]) ->+        pure $+          if snValidate scenario+            then json status200 "{}"+            else responseLBS status401 [] ""+      ("POST", ["setup", "ws", "1", "accountLogin"]) -> do+        n <- readIORef accountLoginRef+        writeIORef accountLoginRef (n + 1)+        pure $+          if snAccountLoginNeeds2FA scenario > n+            then json status200 login2fa+            else+              if snAccountLoginNeeds2SA scenario && n == 0+                then json status200 login2sa+                else json status200 loginWorking+      _ -> pure $ responseLBS status404 [] "not found"+    respond resp

@@ -0,0 +1,119 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.PBKDF2Spec+Copyright   : (c) 2023 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module HStratus.PBKDF2Spec (spec) where++import qualified Crypto.Hash.SHA1 as SHA1+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Crypto.Hash.SHA512 as SHA512+import Data.Aeson+  ( FromJSON (..)+  , Object+  , Value+  , eitherDecodeFileStrict+  , withArray+  , withObject+  , (.:)+  )+import Data.Aeson.Types (Parser)+import Data.ByteString (ByteString)+import Data.ByteString.Base16 (decode)+import Data.Foldable (toList)+import Data.Text.Encoding (encodeUtf8)+import Data.Word (Word32, Word64, Word8)+import Network.HStratus.Internal.PBKDF2 (PseudoRandomF, deriveKey, wrap)+import Paths_hstratus_auth (getDataFileName)+import Test.Hspec (Spec, context, describe, it, runIO, shouldBe)+import Test.Hspec.Runner (SpecWith)+++spec :: Spec+spec = describe "module Network.HStratus.PBKDF2" $ do+  describe "deriveKey" $ do+    context "when using the wycheProof test cases" $ do+      specFrom "sha1" SHA1.hmac+      specFrom "sha256" SHA256.hmac+      specFrom "sha512" SHA512.hmac+++specFrom :: String -> PseudoRandomF -> Spec+specFrom shaName pseudo = do+  context ("with " ++ shaName ++ ".hmac as the pseudorandom function") $ do+    testData <- runIO $ namedDataPath shaName >>= loadTestData+    mapM_ (specWithFrom pseudo) testData+++specWithFrom :: PseudoRandomF -> TestDescription -> SpecWith ()+specWithFrom pseudo td = do+  let TestDescription{tdSalt, tdIterationCount = count, tdDerivedKey = key} = td+  it ("test " ++ show (tdId td) ++ " should succeed") $ do+    let pseudo' = wrap pseudo (tdDerivedLength td)+        calc x = deriveKey x (tdPassword td) tdSalt count+    calc <$> pseudo' `shouldBe` Right key+++loadTestData :: FilePath -> IO [TestDescription]+loadTestData src =+  let decodeDataFile aPath = fmap unTestFile <$> eitherDecodeFileStrict aPath+   in decodeDataFile src >>= either fail pure+++namedDataPath :: String -> IO FilePath+namedDataPath shaName =+  let path = "testdata/pbkdf2_hmac" ++ shaName ++ "_test.json"+   in getDataFileName path+++newtype TestFile = TestFile {unTestFile :: [TestDescription]}+++instance FromJSON TestFile where+  parseJSON = fmap TestFile . parseTestFile+++parseTestFile :: Value -> Parser [TestDescription]+parseTestFile =+  let oneTest = withObject "test" parseTestDescription+      manyTests = traverse oneTest . toList+      testsInTestGroup o = o .: "tests" >>= withArray "[test]" manyTests+      oneTestGroup = withObject "testsInTestGroup" testsInTestGroup+      manyTestGroups = traverse oneTestGroup . toList+      testGroupsAtTop o = o .: "testGroups" >>= withArray "[testGroups]" manyTestGroups+   in withObject "dataFile" (fmap concat . testGroupsAtTop)+++data TestDescription = TestDescription+  { tdId :: !Word8+  , tdPassword :: !ByteString+  , tdSalt :: !ByteString+  , tdIterationCount :: !Word64+  , tdDerivedLength :: !Word32+  , tdDerivedKey :: !ByteString+  }+  deriving (Eq, Show)+++parseTestDescription :: Object -> Parser TestDescription+parseTestDescription o = do+  let parseBase16Bytes = either fail pure . decode . encodeUtf8+  tdId <- o .: "tcId"+  tdPassword <- o .: "password" >>= parseBase16Bytes+  tdSalt <- o .: "salt" >>= parseBase16Bytes+  tdIterationCount <- o .: "iterationCount"+  tdDerivedLength <- o .: "dkLen"+  tdDerivedKey <- o .: "dk" >>= parseBase16Bytes+  pure+    TestDescription+      { tdId+      , tdPassword+      , tdSalt+      , tdIterationCount+      , tdDerivedKey+      , tdDerivedLength+      }

@@ -0,0 +1,530 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.SessionSpec+Copyright   : (c) 2023 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module HStratus.SessionSpec (spec) where++import Control.Monad (when)+import Data.Aeson (decode, eitherDecodeFileStrict, encode, encodeFile, object, (.=))+import Data.Aeson.Types (parseJSON, parseMaybe)+import Data.Bits ((.&.))+import Data.Either (isLeft)+import Data.List (isInfixOf, sort)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe)+import Data.String (IsString (..))+import Data.Text (Text)+import qualified Data.Text.IO as Text+import Data.Word (Word16)+import HStratus.TrustSpec (jsonKeysOf)+import Network.HStratus.Internal.Session+  ( SavedHeaders (..)+  , accountDataPath+  , accountDataRequires2FA+  , accountDataRequires2SA+  , appBase+  , checkSecureMode+  , clientIdPath+  , cookiePath+  , credentialsPath+  , encodeFileAtomic+  , loadAccountData+  , loadSavedHeaders+  , requireSecureFile+  , saveAccountData+  , saveCredentialsTo+  , savedHeadersPath+  , unknownAccountData+  , updateSessionSavedHeaders+  , (</>)+  )+import Network.HStratus.Session (AccountData (..), Credentials (..), Session (..), Webservice (..), loadSession)+import System.Directory (createDirectory, doesFileExist)+import System.Environment (setEnv)+import System.IO.Error (ioeGetErrorString)+import System.IO.Temp (withSystemTempDirectory)+import System.Posix.Files (fileMode, getFileStatus, setFileMode)+import Test.Hspec+  ( Spec+  , anyIOException+  , around+  , context+  , describe+  , it+  , shouldBe+  , shouldReturn+  , shouldSatisfy+  , shouldThrow+  )+import Test.QuickCheck+  ( Arbitrary (arbitrary)+  , Gen+  , Property+  , elements+  , frequency+  , listOf+  )+import Test.QuickCheck.Monadic (assert, monadicIO, pick, run)+++spec :: Spec+spec = do+  secureFileSpec+  secureWriteSpec+  checkSessionFilesSpec+  sessionSpec+  saveCredentialsSpec+  accountDataSpec+++secureFileSpec :: Spec+secureFileSpec = describe "module Network.HStratus.Internal.Session (file security)" $ do+  describe "checkSecureMode" $ do+    it "accepts mode 0o600" $+      checkSecureMode 0o600 "/tmp/test" `shouldBe` Right ()+    it "accepts mode 0o400 (read-only owner)" $+      checkSecureMode 0o400 "/tmp/test" `shouldBe` Right ()+    it "accepts mode 0o700 (owner-execute)" $+      checkSecureMode 0o700 "/tmp/test" `shouldBe` Right ()+    it "rejects mode 0o644 (world-readable)" $+      checkSecureMode 0o644 "/tmp/test" `shouldSatisfy` isLeft+    it "rejects mode 0o640 (group-readable)" $+      checkSecureMode 0o640 "/tmp/test" `shouldSatisfy` isLeft+    it "rejects mode 0o604 (world-readable, no group)" $+      checkSecureMode 0o604 "/tmp/test" `shouldSatisfy` isLeft+    it "includes the path in the error message" $+      case checkSecureMode 0o644 "/some/path" of+        Left msg -> "/some/path" `isInfixOf` msg `shouldBe` True+        Right () -> fail "expected Left"+    it "includes chmod hint in the error message" $+      case checkSecureMode 0o644 "/some/path" of+        Left msg -> "chmod 600" `isInfixOf` msg `shouldBe` True+        Right () -> fail "expected Left"+  describe "requireSecureFile" $ around withTmpDir $ do+    it "does nothing when the file is absent" $ \tmpDir -> do+      requireSecureFile (tmpDir </> "absent.txt")+    it "does nothing when the file has mode 0o600" $ \tmpDir -> do+      let path = tmpDir </> "secure.txt"+      writeFile path "content"+      setFileMode path 0o600+      requireSecureFile path+    it "throws when the file has mode 0o644" $ \tmpDir -> do+      let path = tmpDir </> "insecure.txt"+      writeFile path "content"+      setFileMode path 0o644+      requireSecureFile path `shouldThrow` anyIOException+    it "includes the path in the error for a bad-permission file" $ \tmpDir -> do+      let path = tmpDir </> "insecure.txt"+      writeFile path "content"+      setFileMode path 0o644+      requireSecureFile path+        `shouldThrow` (\e -> tmpDir `isInfixOf` ioeGetErrorString e)+++shouldHaveMode600 :: FilePath -> IO ()+shouldHaveMode600 path = do+  mode <- fileMode <$> getFileStatus path+  (mode .&. 0o777) `shouldBe` 0o600+++secureWriteSpec :: Spec+secureWriteSpec = describe "module Network.HStratus.Internal.Session (secure writes)" $ do+  context "saveCredentialsTo" $ around withTmpDir $ do+    it "writes credentials.json with mode 0o600" $ \tmpDir -> do+      saveCredentialsTo tmpDir exampleCred+      shouldHaveMode600 (credentialsPath tmpDir)+  context "updateSessionSavedHeaders" $ around useTmp $ do+    it "writes session headers with mode 0o600" $ \appRoot -> do+      saveCredentialsTo appRoot exampleCred+      s <- loadSession+      updateSessionSavedHeaders s id+      shouldHaveMode600 (savedHeadersPath appRoot (sessionCreds s))+  context "saveAccountData" $ around useTmp $ do+    it "writes account-data with mode 0o600" $ \appRoot -> do+      saveCredentialsTo appRoot exampleCred+      s <- loadSession+      saveAccountData s unknownAccountData+      shouldHaveMode600 (accountDataPath appRoot (sessionCreds s))+  context "loadClientId (new file)" $ around useTmp $ do+    it "creates client-id file with mode 0o600" $ \appRoot -> do+      saveCredentialsTo appRoot exampleCred+      s <- loadSession+      shouldHaveMode600 (clientIdPath appRoot (sessionCreds s))+++checkSessionFilesSpec :: Spec+checkSessionFilesSpec = describe "checkSessionFiles / loadSession" $ around useTmp $ do+  it "succeeds when credentials.json has mode 0o600" $ \appRoot -> do+    saveCredentialsTo appRoot exampleCred+    _ <- loadSession+    pure ()+  it "fails when credentials.json has mode 0o644" $ \appRoot -> do+    saveCredentialsTo appRoot exampleCred+    setFileMode (credentialsPath appRoot) 0o644+    loadSession `shouldThrow` anyIOException+  it "fails when session headers file has mode 0o644" $ \appRoot -> do+    saveCredentialsTo appRoot exampleCred+    s <- loadSession+    updateSessionSavedHeaders s id+    setFileMode (savedHeadersPath appRoot (sessionCreds s)) 0o644+    loadSession `shouldThrow` anyIOException+++-- save credential somewhere+-- confirm Session loads++-- save credentials+-- save a pre-existing clientId+-- loadSession; confirm loaded session as the clientId++-- save credentials+-- save generated SavedHeaders+-- loadSession; confirm saveHeaders are loaded++sessionSpec :: Spec+sessionSpec = describe "module Network.HStratus.Session" $ do+  context "Using an example Credential" $ do+    let topDir = "/tmp/icloud_authspec"+    context "cookiePath" $ do+      it "should be computed correctly" $ do+        let want = "/tmp/icloud_authspec/myaccountid-applecom.cookies.txt"+        cookiePath topDir exampleCred `shouldBe` want++    context "savedHeadersPath" $ do+      it "should be computed correctly" $ do+        let want = "/tmp/icloud_authspec/myaccountid-applecom.session.json"+        savedHeadersPath topDir exampleCred `shouldBe` want++    context "clientIdPath" $ do+      it "should be computed correctly" $ do+        let want = "/tmp/icloud_authspec/myaccountid-applecom.client-id.txt"+        clientIdPath topDir exampleCred `shouldBe` want+  savedHeadersFieldNamesSpec+  loadSessionSpec+  loadSavedHeadersSpec+  updateSessionSavedHeadersSpec+  encodeFileAtomicSpec+++savedHeadersFieldNamesSpec :: Spec+savedHeadersFieldNamesSpec = describe "SavedHeaders JSON field names" $ do+  it "uses the expected field names" $+    jsonKeysOf (SavedHeaders (Just "a") (Just "b") (Just "c") (Just "d") (Just "e"))+      `shouldBe` Just (sort ["country", "session_id", "session_token", "trust_token", "counter"])+++loadSessionSpec :: Spec+loadSessionSpec = describe "loadSession" $ around useTmp $ do+  context "with an invalid credentials file" $ do+    it "should fail to load" $ \appRoot ->+      failsOnBadCredentials appRoot `shouldThrow` anyIOException+  context "with only the credentials file" $ do+    it "should load a Session with a new clientId" prop_loadsSession+  context "with a clientId file available" $ do+    it "should load the saved clientId" prop_readsStoredCliendId+  context "with a saved headers file" $ do+    it "should load the saved headers" prop_readsStoredSavedHeaders+++loadSavedHeadersSpec :: Spec+loadSavedHeadersSpec = describe "loadSavedHeaders" $ around useTmp $ do+  context "with an invalid saved headers file" $ do+    it "should fail to load" $ \appRoot ->+      failsOnBadSavedHeaders appRoot `shouldThrow` anyIOException+    it "includes a re-login hint in the error message" $ \appRoot ->+      failsOnBadSavedHeaders appRoot+        `shouldThrow` (\e -> "hstratus auth login" `isInfixOf` ioeGetErrorString e)+++updateSessionSavedHeadersSpec :: Spec+updateSessionSavedHeadersSpec = describe "updateSessionSavedHeaders" $ around useTmp $ do+  context "when some SaveHeaders are already saved" $ do+    it "should update to the new headers" $ prop_updatesSavedHeaders True+  context "when No SaveHeaders have been saved" $ do+    it "should update to the new headers" $ prop_updatesSavedHeaders True+++useTmp :: (FilePath -> IO a) -> IO a+useTmp = withSystemTempDirectory "icloud-auth" . asConfigHome+++setupInvalid :: FilePath -> IO ()+setupInvalid path = Text.writeFile path "[}"+++failsOnBadCredentials :: FilePath -> IO Session+failsOnBadCredentials appRoot = do+  let path = credentialsPath appRoot+  setupInvalid path+  setFileMode path 0o600+  loadSession+++failsOnBadSavedHeaders :: FilePath -> IO SavedHeaders+failsOnBadSavedHeaders appRoot = do+  saveCredentialsTo appRoot exampleCred+  let shPath = savedHeadersPath appRoot exampleCred+  setupInvalid shPath+  setFileMode shPath 0o600+  s <- loadSession+  loadSavedHeaders s+++asConfigHome :: (FilePath -> IO a) -> FilePath -> IO a+asConfigHome action root = do+  setEnv "XDG_CONFIG_HOME" root+  let appRoot = root </> appBase+  createDirectory appRoot+  action appRoot+++prop_loadsSession :: FilePath -> Property+prop_loadsSession appRoot = monadicIO $ do+  preCreds <- pick genPreCredentials+  let creds = asCreds preCreds+  s <- run $ do+    saveCredentialsTo appRoot creds+    loadSession+  assert $ sessionClientId s /= "" && creds == sessionCreds s+++prop_readsStoredCliendId :: FilePath -> Property+prop_readsStoredCliendId appRoot = monadicIO $ do+  preCreds <- pick genPreCredentials+  fakeId <- pick $ genIndexedSuffix "client-id-"+  let creds = asCreds preCreds+  session <- run $ do+    saveCredentialsTo appRoot creds+    let cidPath = clientIdPath appRoot creds+    Text.writeFile cidPath fakeId+    setFileMode cidPath 0o600+    loadSession+  assert $ fakeId == sessionClientId session+++prop_readsStoredSavedHeaders :: FilePath -> Property+prop_readsStoredSavedHeaders appRoot = monadicIO $ do+  preCreds <- pick genPreCredentials+  savedHdrs <- pick genSaveHeaders+  let creds = asCreds preCreds+  savedHdrs' <- run $ do+    saveCredentialsTo appRoot creds+    s <- loadSession+    updateSessionSavedHeaders s (const savedHdrs)+    loadSavedHeaders s+  assert $ savedHdrs == savedHdrs'+++prop_updatesSavedHeaders :: Bool -> FilePath -> Property+prop_updatesSavedHeaders storeInitial appRoot = monadicIO $ do+  preCreds <- pick genPreCredentials+  savedHdrs <- pick genSaveHeaders+  newHdrs <- pick genSaveHeaders+  let creds = asCreds preCreds+  loadedHdrs <- run $ do+    saveCredentialsTo appRoot creds+    when storeInitial $ do+      let shPath = savedHeadersPath appRoot creds+      encodeFile shPath savedHdrs+      setFileMode shPath 0o600+    s <- loadSession+    updateSessionSavedHeaders s (const newHdrs)+    loadSavedHeaders s+  assert $ newHdrs == loadedHdrs+++saveCredentialsSpec :: Spec+saveCredentialsSpec = describe "saveCredentialsTo" $ do+  context "in a pre-existing directory" $ around withTmpDir $ do+    it "creates the credentials file" $ \tmpDir -> do+      saveCredentialsTo tmpDir exampleCred+      doesFileExist (credentialsPath tmpDir) `shouldReturn` True+    it "round-trips credentials through JSON" prop_saveLoadCredentials+    it "overwrites when called a second time" prop_overwritesCredentials+  context "when the target directory does not exist" $ do+    it "creates the directory and the file" $+      withSystemTempDirectory "icloud-auth-creds" $ \tmp -> do+        let target = tmp </> "new-subdir"+        saveCredentialsTo target exampleCred+        doesFileExist (credentialsPath target) `shouldReturn` True+++withTmpDir :: (FilePath -> IO a) -> IO a+withTmpDir = withSystemTempDirectory "icloud-auth-creds"+++prop_saveLoadCredentials :: FilePath -> Property+prop_saveLoadCredentials tmpDir = monadicIO $ do+  creds <- asCreds <$> pick genPreCredentials+  result <- run $ do+    saveCredentialsTo tmpDir creds+    eitherDecodeFileStrict (credentialsPath tmpDir)+  assert $ result == Right creds+++prop_overwritesCredentials :: FilePath -> Property+prop_overwritesCredentials tmpDir = monadicIO $ do+  creds1 <- asCreds <$> pick genPreCredentials+  creds2 <- asCreds <$> pick genPreCredentials+  result <- run $ do+    saveCredentialsTo tmpDir creds1+    saveCredentialsTo tmpDir creds2+    eitherDecodeFileStrict (credentialsPath tmpDir)+  assert $ result == Right creds2+++exampleCred :: Credentials+exampleCred =+  Credentials+    { credAccountName = "my-account-id@apple.com"+    , credPassword = "notasecret"+    }+++type PreCredentials = (Text, Text)+++asCreds :: PreCredentials -> Credentials+asCreds (credAccountName, credPassword) = Credentials{credAccountName, credPassword}+++genPreCredentials :: Gen PreCredentials+genPreCredentials =+  let mkId x = "account-" <> x <> "@apple.com"+   in (,) <$> genIndexedTemplate mkId <*> genIndexedSuffix "password-"+++genSaveHeaders :: Gen SavedHeaders+genSaveHeaders =+  let arb pre = frequency [(2, pure Nothing), (1, Just <$> genIndexedSuffix pre)]+   in SavedHeaders+        <$> arb "country-"+        <*> arb "session-id-"+        <*> arb "session-token-"+        <*> arb "trust-token-"+        <*> arb "counter="+++genWord16 :: Gen Word16+genWord16 = arbitrary+++genIndexedSuffix :: (Monoid a, IsString a) => a -> Gen a+genIndexedSuffix pre = genIndexedTemplate (pre <>)+++genIndexedTemplate :: (IsString a) => (a -> a) -> Gen a+genIndexedTemplate plate = plate . fromString . show <$> genWord16+++accountDataSpec :: Spec+accountDataSpec = describe "module Network.HStratus.Session (AccountData)" $ do+  context "AccountData" $ do+    it "round-trips through JSON encoding" prop_jsonRoundtripAccountData+  context "accountDataRequires2FA" $ do+    it "is True when hsaVersion == 2 and challenged" $+      accountDataRequires2FA (mkAccountData 2 True (Just False)) `shouldBe` True+    it "is True when hsaVersion == 2, not challenged, but browser explicitly untrusted" $+      accountDataRequires2FA (mkAccountData 2 False (Just False)) `shouldBe` True+    it "is False when hsaVersion == 2, not challenged, and browser trusted" $+      accountDataRequires2FA (mkAccountData 2 False (Just True)) `shouldBe` False+    it "is False when hsaVersion == 2, not challenged, and hsaTrustedBrowser absent" $+      accountDataRequires2FA (mkAccountData 2 False Nothing) `shouldBe` False+    it "is False when hsaVersion is 1" $+      accountDataRequires2FA (mkAccountData 1 True (Just False)) `shouldBe` False+    it "is False when hsaVersion is 3 (unknown version)" $+      accountDataRequires2FA (mkAccountData 3 True (Just False)) `shouldBe` False+  context "accountDataRequires2SA" $ do+    it "is True when hsaVersion is 1" $+      accountDataRequires2SA (mkAccountData 1 False (Just False)) `shouldBe` True+    it "is False when hsaVersion is 2" $+      accountDataRequires2SA (mkAccountData 2 False (Just False)) `shouldBe` False+    it "is False when hsaVersion is 0" $+      accountDataRequires2SA (mkAccountData 0 False (Just False)) `shouldBe` False+  context "AccountData JSON parsing" $ do+    it "fails to parse from null JSON" $+      (decode "null" :: Maybe AccountData) `shouldBe` Nothing+    it "fails to parse when dsInfo is absent" $+      (decode "{}" :: Maybe AccountData) `shouldBe` Nothing+  context "saveAccountData / loadAccountData" $ around useTmp $ do+    it "round-trips in a temp directory" prop_saveLoadAccountData+++prop_jsonRoundtripAccountData :: Property+prop_jsonRoundtripAccountData = monadicIO $ do+  ad <- pick genAccountData+  assert $ decode (encode ad) == Just ad+++prop_saveLoadAccountData :: FilePath -> Property+prop_saveLoadAccountData appRoot = monadicIO $ do+  preCreds <- pick genPreCredentials+  ad <- pick genAccountData+  let creds = asCreds preCreds+  loaded <- run $ do+    saveCredentialsTo appRoot creds+    s <- loadSession+    saveAccountData s ad+    loadAccountData s+  assert $ Just ad == loaded+++mkAccountData :: Int -> Bool -> Maybe Bool -> AccountData+mkAccountData ver challenged trusted =+  AccountData+    { adHsaVersion = ver+    , adHsaChallengeRequired = challenged+    , adHsaTrustedBrowser = trusted+    , adWebservices = Map.empty+    , adRaw = object []+    }+++genAccountData :: Gen AccountData+genAccountData = do+  adHsaVersion <- abs <$> (arbitrary :: Gen Int)+  adHsaChallengeRequired <- (arbitrary :: Gen Bool)+  adHsaTrustedBrowser <- elements [Nothing, Just True, Just False]+  adWebservices <- Map.fromList <$> listOf genWsPair+  let trustedField = maybe [] (\t -> ["hsaTrustedBrowser" .= t]) adHsaTrustedBrowser+      v =+        object $+          [ "dsInfo" .= object ["hsaVersion" .= adHsaVersion]+          , "hsaChallengeRequired" .= adHsaChallengeRequired+          , "webservices"+              .= fmap+                (\(Webservice url st) -> object $ ["url" .= url] <> maybe [] (\s -> ["status" .= s]) st)+                adWebservices+          ]+            <> trustedField+  pure $ fromMaybe unknownAccountData (parseMaybe parseJSON v)+ where+  genWsPair :: Gen (Text, Webservice)+  genWsPair = (,) <$> elements wsNames <*> genWebservice+  genWebservice :: Gen Webservice+  genWebservice = Webservice <$> genIndexedSuffix "https://example.com/" <*> elements [Nothing, Just "active", Just "inactive"]+  wsNames = ["findme", "contacts", "calendar", "mail"]+++encodeFileAtomicSpec :: Spec+encodeFileAtomicSpec = describe "encodeFileAtomic" $ around useTmp $ do+  it "round-trips a JSON value" $ \appRoot -> do+    let path = appRoot </> "test.json"+        value = object ["key" .= ("value" :: Text)]+    encodeFileAtomic path value+    result <- eitherDecodeFileStrict path+    result `shouldBe` Right value+  it "overwrites an existing file" $ \appRoot -> do+    let path = appRoot </> "test.json"+        old = object ["version" .= (1 :: Int)]+        new = object ["version" .= (2 :: Int)]+    encodeFileAtomic path old+    encodeFileAtomic path new+    result <- eitherDecodeFileStrict path+    result `shouldBe` Right new

@@ -0,0 +1,263 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : HStratus.TrustSpec+Copyright   : (c) 2023 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module HStratus.TrustSpec (spec, encode, genTrustData, genTrustedList, jsonKeysOf) where++import Data.Aeson (Key, ToJSON (..), Value (..), decode, eitherDecodeFileStrict, encode)+import Data.Aeson.KeyMap (fromList)+import qualified Data.Aeson.KeyMap as KeyMap+import Data.List (sort)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe (catMaybes)+import Data.String.Conv (toS)+import Data.Text (Text)+import qualified HStratus.Examples as Examples+import Network.HStratus.Internal.Trust+import Paths_hstratus_auth (getDataFileName)+import System.IO.Silently (silence)+import Test.Hspec+  ( Spec+  , context+  , describe+  , it+  , shouldBe+  )+import Test.Hspec.Benri (endsJust, endsNothing, endsRight)+import Test.Main (withStdin)+import Test.QuickCheck+  ( Arbitrary (arbitrary)+  , Gen+  , Property+  , chooseInt+  , elements+  , forAll+  , frequency+  , listOf1+  , vectorOf+  )+import Test.QuickCheck.Monadic (assert, monadicIO, pick, run)+++spec :: Spec+spec = describe "module Network.HStratus.Trust" $ do+  describe "TrustData" $ do+    context "parsing generated examples to/from JSON" $ do+      it "should succeed" prop_jsonRoundtripTrustData+    context "parsing a hand-crafted Apple-shaped fixture" $ do+      it "should succeed" $ do+        fp <- getDataFileName "testdata/trust_data_test.json"+        eitherDecodeFileStrict fp `endsRight` expectedTrustData+  describe "CodeStatus JSON field names" $ do+    it "uses the server field names" $+      jsonKeysOf (CodeStatus 6 False False False False)+        `shouldBe` Just (sort ["length", "tooManyCodesSent", "tooManyCodesValidated", "securityCodeLocked", "securityCodeCooldown"])+  describe "CodeStatus JSON parsing" $ do+    it "defaults all boolean fields to False when absent" $+      decode "{\"length\":6}" `shouldBe` Just (CodeStatus 6 False False False False)+  describe "TrustedPhone JSON field names" $ do+    it "uses the server field names" $+      jsonKeysOf (TrustedPhone 1 "+81 test" (Just "sms"))+        `shouldBe` Just (sort ["id", "numberWithDialCode", "pushMode"])+  describe "TrustedDevice JSON field names" $ do+    it "uses the server field names" $+      jsonKeysOf (TrustedDevice "id1" "iPhone" "iPhone14")+        `shouldBe` Just (sort ["id", "name", "modelName"])+  describe "TrustedDevice JSON parsing" $ do+    it "defaults modelName to empty string when absent" $+      decode "{\"id\":\"1\",\"name\":\"iPhone\"}" `shouldBe` Just (TrustedDevice "1" "iPhone" "")++  describe "Setup2SADevice" $ do+    context "parsing generated examples to/from JSON" $ do+      it "should succeed" prop_jsonRoundtripSetup2SADevice++  describe "setup2SADeviceLabel" $ do+    it "returns phoneNumber when present" $+      setup2SADeviceLabel (mkDevice [("phoneNumber", String "+1234")]) `shouldBe` "+1234"+    it "returns name when phoneNumber is absent" $+      setup2SADeviceLabel (mkDevice [("name", String "iPhone")]) `shouldBe` "iPhone"+    it "prefers phoneNumber over name" $+      setup2SADeviceLabel (mkDevice [("phoneNumber", String "+1234"), ("name", String "iPhone")]) `shouldBe` "+1234"+    it "returns (unknown) when neither field is present" $+      setup2SADeviceLabel (mkDevice [("deviceId", String "abc")]) `shouldBe` "(unknown)"++  describe "selectPhone" $ do+    context "when the selected input" $ do+      context "is a number within the range" $ do+        it "should succeed" (prop_selectsWithNonMaxIndex selectPhone genTrustedPhone)+      context "is the maximum number" $ do+        it "should succeed" (prop_selectsWithMaxIndex selectPhone genTrustedPhone)++  describe "selectDevice" $ do+    context "when the selected input" $ do+      context "is a number within the range" $ do+        it "should succeed" (prop_selectsWithNonMaxIndex selectDevice genTrustedDevice)+      context "is the maximum number" $ do+        it "should succeed" (prop_selectsWithMaxIndex selectDevice genTrustedDevice)++  describe "selectSetupDevice" $ do+    context "when the selected input" $ do+      context "is a number within the range" $ do+        it "should succeed" (prop_selectsWithNonMaxIndex selectSetupDevice genSetup2SADevice)+      context "is the maximum number" $ do+        it "should succeed" (prop_selectsWithMaxIndex selectSetupDevice genSetup2SADevice)++  describe "selectTwoFaPhone" $ do+    context "when noTrustedDevices is True" $ do+      it "returns the first phone without prompting" $+        silence (selectTwoFaPhone (mkTrustData True [twoFaPhone1, twoFaPhone2]))+          `endsJust` twoFaPhone1+      it "returns Nothing when the phone list is empty" $+        endsNothing $+          silence (selectTwoFaPhone (mkTrustData True []))+    context "when noTrustedDevices is False" $ do+      context "and the phone list is empty" $ do+        it "returns Nothing without prompting" $+          endsNothing $+            silence (selectTwoFaPhone (mkTrustData False []))+      context "and the user presses Enter" $ do+        it "returns Nothing" $+          withStdin "\n" $+            endsNothing $+              silence (selectTwoFaPhone (mkTrustData False [twoFaPhone1]))+      context "and the user enters a valid index" $ do+        it "returns the selected phone" $+          withStdin "2" $+            silence (selectTwoFaPhone (mkTrustData False [twoFaPhone1, twoFaPhone2]))+              `endsJust` twoFaPhone2+      context "and the user first enters an invalid index" $ do+        it "retries and returns the selected phone" $+          withStdin (toS ("99\n1" :: String)) $+            silence (selectTwoFaPhone (mkTrustData False [twoFaPhone1, twoFaPhone2]))+              `endsJust` twoFaPhone1+++prop_jsonRoundtripTrustData :: Property+prop_jsonRoundtripTrustData = forAll genTrustData $ \td ->+  decode (encode td) == Just td+++prop_jsonRoundtripSetup2SADevice :: Property+prop_jsonRoundtripSetup2SADevice = forAll genSetup2SADevice $ \d ->+  decode (encode d) == Just d+++mkDevice :: [(Key, Value)] -> Setup2SADevice+mkDevice = Setup2SADevice . fromList+++genSetup2SADevice :: Gen Setup2SADevice+genSetup2SADevice = do+  phone <- genExWordMaybe+  devId <- genExWord+  let pairs =+        catMaybes+          [ Just ("deviceId", String devId)+          , fmap (\p -> ("phoneNumber", String p)) phone+          ]+  pure $ Setup2SADevice $ fromList pairs+++genCodeStatus :: Gen CodeStatus+genCodeStatus =+  CodeStatus+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+++genTrustedPhone :: Gen TrustedPhone+genTrustedPhone = TrustedPhone <$> arbitrary <*> genExWord <*> genExWordMaybe+++genTrustedDevice :: Gen TrustedDevice+genTrustedDevice = TrustedDevice <$> genExWord <*> genExWord <*> genExWord+++genTrustedList :: Gen TrustedList+genTrustedList =+  frequency+    [ (1, TrustedPhoneNumbers . NE.fromList <$> listOf1 genTrustedPhone)+    , (1, TrustedDevices . NE.fromList <$> listOf1 genTrustedDevice)+    ]+++twoFaPhone1 :: TrustedPhone+twoFaPhone1 = TrustedPhone 1 "+81 test-1" (Just "sms")+++twoFaPhone2 :: TrustedPhone+twoFaPhone2 = TrustedPhone 2 "+1 test-2" Nothing+++mkTrustData :: Bool -> [TrustedPhone] -> TrustData+mkTrustData noDevices phones =+  TrustData+    { tdList = case NE.nonEmpty phones of+        Just nep -> TrustedPhoneNumbers nep+        Nothing -> TrustedDevices (TrustedDevice "" "" "" :| [])+    , tdSecurityCode = CodeStatus 6 False False False False+    , tdNoTrustedDevices = noDevices+    }+++useIOSelector :: (Eq a) => (NonEmpty a -> IO a) -> (Int, a, NonEmpty a) -> IO Bool+useIOSelector selector (idx, want, xs) = do+  withStdin (toS $ show idx) $ do+    selected <- silence $ selector xs+    pure $ selected == want+++prop_selectsWithNonMaxIndex :: (Eq a, Show a) => (NonEmpty a -> IO a) -> Gen a -> Property+prop_selectsWithNonMaxIndex selector generator = monadicIO $ do+  pick (genWithNonMaxIndex generator) >>= run . useIOSelector selector >>= assert+++prop_selectsWithMaxIndex :: (Eq a, Show a) => (NonEmpty a -> IO a) -> Gen a -> Property+prop_selectsWithMaxIndex selector generator = monadicIO $ do+  let useMax (_ignoredIndex, _ignoredSelection, xs) = (NE.length xs, NE.last xs, xs)+      withNonMax = genWithNonMaxIndex generator+  pick (fmap useMax withNonMax) >>= run . useIOSelector selector >>= assert+++genWithNonMaxIndex :: Gen a -> Gen (Int, a, NonEmpty a)+genWithNonMaxIndex sourceGen = do+  low <- chooseInt (1, 5)+  high <- chooseInt (low, 10)+  xs <- NE.fromList <$> vectorOf high sourceGen -- vectorOf high always gives exactly high elements, high >= 1+  pure (low, NE.toList xs !! (low - 1), xs) -- low in [1..high], so in-bounds+++genTrustData :: Gen TrustData+genTrustData = TrustData <$> genTrustedList <*> genCodeStatus <*> arbitrary+++genExWord :: Gen Text+genExWord = elements Examples.wordz+++genExWordMaybe :: Gen (Maybe Text)+genExWordMaybe = frequency [(1, pure Nothing), (1, Just <$> genExWord)]+++jsonKeysOf :: (ToJSON a) => a -> Maybe [Key]+jsonKeysOf x = case toJSON x of+  Object o -> Just (sort $ KeyMap.keys o)+  _ -> Nothing+++expectedTrustData :: TrustData+expectedTrustData =+  TrustData+    { tdList = TrustedPhoneNumbers (TrustedPhone 1 "+81 \x2022\x2022 \x2022\x2022\x2022\x2022 \x2022\&34" (Just "sms") :| [])+    , tdSecurityCode = CodeStatus 6 False False False False+    , tdNoTrustedDevices = False+    }

@@ -0,0 +1,48 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- |+Module      : Main+Copyright   : (c) 2026 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Test suite entry point for hstratus-auth.+-}+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+import qualified HStratus.HttpMockSpec as HttpMock+import qualified HStratus.HttpSpec as Http+import qualified HStratus.LoginFSMSpec as LoginFSM+import qualified HStratus.PBKDF2Spec as PBKDF2+import qualified HStratus.SessionSpec as Session+import qualified HStratus.TrustSpec as Trust+import System.IO+  ( BufferMode (..)+  , hSetBuffering+  , stderr+  , stdout+  )+import Test.Hspec+++main :: IO ()+main = do+  hSetBuffering stdout NoBuffering+  hSetBuffering stderr NoBuffering+  hspec $ do+    Session.spec+    Http.spec+    ApiLogger.spec+    HttpCli.spec+    HttpEndpoints.spec+    HttpErrors.spec+    HttpHeaders.spec+    HttpMock.spec+    PBKDF2.spec+    Trust.spec+    LoginFSM.spec

@@ -0,0 +1,3 @@+{+  "authType": "hsa2"+}

@@ -0,0 +1,244 @@+{+  "dsInfo": {+    "lastName": "TARANTINO",+    "iCDPEnabled": false,+    "tantorMigrated": true,+    "dsid": "quentintarantino",+    "hsaEnabled": true,+    "ironcadeMigrated": true,+    "locale": "fr-fr_FR",+    "brZoneConsolidated": false,+    "isManagedAppleID": false,+    "gilligan-invited": "true",+    "appleIdAliases": [+      "quentintarantino@me.com",+      "quentintarantino@icloud.com"+    ],+    "hsaVersion": 2,+    "isPaidDeveloper": false,+    "countryCode": "FRA",+    "notificationId": "12345678-1234-1234-1234-123456789012quentintarantino",+    "primaryEmailVerified": true,+    "aDsID": "123456-12-12345678-1234-1234-1234-123456789012quentintarantino",+    "locked": false,+    "hasICloudQualifyingDevice": true,+    "primaryEmail": "quentintarantino@hotmail.fr",+    "appleIdEntries": [+      {+        "isPrimary": true,+        "type": "EMAIL",+        "value": "quentintarantino@hotmail.fr"+      },+      {+        "type": "EMAIL",+        "value": "quentintarantino@me.com"+      },+      {+        "type": "EMAIL",+        "value": "quentintarantino@icloud.com"+      }+    ],+    "gilligan-enabled": "true",+    "fullName": "Quentin TARANTINO",+    "languageCode": "fr-fr",+    "appleId": "quentintarantino@hotmail.fr",+    "firstName": "Quentin",+    "iCloudAppleIdAlias": "quentintarantino@icloud.com",+    "notesMigrated": true,+    "hasPaymentInfo": true,+    "pcsDeleted": false,+    "appleIdAlias": "quentintarantino@me.com",+    "brMigrated": true,+    "statusCode": 2,+    "familyEligible": true+  },+  "hasMinimumDeviceForPhotosWeb": true,+  "iCDPEnabled": false,+  "webservices": {+    "reminders": {+      "url": "https://p31-remindersws.icloud.com:443",+      "status": "active"+    },+    "notes": {+      "url": "https://p38-notesws.icloud.com:443",+      "status": "active"+    },+    "mail": {+      "url": "https://p38-mailws.icloud.com:443",+      "status": "active"+    },+    "ckdatabasews": {+      "pcsRequired": true,+      "url": "https://p31-ckdatabasews.icloud.com:443",+      "status": "active"+    },+    "photosupload": {+      "pcsRequired": true,+      "url": "https://p31-uploadphotosws.icloud.com:443",+      "status": "active"+    },+    "photos": {+      "pcsRequired": true,+      "uploadUrl": "https://p31-uploadphotosws.icloud.com:443",+      "url": "https://p31-photosws.icloud.com:443",+      "status": "active"+    },+    "drivews": {+      "pcsRequired": true,+      "url": "https://p31-drivews.icloud.com:443",+      "status": "active"+    },+    "uploadimagews": {+      "url": "https://p31-uploadimagews.icloud.com:443",+      "status": "active"+    },+    "schoolwork": {},+    "cksharews": {+      "url": "https://p31-ckshare.icloud.com:443",+      "status": "active"+    },+    "findme": {+      "url": "https://p31-fmipweb.icloud.com:443",+      "status": "active"+    },+    "ckdeviceservice": {+      "url": "https://p31-ckdevice.icloud.com:443"+    },+    "iworkthumbnailws": {+      "url": "https://p31-iworkthumbnailws.icloud.com:443",+      "status": "active"+    },+    "calendar": {+      "url": "https://p31-calendarws.icloud.com:443",+      "status": "active"+    },+    "docws": {+      "pcsRequired": true,+      "url": "https://p31-docws.icloud.com:443",+      "status": "active"+    },+    "settings": {+      "url": "https://p31-settingsws.icloud.com:443",+      "status": "active"+    },+    "streams": {+      "url": "https://p31-streams.icloud.com:443",+      "status": "active"+    },+    "keyvalue": {+      "url": "https://p31-keyvalueservice.icloud.com:443",+      "status": "active"+    },+    "archivews": {+      "url": "https://p31-archivews.icloud.com:443",+      "status": "active"+    },+    "push": {+      "url": "https://p31-pushws.icloud.com:443",+      "status": "active"+    },+    "iwmb": {+      "url": "https://p31-iwmb.icloud.com:443",+      "status": "active"+    },+    "iworkexportws": {+      "url": "https://p31-iworkexportws.icloud.com:443",+      "status": "active"+    },+    "geows": {+      "url": "https://p31-geows.icloud.com:443",+      "status": "active"+    },+    "account": {+      "iCloudEnv": {+        "shortId": "p",+        "vipSuffix": "prod"+      },+      "url": "https://p31-setup.icloud.com:443",+      "status": "active"+    },+    "fmf": {+      "url": "https://p31-fmfweb.icloud.com:443",+      "status": "active"+    },+    "contacts": {+      "url": "https://p31-contactsws.icloud.com:443",+      "status": "active"+    }+  },+  "pcsEnabled": true,+  "configBag": {+    "urls": {+      "accountCreateUI": "https://appleid.apple.com/widget/account/?widgetKey=widget_keyquentintarantino#!create",+      "accountLoginUI": "https://idmsa.apple.com/appleauth/auth/signin?widgetKey=widget_keyquentintarantino",+      "accountLogin": "https://setup.icloud.com/setup/ws/1/accountLogin",+      "accountRepairUI": "https://appleid.apple.com/widget/account/?widgetKey=widget_keyquentintarantino#!repair",+      "downloadICloudTerms": "https://setup.icloud.com/setup/ws/1/downloadLiteTerms",+      "repairDone": "https://setup.icloud.com/setup/ws/1/repairDone",+      "accountAuthorizeUI": "https://idmsa.apple.com/appleauth/auth/authorize/signin?client_id=widget_keyquentintarantino",+      "vettingUrlForEmail": "https://id.apple.com/IDMSEmailVetting/vetShareEmail",+      "accountCreate": "https://setup.icloud.com/setup/ws/1/createLiteAccount",+      "getICloudTerms": "https://setup.icloud.com/setup/ws/1/getTerms",+      "vettingUrlForPhone": "https://id.apple.com/IDMSEmailVetting/vetSharePhone"+    },+    "accountCreateEnabled": "true"+  },+  "hsaTrustedBrowser": false,+  "appsOrder": [+    "mail",+    "contacts",+    "calendar",+    "photos",+    "iclouddrive",+    "notes3",+    "reminders",+    "pages",+    "numbers",+    "keynote",+    "newspublisher",+    "fmf",+    "find",+    "settings"+  ],+  "version": 2,+  "isExtendedLogin": true,+  "pcsServiceIdentitiesIncluded": false,+  "hsaChallengeRequired": true,+  "requestInfo": {+    "country": "FR",+    "timeZone": "GMT+1",+    "region": "IDF"+  },+  "pcsDeleted": false,+  "iCloudInfo": {+    "SafariBookmarksHasMigratedToCloudKit": true+  },+  "apps": {+    "calendar": {},+    "reminders": {},+    "keynote": {+      "isQualifiedForBeta": true+    },+    "settings": {+      "canLaunchWithOneFactor": true+    },+    "mail": {},+    "numbers": {+      "isQualifiedForBeta": true+    },+    "photos": {},+    "pages": {+      "isQualifiedForBeta": true+    },+    "notes3": {},+    "find": {+      "canLaunchWithOneFactor": true+    },+    "iclouddrive": {},+    "newspublisher": {+      "isHidden": true+    },+    "fmf": {},+    "contacts": {}+  }+}

@@ -0,0 +1,6 @@+{+  "dsInfo": {"hsaVersion": 1},+  "hsaChallengeRequired": false,+  "hsaTrustedBrowser": false,+  "webservices": {}+}

@@ -0,0 +1,244 @@+{+  "dsInfo": {+    "lastName": "TARANTINO",+    "iCDPEnabled": false,+    "tantorMigrated": true,+    "dsid": "quentintarantino",+    "hsaEnabled": true,+    "ironcadeMigrated": true,+    "locale": "fr-fr_FR",+    "brZoneConsolidated": false,+    "isManagedAppleID": false,+    "gilligan-invited": "true",+    "appleIdAliases": [+      "quentintarantino@me.com",+      "quentintarantino@icloud.com"+    ],+    "hsaVersion": 2,+    "isPaidDeveloper": false,+    "countryCode": "FRA",+    "notificationId": "12345678-1234-1234-1234-123456789012quentintarantino",+    "primaryEmailVerified": true,+    "aDsID": "123456-12-12345678-1234-1234-1234-123456789012quentintarantino",+    "locked": false,+    "hasICloudQualifyingDevice": true,+    "primaryEmail": "quentintarantino@hotmail.fr",+    "appleIdEntries": [+      {+        "isPrimary": true,+        "type": "EMAIL",+        "value": "quentintarantino@hotmail.fr"+      },+      {+        "type": "EMAIL",+        "value": "quentintarantino@me.com"+      },+      {+        "type": "EMAIL",+        "value": "quentintarantino@icloud.com"+      }+    ],+    "gilligan-enabled": "true",+    "fullName": "Quentin TARANTINO",+    "languageCode": "fr-fr",+    "appleId": "quentintarantino@hotmail.fr",+    "firstName": "Quentin",+    "iCloudAppleIdAlias": "quentintarantino@icloud.com",+    "notesMigrated": true,+    "hasPaymentInfo": false,+    "pcsDeleted": false,+    "appleIdAlias": "quentintarantino@me.com",+    "brMigrated": true,+    "statusCode": 2,+    "familyEligible": true+  },+  "hasMinimumDeviceForPhotosWeb": true,+  "iCDPEnabled": false,+  "webservices": {+    "reminders": {+      "url": "https://p31-remindersws.icloud.com:443",+      "status": "active"+    },+    "notes": {+      "url": "https://p38-notesws.icloud.com:443",+      "status": "active"+    },+    "mail": {+      "url": "https://p38-mailws.icloud.com:443",+      "status": "active"+    },+    "ckdatabasews": {+      "pcsRequired": true,+      "url": "https://p31-ckdatabasews.icloud.com:443",+      "status": "active"+    },+    "photosupload": {+      "pcsRequired": true,+      "url": "https://p31-uploadphotosws.icloud.com:443",+      "status": "active"+    },+    "photos": {+      "pcsRequired": true,+      "uploadUrl": "https://p31-uploadphotosws.icloud.com:443",+      "url": "https://p31-photosws.icloud.com:443",+      "status": "active"+    },+    "drivews": {+      "pcsRequired": true,+      "url": "https://p31-drivews.icloud.com:443",+      "status": "active"+    },+    "uploadimagews": {+      "url": "https://p31-uploadimagews.icloud.com:443",+      "status": "active"+    },+    "schoolwork": {},+    "cksharews": {+      "url": "https://p31-ckshare.icloud.com:443",+      "status": "active"+    },+    "findme": {+      "url": "https://p31-fmipweb.icloud.com:443",+      "status": "active"+    },+    "ckdeviceservice": {+      "url": "https://p31-ckdevice.icloud.com:443"+    },+    "iworkthumbnailws": {+      "url": "https://p31-iworkthumbnailws.icloud.com:443",+      "status": "active"+    },+    "calendar": {+      "url": "https://p31-calendarws.icloud.com:443",+      "status": "active"+    },+    "docws": {+      "pcsRequired": true,+      "url": "https://p31-docws.icloud.com:443",+      "status": "active"+    },+    "settings": {+      "url": "https://p31-settingsws.icloud.com:443",+      "status": "active"+    },+    "streams": {+      "url": "https://p31-streams.icloud.com:443",+      "status": "active"+    },+    "keyvalue": {+      "url": "https://p31-keyvalueservice.icloud.com:443",+      "status": "active"+    },+    "archivews": {+      "url": "https://p31-archivews.icloud.com:443",+      "status": "active"+    },+    "push": {+      "url": "https://p31-pushws.icloud.com:443",+      "status": "active"+    },+    "iwmb": {+      "url": "https://p31-iwmb.icloud.com:443",+      "status": "active"+    },+    "iworkexportws": {+      "url": "https://p31-iworkexportws.icloud.com:443",+      "status": "active"+    },+    "geows": {+      "url": "https://p31-geows.icloud.com:443",+      "status": "active"+    },+    "account": {+      "iCloudEnv": {+        "shortId": "p",+        "vipSuffix": "prod"+      },+      "url": "https://p31-setup.icloud.com:443",+      "status": "active"+    },+    "fmf": {+      "url": "https://p31-fmfweb.icloud.com:443",+      "status": "active"+    },+    "contacts": {+      "url": "https://p31-contactsws.icloud.com:443",+      "status": "active"+    }+  },+  "pcsEnabled": true,+  "configBag": {+    "urls": {+      "accountCreateUI": "https://appleid.apple.com/widget/account/?widgetKey=widget_keyquentintarantino#!create",+      "accountLoginUI": "https://idmsa.apple.com/appleauth/auth/signin?widgetKey=widget_keyquentintarantino",+      "accountLogin": "https://setup.icloud.com/setup/ws/1/accountLogin",+      "accountRepairUI": "https://appleid.apple.com/widget/account/?widgetKey=widget_keyquentintarantino#!repair",+      "downloadICloudTerms": "https://setup.icloud.com/setup/ws/1/downloadLiteTerms",+      "repairDone": "https://setup.icloud.com/setup/ws/1/repairDone",+      "accountAuthorizeUI": "https://idmsa.apple.com/appleauth/auth/authorize/signin?client_id=widget_keyquentintarantino",+      "vettingUrlForEmail": "https://id.apple.com/IDMSEmailVetting/vetShareEmail",+      "accountCreate": "https://setup.icloud.com/setup/ws/1/createLiteAccount",+      "getICloudTerms": "https://setup.icloud.com/setup/ws/1/getTerms",+      "vettingUrlForPhone": "https://id.apple.com/IDMSEmailVetting/vetSharePhone"+    },+    "accountCreateEnabled": "true"+  },+  "hsaTrustedBrowser": true,+  "appsOrder": [+    "mail",+    "contacts",+    "calendar",+    "photos",+    "iclouddrive",+    "notes3",+    "reminders",+    "pages",+    "numbers",+    "keynote",+    "newspublisher",+    "fmf",+    "find",+    "settings"+  ],+  "version": 2,+  "isExtendedLogin": true,+  "pcsServiceIdentitiesIncluded": true,+  "hsaChallengeRequired": false,+  "requestInfo": {+    "country": "FR",+    "timeZone": "GMT+1",+    "region": "IDF"+  },+  "pcsDeleted": false,+  "iCloudInfo": {+    "SafariBookmarksHasMigratedToCloudKit": true+  },+  "apps": {+    "calendar": {},+    "reminders": {},+    "keynote": {+      "isQualifiedForBeta": true+    },+    "settings": {+      "canLaunchWithOneFactor": true+    },+    "mail": {},+    "numbers": {+      "isQualifiedForBeta": true+    },+    "photos": {},+    "pages": {+      "isQualifiedForBeta": true+    },+    "notes3": {},+    "find": {+      "canLaunchWithOneFactor": true+    },+    "iclouddrive": {},+    "newspublisher": {+      "isHidden": true+    },+    "fmf": {},+    "contacts": {}+  }+}

@@ -0,0 +1,937 @@+{+  "algorithm" : "PBKDF2-HMACSHA1",+  "schema" : "pbkdf_test_schema.json",+  "generatorVersion" : "0.9",+  "numberOfTests" : 64,+  "header" : [+    "Test vector of type PbkdfTest are for password based key derivations."+  ],+  "notes" : {+    "Ascii" : {+      "bugType" : "FUNCTIONALITY",+      "description" : "The test vector contains a password consisting of ASCII characters."+    },+    "LargeIterationCount" : {+      "bugType" : "FUNCTIONALITY",+      "description" : "The test vector contains a high iteration count"+    },+    "NonUtf8" : {+      "bugType" : "FUNCTIONALITY",+      "description" : "The test vector contains a password that is not a valid UTF-8 string."+    },+    "Printable" : {+      "bugType" : "FUNCTIONALITY",+      "description" : "The test vector contains a password consisting of printable ASCII characters."+    },+    "Pseudorandom" : {+      "bugType" : "BASIC",+      "description" : "Pseudorandomly generated test vector"+    },+    "Rfc6070" : {+      "bugType" : "BASIC",+      "description" : "Known test vector from RFC 6070"+    },+    "Utf8" : {+      "bugType" : "FUNCTIONALITY",+      "description" : "The test vector contains a password that is a valid UTF-8 string."+    }+  },+  "testGroups" : [+    {+      "type" : "PbkdfTest",+      "tests" : [+        {+          "tcId" : 1,+          "comment" : "RFC 6070",+          "flags" : [+            "Rfc6070",+            "Printable"+          ],+          "password" : "70617373776f7264",+          "salt" : "73616c74",+          "iterationCount" : 1,+          "dkLen" : 20,+          "dk" : "0c60c80f961f0e71f3a9b524af6012062fe037a6",+          "result" : "valid"+        },+        {+          "tcId" : 2,+          "comment" : "RFC 6070",+          "flags" : [+            "Rfc6070",+            "Printable"+          ],+          "password" : "70617373776f7264",+          "salt" : "73616c74",+          "iterationCount" : 2,+          "dkLen" : 20,+          "dk" : "ea6c014dc72d6f8ccd1ed92ace1d41f0d8de8957",+          "result" : "valid"+        },+        {+          "tcId" : 3,+          "comment" : "RFC 6070",+          "flags" : [+            "Rfc6070",+            "Printable"+          ],+          "password" : "70617373776f7264",+          "salt" : "73616c74",+          "iterationCount" : 4096,+          "dkLen" : 20,+          "dk" : "4b007901b765489abead49d926f721d065a429c1",+          "result" : "valid"+        },+        {+          "tcId" : 4,+          "comment" : "RFC 6070",+          "flags" : [+            "Rfc6070",+            "LargeIterationCount",+            "Printable"+          ],+          "password" : "70617373776f7264",+          "salt" : "73616c74",+          "iterationCount" : 16777216,+          "dkLen" : 20,+          "dk" : "eefe3d61cd4da4e4e9945b3d6ba2158c2634e984",+          "result" : "valid"+        },+        {+          "tcId" : 5,+          "comment" : "RFC 6070",+          "flags" : [+            "Rfc6070",+            "Printable"+          ],+          "password" : "70617373776f726450415353574f524470617373776f7264",+          "salt" : "73616c7453414c5473616c7453414c5473616c7453414c5473616c7453414c5473616c74",+          "iterationCount" : 4096,+          "dkLen" : 25,+          "dk" : "3d2eec4fe41c849b80c8d83662c0e44a8b291a964cf2f07038",+          "result" : "valid"+        },+        {+          "tcId" : 6,+          "comment" : "RFC 6070",+          "flags" : [+            "Rfc6070",+            "Ascii"+          ],+          "password" : "7061737300776f7264",+          "salt" : "7361006c74",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "56fa6aa75548099dcc37d7f03425e0c3",+          "result" : "valid"+        },+        {+          "tcId" : 7,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "7130577430643470",+          "salt" : "798acc7c76739d75",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "9ea245e919e491118087fc369142e2ee",+          "result" : "valid"+        },+        {+          "tcId" : 8,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "5a30673349567272",+          "salt" : "84bbd18de5ec10ff",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "b874ff052f517d94eb6cb7edd2ede57a7d96c01eea5dbe4fafc47d6fce32ce28defb14f7980c5ed3ba10",+          "result" : "valid"+        },+        {+          "tcId" : 9,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "7439315572766f47",+          "salt" : "5d76db9ca0f0bae2",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "56799b703ed17b58b9e3ee12c80f93b35b83baa769789c539f7a4cb3e825db5df8c7afed85bb276a01aae0dc78beb492de832b581c7d5b899b184516cf028e90f7",+          "result" : "valid"+        },+        {+          "tcId" : 10,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "6b6f67583748447a",+          "salt" : "0a8fbd0232a3a7f6e60d6564c92ea35f",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "8e7c43f3a3baa0ac7e8e24db0b99ea45",+          "result" : "valid"+        },+        {+          "tcId" : 11,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "4939745242645168",+          "salt" : "0a3bb93c0de86a174ab005b8089706ab",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "ab713dcf744ded086b1b588f570ba0c1876e8737c488a852216add421c2dd70ff3b58e5390c80bbe9103",+          "result" : "valid"+        },+        {+          "tcId" : 12,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "6f4f4d37324f6330",+          "salt" : "3827c3b6b1e6de7aab096eb75e23610d",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "8cd3a480add2dfd8fbfee4f49c55b6b2980955635474c5a795d1d6cdca9e0934797cd5ea797a1cf8cfa7d975a63b3f66855ec6b4a97dde26e49bd149c6259f6f52",+          "result" : "valid"+        },+        {+          "tcId" : 13,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "6761734354484546654d36526f61386349",+          "salt" : "cac9ae7ef670990e",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "5e71edeb8746e5215b0949e0f64a03aa",+          "result" : "valid"+        },+        {+          "tcId" : 14,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "75375330684678774e33586f76707a6551",+          "salt" : "201b1e277f4ff955",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "349d048452b7fc74ae8e7b373925621321ff807968e3ff4d5a31b815ace5b95d07cd868f20f958161c68",+          "result" : "valid"+        },+        {+          "tcId" : 15,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "51524b6a6d6d6b48524462507178696868",+          "salt" : "e71d6a702d2d54bc",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "5c480790477441c254bc89611d52e5cb83fb0e6eb9fe1000344c638dfd134d67d4c633f6fdbb3316dc57115f34b0e9d4186b96023d6d0c6b90da34720731bdad6b",+          "result" : "valid"+        },+        {+          "tcId" : 16,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "3732317a52704b79306b4c6d3862317279",+          "salt" : "8b9314972ef99ac98b69b6c2ac4247c7",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "9edef2939c154b91d359876d41772d79",+          "result" : "valid"+        },+        {+          "tcId" : 17,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "75507078436d7536577a68535030553947",+          "salt" : "874d7cc9369ff9988642ffe05a7f2153",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "69cc4a0b7374717be2312a49cc4768a8e40a360f8637eb475dc125f253a54747edfcb64132ce8097a9ed",+          "result" : "valid"+        },+        {+          "tcId" : 18,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "6f39505350597a445349783365374d7063",+          "salt" : "1569909588ec25a3afa147cb7fff9fb1",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "744a5c9831b81db08874abdc9cd0afd7bc7f11250da19ad6aa61ed02626b1d52dcbf9bbb34dd44c65a8a7973f34244e0e16f27e31ee45c37d84ad1f9465445ddc9",+          "result" : "valid"+        },+        {+          "tcId" : 19,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "4b2d6c600e66535c7f3d6d6c",+          "salt" : "7a4c02db8bd8fcc2",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "8739361a2fa899f6d5cceba27d4142da",+          "result" : "valid"+        },+        {+          "tcId" : 20,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "287e74200e6b69285f5f7e00",+          "salt" : "dddf018487fa4b95",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "68a1ad4082c5f45e339ac85e44fbe4368fd604d73030bab4d459e0f7e79a709293a349305bc91ac86de4",+          "result" : "valid"+        },+        {+          "tcId" : 21,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "0f3b5e220e1c000c2a703a4d",+          "salt" : "7cf71b19c0daf499",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "b58ad2cb772a9eb1bae46afcfc7738a043bcc3ff602071850d3019b8935270dc20a2ee90c5cb8f6c323b49f7477797352b1ba0b7973f6a2652cd2bb319f092f371",+          "result" : "valid"+        },+        {+          "tcId" : 22,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "1f4b7b354903545f2b07720b",+          "salt" : "62f91ea01f3a18aa2f122bd15c4a615b",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "deea05da06df69c5401517d132678f90",+          "result" : "valid"+        },+        {+          "tcId" : 23,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "5d7e1f70174b2f616c0d6722",+          "salt" : "4fb602173327228431dd8d088154c7ec",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "05489b534681b9eb74d4bac4caeaa9e7fa5977dca35314b0118f57662b539b016b38c6393c8c75aa419d",+          "result" : "valid"+        },+        {+          "tcId" : 24,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "2657324e694c6b242b174f1a",+          "salt" : "3cad67ef1eaf3aaafb5ee372d6b1ecb4",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "a175e5aa360bd47b5e0e7d4d7bb29d0e4d5eef89f80e30e5570cb2b21aabdffb37996aee3dfefef1d79d1ec9fa0198276db9ed763770f1127d4d3e0c047037ab0a",+          "result" : "valid"+        },+        {+          "tcId" : 25,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "15296b0933473119180f3c0645202d5221633803",+          "salt" : "d7412e4137fc4410",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "6033619ba0f6a1c4d2877ab466cc8bca",+          "result" : "valid"+        },+        {+          "tcId" : 26,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "2a1124361d53464245580130076d6b54001e3d01",+          "salt" : "7ecaaed1eab03c3f",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "2e481954bbb8ac4e330a1d28ea8f736d63a1f760bb58d97a70855ffe8ff9480972c46b645095470a8cda",+          "result" : "valid"+        },+        {+          "tcId" : 27,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "666252024e18233308430820127e753e6b041f56",+          "salt" : "756fafa7fac1f019",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "95273cd50ba4a4e419b2e3a59d4587291188710912bcab5bf7640deb5f34c9c046f410f4e6b83192a6d36e96b5b8f11a898fb69d1ea6df38614138165c5438ee86",+          "result" : "valid"+        },+        {+          "tcId" : 28,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "7a106c2773542c791d2f0a02632b69644f666278",+          "salt" : "a36350db68186d747254bd9835219487",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "d206f75207b50786c7571d9a4b21a2a0",+          "result" : "valid"+        },+        {+          "tcId" : 29,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "0b3c6f070149615b5b461c7f5c3a366a6d375402",+          "salt" : "42be6c8fcd7858458fb97cece0069524",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "6a0ffe5218cde4ec89dad3bc6ff32133c31b86baf45740fdd1313b8b2c525871fce7be5b312999bde78d",+          "result" : "valid"+        },+        {+          "tcId" : 30,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Ascii"+          ],+          "password" : "5177161d237c1b64426353434113015665344a6c",+          "salt" : "596dbf5830aa8b00682429883e0b1ed0",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "52ec2859141885b77108eade00564a7564c41aa1747af8ef2fee384ada8e82c51743a5005d3ca4f855339837e8ff2e8fe78dcb17904a192591f508c801fc4c8abc",+          "result" : "valid"+        },+        {+          "tcId" : 31,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "d0a3d1bed38acc83",+          "salt" : "8dfae85c9f2072ae",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "672b655566b8ce79b5e5244b2bb59472",+          "result" : "valid"+        },+        {+          "tcId" : 32,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "d0bcccab64cf9a",+          "salt" : "15187b0393d8a441",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "b753a37266ffa863239bf199abf0a8eef11c7a40cfc058ea4d46f58353d08a7bffda005327f98db8fd1d",+          "result" : "valid"+        },+        {+          "tcId" : 33,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "c4bddd8f4ad69d",+          "salt" : "775bde4bd6e40ddd",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "28bffd8c6c6a6231336c3948c5a00510f433be50c1a36ebc2f180ace80feb4914fa35204386c2b6eb41e634951702f6de924bcffaaf4d976c01794c64c6af3d08e",+          "result" : "valid"+        },+        {+          "tcId" : 34,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "c299d292cd92dcb8",+          "salt" : "99c55e182238c8e0c385447685e9ba85",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "5be67e596d953ede56531b9a66bbe566",+          "result" : "valid"+        },+        {+          "tcId" : 35,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "d086d0bed193d9b6",+          "salt" : "42a7aca6a7664f87b405b49d62a074db",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "f73504788a1c491bc856cb3ab9b873f07cf1dba837c100997029a206f19169583c8a2c4efe1e2bbca6aa",+          "result" : "valid"+        },+        {+          "tcId" : 36,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "da8ddcacde86d3b0",+          "salt" : "f3eb3938f338fe8639813beacd8100a5",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "8ad0fc0024268cc557baad39644cbbe03fbc251262a51fb20f5dd2f1b4e14e73f4f53f6912e3a75f69f6ec6a42273411069df812899e4877323351b6056d8f21a2",+          "result" : "valid"+        },+        {+          "tcId" : 37,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "cfbec3b9d7acc7a9d585d1a5c28fcca119",+          "salt" : "e9c55717a1259a29",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "4a5fdfd0cafdbb8793806299275372dd",+          "result" : "valid"+        },+        {+          "tcId" : 38,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "d29cd099d197d1b0da9aca8ec2a3daa5c38a",+          "salt" : "5acc2d76a9f4444c",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "0479f3777ab64d13f2b514526b149686347688d824be30e077b2bcd4c05cbca845e3091b00d3b049e721",+          "result" : "valid"+        },+        {+          "tcId" : 39,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "de89d193d18c75c2b8c6bcd190d198c3a2",+          "salt" : "c69c3b58917e0975",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "7374cbb82049ccfb9271ee9df3dcdcf5f64870f356816e5077f8a5fb0cad52e14df3609814b771bf7d151de23d91584b973bc7fd34ee955a893f904fcfdc9e0215",+          "result" : "valid"+        },+        {+          "tcId" : 40,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "da9dd096cb93db88dbbed495ceaacf853c",+          "salt" : "200bba668b2010b1968b82091848937c",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "f90c5c5cab441e656c21a259fb83547e",+          "result" : "valid"+        },+        {+          "tcId" : 41,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "de81d0a6cea9c7b3cbabce9bda90d29f73",+          "salt" : "36586fdefbe916369412c9f3e6337ddf",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "bf873cb5210319562901a01c9fc8521a41b4d0397f774853f2499ec6b6b37490c4a8487523868af2ee3c",+          "result" : "valid"+        },+        {+          "tcId" : 42,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "Utf8"+          ],+          "password" : "d281da97c8a3d8b7ceb9db80dc8dd4a0c3be",+          "salt" : "ab7c17e3b78fe71e373b0ccb0fc3ccda",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "dcd906b27d8cffe87013fbb1557877e21c2bb58fcdec5f94d9a18beb523902c60fc4d63bb78f58cff300309f4d3411e8f524dadeadd956d94c551e3370b55c60b1",+          "result" : "valid"+        },+        {+          "tcId" : 43,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "8423ec7ea4ca4b03",+          "salt" : "8dfae85c9f2072ae",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "5409681bde39075bda761ad33cfd06f8",+          "result" : "valid"+        },+        {+          "tcId" : 44,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "2c3c932bf0648bda",+          "salt" : "15187b0393d8a441",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "357f1e696f62b232b242d6a64b680fb73ccda4cdde09cc7ade62d5a9f828f4ac2f728a687c79a079c4ff",+          "result" : "valid"+        },+        {+          "tcId" : 45,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "393d474fd84a259d",+          "salt" : "775bde4bd6e40ddd",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "e04e777c27b3ab84cd7647751f710fa37f50019f2b1536ae52b3f7893dd9bcd6345fa2e1459501c01dfe65da07dd83ff6e88e211418c88fec36410e6efaaf59240",+          "result" : "valid"+        },+        {+          "tcId" : 46,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "48997492c3528738",+          "salt" : "99c55e182238c8e0c385447685e9ba85",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "1436967f0de829ae653a31c45168525c",+          "result" : "valid"+        },+        {+          "tcId" : 47,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "74064c3ebc53d676",+          "salt" : "42a7aca6a7664f87b405b49d62a074db",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "6b7433a14d6225b5222fb7d5f5dfe674154c075ad83d13dbb274ccf6880f75c7545d35bc6e7bfcfa814b",+          "result" : "valid"+        },+        {+          "tcId" : 48,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "668d4f2c8f86f4f0",+          "salt" : "f3eb3938f338fe8639813beacd8100a5",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "23c9045a0a037f60d0ef0e4058c8a3633714c67e4d3f4637499de4d9c949248bfce2bc7cd6bac4cfe74e9c28a221401d3ea7d99e0b33ca23bcd66ff239d1e8c40d",+          "result" : "valid"+        },+        {+          "tcId" : 49,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "e3feb0f96dec61e9dd451465f88f132119",+          "salt" : "e9c55717a1259a29",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "16ef25c3c98e34147b33a8d33813b13f",+          "result" : "valid"+        },+        {+          "tcId" : 50,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "5c9ca419dc576470269a828e40a3aea5ca",+          "salt" : "5acc2d76a9f4444c",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "fb711258128c94ffbe6c2ecffa8ae50823ec51c71ad512a2c3df0e56ad82403a87cb1b24e4049f56c065",+          "result" : "valid"+        },+        {+          "tcId" : 51,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "bf898453344c6875f0b8b9bc2c50fc58e2",+          "salt" : "c69c3b58917e0975",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "25917d740b0882ba22158b8008ce8c074462c3751413b85e44e86366147c06aa11fa07dd3ee95424d4c8db162cbd164d795e9ddfb2b369b3475c1152c2d3f01b19",+          "result" : "valid"+        },+        {+          "tcId" : 52,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "9e9d7c166ad3bec856fe5d15d3aacbc53c",+          "salt" : "200bba668b2010b1968b82091848937c",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "72a9fed7bf44ed9f3d09a812e14ada47",+          "result" : "valid"+        },+        {+          "tcId" : 53,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "17812c26bba941f3c2ebdb9bb6904c9f73",+          "salt" : "36586fdefbe916369412c9f3e6337ddf",+          "iterationCount" : 4096,+          "dkLen" : 42,+          "dk" : "65a48055639d90cb775b68926e1ad0bfa164d80c010711da0d1ff6838da9d4a7d1aaf28f3b1994f8c50f",+          "result" : "valid"+        },+        {+          "tcId" : 54,+          "comment" : "",+          "flags" : [+            "Pseudorandom",+            "NonUtf8"+          ],+          "password" : "6c816697ba2366375bb986c0af0d7d20fe",+          "salt" : "ab7c17e3b78fe71e373b0ccb0fc3ccda",+          "iterationCount" : 4096,+          "dkLen" : 65,+          "dk" : "17d8c8f2974fbcb8c75109d1660e72fc808aaa96fbd8542a0f51bab2135333e42a5e97c5a96005550aafdba80f78da789d2759e79135a75315baa99f27e8f5f898",+          "result" : "valid"+        },+        {+          "tcId" : 55,+          "comment" : "empty password",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "",+          "salt" : "1a71e2118c9fbcc9",+          "iterationCount" : 4096,+          "dkLen" : 32,+          "dk" : "93f5d4cf0da5cd8c1f2c71a48a8efebfbda76763c29ca535c5a09e627af5c410",+          "result" : "valid"+        },+        {+          "tcId" : 56,+          "comment" : "long password",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "523249584467597a5a4271363970667a4a714e744b7761545a4544494676766b6a6253417167566e456a6b456b454557504e69383653626a6e376b725764394d67",+          "salt" : "d26b99043c8ba3a4",+          "iterationCount" : 4096,+          "dkLen" : 32,+          "dk" : "de22ce1289402528225f5e52e00dad82b394f1e593d2fa0fa83185137bef5ed2",+          "result" : "valid"+        },+        {+          "tcId" : 57,+          "comment" : "long password",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "63727a466d396430795463456a6468545758693877674e516f544e6d486e61686f6956317071613133655471477933497531354b4f52516339494c53646756527a45524e6b4463723565676a62584a78426572536a74726b6b674341616a63356243354434706e66743836663754626663666370595a30767354454d4930524178",+          "salt" : "9266da5b8c102b27",+          "iterationCount" : 4096,+          "dkLen" : 32,+          "dk" : "c80288d20baa94340a79735e9257867b92709568e71355209911d7c4ad484621",+          "result" : "valid"+        },+        {+          "tcId" : 58,+          "comment" : "long password",+          "flags" : [+            "Pseudorandom",+            "Printable"+          ],+          "password" : "32647a56696e6f45774464656c656257797058314d6f4f685975585a463172514b7a32535a6c307578576377796f3561416e6f42524e7a5044763072513662693742345a34324f50695258534c6859684441643262746f647633744d54424430744b46316e4b655942656565547a70413145434150713942687a4a4c555a67737636754e4b664450333558414d684a486c736a6f5a796b677130624d506265556941796d6f324371586b64524752633876544176684e5a5838536f564d33704e74594a4a7258766975337547583233736a353847723061614a4b45763765796c373248636e6167713474766e533737626d6376676c79536d347370707a65673869",+          "salt" : "6a06903b78dae6de",+          "iterationCount" : 4096,+          "dkLen" : 32,+          "dk" : "90767f81981d82c053146a0f69f04d3035a675ffc0cbca5f5debdccfbe59aa69",+          "result" : "valid"+        },+        {+          "tcId" : 59,+          "comment" : "special case password",+          "flags" : [+            "NonUtf8"+          ],+          "password" : "ff",+          "salt" : "32140a66b88e1683",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "33d50f1918fd8cc91969b41cf0ac6cb7",+          "result" : "valid"+        },+        {+          "tcId" : 60,+          "comment" : "special case password",+          "flags" : [+            "NonUtf8"+          ],+          "password" : "ffffffffffffffff",+          "salt" : "8a359634423ed028",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "ced7945a9c40448206dc738a462cabe5",+          "result" : "valid"+        },+        {+          "tcId" : 61,+          "comment" : "special case password",+          "flags" : [+            "NonUtf8"+          ],+          "password" : "c0c0c0c0c0c0c0c0",+          "salt" : "d6f596f170ed2414",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "c6d3d7d40940ce6ea88ec034df470722",+          "result" : "valid"+        },+        {+          "tcId" : 62,+          "comment" : "special case password",+          "flags" : [+            "NonUtf8"+          ],+          "password" : "eeeeeeeeeeeeeeee",+          "salt" : "6b2269425e288d03",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "d1dd8d5b7f5e74d628bc656b2c4a7e08",+          "result" : "valid"+        },+        {+          "tcId" : 63,+          "comment" : "special case password",+          "flags" : [+            "NonUtf8"+          ],+          "password" : "f0f0f0f0f0f0f0f0",+          "salt" : "ebf0b04633711248",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "1cf137fbce42e38f531a4f36ff3717e4",+          "result" : "valid"+        },+        {+          "tcId" : 64,+          "comment" : "special case password",+          "flags" : [+            "Ascii"+          ],+          "password" : "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000",+          "salt" : "9de9b71eeb9d9a34",+          "iterationCount" : 4096,+          "dkLen" : 16,+          "dk" : "a7b2fbb97f52f3b5f9006e0f1acf0903",+          "result" : "valid"+        }+      ]+    }+  ]+}