hstratus (empty) → 0.1.0.0
raw patch · 13 files changed
+2013/−0 lines, 13 filesdep +basedep +benri-hspecdep +bytestring
Dependencies added: base, benri-hspec, bytestring, containers, directory, filepath, hspec, hstratus, hstratus-auth, hstratus-drive, hstratus-notes, http-client-tls, optparse-applicative, text, time, xdg-basedir
Files
- ChangeLog.md +9/−0
- LICENSE +30/−0
- README.md +230/−0
- app/Main.hs +7/−0
- hstratus.cabal +88/−0
- src/Hstratus/Cli.hs +52/−0
- src/Hstratus/Cli/Auth.hs +101/−0
- src/Hstratus/Cli/Drive.hs +452/−0
- src/Hstratus/Cli/Notes.hs +376/−0
- test/Hstratus/Cli/AuthSpec.hs +48/−0
- test/Hstratus/Cli/DriveSpec.hs +420/−0
- test/Hstratus/Cli/NotesSpec.hs +178/−0
- test/Spec.hs +22/−0
+ ChangeLog.md view
@@ -0,0 +1,9 @@+# Revision history for hstratus++`hstratus` uses [PVP Versioning][1].++## 0.1.0.0 -- 2026-07-28++* Initial version.++[1]: https://pvp.haskell.org
+ LICENSE view
@@ -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.
+ README.md view
@@ -0,0 +1,230 @@+# hstratus — unified command-line tool for iCloud services++`hstratus` provides a single executable with subcommands for iCloud+authentication, Drive, and Notes. It uses Apple ID credentials stored on disk+and depends on [`hstratus-auth`](../hstratus-auth/#readme) for the authentication+flow.+++## Disclaimer — use at your own risk++- This tool is **unofficial** and not supported by Apple.+- The iCloud APIs it uses are undocumented and may change without notice.+++## Getting started++Run `hstratus auth init` once to save your Apple ID and password, then+`hstratus auth login` to authenticate. The session token is cached on disk and+reused by the Drive and Notes subcommands until it expires.++```+$ hstratus auth init+Apple ID: your-apple-id@example.com+Password:+Credentials saved.++$ hstratus auth login+Authenticated.+```+++## Commands++```+Usage: hstratus COMMAND++ hstratus: iCloud service tools++Available commands:+ auth iCloud authentication commands+ drive iCloud Drive commands+ notes iCloud Notes commands+```++### `hstratus auth`++```+Usage: hstratus auth COMMAND++Available commands:+ init Save Apple ID credentials to the config directory+ login Authenticate with iCloud+```++#### `hstratus auth init`++Prompts for an Apple ID and password and saves them to+`$XDG_CONFIG_HOME/hstratus/credentials.json`.++#### `hstratus auth login`++```+Usage: hstratus auth login [--china] [--log] [--log-file FILE] [--redact]++Available options:+ --china Use mainland China endpoints+ --log Append HTTP exchanges to the default log file+ --log-file FILE Append HTTP exchanges to FILE+ --redact Redact sensitive headers (tokens, cookies) in the log+```++Runs the full sign-in flow interactively, prompting for a 2FA or 2SA+verification code when required.+++### `hstratus drive`++```+Usage: hstratus drive COMMAND++Available commands:+ ls List contents of a Drive folder (default: root)+ cp Download a file from Drive to the local filesystem+```++#### `hstratus drive ls`++```+Usage: hstratus drive ls [[PATH]] [--human | --si] [--sort KEY] [--reverse]+ [--long] [--ids] [--folders-only | --files-only]+ [--china] [--log] [--log-file FILE] [--log-bodies]+ [--redact]++ [PATH] Slash-separated path from root (e.g. Documents/Work)+ --human Human-readable sizes (KiB, MiB, …)+ --si SI sizes (KB, MB, …)+ --sort KEY Sort order: name or date+ --reverse Reverse the sort order+ --long Show date as a column before the name+ --ids Show node identifier before the name+ --folders-only Show only folders+ --files-only Show only files+```++With no argument, lists the root folder. With a path, lists that folder.++```+$ hstratus drive ls+d 4096 Desktop+d 4096 Documents+ 1024 notes.txt++$ hstratus drive ls Documents/Work+d 4096 Archive+ 204800 report.pdf+```++#### `hstratus drive cp`++```+Usage: hstratus drive cp PATH [--root DIR | --output FILE] [--verbose]+ [--human | --si] [--china] [--log]+ [--log-file FILE] [--log-bodies] [--redact]++ PATH Slash-separated path to the file in Drive+ --root DIR Copy under DIR, mirroring the Drive path+ --output FILE Copy to the exact local path FILE+ --verbose Print downloaded file entry in ls style+ --human Human-readable sizes (KiB, MiB, …)+ --si SI sizes (KB, MB, …)+```++Without `--root` or `--output`, the file is placed under `~/icloud-drive/`+mirroring the Drive path.++```+$ hstratus drive cp Documents/report.pdf --output /tmp/report.pdf+Downloaded to /tmp/report.pdf+```+++### `hstratus notes`++```+Usage: hstratus notes COMMAND++Available commands:+ list-note-folders List all iCloud Notes folders+ list-notes List notes, optionally filtered by folder name+ get Fetch and display a note body (default format: markdown)+ export-folder Download all notes in a folder to local files+```++#### `hstratus notes list-note-folders`++```+Usage: hstratus notes list-note-folders [--china] [--log] [--log-file FILE]+ [--log-bodies] [--redact]+```++Lists all Notes folders, showing each folder's ID and name.++#### `hstratus notes list-notes`++```+Usage: hstratus notes list-notes [--folder NAME] [--china] [--log]+ [--log-file FILE] [--log-bodies] [--redact]++ --folder NAME Folder name (e.g. TukTuk)+```++Lists notes sorted by modification time. Pass `--folder` to restrict output to+a single folder.++#### `hstratus notes get`++```+Usage: hstratus notes get NOTE_ID [--format FORMAT] [--china] [--log]+ [--log-file FILE] [--log-bodies] [--redact]++ NOTE_ID UUID record name, as shown by list-notes+ --format FORMAT Output format: markdown (default) or text+```++Fetches the named note and prints its title, modification time, and body.+`--format markdown` renders the body as Markdown; `--format text` emits the+raw plain-text content.++#### `hstratus notes export-folder`++```+Usage: hstratus notes export-folder FOLDER [--root DIR | --output DIR]+ [--format FORMAT] [--china] [--log]+ [--log-file FILE] [--log-bodies] [--redact]++ FOLDER Folder name (case-insensitive)+ --root DIR Save under DIR/<folder-slug>/+ --output DIR Save directly into DIR+ --format FORMAT Output format: markdown (default) or text+```++Downloads every note in the named folder and writes each one to a local file.+Without `--root` or `--output`, files are placed under `~/icloud-notes/<folder-slug>/`.+Locked notes are skipped with a message; network errors abort the run.++```+$ hstratus notes export-folder TukTuk --output /tmp/tuktuk+saved /tmp/tuktuk/shopping-list.md+saved /tmp/tuktuk/meeting-notes.md+skipped ABC-123: note is locked+```+++## Common options++All `drive` and `notes` subcommands accept these options:++| Option | Description |+|--------|-------------|+| `--china` | Use mainland China endpoints |+| `--log` | Append HTTP exchanges to the default log file |+| `--log-file FILE` | Append HTTP exchanges to FILE |+| `--log-bodies` | Include request bodies in the log |+| `--redact` | Redact tokens and cookies in the log |+++---++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.
+ app/Main.hs view
@@ -0,0 +1,7 @@+module Main where++import Hstratus.Cli (run)+++main :: IO ()+main = run
+ hstratus.cabal view
@@ -0,0 +1,88 @@+cabal-version: 3.0+name: hstratus+version: 0.1.0.0+synopsis: Unified CLI for iCloud services+description:+ An @hstratus@ executable that provides subcommands for iCloud authentication,+ Drive, and Notes.++license: BSD-3-Clause+license-file: LICENSE+author: Tim Emiola+maintainer: Tim Emiola <adetokunbo@emio.la>+copyright: (c) 2026 Tim Emiola+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++source-repository head+ type: git+ location: https://github.com/adetokunbo/hstratus.git+ subdir: hstratus++library+ exposed-modules:+ Hstratus.Cli+ Hstratus.Cli.Auth+ Hstratus.Cli.Drive+ Hstratus.Cli.Notes+ hs-source-dirs: src+ build-depends:+ , base >=4.12 && <5+ , bytestring >=0.10.8 && <0.11 || >=0.11.3 && <0.13+ , containers >=0.6 && <0.8+ , directory >=1.3 && <1.4+ , filepath >=1.4 && <1.6+ , hstratus-auth >=0.1 && <0.2+ , hstratus-auth:hstratus-auth-cli >=0.1 && <0.2+ , hstratus-drive >=0.1 && <0.2+ , hstratus-notes >=0.1 && <0.2+ , http-client-tls >=0.3 && <0.4+ , optparse-applicative >=0.18 && <0.19+ , text >=1.2.3 && <2.2+ , time >=1.8 && <1.15+ , xdg-basedir >=0.2 && <0.3+ default-language: Haskell2010+ ghc-options: -Wall -Wincomplete-uni-patterns -Wpartial-fields -fwarn-tabs++executable hstratus+ main-is: Main.hs+ hs-source-dirs: app+ default-language: Haskell2010+ ghc-options: -Wall -fwarn-tabs+ build-depends:+ , base >=4.12 && <5+ , hstratus++test-suite test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules:+ Hstratus.Cli.AuthSpec+ Hstratus.Cli.DriveSpec+ Hstratus.Cli.NotesSpec+ default-language: Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs+ build-depends:+ , base >=4.12 && <5+ , benri-hspec >=0.1 && <0.3+ , directory >=1.3 && <1.4+ , filepath >=1.4 && <1.6+ , hspec >=2.1 && <3.0+ , hstratus+ , hstratus-auth:hstratus-auth-cli+ , hstratus-drive+ , hstratus-notes+ , optparse-applicative >=0.18 && <0.19+ , text >=1.2.3 && <2.2+ , time >=1.8 && <1.15
+ src/Hstratus/Cli.hs view
@@ -0,0 +1,52 @@+{- |+Module : Hstratus.Cli+Copyright : (c) 2026 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Top-level CLI parser and dispatch for the hstratus command-line tool.+-}+module Hstratus.Cli+ ( TopCommand (..)+ , cliParser+ , run+ )+where++import Hstratus.Cli.Auth (AuthCommand, authParser, runAuth)+import Hstratus.Cli.Drive (DriveCommand, driveParser, runDrive)+import Hstratus.Cli.Notes (NotesCommand, notesParser, runNotes)+import Options.Applicative+++data TopCommand+ = AuthCmd !AuthCommand+ | DriveCmd !DriveCommand+ | NotesCmd !NotesCommand+ deriving (Eq, Show)+++cliParser :: ParserInfo TopCommand+cliParser =+ info+ (topParser <**> helper)+ (fullDesc <> progDesc "hstratus: iCloud service tools")+++topParser :: Parser TopCommand+topParser =+ subparser+ ( command "auth" (info (AuthCmd <$> authParser <**> helper) (progDesc "iCloud authentication commands"))+ <> command "drive" (info (DriveCmd <$> driveParser <**> helper) (progDesc "iCloud Drive commands"))+ <> command "notes" (info (NotesCmd <$> notesParser <**> helper) (progDesc "iCloud Notes commands"))+ )+++run :: IO ()+run = execParser cliParser >>= dispatch+++dispatch :: TopCommand -> IO ()+dispatch (AuthCmd cmd) = runAuth cmd+dispatch (DriveCmd cmd) = runDrive cmd+dispatch (NotesCmd cmd) = runNotes cmd
+ src/Hstratus/Cli/Auth.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE LambdaCase #-}++{- |+Module : Hstratus.Cli.Auth+Copyright : (c) 2026 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++CLI subcommands for iCloud authentication (login, logout, status).+-}+module Hstratus.Cli.Auth+ ( AuthCommand (..)+ , authParser+ , runAuth+ )+where++import Control.Exception (bracket_, catch, displayException)+import Data.String (fromString)+import Network.HStratus.Http+ ( AuthError+ , login+ , mkApiWith+ , withLogger+ )+import Network.HStratus.Http.Cli+ ( CommonOpts (..)+ , commonOptsParser+ , mkLoggerFor+ , resolveLogTarget+ )+import Network.HStratus.Http.Endpoints (Realm (..), realmEndpoints)+import Network.HStratus.Session (Credentials (..), loadSession, saveCredentials)+import Network.HTTP.Client.TLS (newTlsManager)+import Options.Applicative+import System.Exit (exitFailure)+import System.IO (IOMode (..), hFlush, hSetEcho, stdin, stdout, withFile)+++-- | Top-level auth subcommand.+data AuthCommand+ = -- | save Apple ID credentials to the config directory+ AuthInit+ | -- | authenticate with iCloud+ AuthLogin !CommonOpts+ deriving (Eq, Show)+++-- | Optparse-applicative parser for the @auth@ subcommand.+authParser :: Parser AuthCommand+authParser =+ subparser+ ( command "init" (info (pure AuthInit) (progDesc "Save Apple ID credentials to the config directory"))+ <> command "login" (info (AuthLogin <$> commonOptsParser <**> helper) (progDesc "Authenticate with iCloud"))+ )+++-- | Dispatch an 'AuthCommand' to its handler.+runAuth :: AuthCommand -> IO ()+runAuth = \case+ AuthInit -> runInit+ AuthLogin opts -> runLogin opts+++runInit :: IO ()+runInit = do+ appleId <- prompt "Apple ID: "+ password <- promptSecret "Password: "+ saveCredentials (Credentials (fromString appleId) (fromString password))+ putStrLn "Credentials saved."+++runLogin :: CommonOpts -> IO ()+runLogin opts = 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+ go = case mbLogPath of+ Nothing -> login api0 >> putStrLn "Authenticated."+ Just fp -> withFile fp AppendMode $ \h ->+ login (withLogger (mkLogger' h) api0) >> putStrLn "Authenticated."+ go `catch` \e -> do+ putStrLn $ "Login failed: " <> displayException (e :: AuthError)+ exitFailure+++prompt :: String -> IO String+prompt label = putStr label >> hFlush stdout >> getLine+++promptSecret :: String -> IO String+promptSecret label = do+ putStr label+ hFlush stdout+ bracket_ (hSetEcho stdin False) (hSetEcho stdin True) $ do+ secret <- getLine+ putStrLn ""+ pure secret
+ src/Hstratus/Cli/Drive.hs view
@@ -0,0 +1,452 @@+{-# LANGUAGE TypeApplications #-}++{- |+Module : Hstratus.Cli.Drive+Copyright : (c) 2026 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++CLI subcommands for iCloud Drive (list, copy, download).+-}+module Hstratus.Cli.Drive+ ( DriveCommand (..)+ , LsFormat (..)+ , LsSort (..)+ , LsFilter (..)+ , LsOpts (..)+ , CpOpts (..)+ , CpDest (..)+ , driveParser+ , runDrive+ , resolveLocalDest+ , formatSize+ , nodeDisplaySize+ , displayNode+ , displayNodes+ , nodeDate+ , nodeName+ , sortNodes+ , filterNodes+ )+where++import Control.Exception (catch)+import Control.Monad (when)+import qualified Data.ByteString.Lazy as LBS+import Data.Int (Int64)+import Data.List (sortBy)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe (fromMaybe)+import Data.Ord (Down (..), comparing)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Time (UTCTime)+import Data.Time.Format (defaultTimeLocale, formatTime)+import Network.HStratus.Drive+ ( DriveApi+ , DriveError+ , DriveNode (..)+ , DriveNodeId (..)+ , FileData (..)+ , FolderData (..)+ , downloadFile+ , driveRoot+ , fileName+ , listFolder+ , mkDriveApi+ , selectFileNode+ )+import Network.HStratus.Http.Cli (CommonOpts (..), commonOptsParser, onServiceError, runWithApi)+import Options.Applicative+import System.Directory (createDirectoryIfMissing, getHomeDirectory)+import System.Exit (die)+import System.FilePath (joinPath, takeDirectory, (</>))+++-- | Top-level Drive subcommand.+data DriveCommand+ = -- | list the contents of a Drive folder+ DriveLs !LsOpts+ | -- | download a file from Drive+ DriveCp !CpOpts+ deriving (Eq, Show)+++-- | Controls size display in @ls@ output.+data LsFormat+ = -- | raw bytes (default)+ LsBytes+ | -- | powers of 1024: KiB, MiB, GiB, …+ LsHuman+ | -- | powers of 1000: KB, MB, GB, …+ LsSI+ deriving (Eq, Ord, Show)+++-- | Controls sort order in @ls@ output.+data LsSort+ = -- | preserve API order (default)+ LsSortDefault+ | -- | alphabetical by display name+ LsSortName+ | -- | newest first; folders use creation date, files use modification date+ LsSortDate+ deriving (Eq, Ord, Show)+++-- | Controls which node types appear in @ls@ output.+data LsFilter+ = -- | show all nodes (default)+ LsFilterAll+ | -- | show only folders+ LsFilterFolders+ | -- | show only files+ LsFilterFiles+ deriving (Eq, Ord, Show)+++-- | Options for the @drive ls@ subcommand.+data LsOpts = LsOpts+ { lsPath :: ![Text]+ -- ^ slash-separated path segments from the Drive root; empty means root+ , lsFormat :: !LsFormat+ -- ^ size display format; controlled by @--human@ and @--si@+ , lsSort :: !LsSort+ -- ^ sort order; controlled by @--sort=name|date@+ , lsReverse :: !Bool+ -- ^ when @True@, reverse the sort order+ , lsLong :: !Bool+ -- ^ when @True@, show a date column before the name+ , lsIds :: !Bool+ -- ^ when @True@, show the node identifier before the name+ , lsFilter :: !LsFilter+ -- ^ which node types to show; controlled by @--folders-only@ and @--files-only@+ , lsCommon :: !CommonOpts+ -- ^ shared connection and logging options+ }+ deriving (Eq, Show)+++-- | Destination specifier for the @drive cp@ subcommand.+data CpDest+ = -- | mirror the Drive path under the given local root directory+ CpDestRoot !FilePath+ | -- | write the file to the exact local path+ CpDestOutput !FilePath+ deriving (Eq, Show)+++-- | Options for the @drive cp@ subcommand.+data CpOpts = CpOpts+ { cpSrcPath :: !(NonEmpty Text)+ -- ^ slash-separated path segments identifying the source file in Drive+ , cpDest :: !(Maybe CpDest)+ -- ^ local destination; @Nothing@ defaults to @~/icloud-drive/\<path\>@+ , cpVerbose :: !Bool+ -- ^ when @True@, print the downloaded file entry in @ls@ style after download+ , cpFormat :: !LsFormat+ -- ^ size format for verbose output; controlled by @--human@ and @--si@+ , cpCommon :: !CommonOpts+ -- ^ shared connection and logging options+ }+ deriving (Eq, Show)+++-- | Optparse-applicative parser for the @drive@ subcommand.+driveParser :: Parser DriveCommand+driveParser =+ subparser+ ( command+ "ls"+ ( info+ (DriveLs <$> lsOptsParser <**> helper)+ (progDesc "List contents of a Drive folder (default: root)")+ )+ <> command+ "cp"+ ( info+ (DriveCp <$> cpOptsParser <**> helper)+ (progDesc "Download a file from Drive to the local filesystem")+ )+ )+++cpOptsParser :: Parser CpOpts+cpOptsParser =+ CpOpts+ <$> argument+ ( eitherReader $ \s ->+ let segs = filter (not . Text.null) (Text.splitOn (Text.pack "/") (Text.pack s))+ in case NE.nonEmpty segs of+ Nothing -> Left "PATH must not be empty"+ Just ne -> Right ne+ )+ (metavar "PATH" <> help "Slash-separated path to the file in Drive")+ <*> optional+ ( (CpDestRoot <$> strOption (long "root" <> metavar "DIR" <> help "Copy under DIR, mirroring the Drive path"))+ <|> (CpDestOutput <$> strOption (long "output" <> metavar "FILE" <> help "Copy to the exact local path FILE"))+ )+ <*> switch (long "verbose" <> help "Print downloaded file entry in ls style")+ <*> lsFormatParser+ <*> commonOptsParser+++lsOptsParser :: Parser LsOpts+lsOptsParser =+ LsOpts+ <$> fmap+ (maybe [] (filter (not . Text.null) . Text.splitOn (Text.pack "/") . Text.pack))+ (optional (argument str (metavar "[PATH]" <> help "Slash-separated path from root (e.g. Documents/Work)")))+ <*> lsFormatParser+ <*> lsSortParser+ <*> switch (long "reverse" <> help "Reverse the sort order")+ <*> switch (long "long" <> help "Show date as a column before the name")+ <*> switch (long "ids" <> help "Show node identifier before the name")+ <*> lsFilterParser+ <*> commonOptsParser+++lsFormatParser :: Parser LsFormat+lsFormatParser =+ flag' LsHuman (long "human" <> help "Human-readable sizes (KiB, MiB, …)")+ <|> flag' LsSI (long "si" <> help "SI sizes (KB, MB, …)")+ <|> pure LsBytes+++lsSortParser :: Parser LsSort+lsSortParser =+ option+ ( eitherReader $ \s -> case s of+ "name" -> Right LsSortName+ "date" -> Right LsSortDate+ _ -> Left $ "unknown sort key: " <> s <> "; expected name or date"+ )+ (long "sort" <> metavar "KEY" <> help "Sort order: name or date")+ <|> pure LsSortDefault+++lsFilterParser :: Parser LsFilter+lsFilterParser =+ flag' LsFilterFolders (long "folders-only" <> help "Show only folders")+ <|> flag' LsFilterFiles (long "files-only" <> help "Show only files")+ <|> pure LsFilterAll+++-- | Dispatch a 'DriveCommand' to its handler.+runDrive :: DriveCommand -> IO ()+runDrive (DriveLs opts) = runLs opts+runDrive (DriveCp opts) = runCp opts+++runCp :: CpOpts -> IO ()+runCp opts =+ withDriveApi (cpCommon opts) $ \da -> do+ root <- driveRoot da+ fd <- navigateToFile da (fnId root) (cpSrcPath opts)+ dest <- resolveLocalDest opts (cpSrcPath opts)+ createDirectoryIfMissing True (takeDirectory dest)+ bytes <- downloadFile da fd+ LBS.writeFile dest bytes+ when (cpVerbose opts) $ do+ let verboseOpts =+ LsOpts+ { lsPath = []+ , lsFormat = cpFormat opts+ , lsSort = LsSortDefault+ , lsReverse = False+ , lsLong = False+ , lsIds = False+ , lsFilter = LsFilterAll+ , lsCommon = cpCommon opts+ }+ putStrLn (displayNode verboseOpts (DriveFile fd))+ putStrLn $ "Downloaded to " <> dest+++navigateToFile :: DriveApi -> DriveNodeId -> NonEmpty Text -> IO FileData+navigateToFile da nid (name :| []) = do+ children <- listFolder da nid+ case selectFileNode name children of+ Just (DriveFile fd) -> pure fd+ Just (DriveFolder _) -> die $ "Not a file: " <> Text.unpack name+ Nothing -> die $ "File not found: " <> Text.unpack name+navigateToFile da nid (seg :| (s : rest)) = do+ children <- listFolder da nid+ case selectFileNode seg children of+ Nothing -> die $ "Folder not found: " <> Text.unpack seg+ Just (DriveFile _) -> die $ "Not a folder: " <> Text.unpack seg+ Just (DriveFolder fd) -> navigateToFile da (fnId fd) (s :| rest)+++-- | Resolve the local destination path for a download, expanding @~@ via 'getHomeDirectory' when needed.+resolveLocalDest :: CpOpts -> NonEmpty Text -> IO FilePath+resolveLocalDest (CpOpts{cpDest = Just (CpDestOutput out)}) _ = pure out+resolveLocalDest (CpOpts{cpDest = Just (CpDestRoot topDir)}) segs =+ pure $ topDir </> joinPath (map Text.unpack (NE.toList segs))+resolveLocalDest _ segs = do+ home <- getHomeDirectory+ pure $ home </> "icloud-drive" </> joinPath (map Text.unpack (NE.toList segs))+++runLs :: LsOpts -> IO ()+runLs opts =+ withDriveApi (lsCommon opts) $ \da -> do+ root <- driveRoot da+ nid <- navigatePath da (fnId root) (lsPath opts)+ nodes <- listFolder da nid+ mapM_ putStrLn+ . displayNodes opts+ . sortNodes (lsSort opts) (lsReverse opts)+ . filterNodes (lsFilter opts)+ $ nodes+++navigatePath :: DriveApi -> DriveNodeId -> [Text] -> IO DriveNodeId+navigatePath _ nid [] = pure nid+navigatePath da nid (seg : segs) = do+ children <- listFolder da nid+ case selectFileNode seg children of+ Nothing -> die $ "Folder not found: " <> Text.unpack seg+ Just (DriveFile _) -> die $ "Not a folder: " <> Text.unpack seg+ Just (DriveFolder fd) -> navigatePath da (fnId fd) segs+++-- | Format a node size for display according to the given 'LsFormat'.+formatSize :: LsFormat -> Int64 -> String+formatSize LsBytes n = show n+formatSize LsHuman n+ | n < 1024 = show n <> " bytes"+ | n < 1024 * 1024 = showFrac (fromIntegral n / 1024) <> " KiB"+ | n < 1024 * 1024 * 1024 = showFrac (fromIntegral n / (1024 * 1024)) <> " MiB"+ | otherwise = showFrac (fromIntegral n / (1024 * 1024 * 1024)) <> " GiB"+formatSize LsSI n+ | n < 1000 = show n <> " bytes"+ | n < 1000 * 1000 = showFrac (fromIntegral n / 1000) <> " KB"+ | n < 1000 * 1000 * 1000 = showFrac (fromIntegral n / (1000 * 1000)) <> " MB"+ | otherwise = showFrac (fromIntegral n / (1000 * 1000 * 1000)) <> " GB"+++showFrac :: Double -> String+showFrac x =+ let tenths = round (x * 10) :: Int+ whole = tenths `div` 10+ frac = tenths `mod` 10+ in show whole <> "." <> show frac+++padLeft :: Int -> String -> String+padLeft n s = replicate (max 0 (n - length s)) ' ' <> s+++{- | Returns the display size of a 'DriveNode' in bytes.++Folders use a conventional 4096 bytes (matching @ls(1)@ block-size behaviour).+Files with an unknown size report 0.+-}+nodeDisplaySize :: DriveNode -> Int64+nodeDisplaySize (DriveFolder _) = 4096+nodeDisplaySize (DriveFile fd) = fromMaybe 0 (fdSize fd)+++sizeColWidth :: LsFormat -> [DriveNode] -> Int+sizeColWidth fmt nodes =+ maximum (1 : map (length . formatSize fmt . nodeDisplaySize) nodes)+++displayNodeW :: LsOpts -> Int -> DriveNode -> String+displayNodeW opts width node =+ typeStr <> idPart <> datePart <> sizePart <> namePart+ where+ typeStr = case node of+ DriveFolder _ -> "d "+ DriveFile _ -> " "+ idPart+ | lsIds opts = case node of+ DriveFolder fd -> Text.unpack (unDriveNodeId (fnId fd)) <> " "+ DriveFile fd -> Text.unpack (unDriveNodeId (fdId fd)) <> " "+ | otherwise = ""+ datePart+ | lsLong opts =+ maybe (replicate 16 ' ') (formatTime defaultTimeLocale "%Y-%m-%d %H:%M") (nodeDate node)+ <> " "+ | otherwise = ""+ sizePart = padLeft width (formatSize (lsFormat opts) (nodeDisplaySize node)) <> " "+ namePart = Text.unpack (nodeName node)+++{- | Format a single 'DriveNode' for display in @ls@ output.++The column order is: type char, optional node ID, optional date, size, name.+Name is always the last column. Folders are prefixed with @d@; files with a+space. The date column (16 chars) is only emitted with @--long@.++The size column is right-justified to the width of this node's own formatted+size string. For cross-listing alignment with consistent column widths, use+'displayNodes' instead.+-}+displayNode :: LsOpts -> DriveNode -> String+displayNode opts node =+ displayNodeW opts (length (formatSize (lsFormat opts) (nodeDisplaySize node))) node+++{- | Format a list of 'DriveNode' values for display, with the size column+right-justified to the widest entry in the list.+-}+displayNodes :: LsOpts -> [DriveNode] -> [String]+displayNodes opts nodes = map (displayNodeW opts width) nodes+ where+ width = sizeColWidth (lsFormat opts) nodes+++-- | The display name of a node: folder name for folders, full file name (with extension) for files.+nodeName :: DriveNode -> Text+nodeName (DriveFolder fd) = fnName fd+nodeName (DriveFile fd) = fileName fd+++{- | The relevant date of a node, used for sorting and @--long@ date-column display.++Folders use 'fnDateCreated'; files use 'fdDateModified' falling back to+'fdDateCreated'. Returns 'Nothing' when no date is available.+-}+nodeDate :: DriveNode -> Maybe UTCTime+nodeDate (DriveFolder fd) = fnDateCreated fd+nodeDate (DriveFile fd) = fdDateModified fd <|> fdDateCreated fd+++{- | Sort a list of 'DriveNode' values by the given key, optionally reversed.++'LsSortDate' orders newest first; nodes with no date sort last.+'LsSortDefault' preserves the input order. The @rev@ flag reverses the+result regardless of sort key.+-}+sortNodes :: LsSort -> Bool -> [DriveNode] -> [DriveNode]+sortNodes sort' rev = applyReverse rev . sortByKey sort'+ where+ sortByKey LsSortDefault = id+ sortByKey LsSortName = sortBy (comparing nodeName)+ sortByKey LsSortDate = sortBy (comparing (Down . nodeDate))+++-- | Filter a list of 'DriveNode' values by node type.+filterNodes :: LsFilter -> [DriveNode] -> [DriveNode]+filterNodes LsFilterAll = id+filterNodes LsFilterFolders = filter isFolder+filterNodes LsFilterFiles = filter (not . isFolder)+++isFolder :: DriveNode -> Bool+isFolder (DriveFolder _) = True+isFolder (DriveFile _) = False+++applyReverse :: Bool -> [a] -> [a]+applyReverse True = reverse+applyReverse False = id+++withDriveApi :: CommonOpts -> (DriveApi -> IO ()) -> IO ()+withDriveApi opts runAction =+ runWithApi opts (\ad sess api -> mkDriveApi ad sess api >>= runAction)+ `catch` onServiceError @DriveError
+ src/Hstratus/Cli/Notes.hs view
@@ -0,0 +1,376 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++{- |+Module : Hstratus.Cli.Notes+Copyright : (c) 2026 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++CLI subcommands for iCloud Notes (list, get, render, export-folder).+-}+module Hstratus.Cli.Notes+ ( NotesCommand (..)+ , ListNotesOpts (..)+ , GetOpts (..)+ , GetFormat (..)+ , ExportFolderDest (..)+ , ExportFolderOpts (..)+ , noteBasename+ , uniqueBasenames+ , resolveExportDest+ , notesParser+ , runNotes+ , findFolderByName+ )+where++import Control.Exception (catch)+import Control.Monad ((>=>))+import Data.Char (isAlphaNum)+import Data.List (find)+import Data.Maybe (catMaybes)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as TIO+import Network.HStratus.Http.Cli (CommonOpts (..), commonOptsParser, onServiceError, runWithApi)+import Network.HStratus.Notes+import Network.HStratus.Notes.Markdown (noteToMarkdown)+import Options.Applicative+import System.Directory (createDirectoryIfMissing, getHomeDirectory)+import System.Exit (die, exitFailure)+import System.FilePath ((<.>), (</>))+++-- | Top-level Notes subcommand.+data NotesCommand+ = -- | list all Notes folders+ NotesListFolders !CommonOpts+ | -- | list notes, optionally filtered by folder name+ NotesListNotes !ListNotesOpts+ | -- | fetch and display the body of a note by ID+ NotesGet !GetOpts+ | -- | download all notes in a folder to local files+ NotesExportFolder !ExportFolderOpts+ deriving (Eq, Show)+++-- | Options for the @notes list-notes@ subcommand.+data ListNotesOpts = ListNotesOpts+ { lnFolder :: !(Maybe Text)+ -- ^ optional folder name to filter by; @Nothing@ lists recent notes across all folders+ , lnCommon :: !CommonOpts+ -- ^ shared connection and logging options+ }+ deriving (Eq, Show)+++-- | Output format for the @notes get@ subcommand.+data GetFormat+ = -- | render the note body as Markdown (default)+ GetMarkdown+ | -- | emit the raw plain-text content of the note+ GetText+ deriving (Eq, Show)+++-- | Options for the @notes get@ subcommand.+data GetOpts = GetOpts+ { gnNoteId :: !NoteId+ -- ^ UUID record name of the note to fetch+ , gnFormat :: !GetFormat+ -- ^ output format; defaults to 'GetMarkdown'+ , gnCommon :: !CommonOpts+ -- ^ shared connection and logging options+ }+ deriving (Eq, Show)+++-- | Options for the @notes export-folder@ subcommand.+data ExportFolderOpts = ExportFolderOpts+ { efFolder :: !Text+ -- ^ folder name, resolved case-insensitively+ , efDest :: !(Maybe ExportFolderDest)+ -- ^ destination; @Nothing@ defaults to @~\/icloud-notes\/\<folder-slug\>@+ , efFormat :: !GetFormat+ -- ^ output format; default 'GetMarkdown'+ , efCommon :: !CommonOpts+ -- ^ shared connection and logging options+ }+ deriving (Eq, Show)+++-- | Destination specifier for the @notes export-folder@ subcommand.+data ExportFolderDest+ = -- | write files under @DIR\/\<folder-slug\>\/@+ ExportFolderRoot !FilePath+ | -- | write files directly into @DIR@ (no slug appended)+ ExportFolderOutput !FilePath+ deriving (Eq, Show)+++{- | Map a note title to a filesystem-safe slug.++Applies 'Data.Char.isAlphaNum' as a filter (non-alphanumeric characters become+@\'-\'@), collapses consecutive hyphens, strips leading and trailing hyphens,+and case-folds the result. Returns @\"untitled\"@ for titles that produce an+empty slug.+-}+noteBasename :: Text -> Text+noteBasename t =+ let mapped = Text.map (\c -> if isAlphaNum c then c else '-') (Text.toCaseFold t)+ parts = filter (not . Text.null) (Text.splitOn "-" mapped)+ slug = Text.intercalate "-" parts+ in if Text.null slug then "untitled" else slug+++{- | Allocate a unique slug for each note title, preserving list order.++@Nothing@ titles use @\"untitled\"@ as the base slug. When a slug collides+with one already allocated earlier in the list, a numeric suffix is appended+(@\"-2\"@, @\"-3\"@, …) until the candidate is unique. The first occurrence+of a slug always keeps the bare form.+-}+uniqueBasenames :: [Maybe Text] -> [Text]+uniqueBasenames = go Set.empty+ where+ go _ [] = []+ go seen (mt : rest) =+ let base = maybe "untitled" noteBasename mt+ slug = findUnique seen base+ in slug : go (Set.insert slug seen) rest+ findUnique seen base+ | Set.notMember base seen = base+ | otherwise = findSuffix seen base 2+ findSuffix :: Set.Set Text -> Text -> Int -> Text+ findSuffix seen base n =+ let candidate = base <> "-" <> Text.pack (show n)+ in if Set.notMember candidate seen+ then candidate+ else findSuffix seen base (n + 1)+++{- | Resolve the local output directory for a folder export, expanding @~@ via+'System.Directory.getHomeDirectory' for the default case.++* 'ExportFolderOutput' @dir@ — returns @dir@ unchanged.+* 'ExportFolderRoot' @root@ — appends the slug of @folderName@ to @root@.+* 'Nothing' — uses @~\/icloud-notes\/\<slug\>@ as the default.+-}+resolveExportDest :: Maybe ExportFolderDest -> Text -> IO FilePath+resolveExportDest (Just (ExportFolderOutput dir)) _ = pure dir+resolveExportDest (Just (ExportFolderRoot root)) folderName =+ pure $ root </> Text.unpack (noteBasename folderName)+resolveExportDest Nothing folderName = do+ home <- getHomeDirectory+ pure $ home </> "icloud-notes" </> Text.unpack (noteBasename folderName)+++-- | Optparse-applicative parser for the @notes@ subcommand.+notesParser :: Parser NotesCommand+notesParser =+ subparser+ ( command+ "list-note-folders"+ ( info+ (NotesListFolders <$> commonOptsParser <**> helper)+ (progDesc "List all iCloud Notes folders")+ )+ <> command+ "list-notes"+ ( info+ (NotesListNotes <$> listNotesOptsParser <**> helper)+ (progDesc "List notes, optionally filtered by folder name")+ )+ <> command+ "get"+ ( info+ (NotesGet <$> getOptsParser <**> helper)+ (progDesc "Fetch and display a note body (default format: markdown)")+ )+ <> command+ "export-folder"+ ( info+ (NotesExportFolder <$> exportFolderOptsParser <**> helper)+ (progDesc "Download all notes in a folder to local files")+ )+ )+++getOptsParser :: Parser GetOpts+getOptsParser =+ (GetOpts . NoteId . Text.pack <$> argument str (metavar "NOTE_ID" <> help "UUID record name (e.g. 68567409-5528-458C-9A00-7A2AB485CAD6), as shown by list-notes"))+ <*> option+ ( eitherReader $ \s -> case s of+ "markdown" -> Right GetMarkdown+ "text" -> Right GetText+ _ -> Left ("unknown format: " <> s <> "; use markdown or text")+ )+ ( long "format"+ <> metavar "FORMAT"+ <> value GetMarkdown+ <> showDefault+ <> help "Output format: markdown (default) or text"+ )+ <*> commonOptsParser+++listNotesOptsParser :: Parser ListNotesOpts+listNotesOptsParser =+ ListNotesOpts+ <$> optional+ ( Text.pack+ <$> strOption+ ( long "folder"+ <> metavar "NAME"+ <> help "Folder name (e.g. TukTuk)"+ )+ )+ <*> commonOptsParser+++exportFolderOptsParser :: Parser ExportFolderOpts+exportFolderOptsParser =+ ExportFolderOpts+ <$> (Text.pack <$> argument str (metavar "FOLDER" <> help "Folder name (case-insensitive)"))+ <*> optional+ ( (ExportFolderRoot <$> strOption (long "root" <> metavar "DIR" <> help "Save under DIR/<folder-slug>/"))+ <|> (ExportFolderOutput <$> strOption (long "output" <> metavar "DIR" <> help "Save directly into DIR"))+ )+ <*> option+ ( eitherReader $ \s -> case s of+ "markdown" -> Right GetMarkdown+ "text" -> Right GetText+ _ -> Left ("unknown format: " <> s <> "; use markdown or text")+ )+ ( long "format"+ <> metavar "FORMAT"+ <> value GetMarkdown+ <> showDefault+ <> help "Output format: markdown (default) or text"+ )+ <*> commonOptsParser+++-- | Dispatch a 'NotesCommand' to its handler.+runNotes :: NotesCommand -> IO ()+runNotes (NotesListFolders opts) = runListFolders opts+runNotes (NotesListNotes opts) = runListNotes opts+runNotes (NotesGet opts) = runGet opts+runNotes (NotesExportFolder opts) = runExportFolder opts+++runListFolders :: CommonOpts -> IO ()+runListFolders opts = withNotesApi opts (noteFolders >=> mapM_ printFolder)+++runListNotes :: ListNotesOpts -> IO ()+runListNotes opts =+ withNotesApi (lnCommon opts) $ \na -> do+ notes <- case lnFolder opts of+ Nothing -> recentNotes na+ Just name -> do+ fid <- resolveFolderName na name+ notesInFolder na fid+ mapM_ printNote notes+++runGet :: GetOpts -> IO ()+runGet opts =+ withNotesApi (gnCommon opts) $ \na -> do+ let nid = gnNoteId opts+ mnote <- getNote na nid+ note <- case mnote of+ Nothing -> die $ "Note not found: " <> Text.unpack (unNoteId nid)+ Just n -> pure n+ result <- decodeNoteBody (noteBodyBytes note)+ nt <- case result of+ Left err -> die $ "Failed to decode note body: " <> err+ Right decoded -> pure decoded+ let s = noteInfo note+ titleStr = maybe "Untitled" Text.unpack (nsTitle s)+ mapM_ putStrLn $+ catMaybes+ [ Just (titleStr <> " [" <> Text.unpack (unNoteId nid) <> "]")+ , fmap (\t -> "Modified: " <> show t) (nsModified s)+ , Just ""+ ]+ let body = case gnFormat opts of+ GetMarkdown -> noteToMarkdown nt+ GetText -> ntText nt+ putStrLn (Text.unpack body)+++runExportFolder :: ExportFolderOpts -> IO ()+runExportFolder opts =+ withNotesApi (efCommon opts) $ \na -> do+ fid <- resolveFolderName na (efFolder opts)+ summaries <- notesInFolder na fid+ let pairs = zip summaries (uniqueBasenames (map nsTitle summaries))+ outDir <- resolveExportDest (efDest opts) (efFolder opts)+ createDirectoryIfMissing True outDir+ mapM_ (exportNote na outDir (efFormat opts)) pairs+++exportNote :: NotesApi -> FilePath -> GetFormat -> (NoteSummary, Text) -> IO ()+exportNote na outDir fmt (summary, slug) = do+ let nid = nsId summary+ idStr = Text.unpack (unNoteId nid)+ if nsLocked summary+ then putStrLn $ "skipped " <> idStr <> ": note is locked"+ else do+ mnote <- getNote na nid+ case mnote of+ Nothing -> putStrLn $ "skipped " <> idStr <> ": not found"+ Just note -> do+ result <- decodeNoteBody (noteBodyBytes note)+ case result of+ Left err -> putStrLn $ "skipped " <> idStr <> ": " <> err+ Right nt -> do+ let body = case fmt of+ GetMarkdown -> noteToMarkdown nt+ GetText -> ntText nt+ ext = case fmt of+ GetMarkdown -> "md"+ GetText -> "txt"+ dest = outDir </> Text.unpack slug <.> ext+ TIO.writeFile dest body+ putStrLn $ "saved " <> dest+++resolveFolderName :: NotesApi -> Text -> IO FolderId+resolveFolderName na name = do+ findFolderByName name <$> noteFolders na >>= \case+ Just fid -> pure fid+ Nothing -> do+ putStrLn $ "No folder named '" <> Text.unpack name <> "'"+ exitFailure+++-- | Find the first folder whose name matches the given string (case-insensitive); returns its 'FolderId'.+findFolderByName :: Text -> [NoteFolder] -> Maybe FolderId+findFolderByName name = fmap nfId . find matchesName+ where+ matchesName nf = maybe False (\fn -> Text.toCaseFold fn == Text.toCaseFold name) (nfName nf)+++printFolder :: NoteFolder -> IO ()+printFolder nf =+ putStrLn $ Text.unpack (unFolderId (nfId nf)) <> nameStr+ where+ nameStr = maybe "" ((" " <>) . Text.unpack) (nfName nf)+++printNote :: NoteSummary -> IO ()+printNote ns =+ putStrLn $ Text.unpack (unNoteId (nsId ns)) <> titleStr+ where+ titleStr = maybe "" ((" " <>) . Text.unpack) (nsTitle ns)+++withNotesApi :: CommonOpts -> (NotesApi -> IO ()) -> IO ()+withNotesApi opts runAction =+ runWithApi opts (\ad sess api -> mkNotesApi ad sess api >>= runAction)+ `catch` onServiceError @NotesError
+ test/Hstratus/Cli/AuthSpec.hs view
@@ -0,0 +1,48 @@+module Hstratus.Cli.AuthSpec (spec) where++import Hstratus.Cli (TopCommand (..), cliParser)+import Hstratus.Cli.Auth (AuthCommand (..))+import Network.HStratus.Http.Cli (CommonOpts (..))+import Options.Applicative+ ( ParserResult (..)+ , defaultPrefs+ , execParserPure+ , renderFailure+ )+import Test.Hspec+import Test.Hspec.Benri (endsRight)+++parseCmd :: [String] -> IO (Either String TopCommand)+parseCmd args =+ pure $ case execParserPure defaultPrefs cliParser args of+ Success cmd -> Right cmd+ Failure failure -> Left (fst (renderFailure failure "test"))+ CompletionInvoked _ -> Left "completion invoked"+++defaultOpts :: CommonOpts+defaultOpts = CommonOpts False False Nothing False False+++spec :: Spec+spec = describe "auth parser" $ do+ it "parses auth init" $+ parseCmd ["auth", "init"]+ `endsRight` AuthCmd AuthInit++ it "parses auth login --china" $+ parseCmd ["auth", "login", "--china"]+ `endsRight` AuthCmd (AuthLogin defaultOpts{optChina = True})++ it "parses auth login --log-file FILE" $+ parseCmd ["auth", "login", "--log-file", "/tmp/x"]+ `endsRight` AuthCmd (AuthLogin defaultOpts{optLogFile = Just "/tmp/x"})++ it "parses auth login --log-bodies" $+ parseCmd ["auth", "login", "--log-bodies"]+ `endsRight` AuthCmd (AuthLogin defaultOpts{optLogBodies = True})++ it "parses auth login --redact" $+ parseCmd ["auth", "login", "--redact"]+ `endsRight` AuthCmd (AuthLogin defaultOpts{optRedact = True})
+ test/Hstratus/Cli/DriveSpec.hs view
@@ -0,0 +1,420 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Hstratus.Cli.DriveSpec+Copyright : (c) 2026 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Tests for the iCloud Drive CLI subcommands.+-}+module Hstratus.Cli.DriveSpec (spec) where++import Data.Either (isLeft)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import Data.Time (UTCTime (..), fromGregorian, secondsToDiffTime)+import Hstratus.Cli (TopCommand (..), cliParser)+import Hstratus.Cli.Drive+ ( CpDest (..)+ , CpOpts (..)+ , DriveCommand (..)+ , LsFilter (..)+ , LsFormat (..)+ , LsOpts (..)+ , LsSort (..)+ , displayNode+ , displayNodes+ , filterNodes+ , formatSize+ , nodeDate+ , nodeDisplaySize+ , nodeName+ , resolveLocalDest+ , sortNodes+ )+import Network.HStratus.Drive (DriveNode (..), FileData (..), FolderData (..))+import Network.HStratus.Http.Cli (CommonOpts (..))+import Options.Applicative+ ( ParserResult (..)+ , defaultPrefs+ , execParserPure+ , renderFailure+ )+import System.Directory (getHomeDirectory)+import System.FilePath ((</>))+import Test.Hspec+import Test.Hspec.Benri (endsRight)+++parseCmd :: [String] -> IO (Either String TopCommand)+parseCmd args =+ pure $ case execParserPure defaultPrefs cliParser args of+ Success cmd -> Right cmd+ Failure failure -> Left (fst (renderFailure failure "test"))+ CompletionInvoked _ -> Left "completion invoked"+++defaultOpts :: CommonOpts+defaultOpts = CommonOpts False False Nothing False False+++defaultLsOpts :: LsOpts+defaultLsOpts =+ LsOpts+ { lsPath = []+ , lsFormat = LsBytes+ , lsSort = LsSortDefault+ , lsReverse = False+ , lsLong = False+ , lsIds = False+ , lsFilter = LsFilterAll+ , lsCommon = defaultOpts+ }+++defaultCpOpts :: CpOpts+defaultCpOpts = CpOpts ("report.pdf" :| []) Nothing False LsBytes defaultOpts+++-- | Two fixed UTC timestamps for sort and date tests. t2 is newer than t1.+t1 :: UTCTime+t1 = UTCTime (fromGregorian 2026 7 1) (secondsToDiffTime (10 * 3600))+++t2 :: UTCTime+t2 = UTCTime (fromGregorian 2026 7 27) (secondsToDiffTime (9 * 3600))+++mkFolder :: Text -> Maybe UTCTime -> DriveNode+mkFolder n d =+ DriveFolder+ FolderData+ { fnId = "folder-id"+ , fnEtag = "etag"+ , fnName = n+ , fnZone = "com.apple.CloudDocs"+ , fnDateCreated = d+ }+++mkFile :: Text -> Maybe UTCTime -> Maybe UTCTime -> DriveNode+mkFile n created modified =+ DriveFile+ FileData+ { fdId = "file-id"+ , fdDocId = "doc-id"+ , fdEtag = "etag"+ , fdName = n+ , fdExtension = Nothing+ , fdZone = "com.apple.CloudDocs"+ , fdSize = Nothing+ , fdDateCreated = created+ , fdDateModified = modified+ }+++testFolderNode :: DriveNode+testFolderNode =+ DriveFolder+ FolderData+ { fnId = "folder-id"+ , fnEtag = "etag"+ , fnName = "Desktop"+ , fnZone = "com.apple.CloudDocs"+ , fnDateCreated = Nothing+ }+++testFileNode :: DriveNode+testFileNode =+ DriveFile+ FileData+ { fdId = "file-id"+ , fdDocId = "doc-id"+ , fdEtag = "etag"+ , fdName = "notes"+ , fdExtension = Just "txt"+ , fdZone = "com.apple.CloudDocs"+ , fdSize = Just (1024 * 1024)+ , fdDateCreated = Nothing+ , fdDateModified = Nothing+ }+++spec :: Spec+spec = do+ describe "formatSize" $ do+ it "LsBytes 0 returns raw count" $+ formatSize LsBytes 0 `shouldBe` "0"+ it "LsBytes 1023 returns raw count" $+ formatSize LsBytes 1023 `shouldBe` "1023"+ it "LsHuman 1023 returns bytes (below 1024 threshold)" $+ formatSize LsHuman 1023 `shouldBe` "1023 bytes"+ it "LsHuman 1024 returns 1.0 KiB" $+ formatSize LsHuman 1024 `shouldBe` "1.0 KiB"+ it "LsHuman 1536 returns 1.5 KiB" $+ formatSize LsHuman 1536 `shouldBe` "1.5 KiB"+ it "LsHuman 1048576 returns 1.0 MiB" $+ formatSize LsHuman (1024 * 1024) `shouldBe` "1.0 MiB"+ it "LsSI 999 returns bytes (below 1000 threshold)" $+ formatSize LsSI 999 `shouldBe` "999 bytes"+ it "LsSI 1000 returns 1.0 KB" $+ formatSize LsSI 1000 `shouldBe` "1.0 KB"+ it "LsSI 1000000 returns 1.0 MB" $+ formatSize LsSI (1000 * 1000) `shouldBe` "1.0 MB"++ describe "displayNode type character" $ do+ it "folder node line starts with 'd'" $+ case displayNode defaultLsOpts testFolderNode of+ (c : _) -> c `shouldBe` 'd'+ [] -> expectationFailure "expected non-empty string"+ it "file node line starts with ' '" $+ case displayNode defaultLsOpts testFileNode of+ (c : _) -> c `shouldBe` ' '+ [] -> expectationFailure "expected non-empty string"++ describe "displayNode column order" $ do+ it "default: folder shows size and name" $+ displayNode defaultLsOpts (mkFolder "Desktop" Nothing)+ `shouldBe` "d 4096 Desktop"++ it "default: file with size shows size and name" $+ displayNode defaultLsOpts testFileNode+ `shouldBe` " 1048576 notes.txt"++ it "default: file with no size shows 0 and name" $+ displayNode defaultLsOpts (mkFile "notes" Nothing Nothing)+ `shouldBe` " 0 notes"++ it "--long: folder with date has 16-char date and size columns, name last" $+ displayNode defaultLsOpts{lsLong = True} (mkFolder "Desktop" (Just t1))+ `shouldBe` "d 2026-07-01 10:00 4096 Desktop"++ it "--long: folder with no date has 16 spaces for date, size column, and name last" $+ displayNode defaultLsOpts{lsLong = True} (mkFolder "Desktop" Nothing)+ `shouldBe` "d 4096 Desktop"++ it "--long: file with size has date, size right-justified, and name last" $+ displayNode defaultLsOpts{lsLong = True, lsFormat = LsHuman} testFileNode+ `shouldBe` " 1.0 MiB notes.txt"++ it "--long: file with no size shows 0 and name last" $+ displayNode defaultLsOpts{lsLong = True} (mkFile "notes" Nothing (Just t1))+ `shouldBe` " 2026-07-01 10:00 0 notes"++ describe "nodeDisplaySize" $ do+ it "folder always returns 4096" $+ nodeDisplaySize (mkFolder "Desktop" Nothing) `shouldBe` 4096++ it "file with known size returns that size" $+ nodeDisplaySize testFileNode `shouldBe` 1024 * 1024++ it "file with no size returns 0" $+ nodeDisplaySize (mkFile "notes" Nothing Nothing) `shouldBe` 0++ describe "displayNodes alignment" $ do+ it "aligns size column to the widest entry in the list" $ do+ let nodes = [mkFolder "Desktop" Nothing, testFileNode]+ case displayNodes defaultLsOpts nodes of+ [folderLine, fileLine] -> do+ folderLine `shouldBe` "d 4096 Desktop"+ fileLine `shouldBe` " 1048576 notes.txt"+ other -> expectationFailure $ "expected 2 lines, got " <> show (length other)++ it "single-node list uses no extra padding" $ do+ case displayNodes defaultLsOpts [testFileNode] of+ [line] -> line `shouldBe` " 1048576 notes.txt"+ other -> expectationFailure $ "expected 1 line, got " <> show (length other)++ it "LsHuman: equal-width sizes produce no extra padding" $ do+ let nodes = [mkFolder "Desktop" Nothing, testFileNode]+ case displayNodes defaultLsOpts{lsFormat = LsHuman} nodes of+ [folderLine, fileLine] -> do+ folderLine `shouldBe` "d 4.0 KiB Desktop"+ fileLine `shouldBe` " 1.0 MiB notes.txt"+ other -> expectationFailure $ "expected 2 lines, got " <> show (length other)++ describe "resolveLocalDest" $ do+ it "returns the exact output path when --output is set" $+ resolveLocalDest defaultCpOpts{cpDest = Just (CpDestOutput "/tmp/out.pdf")} ("report.pdf" :| [])+ `shouldReturn` "/tmp/out.pdf"++ it "mirrors the Drive path under --root DIR" $+ resolveLocalDest defaultCpOpts{cpDest = Just (CpDestRoot "/tmp/dl")} ("Documents" :| ["report.pdf"])+ `shouldReturn` "/tmp/dl/Documents/report.pdf"++ it "uses ~/icloud-drive as the default destination" $ do+ home <- getHomeDirectory+ resolveLocalDest defaultCpOpts ("Documents" :| ["report.pdf"])+ `shouldReturn` home </> "icloud-drive" </> "Documents/report.pdf"++ describe "sortNodes" $ do+ it "LsSortName False sorts alphabetically by display name" $ do+ let nodes = [mkFolder "Zebra" Nothing, mkFile "apple" Nothing Nothing, mkFolder "Banana" Nothing]+ map nodeName (sortNodes LsSortName False nodes) `shouldBe` ["Banana", "Zebra", "apple"]++ it "LsSortName True sorts in reversed alphabetical order" $ do+ let nodes = [mkFolder "Zebra" Nothing, mkFile "apple" Nothing Nothing, mkFolder "Banana" Nothing]+ map nodeName (sortNodes LsSortName True nodes) `shouldBe` ["apple", "Zebra", "Banana"]++ it "LsSortDate False puts newest first when files have fdDateModified" $ do+ let nodes = [mkFile "old" (Just t1) (Just t1), mkFile "new" (Just t2) (Just t2)]+ map nodeName (sortNodes LsSortDate False nodes) `shouldBe` ["new", "old"]++ it "LsSortDate True puts oldest first" $ do+ let nodes = [mkFile "old" (Just t1) (Just t1), mkFile "new" (Just t2) (Just t2)]+ map nodeName (sortNodes LsSortDate True nodes) `shouldBe` ["old", "new"]++ it "LsSortDate False uses fdDateModified for files and fnDateCreated for folders" $ do+ let folder = mkFolder "Folder" (Just t1)+ file = mkFile "file" (Just t1) (Just t2)+ map nodeName (sortNodes LsSortDate False [folder, file]) `shouldBe` ["file", "Folder"]++ it "LsSortDate False falls back to fdDateCreated when fdDateModified is Nothing" $ do+ let fileCreatedLate = mkFile "file" (Just t2) Nothing+ fileModifiedEarly = mkFile "earlier" (Just t1) (Just t1)+ map nodeName (sortNodes LsSortDate False [fileModifiedEarly, fileCreatedLate])+ `shouldBe` ["file", "earlier"]++ it "LsSortDate False puts nodes with no date last" $ do+ let fileNoDate = mkFile "no-date" Nothing Nothing+ fileWithDate = mkFile "has-date" (Just t1) (Just t1)+ map nodeName (sortNodes LsSortDate False [fileNoDate, fileWithDate])+ `shouldBe` ["has-date", "no-date"]++ it "LsSortDefault False preserves input order" $ do+ let nodes = [mkFolder "B" Nothing, mkFile "a" Nothing Nothing, mkFolder "C" Nothing]+ sortNodes LsSortDefault False nodes `shouldBe` nodes++ describe "filterNodes" $ do+ it "LsFilterFolders returns only folders" $ do+ let mixed = [mkFolder "Folder" Nothing, mkFile "file" Nothing Nothing]+ filterNodes LsFilterFolders mixed `shouldBe` [mkFolder "Folder" Nothing]++ it "LsFilterFiles returns only files" $ do+ let mixed = [mkFolder "Folder" Nothing, mkFile "file" Nothing Nothing]+ filterNodes LsFilterFiles mixed `shouldBe` [mkFile "file" Nothing Nothing]++ it "LsFilterAll returns the list unchanged" $ do+ let mixed = [mkFolder "Folder" Nothing, mkFile "file" Nothing Nothing]+ filterNodes LsFilterAll mixed `shouldBe` mixed++ describe "nodeDate" $ do+ it "folder returns fnDateCreated" $+ nodeDate (mkFolder "F" (Just t1)) `shouldBe` Just t1++ it "file with fdDateModified returns fdDateModified" $+ nodeDate (mkFile "f" (Just t1) (Just t2)) `shouldBe` Just t2++ it "file with fdDateModified = Nothing returns fdDateCreated" $+ nodeDate (mkFile "f" (Just t1) Nothing) `shouldBe` Just t1++ it "file with both dates Nothing returns Nothing" $+ nodeDate (mkFile "f" Nothing Nothing) `shouldBe` Nothing++ describe "drive parser" $ do+ it "parses drive ls with no argument (root)" $+ parseCmd ["drive", "ls"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts)++ it "parses drive ls PATH" $+ parseCmd ["drive", "ls", "Documents/Work"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsPath = ["Documents", "Work"]})++ it "parses drive ls PATH with common flags" $+ parseCmd ["drive", "ls", "Documents", "--china", "--log"]+ `endsRight` DriveCmd+ (DriveLs defaultLsOpts{lsPath = ["Documents"], lsCommon = defaultOpts{optChina = True, optLog = True}})++ it "treats a leading slash in PATH as root listing" $+ parseCmd ["drive", "ls", "/Documents/Work"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsPath = ["Documents", "Work"]})++ it "drive ls has lsFormat = LsBytes by default" $+ parseCmd ["drive", "ls"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts)++ it "drive ls --human sets lsFormat = LsHuman" $+ parseCmd ["drive", "ls", "--human"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsFormat = LsHuman})++ it "drive ls --si sets lsFormat = LsSI" $+ parseCmd ["drive", "ls", "--si"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsFormat = LsSI})++ it "drive ls --human --si fails (mutual exclusion)" $ do+ result <- parseCmd ["drive", "ls", "--human", "--si"]+ result `shouldSatisfy` isLeft++ it "parses drive cp PATH with no dest option" $+ parseCmd ["drive", "cp", "Documents/report.pdf"]+ `endsRight` DriveCmd+ (DriveCp (CpOpts ("Documents" :| ["report.pdf"]) Nothing False LsBytes defaultOpts))++ it "parses drive cp PATH --root DIR" $+ parseCmd ["drive", "cp", "Documents/Work/report.pdf", "--root", "/tmp/dl"]+ `endsRight` DriveCmd+ (DriveCp (CpOpts ("Documents" :| ["Work", "report.pdf"]) (Just (CpDestRoot "/tmp/dl")) False LsBytes defaultOpts))++ it "parses drive cp PATH --output FILE" $+ parseCmd ["drive", "cp", "Documents/report.pdf", "--output", "/tmp/report.pdf"]+ `endsRight` DriveCmd+ (DriveCp (CpOpts ("Documents" :| ["report.pdf"]) (Just (CpDestOutput "/tmp/report.pdf")) False LsBytes defaultOpts))++ it "parses drive cp single-segment PATH" $+ parseCmd ["drive", "cp", "report.pdf"]+ `endsRight` DriveCmd+ (DriveCp (CpOpts ("report.pdf" :| []) Nothing False LsBytes defaultOpts))++ it "drive cp PATH has cpVerbose = False, cpFormat = LsBytes by default" $+ parseCmd ["drive", "cp", "report.pdf"]+ `endsRight` DriveCmd (DriveCp (CpOpts ("report.pdf" :| []) Nothing False LsBytes defaultOpts))++ it "drive cp PATH --verbose sets cpVerbose = True" $+ parseCmd ["drive", "cp", "report.pdf", "--verbose"]+ `endsRight` DriveCmd (DriveCp (CpOpts ("report.pdf" :| []) Nothing True LsBytes defaultOpts))++ it "drive cp PATH --verbose --human sets cpFormat = LsHuman" $+ parseCmd ["drive", "cp", "report.pdf", "--verbose", "--human"]+ `endsRight` DriveCmd (DriveCp (CpOpts ("report.pdf" :| []) Nothing True LsHuman defaultOpts))++ it "rejects --root and --output together at parse time" $ do+ result <- parseCmd ["drive", "cp", "Documents/report.pdf", "--root", "/tmp/dl", "--output", "/tmp/out.pdf"]+ result `shouldSatisfy` isLeft++ it "drive ls --sort=name sets lsSort = LsSortName" $+ parseCmd ["drive", "ls", "--sort=name"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsSort = LsSortName})++ it "drive ls --sort=date sets lsSort = LsSortDate" $+ parseCmd ["drive", "ls", "--sort=date"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsSort = LsSortDate})++ it "drive ls --sort=unknown fails" $ do+ result <- parseCmd ["drive", "ls", "--sort=unknown"]+ result `shouldSatisfy` isLeft++ it "drive ls --reverse sets lsReverse = True" $+ parseCmd ["drive", "ls", "--reverse"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsReverse = True})++ it "drive ls --long sets lsLong = True" $+ parseCmd ["drive", "ls", "--long"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsLong = True})++ it "drive ls --ids sets lsIds = True" $+ parseCmd ["drive", "ls", "--ids"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsIds = True})++ it "drive ls --folders-only sets lsFilter = LsFilterFolders" $+ parseCmd ["drive", "ls", "--folders-only"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsFilter = LsFilterFolders})++ it "drive ls --files-only sets lsFilter = LsFilterFiles" $+ parseCmd ["drive", "ls", "--files-only"]+ `endsRight` DriveCmd (DriveLs defaultLsOpts{lsFilter = LsFilterFiles})++ it "drive ls --folders-only --files-only fails (mutual exclusion)" $ do+ result <- parseCmd ["drive", "ls", "--folders-only", "--files-only"]+ result `shouldSatisfy` isLeft
+ test/Hstratus/Cli/NotesSpec.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Hstratus.Cli.NotesSpec+Copyright : (c) 2026 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD-3-Clause++Tests for the Notes CLI subcommand parser, folder-name helpers, and filename+allocation utilities in 'Hstratus.Cli.Notes'.+-}+module Hstratus.Cli.NotesSpec (spec) where++import Hstratus.Cli (TopCommand (..), cliParser)+import Hstratus.Cli.Notes+ ( ExportFolderDest (..)+ , ExportFolderOpts (..)+ , GetFormat (..)+ , GetOpts (..)+ , ListNotesOpts (..)+ , NotesCommand (..)+ , findFolderByName+ , noteBasename+ , resolveExportDest+ , uniqueBasenames+ )+import Network.HStratus.Http.Cli (CommonOpts (..))+import Network.HStratus.Notes.Note (FolderId (..), NoteFolder (..), NoteId (..))+import Options.Applicative+ ( ParserResult (..)+ , defaultPrefs+ , execParserPure+ , renderFailure+ )+import Test.Hspec+import Test.Hspec.Benri (endsLeft_, endsRight)+++parseCmd :: [String] -> IO (Either String TopCommand)+parseCmd args =+ pure $ case execParserPure defaultPrefs cliParser args of+ Success cmd -> Right cmd+ Failure failure -> Left (fst (renderFailure failure "test"))+ CompletionInvoked _ -> Left "completion invoked"+++defaultOpts :: CommonOpts+defaultOpts = CommonOpts False False Nothing False False+++spec :: Spec+spec = do+ describe "notes parser" $ do+ it "parses notes list-note-folders" $+ parseCmd ["notes", "list-note-folders"]+ `endsRight` NotesCmd (NotesListFolders defaultOpts)++ it "parses notes list-notes --folder NAME" $+ parseCmd ["notes", "list-notes", "--folder", "TukTuk"]+ `endsRight` NotesCmd (NotesListNotes (ListNotesOpts (Just "TukTuk") defaultOpts))++ it "parses notes get NOTE_ID (default format is markdown)" $+ parseCmd ["notes", "get", "Note/ABCD-1234"]+ `endsRight` NotesCmd (NotesGet (GetOpts (NoteId "Note/ABCD-1234") GetMarkdown defaultOpts))++ it "parses notes get NOTE_ID --format markdown" $+ parseCmd ["notes", "get", "Note/ABCD-1234", "--format", "markdown"]+ `endsRight` NotesCmd (NotesGet (GetOpts (NoteId "Note/ABCD-1234") GetMarkdown defaultOpts))++ it "parses notes get NOTE_ID --format text" $+ parseCmd ["notes", "get", "Note/ABCD-1234", "--format", "text"]+ `endsRight` NotesCmd (NotesGet (GetOpts (NoteId "Note/ABCD-1234") GetText defaultOpts))++ it "parses notes get NOTE_ID with --china" $+ parseCmd ["notes", "get", "Note/ABCD-1234", "--china"]+ `endsRight` NotesCmd (NotesGet (GetOpts (NoteId "Note/ABCD-1234") GetMarkdown defaultOpts{optChina = True}))++ it "rejects notes get with no argument" $ do+ endsLeft_ $ parseCmd ["notes", "get"]++ it "rejects notes get with unknown --format value" $ do+ endsLeft_ $ parseCmd ["notes", "get", "Note/ABCD-1234", "--format", "html"]++ describe "notes export-folder parser" $ do+ it "parses export-folder FOLDER with defaults" $+ parseCmd ["notes", "export-folder", "TukTuk"]+ `endsRight` NotesCmd+ (NotesExportFolder (ExportFolderOpts "TukTuk" Nothing GetMarkdown defaultOpts))++ it "parses export-folder FOLDER --root DIR" $+ parseCmd ["notes", "export-folder", "TukTuk", "--root", "/data"]+ `endsRight` NotesCmd+ (NotesExportFolder (ExportFolderOpts "TukTuk" (Just (ExportFolderRoot "/data")) GetMarkdown defaultOpts))++ it "parses export-folder FOLDER --output DIR" $+ parseCmd ["notes", "export-folder", "TukTuk", "--output", "/tmp/out"]+ `endsRight` NotesCmd+ (NotesExportFolder (ExportFolderOpts "TukTuk" (Just (ExportFolderOutput "/tmp/out")) GetMarkdown defaultOpts))++ it "parses export-folder FOLDER --format text" $+ parseCmd ["notes", "export-folder", "TukTuk", "--format", "text"]+ `endsRight` NotesCmd+ (NotesExportFolder (ExportFolderOpts "TukTuk" Nothing GetText defaultOpts))++ it "parses export-folder FOLDER --format markdown" $+ parseCmd ["notes", "export-folder", "TukTuk", "--format", "markdown"]+ `endsRight` NotesCmd+ (NotesExportFolder (ExportFolderOpts "TukTuk" Nothing GetMarkdown defaultOpts))++ it "rejects export-folder with unknown --format value" $+ endsLeft_ $+ parseCmd ["notes", "export-folder", "TukTuk", "--format", "html"]++ it "rejects export-folder with no FOLDER argument" $+ endsLeft_ $+ parseCmd ["notes", "export-folder"]++ describe "noteBasename" $ do+ it "plain ASCII title produces a hyphenated lowercase slug" $+ noteBasename "Shopping List" `shouldBe` "shopping-list"+ it "punctuation becomes hyphens with consecutive runs collapsed" $+ noteBasename "Hello, World!!!" `shouldBe` "hello-world"+ it "leading and trailing non-alphanumeric characters are stripped" $+ noteBasename " --Title-- " `shouldBe` "title"+ it "empty title returns untitled" $+ noteBasename "" `shouldBe` "untitled"+ it "non-ASCII letters pass isAlphaNum and are preserved casefolded" $+ noteBasename "Café" `shouldBe` "café"++ describe "uniqueBasenames" $ do+ it "single Nothing title yields [untitled]" $+ uniqueBasenames [Nothing] `shouldBe` ["untitled"]+ it "all distinct titles are returned unchanged" $+ uniqueBasenames [Just "Alpha", Just "Beta"] `shouldBe` ["alpha", "beta"]+ it "duplicate title: first keeps bare slug, second gets -2" $+ uniqueBasenames [Just "foo", Just "foo"] `shouldBe` ["foo", "foo-2"]+ it "three identical titles: bare, -2, -3" $+ uniqueBasenames [Just "foo", Just "foo", Just "foo"] `shouldBe` ["foo", "foo-2", "foo-3"]+ it "natural slug collides with a suffix-generated one" $+ uniqueBasenames [Just "foo", Just "foo", Just "foo-2"]+ `shouldBe` ["foo", "foo-2", "foo-2-2"]+ it "suffix-generated slug collides with an earlier natural slug" $+ uniqueBasenames [Just "foo-2", Just "foo", Just "foo"]+ `shouldBe` ["foo-2", "foo", "foo-3"]+ it "mix of Nothing and Just titles with untitled collision" $+ uniqueBasenames [Nothing, Nothing, Just "untitled"]+ `shouldBe` ["untitled", "untitled-2", "untitled-3"]++ describe "resolveExportDest" $ do+ it "ExportFolderOutput returns the directory unchanged" $+ resolveExportDest (Just (ExportFolderOutput "/tmp/out")) "any folder"+ `shouldReturn` "/tmp/out"+ it "ExportFolderRoot appends the folder slug to the root" $+ resolveExportDest (Just (ExportFolderRoot "/data")) "My Notes"+ `shouldReturn` "/data/my-notes"+ it "ExportFolderRoot uses untitled slug when name slugs to empty" $+ resolveExportDest (Just (ExportFolderRoot "/data")) "!!!"+ `shouldReturn` "/data/untitled"++ describe "findFolderByName" $ do+ it "returns Just FolderId on an exact-case match" $+ findFolderByName "Work" testFolders `shouldBe` Just (FolderId "Folder/WORK")++ it "returns Just FolderId on a case-insensitive match" $+ findFolderByName "work" testFolders `shouldBe` Just (FolderId "Folder/WORK")++ it "returns Nothing when no folder matches" $+ findFolderByName "Missing" testFolders `shouldBe` Nothing++ it "returns Nothing for a folder whose name is absent" $+ findFolderByName "Work" [NoteFolder (FolderId "Folder/UNNAMED") Nothing] `shouldBe` Nothing+++testFolders :: [NoteFolder]+testFolders =+ [ NoteFolder (FolderId "Folder/WORK") (Just "Work")+ , NoteFolder (FolderId "Folder/PERSONAL") (Just "Personal")+ ]
+ test/Spec.hs view
@@ -0,0 +1,22 @@+module Main where++import qualified Hstratus.Cli.AuthSpec as Auth+import qualified Hstratus.Cli.DriveSpec as Drive+import qualified Hstratus.Cli.NotesSpec as Notes+import System.IO+ ( BufferMode (..)+ , hSetBuffering+ , stderr+ , stdout+ )+import Test.Hspec+++main :: IO ()+main = do+ hSetBuffering stdout NoBuffering+ hSetBuffering stderr NoBuffering+ hspec $ do+ Auth.spec+ Drive.spec+ Notes.spec