{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}

#if !defined(mingw32_HOST_OS)
#define UNIX
#endif

-- | Internal utils for the other Api modules
--
module Cardano.Api.Utils
  ( (?!)
  , (?!.)
  , formatParsecError
  , failEither
  , failEitherWith
  , noInlineMaybeToStrictMaybe
  , note
  , parseFilePath
  , runParsecParser
  , writeSecrets
  ) where

import           Prelude

import           Control.Monad (forM_)
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString as BS
import           Data.Maybe.Strict
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Text.Parsec as Parsec
import qualified Text.Parsec.String as Parsec
import qualified Text.ParserCombinators.Parsec.Error as Parsec
import           Text.Printf (printf)
import qualified Options.Applicative as Opt
import           System.FilePath ((</>))
#ifdef UNIX
import           System.Posix.Files (ownerReadMode, setFileMode)
#else
import           System.Directory (emptyPermissions, readable, setPermissions)
#endif

(?!) :: Maybe a -> e -> Either e a
Maybe a
Nothing ?! :: Maybe a -> e -> Either e a
?! e
e = e -> Either e a
forall a b. a -> Either a b
Left e
e
Just a
x  ?! e
_ = a -> Either e a
forall a b. b -> Either a b
Right a
x

(?!.) :: Either e a -> (e -> e') -> Either e' a
Left  e
e ?!. :: Either e a -> (e -> e') -> Either e' a
?!. e -> e'
f = e' -> Either e' a
forall a b. a -> Either a b
Left (e -> e'
f e
e)
Right a
x ?!. e -> e'
_ = a -> Either e' a
forall a b. b -> Either a b
Right a
x

{-# NOINLINE noInlineMaybeToStrictMaybe #-}
noInlineMaybeToStrictMaybe :: Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe :: Maybe a -> StrictMaybe a
noInlineMaybeToStrictMaybe Maybe a
Nothing = StrictMaybe a
forall a. StrictMaybe a
SNothing
noInlineMaybeToStrictMaybe (Just a
x) = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
x

formatParsecError :: Parsec.ParseError -> String
formatParsecError :: ParseError -> String
formatParsecError ParseError
err =
  String
-> String -> String -> String -> String -> [Message] -> String
Parsec.showErrorMessages String
"or" String
"unknown parse error"
    String
"expecting" String
"unexpected" String
"end of input"
    ([Message] -> String) -> [Message] -> String
forall a b. (a -> b) -> a -> b
$ ParseError -> [Message]
Parsec.errorMessages ParseError
err

runParsecParser :: Parsec.Parser a -> Text -> Aeson.Parser a
runParsecParser :: Parser a -> Text -> Parser a
runParsecParser Parser a
parser Text
input =
  case Parser a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
Parsec.parse (Parser a
parser Parser a -> ParsecT String () Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
Parsec.eof) String
"" (Text -> String
Text.unpack Text
input) of
    Right a
txin -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
txin
    Left ParseError
parseError -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ ParseError -> String
formatParsecError ParseError
parseError

failEither :: MonadFail m => Either String a -> m a
failEither :: Either String a -> m a
failEither = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

failEitherWith :: MonadFail m => (e -> String) -> Either e a -> m a
failEitherWith :: (e -> String) -> Either e a -> m a
failEitherWith e -> String
f = (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (e -> String) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
f) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

note :: MonadFail m => String -> Maybe a -> m a
note :: String -> Maybe a -> m a
note String
msg = \case
  Maybe a
Nothing -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
  Just a
a -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

parseFilePath :: String -> String -> Opt.Parser FilePath
parseFilePath :: String -> String -> Parser String
parseFilePath String
optname String
desc =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
    ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
optname
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILEPATH"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
desc
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
Opt.completer (String -> Completer
Opt.bashCompleter String
"file")
    )

writeSecrets :: FilePath -> [Char] -> [Char] -> (a -> BS.ByteString) -> [a] -> IO ()
writeSecrets :: String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
outDir String
prefix String
suffix a -> ByteString
secretOp [a]
xs =
  [(a, Int)] -> ((a, Int) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [Int
0::Int ..]) (((a, Int) -> IO ()) -> IO ()) -> ((a, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \(a
secret, Int
nr)-> do
    let filename :: String
filename = String
outDir String -> String -> String
</> String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03d" Int
nr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix
    String -> ByteString -> IO ()
BS.writeFile String
filename (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
secretOp a
secret
#ifdef UNIX
    String -> FileMode -> IO ()
setFileMode    String
filename FileMode
ownerReadMode
#else
    setPermissions filename (emptyPermissions {readable = True})
#endif