Options.hs

module ExampleClient.Options (
    GlobalOpts(..)
  , Command(..)
  , NewOnly
  , getOptions
    -- * Re-exports
  , URI
  ) where

import Data.List (isPrefixOf)
import Network.URI (URI, parseURI)
import Options.Applicative
import System.IO.Unsafe (unsafePerformIO)

import Distribution.Package
import Distribution.Text

import Hackage.Security.Client
import Hackage.Security.Util.Path

{-------------------------------------------------------------------------------
  Datatypes
-------------------------------------------------------------------------------}

data GlobalOpts = GlobalOpts {
    -- | Path to the repository (local or remote)
    globalRepo :: Either (Path Absolute) URI

    -- | Directory to store the client cache
  , globalCache :: Path Absolute

    -- | HTTP client to use
  , globalHttpClient :: String

    -- | Trusted root key (used for bootstrapping)
  , globalRootKeys :: [KeyId]

    -- | Should we check expiry times?
  , globalCheckExpiry :: Bool

    -- | Command to execute
  , globalCommand :: Command
  }

data Command =
    -- | Get initial root info
    Bootstrap KeyThreshold

    -- | Check for updates on the server
  | Check

    -- | Download a specific package
  | Get PackageIdentifier

    -- | Enumerate the entries in the index
  | EnumIndex NewOnly

    -- | Extract a cabal file from the index
  | GetCabal PackageIdentifier

    -- | Read a package hash from the index
  | GetHash PackageIdentifier
  deriving Show

type NewOnly = Bool

{-------------------------------------------------------------------------------
  Parsers
-------------------------------------------------------------------------------}

getOptions :: IO GlobalOpts
getOptions = execParser opts
  where
    opts = info (helper <*> parseGlobalOptions) $ mconcat [
        fullDesc
      , header "Example Hackage client"
      ]

parseBootstrap :: Parser Command
parseBootstrap = Bootstrap <$> argument readKeyThreshold (metavar "THRESHOLD")

parseCheck :: Parser Command
parseCheck = pure Check

parseGet :: Parser Command
parseGet = Get <$> argument readPackageIdentifier (metavar "PKG")

parseEnumIndex :: Parser Command
parseEnumIndex = EnumIndex
  <$> (switch $ mconcat [
      long "new-only"
    , help "Only enumerate entries since last call to enum-index"
    ])

parseGetCabal :: Parser Command
parseGetCabal = GetCabal <$> argument readPackageIdentifier (metavar "PKG")

parseGetHash :: Parser Command
parseGetHash = GetHash <$> argument readPackageIdentifier (metavar "PKG")

parseGlobalOptions :: Parser GlobalOpts
parseGlobalOptions = GlobalOpts
  <$> (option (str >>= readRepo) $ mconcat [
          long "repo"
        , metavar "URL"
        , help "Location of the repository"
        ])
  <*> (option (str >>= readAbsolutePath) $ mconcat [
          long "cache"
        , metavar "PATH"
        , help "Path to client cache"
        ])
  <*> (strOption $ mconcat [
         long "http-client"
       , metavar "CLIENT"
       , value "HTTP"
       , showDefault
       , help "HTTP client to use (currently supported: HTTP, http-conduit, curl)"
       ])
  <*> (many . option readKeyId $ mconcat [
         long "root-key"
       , metavar "KEYID"
       , help "Root key (used for bootstrapping; can be used multiple times)"
       ])
  <*> (switch $ mconcat [
         long "ignore-expiry"
       , help "Don't check expiry dates (should only be used in exceptional circumstances)"
       ])
  <*> (subparser $ mconcat [
          command "bootstrap" $ info (helper <*> parseBootstrap) $
            progDesc "Get the initial root information. If using a key threshold larger than 0, you will need to use the --root-key option to specify one or more trusted root keys."
        , command "check" $ info (helper <*> parseCheck) $
            progDesc "Check for updates"
        , command "get" $ info (helper <*> parseGet) $
            progDesc "Download a package"
        , command "enum-index" $ info (helper <*> parseEnumIndex) $
            progDesc "Enumerate the index"
        , command "cabal" $ info (helper <*> parseGetCabal) $
            progDesc "Extract a cabal file from the index"
        , command "hash" $ info (helper <*> parseGetHash) $
            progDesc "Read a package hash from the index"
        ])

readKeyId :: ReadM KeyId
readKeyId = KeyId <$> str

readKeyThreshold :: ReadM KeyThreshold
readKeyThreshold = KeyThreshold <$> auto

readPackageIdentifier :: ReadM PackageIdentifier
readPackageIdentifier = do
    raw <- str
    case simpleParse raw of
      Just pkgId -> return pkgId
      Nothing    -> fail $ "Invalid package ID " ++ show raw

-- Sadly, cannot do I/O actions inside ReadM
readAbsolutePath :: String -> ReadM (Path Absolute)
readAbsolutePath = return . unsafePerformIO . makeAbsolute . fromFilePath

readRepo :: String -> ReadM (Either (Path Absolute) URI)
readRepo filePath =
    if "http://" `isPrefixOf` filePath
      then Right <$> readURI filePath
      else Left <$> readAbsolutePath filePath

readURI :: String -> ReadM URI
readURI uriStr =
   case parseURI uriStr of
     Nothing  -> fail $ "Invalid URI " ++ show uriStr
     Just uri -> return uri