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

#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
  , readFileBlocking
  , runParsecParser
  , textShow
  , writeSecrets
  ) where

import           Prelude

import           Control.Exception (bracket)
import           Control.Monad (forM_)
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as LBS
import           Data.Maybe.Strict
import           Data.Text (Text)
import qualified Data.Text as Text
import           GHC.IO.Handle.FD (openFileBlocking)
import qualified Options.Applicative as Opt
import           System.FilePath ((</>))
import           System.IO (IOMode (ReadMode), hClose)
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)
#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

readFileBlocking :: FilePath -> IO BS.ByteString
readFileBlocking :: String -> IO ByteString
readFileBlocking String
path = IO Handle
-> (Handle -> IO ()) -> (Handle -> IO ByteString) -> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
  (String -> IOMode -> IO Handle
openFileBlocking String
path IOMode
ReadMode)
  Handle -> IO ()
hClose
  (\Handle
fp -> do
    -- An arbitrary block size.
    let blockSize :: Int
blockSize = Int
4096
    let go :: Builder -> IO Builder
go Builder
acc = do
          ByteString
next <- Handle -> Int -> IO ByteString
BS.hGet Handle
fp Int
blockSize
          if ByteString -> Bool
BS.null ByteString
next
          then Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
acc
          else Builder -> IO Builder
go (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
next)
    Builder
contents <- Builder -> IO Builder
go Builder
forall a. Monoid a => a
mempty
    ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString Builder
contents)

textShow :: Show a => a -> Text
textShow :: a -> Text
textShow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show