module B9.B9Config.Repository
  ( RemoteRepo (..),
    remoteRepoRepoId,
    RepoCache (..),
    SshPrivKey (..),
    SshRemoteHost (..),
    SshRemoteUser (..),
    remoteRepoToCPDocument,
    parseRemoteRepos,
  )
where

import Data.ConfigFile.B9Extras
import Data.Data
import Data.List (isSuffixOf, sort)
import Test.QuickCheck (Positive(..), Arbitrary(arbitrary), listOf1)
import B9.QCUtil (smaller, arbitraryFilePath, arbitraryLetter)

newtype RepoCache = RepoCache FilePath
  deriving (ReadPrec [RepoCache]
ReadPrec RepoCache
Int -> ReadS RepoCache
ReadS [RepoCache]
(Int -> ReadS RepoCache)
-> ReadS [RepoCache]
-> ReadPrec RepoCache
-> ReadPrec [RepoCache]
-> Read RepoCache
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RepoCache]
$creadListPrec :: ReadPrec [RepoCache]
readPrec :: ReadPrec RepoCache
$creadPrec :: ReadPrec RepoCache
readList :: ReadS [RepoCache]
$creadList :: ReadS [RepoCache]
readsPrec :: Int -> ReadS RepoCache
$creadsPrec :: Int -> ReadS RepoCache
Read, Int -> RepoCache -> ShowS
[RepoCache] -> ShowS
RepoCache -> String
(Int -> RepoCache -> ShowS)
-> (RepoCache -> String)
-> ([RepoCache] -> ShowS)
-> Show RepoCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoCache] -> ShowS
$cshowList :: [RepoCache] -> ShowS
show :: RepoCache -> String
$cshow :: RepoCache -> String
showsPrec :: Int -> RepoCache -> ShowS
$cshowsPrec :: Int -> RepoCache -> ShowS
Show, Typeable, Typeable RepoCache
DataType
Constr
Typeable RepoCache
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RepoCache -> c RepoCache)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RepoCache)
-> (RepoCache -> Constr)
-> (RepoCache -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RepoCache))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoCache))
-> ((forall b. Data b => b -> b) -> RepoCache -> RepoCache)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RepoCache -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RepoCache -> r)
-> (forall u. (forall d. Data d => d -> u) -> RepoCache -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RepoCache -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RepoCache -> m RepoCache)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RepoCache -> m RepoCache)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RepoCache -> m RepoCache)
-> Data RepoCache
RepoCache -> DataType
RepoCache -> Constr
(forall b. Data b => b -> b) -> RepoCache -> RepoCache
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoCache -> c RepoCache
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoCache
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RepoCache -> u
forall u. (forall d. Data d => d -> u) -> RepoCache -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoCache -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoCache -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoCache -> m RepoCache
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoCache -> m RepoCache
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoCache
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoCache -> c RepoCache
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoCache)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoCache)
$cRepoCache :: Constr
$tRepoCache :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RepoCache -> m RepoCache
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoCache -> m RepoCache
gmapMp :: (forall d. Data d => d -> m d) -> RepoCache -> m RepoCache
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoCache -> m RepoCache
gmapM :: (forall d. Data d => d -> m d) -> RepoCache -> m RepoCache
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoCache -> m RepoCache
gmapQi :: Int -> (forall d. Data d => d -> u) -> RepoCache -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RepoCache -> u
gmapQ :: (forall d. Data d => d -> u) -> RepoCache -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RepoCache -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoCache -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoCache -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoCache -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoCache -> r
gmapT :: (forall b. Data b => b -> b) -> RepoCache -> RepoCache
$cgmapT :: (forall b. Data b => b -> b) -> RepoCache -> RepoCache
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoCache)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoCache)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RepoCache)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoCache)
dataTypeOf :: RepoCache -> DataType
$cdataTypeOf :: RepoCache -> DataType
toConstr :: RepoCache -> Constr
$ctoConstr :: RepoCache -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoCache
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoCache
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoCache -> c RepoCache
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoCache -> c RepoCache
$cp1Data :: Typeable RepoCache
Data)

data RemoteRepo
  = RemoteRepo
      String
      FilePath
      SshPrivKey
      SshRemoteHost
      SshRemoteUser
  deriving (ReadPrec [RemoteRepo]
ReadPrec RemoteRepo
Int -> ReadS RemoteRepo
ReadS [RemoteRepo]
(Int -> ReadS RemoteRepo)
-> ReadS [RemoteRepo]
-> ReadPrec RemoteRepo
-> ReadPrec [RemoteRepo]
-> Read RemoteRepo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoteRepo]
$creadListPrec :: ReadPrec [RemoteRepo]
readPrec :: ReadPrec RemoteRepo
$creadPrec :: ReadPrec RemoteRepo
readList :: ReadS [RemoteRepo]
$creadList :: ReadS [RemoteRepo]
readsPrec :: Int -> ReadS RemoteRepo
$creadsPrec :: Int -> ReadS RemoteRepo
Read, Int -> RemoteRepo -> ShowS
[RemoteRepo] -> ShowS
RemoteRepo -> String
(Int -> RemoteRepo -> ShowS)
-> (RemoteRepo -> String)
-> ([RemoteRepo] -> ShowS)
-> Show RemoteRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteRepo] -> ShowS
$cshowList :: [RemoteRepo] -> ShowS
show :: RemoteRepo -> String
$cshow :: RemoteRepo -> String
showsPrec :: Int -> RemoteRepo -> ShowS
$cshowsPrec :: Int -> RemoteRepo -> ShowS
Show, Typeable, Typeable RemoteRepo
DataType
Constr
Typeable RemoteRepo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RemoteRepo -> c RemoteRepo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RemoteRepo)
-> (RemoteRepo -> Constr)
-> (RemoteRepo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RemoteRepo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RemoteRepo))
-> ((forall b. Data b => b -> b) -> RemoteRepo -> RemoteRepo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RemoteRepo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RemoteRepo -> r)
-> (forall u. (forall d. Data d => d -> u) -> RemoteRepo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RemoteRepo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo)
-> Data RemoteRepo
RemoteRepo -> DataType
RemoteRepo -> Constr
(forall b. Data b => b -> b) -> RemoteRepo -> RemoteRepo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RemoteRepo -> c RemoteRepo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RemoteRepo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RemoteRepo -> u
forall u. (forall d. Data d => d -> u) -> RemoteRepo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RemoteRepo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RemoteRepo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RemoteRepo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RemoteRepo -> c RemoteRepo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RemoteRepo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RemoteRepo)
$cRemoteRepo :: Constr
$tRemoteRepo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo
gmapMp :: (forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo
gmapM :: (forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RemoteRepo -> m RemoteRepo
gmapQi :: Int -> (forall d. Data d => d -> u) -> RemoteRepo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RemoteRepo -> u
gmapQ :: (forall d. Data d => d -> u) -> RemoteRepo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RemoteRepo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RemoteRepo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RemoteRepo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RemoteRepo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RemoteRepo -> r
gmapT :: (forall b. Data b => b -> b) -> RemoteRepo -> RemoteRepo
$cgmapT :: (forall b. Data b => b -> b) -> RemoteRepo -> RemoteRepo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RemoteRepo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RemoteRepo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RemoteRepo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RemoteRepo)
dataTypeOf :: RemoteRepo -> DataType
$cdataTypeOf :: RemoteRepo -> DataType
toConstr :: RemoteRepo -> Constr
$ctoConstr :: RemoteRepo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RemoteRepo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RemoteRepo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RemoteRepo -> c RemoteRepo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RemoteRepo -> c RemoteRepo
$cp1Data :: Typeable RemoteRepo
Data, RemoteRepo -> RemoteRepo -> Bool
(RemoteRepo -> RemoteRepo -> Bool)
-> (RemoteRepo -> RemoteRepo -> Bool) -> Eq RemoteRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteRepo -> RemoteRepo -> Bool
$c/= :: RemoteRepo -> RemoteRepo -> Bool
== :: RemoteRepo -> RemoteRepo -> Bool
$c== :: RemoteRepo -> RemoteRepo -> Bool
Eq, Eq RemoteRepo
Eq RemoteRepo
-> (RemoteRepo -> RemoteRepo -> Ordering)
-> (RemoteRepo -> RemoteRepo -> Bool)
-> (RemoteRepo -> RemoteRepo -> Bool)
-> (RemoteRepo -> RemoteRepo -> Bool)
-> (RemoteRepo -> RemoteRepo -> Bool)
-> (RemoteRepo -> RemoteRepo -> RemoteRepo)
-> (RemoteRepo -> RemoteRepo -> RemoteRepo)
-> Ord RemoteRepo
RemoteRepo -> RemoteRepo -> Bool
RemoteRepo -> RemoteRepo -> Ordering
RemoteRepo -> RemoteRepo -> RemoteRepo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RemoteRepo -> RemoteRepo -> RemoteRepo
$cmin :: RemoteRepo -> RemoteRepo -> RemoteRepo
max :: RemoteRepo -> RemoteRepo -> RemoteRepo
$cmax :: RemoteRepo -> RemoteRepo -> RemoteRepo
>= :: RemoteRepo -> RemoteRepo -> Bool
$c>= :: RemoteRepo -> RemoteRepo -> Bool
> :: RemoteRepo -> RemoteRepo -> Bool
$c> :: RemoteRepo -> RemoteRepo -> Bool
<= :: RemoteRepo -> RemoteRepo -> Bool
$c<= :: RemoteRepo -> RemoteRepo -> Bool
< :: RemoteRepo -> RemoteRepo -> Bool
$c< :: RemoteRepo -> RemoteRepo -> Bool
compare :: RemoteRepo -> RemoteRepo -> Ordering
$ccompare :: RemoteRepo -> RemoteRepo -> Ordering
$cp1Ord :: Eq RemoteRepo
Ord)

instance Arbitrary RemoteRepo where 
  arbitrary :: Gen RemoteRepo
arbitrary = String
-> String
-> SshPrivKey
-> SshRemoteHost
-> SshRemoteUser
-> RemoteRepo
RemoteRepo (String
 -> String
 -> SshPrivKey
 -> SshRemoteHost
 -> SshRemoteUser
 -> RemoteRepo)
-> Gen String
-> Gen
     (String
      -> SshPrivKey -> SshRemoteHost -> SshRemoteUser -> RemoteRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Gen String -> Gen String
forall a. Gen a -> Gen a
smaller (Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 Gen Char
arbitraryLetter) Gen
  (String
   -> SshPrivKey -> SshRemoteHost -> SshRemoteUser -> RemoteRepo)
-> Gen String
-> Gen (SshPrivKey -> SshRemoteHost -> SshRemoteUser -> RemoteRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Gen String -> Gen String
forall a. Gen a -> Gen a
smaller Gen String
arbitraryFilePath Gen (SshPrivKey -> SshRemoteHost -> SshRemoteUser -> RemoteRepo)
-> Gen SshPrivKey
-> Gen (SshRemoteHost -> SshRemoteUser -> RemoteRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 
    Gen SshPrivKey -> Gen SshPrivKey
forall a. Gen a -> Gen a
smaller Gen SshPrivKey
forall a. Arbitrary a => Gen a
arbitrary Gen (SshRemoteHost -> SshRemoteUser -> RemoteRepo)
-> Gen SshRemoteHost -> Gen (SshRemoteUser -> RemoteRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Gen SshRemoteHost -> Gen SshRemoteHost
forall a. Gen a -> Gen a
smaller Gen SshRemoteHost
forall a. Arbitrary a => Gen a
arbitrary Gen (SshRemoteUser -> RemoteRepo)
-> Gen SshRemoteUser -> Gen RemoteRepo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Gen SshRemoteUser -> Gen SshRemoteUser
forall a. Gen a -> Gen a
smaller Gen SshRemoteUser
forall a. Arbitrary a => Gen a
arbitrary 


remoteRepoRepoId :: RemoteRepo -> String
remoteRepoRepoId :: RemoteRepo -> String
remoteRepoRepoId (RemoteRepo String
repoId String
_ SshPrivKey
_ SshRemoteHost
_ SshRemoteUser
_) = String
repoId

newtype SshPrivKey = SshPrivKey FilePath
  deriving (ReadPrec [SshPrivKey]
ReadPrec SshPrivKey
Int -> ReadS SshPrivKey
ReadS [SshPrivKey]
(Int -> ReadS SshPrivKey)
-> ReadS [SshPrivKey]
-> ReadPrec SshPrivKey
-> ReadPrec [SshPrivKey]
-> Read SshPrivKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SshPrivKey]
$creadListPrec :: ReadPrec [SshPrivKey]
readPrec :: ReadPrec SshPrivKey
$creadPrec :: ReadPrec SshPrivKey
readList :: ReadS [SshPrivKey]
$creadList :: ReadS [SshPrivKey]
readsPrec :: Int -> ReadS SshPrivKey
$creadsPrec :: Int -> ReadS SshPrivKey
Read, Int -> SshPrivKey -> ShowS
[SshPrivKey] -> ShowS
SshPrivKey -> String
(Int -> SshPrivKey -> ShowS)
-> (SshPrivKey -> String)
-> ([SshPrivKey] -> ShowS)
-> Show SshPrivKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SshPrivKey] -> ShowS
$cshowList :: [SshPrivKey] -> ShowS
show :: SshPrivKey -> String
$cshow :: SshPrivKey -> String
showsPrec :: Int -> SshPrivKey -> ShowS
$cshowsPrec :: Int -> SshPrivKey -> ShowS
Show, Typeable, Typeable SshPrivKey
DataType
Constr
Typeable SshPrivKey
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SshPrivKey -> c SshPrivKey)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SshPrivKey)
-> (SshPrivKey -> Constr)
-> (SshPrivKey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SshPrivKey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SshPrivKey))
-> ((forall b. Data b => b -> b) -> SshPrivKey -> SshPrivKey)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SshPrivKey -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SshPrivKey -> r)
-> (forall u. (forall d. Data d => d -> u) -> SshPrivKey -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SshPrivKey -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey)
-> Data SshPrivKey
SshPrivKey -> DataType
SshPrivKey -> Constr
(forall b. Data b => b -> b) -> SshPrivKey -> SshPrivKey
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshPrivKey -> c SshPrivKey
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshPrivKey
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SshPrivKey -> u
forall u. (forall d. Data d => d -> u) -> SshPrivKey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshPrivKey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshPrivKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshPrivKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshPrivKey -> c SshPrivKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SshPrivKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SshPrivKey)
$cSshPrivKey :: Constr
$tSshPrivKey :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey
gmapMp :: (forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey
gmapM :: (forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SshPrivKey -> m SshPrivKey
gmapQi :: Int -> (forall d. Data d => d -> u) -> SshPrivKey -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SshPrivKey -> u
gmapQ :: (forall d. Data d => d -> u) -> SshPrivKey -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SshPrivKey -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshPrivKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshPrivKey -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshPrivKey -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshPrivKey -> r
gmapT :: (forall b. Data b => b -> b) -> SshPrivKey -> SshPrivKey
$cgmapT :: (forall b. Data b => b -> b) -> SshPrivKey -> SshPrivKey
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SshPrivKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SshPrivKey)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SshPrivKey)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SshPrivKey)
dataTypeOf :: SshPrivKey -> DataType
$cdataTypeOf :: SshPrivKey -> DataType
toConstr :: SshPrivKey -> Constr
$ctoConstr :: SshPrivKey -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshPrivKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshPrivKey
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshPrivKey -> c SshPrivKey
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshPrivKey -> c SshPrivKey
$cp1Data :: Typeable SshPrivKey
Data, SshPrivKey -> SshPrivKey -> Bool
(SshPrivKey -> SshPrivKey -> Bool)
-> (SshPrivKey -> SshPrivKey -> Bool) -> Eq SshPrivKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SshPrivKey -> SshPrivKey -> Bool
$c/= :: SshPrivKey -> SshPrivKey -> Bool
== :: SshPrivKey -> SshPrivKey -> Bool
$c== :: SshPrivKey -> SshPrivKey -> Bool
Eq, Eq SshPrivKey
Eq SshPrivKey
-> (SshPrivKey -> SshPrivKey -> Ordering)
-> (SshPrivKey -> SshPrivKey -> Bool)
-> (SshPrivKey -> SshPrivKey -> Bool)
-> (SshPrivKey -> SshPrivKey -> Bool)
-> (SshPrivKey -> SshPrivKey -> Bool)
-> (SshPrivKey -> SshPrivKey -> SshPrivKey)
-> (SshPrivKey -> SshPrivKey -> SshPrivKey)
-> Ord SshPrivKey
SshPrivKey -> SshPrivKey -> Bool
SshPrivKey -> SshPrivKey -> Ordering
SshPrivKey -> SshPrivKey -> SshPrivKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SshPrivKey -> SshPrivKey -> SshPrivKey
$cmin :: SshPrivKey -> SshPrivKey -> SshPrivKey
max :: SshPrivKey -> SshPrivKey -> SshPrivKey
$cmax :: SshPrivKey -> SshPrivKey -> SshPrivKey
>= :: SshPrivKey -> SshPrivKey -> Bool
$c>= :: SshPrivKey -> SshPrivKey -> Bool
> :: SshPrivKey -> SshPrivKey -> Bool
$c> :: SshPrivKey -> SshPrivKey -> Bool
<= :: SshPrivKey -> SshPrivKey -> Bool
$c<= :: SshPrivKey -> SshPrivKey -> Bool
< :: SshPrivKey -> SshPrivKey -> Bool
$c< :: SshPrivKey -> SshPrivKey -> Bool
compare :: SshPrivKey -> SshPrivKey -> Ordering
$ccompare :: SshPrivKey -> SshPrivKey -> Ordering
$cp1Ord :: Eq SshPrivKey
Ord)

instance Arbitrary SshPrivKey where 
  arbitrary :: Gen SshPrivKey
arbitrary = String -> SshPrivKey
SshPrivKey (String -> SshPrivKey) -> Gen String -> Gen SshPrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryFilePath

newtype SshRemoteHost = SshRemoteHost (String, Int)
  deriving (ReadPrec [SshRemoteHost]
ReadPrec SshRemoteHost
Int -> ReadS SshRemoteHost
ReadS [SshRemoteHost]
(Int -> ReadS SshRemoteHost)
-> ReadS [SshRemoteHost]
-> ReadPrec SshRemoteHost
-> ReadPrec [SshRemoteHost]
-> Read SshRemoteHost
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SshRemoteHost]
$creadListPrec :: ReadPrec [SshRemoteHost]
readPrec :: ReadPrec SshRemoteHost
$creadPrec :: ReadPrec SshRemoteHost
readList :: ReadS [SshRemoteHost]
$creadList :: ReadS [SshRemoteHost]
readsPrec :: Int -> ReadS SshRemoteHost
$creadsPrec :: Int -> ReadS SshRemoteHost
Read, Int -> SshRemoteHost -> ShowS
[SshRemoteHost] -> ShowS
SshRemoteHost -> String
(Int -> SshRemoteHost -> ShowS)
-> (SshRemoteHost -> String)
-> ([SshRemoteHost] -> ShowS)
-> Show SshRemoteHost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SshRemoteHost] -> ShowS
$cshowList :: [SshRemoteHost] -> ShowS
show :: SshRemoteHost -> String
$cshow :: SshRemoteHost -> String
showsPrec :: Int -> SshRemoteHost -> ShowS
$cshowsPrec :: Int -> SshRemoteHost -> ShowS
Show, Typeable, Typeable SshRemoteHost
DataType
Constr
Typeable SshRemoteHost
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SshRemoteHost -> c SshRemoteHost)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SshRemoteHost)
-> (SshRemoteHost -> Constr)
-> (SshRemoteHost -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SshRemoteHost))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SshRemoteHost))
-> ((forall b. Data b => b -> b) -> SshRemoteHost -> SshRemoteHost)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SshRemoteHost -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SshRemoteHost -> r)
-> (forall u. (forall d. Data d => d -> u) -> SshRemoteHost -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SshRemoteHost -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost)
-> Data SshRemoteHost
SshRemoteHost -> DataType
SshRemoteHost -> Constr
(forall b. Data b => b -> b) -> SshRemoteHost -> SshRemoteHost
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshRemoteHost -> c SshRemoteHost
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshRemoteHost
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SshRemoteHost -> u
forall u. (forall d. Data d => d -> u) -> SshRemoteHost -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteHost -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteHost -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshRemoteHost
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshRemoteHost -> c SshRemoteHost
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SshRemoteHost)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SshRemoteHost)
$cSshRemoteHost :: Constr
$tSshRemoteHost :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost
gmapMp :: (forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost
gmapM :: (forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SshRemoteHost -> m SshRemoteHost
gmapQi :: Int -> (forall d. Data d => d -> u) -> SshRemoteHost -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SshRemoteHost -> u
gmapQ :: (forall d. Data d => d -> u) -> SshRemoteHost -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SshRemoteHost -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteHost -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteHost -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteHost -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteHost -> r
gmapT :: (forall b. Data b => b -> b) -> SshRemoteHost -> SshRemoteHost
$cgmapT :: (forall b. Data b => b -> b) -> SshRemoteHost -> SshRemoteHost
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SshRemoteHost)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SshRemoteHost)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SshRemoteHost)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SshRemoteHost)
dataTypeOf :: SshRemoteHost -> DataType
$cdataTypeOf :: SshRemoteHost -> DataType
toConstr :: SshRemoteHost -> Constr
$ctoConstr :: SshRemoteHost -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshRemoteHost
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshRemoteHost
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshRemoteHost -> c SshRemoteHost
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshRemoteHost -> c SshRemoteHost
$cp1Data :: Typeable SshRemoteHost
Data, SshRemoteHost -> SshRemoteHost -> Bool
(SshRemoteHost -> SshRemoteHost -> Bool)
-> (SshRemoteHost -> SshRemoteHost -> Bool) -> Eq SshRemoteHost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SshRemoteHost -> SshRemoteHost -> Bool
$c/= :: SshRemoteHost -> SshRemoteHost -> Bool
== :: SshRemoteHost -> SshRemoteHost -> Bool
$c== :: SshRemoteHost -> SshRemoteHost -> Bool
Eq, Eq SshRemoteHost
Eq SshRemoteHost
-> (SshRemoteHost -> SshRemoteHost -> Ordering)
-> (SshRemoteHost -> SshRemoteHost -> Bool)
-> (SshRemoteHost -> SshRemoteHost -> Bool)
-> (SshRemoteHost -> SshRemoteHost -> Bool)
-> (SshRemoteHost -> SshRemoteHost -> Bool)
-> (SshRemoteHost -> SshRemoteHost -> SshRemoteHost)
-> (SshRemoteHost -> SshRemoteHost -> SshRemoteHost)
-> Ord SshRemoteHost
SshRemoteHost -> SshRemoteHost -> Bool
SshRemoteHost -> SshRemoteHost -> Ordering
SshRemoteHost -> SshRemoteHost -> SshRemoteHost
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SshRemoteHost -> SshRemoteHost -> SshRemoteHost
$cmin :: SshRemoteHost -> SshRemoteHost -> SshRemoteHost
max :: SshRemoteHost -> SshRemoteHost -> SshRemoteHost
$cmax :: SshRemoteHost -> SshRemoteHost -> SshRemoteHost
>= :: SshRemoteHost -> SshRemoteHost -> Bool
$c>= :: SshRemoteHost -> SshRemoteHost -> Bool
> :: SshRemoteHost -> SshRemoteHost -> Bool
$c> :: SshRemoteHost -> SshRemoteHost -> Bool
<= :: SshRemoteHost -> SshRemoteHost -> Bool
$c<= :: SshRemoteHost -> SshRemoteHost -> Bool
< :: SshRemoteHost -> SshRemoteHost -> Bool
$c< :: SshRemoteHost -> SshRemoteHost -> Bool
compare :: SshRemoteHost -> SshRemoteHost -> Ordering
$ccompare :: SshRemoteHost -> SshRemoteHost -> Ordering
$cp1Ord :: Eq SshRemoteHost
Ord)

instance Arbitrary SshRemoteHost where 
  arbitrary :: Gen SshRemoteHost
arbitrary = do 
    String
h <- Gen String -> Gen String
forall a. Gen a -> Gen a
smaller (Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 Gen Char
arbitraryLetter)
    Positive Int
p <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
    SshRemoteHost -> Gen SshRemoteHost
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, Int) -> SshRemoteHost
SshRemoteHost (String
h,Int
p))

newtype SshRemoteUser = SshRemoteUser String
  deriving (ReadPrec [SshRemoteUser]
ReadPrec SshRemoteUser
Int -> ReadS SshRemoteUser
ReadS [SshRemoteUser]
(Int -> ReadS SshRemoteUser)
-> ReadS [SshRemoteUser]
-> ReadPrec SshRemoteUser
-> ReadPrec [SshRemoteUser]
-> Read SshRemoteUser
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SshRemoteUser]
$creadListPrec :: ReadPrec [SshRemoteUser]
readPrec :: ReadPrec SshRemoteUser
$creadPrec :: ReadPrec SshRemoteUser
readList :: ReadS [SshRemoteUser]
$creadList :: ReadS [SshRemoteUser]
readsPrec :: Int -> ReadS SshRemoteUser
$creadsPrec :: Int -> ReadS SshRemoteUser
Read, Int -> SshRemoteUser -> ShowS
[SshRemoteUser] -> ShowS
SshRemoteUser -> String
(Int -> SshRemoteUser -> ShowS)
-> (SshRemoteUser -> String)
-> ([SshRemoteUser] -> ShowS)
-> Show SshRemoteUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SshRemoteUser] -> ShowS
$cshowList :: [SshRemoteUser] -> ShowS
show :: SshRemoteUser -> String
$cshow :: SshRemoteUser -> String
showsPrec :: Int -> SshRemoteUser -> ShowS
$cshowsPrec :: Int -> SshRemoteUser -> ShowS
Show, Typeable, Typeable SshRemoteUser
DataType
Constr
Typeable SshRemoteUser
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SshRemoteUser -> c SshRemoteUser)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SshRemoteUser)
-> (SshRemoteUser -> Constr)
-> (SshRemoteUser -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SshRemoteUser))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SshRemoteUser))
-> ((forall b. Data b => b -> b) -> SshRemoteUser -> SshRemoteUser)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SshRemoteUser -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SshRemoteUser -> r)
-> (forall u. (forall d. Data d => d -> u) -> SshRemoteUser -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SshRemoteUser -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser)
-> Data SshRemoteUser
SshRemoteUser -> DataType
SshRemoteUser -> Constr
(forall b. Data b => b -> b) -> SshRemoteUser -> SshRemoteUser
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshRemoteUser -> c SshRemoteUser
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshRemoteUser
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SshRemoteUser -> u
forall u. (forall d. Data d => d -> u) -> SshRemoteUser -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteUser -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteUser -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshRemoteUser
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshRemoteUser -> c SshRemoteUser
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SshRemoteUser)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SshRemoteUser)
$cSshRemoteUser :: Constr
$tSshRemoteUser :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser
gmapMp :: (forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser
gmapM :: (forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SshRemoteUser -> m SshRemoteUser
gmapQi :: Int -> (forall d. Data d => d -> u) -> SshRemoteUser -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SshRemoteUser -> u
gmapQ :: (forall d. Data d => d -> u) -> SshRemoteUser -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SshRemoteUser -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteUser -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteUser -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteUser -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SshRemoteUser -> r
gmapT :: (forall b. Data b => b -> b) -> SshRemoteUser -> SshRemoteUser
$cgmapT :: (forall b. Data b => b -> b) -> SshRemoteUser -> SshRemoteUser
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SshRemoteUser)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SshRemoteUser)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SshRemoteUser)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SshRemoteUser)
dataTypeOf :: SshRemoteUser -> DataType
$cdataTypeOf :: SshRemoteUser -> DataType
toConstr :: SshRemoteUser -> Constr
$ctoConstr :: SshRemoteUser -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshRemoteUser
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SshRemoteUser
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshRemoteUser -> c SshRemoteUser
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SshRemoteUser -> c SshRemoteUser
$cp1Data :: Typeable SshRemoteUser
Data, SshRemoteUser -> SshRemoteUser -> Bool
(SshRemoteUser -> SshRemoteUser -> Bool)
-> (SshRemoteUser -> SshRemoteUser -> Bool) -> Eq SshRemoteUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SshRemoteUser -> SshRemoteUser -> Bool
$c/= :: SshRemoteUser -> SshRemoteUser -> Bool
== :: SshRemoteUser -> SshRemoteUser -> Bool
$c== :: SshRemoteUser -> SshRemoteUser -> Bool
Eq, Eq SshRemoteUser
Eq SshRemoteUser
-> (SshRemoteUser -> SshRemoteUser -> Ordering)
-> (SshRemoteUser -> SshRemoteUser -> Bool)
-> (SshRemoteUser -> SshRemoteUser -> Bool)
-> (SshRemoteUser -> SshRemoteUser -> Bool)
-> (SshRemoteUser -> SshRemoteUser -> Bool)
-> (SshRemoteUser -> SshRemoteUser -> SshRemoteUser)
-> (SshRemoteUser -> SshRemoteUser -> SshRemoteUser)
-> Ord SshRemoteUser
SshRemoteUser -> SshRemoteUser -> Bool
SshRemoteUser -> SshRemoteUser -> Ordering
SshRemoteUser -> SshRemoteUser -> SshRemoteUser
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SshRemoteUser -> SshRemoteUser -> SshRemoteUser
$cmin :: SshRemoteUser -> SshRemoteUser -> SshRemoteUser
max :: SshRemoteUser -> SshRemoteUser -> SshRemoteUser
$cmax :: SshRemoteUser -> SshRemoteUser -> SshRemoteUser
>= :: SshRemoteUser -> SshRemoteUser -> Bool
$c>= :: SshRemoteUser -> SshRemoteUser -> Bool
> :: SshRemoteUser -> SshRemoteUser -> Bool
$c> :: SshRemoteUser -> SshRemoteUser -> Bool
<= :: SshRemoteUser -> SshRemoteUser -> Bool
$c<= :: SshRemoteUser -> SshRemoteUser -> Bool
< :: SshRemoteUser -> SshRemoteUser -> Bool
$c< :: SshRemoteUser -> SshRemoteUser -> Bool
compare :: SshRemoteUser -> SshRemoteUser -> Ordering
$ccompare :: SshRemoteUser -> SshRemoteUser -> Ordering
$cp1Ord :: Eq SshRemoteUser
Ord)

instance Arbitrary SshRemoteUser where 
  arbitrary :: Gen SshRemoteUser
arbitrary = String -> SshRemoteUser
SshRemoteUser (String -> SshRemoteUser) -> Gen String -> Gen SshRemoteUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String -> Gen String
forall a. Gen a -> Gen a
smaller (Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 Gen Char
arbitraryLetter)

-- | Persist a repo to a configuration file.
remoteRepoToCPDocument :: RemoteRepo -> CPDocument -> Either CPError CPDocument
remoteRepoToCPDocument :: RemoteRepo -> CPDocument -> Either CPError CPDocument
remoteRepoToCPDocument RemoteRepo
repo CPDocument
cpIn = Either CPError CPDocument
cpWithRepo
  where
    section :: String
section = String
repoId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
repoSectionSuffix
    (RemoteRepo String
repoId String
remoteRootDir (SshPrivKey String
keyFile) (SshRemoteHost (String
host, Int
port)) (SshRemoteUser String
user)) =
      RemoteRepo
repo
    cpWithRepo :: Either CPError CPDocument
cpWithRepo = do
      CPDocument
cp1 <- CPDocument -> String -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> String -> m CPDocument
addSectionCP CPDocument
cpIn String
section
      CPDocument
cp2 <- CPDocument
-> String -> String -> String -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> String -> String -> String -> m CPDocument
setCP CPDocument
cp1 String
section String
repoRemotePathK String
remoteRootDir
      CPDocument
cp3 <- CPDocument
-> String -> String -> String -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> String -> String -> String -> m CPDocument
setCP CPDocument
cp2 String
section String
repoRemoteSshKeyK String
keyFile
      CPDocument
cp4 <- CPDocument
-> String -> String -> String -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> String -> String -> String -> m CPDocument
setCP CPDocument
cp3 String
section String
repoRemoteSshHostK String
host
      CPDocument
cp5 <- CPDocument -> String -> String -> Int -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp4 String
section String
repoRemoteSshPortK Int
port
      CPDocument
-> String -> String -> String -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> String -> String -> String -> m CPDocument
setCP CPDocument
cp5 String
section String
repoRemoteSshUserK String
user

-- | Load a repository from a configuration file that has been written by
-- 'writeRepositoryToB9Config'.
parseRemoteRepos :: CPDocument -> Either CPError [RemoteRepo]
parseRemoteRepos :: CPDocument -> Either CPError [RemoteRepo]
parseRemoteRepos CPDocument
cp = [RemoteRepo] -> [RemoteRepo]
forall a. Ord a => [a] -> [a]
sort ([RemoteRepo] -> [RemoteRepo])
-> Either CPError [RemoteRepo] -> Either CPError [RemoteRepo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Either CPError RemoteRepo)
-> [String] -> Either CPError [RemoteRepo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Either CPError RemoteRepo
parseRepoSection [String]
repoSections
  where
    repoSections :: [String]
repoSections = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
repoSectionSuffix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) (CPDocument -> [String]
sectionsCP CPDocument
cp)
    parseRepoSection :: String -> Either CPError RemoteRepo
parseRepoSection String
section = Either CPError RemoteRepo
parseResult
      where
        getsec :: CPGet a => CPOptionSpec -> Either CPError a
        getsec :: String -> Either CPError a
getsec = CPDocument -> String -> String -> Either CPError a
forall a (m :: * -> *).
(CPGet a, MonadError CPError m) =>
CPDocument -> String -> String -> m a
readCP CPDocument
cp String
section
        parseResult :: Either CPError RemoteRepo
parseResult =
          String
-> String
-> SshPrivKey
-> SshRemoteHost
-> SshRemoteUser
-> RemoteRepo
RemoteRepo String
repoId
            (String
 -> SshPrivKey -> SshRemoteHost -> SshRemoteUser -> RemoteRepo)
-> Either CPError String
-> Either
     CPError
     (SshPrivKey -> SshRemoteHost -> SshRemoteUser -> RemoteRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either CPError String
forall a. CPGet a => String -> Either CPError a
getsec String
repoRemotePathK
            Either
  CPError
  (SshPrivKey -> SshRemoteHost -> SshRemoteUser -> RemoteRepo)
-> Either CPError SshPrivKey
-> Either CPError (SshRemoteHost -> SshRemoteUser -> RemoteRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> SshPrivKey
SshPrivKey (String -> SshPrivKey)
-> Either CPError String -> Either CPError SshPrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either CPError String
forall a. CPGet a => String -> Either CPError a
getsec String
repoRemoteSshKeyK)
            Either CPError (SshRemoteHost -> SshRemoteUser -> RemoteRepo)
-> Either CPError SshRemoteHost
-> Either CPError (SshRemoteUser -> RemoteRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (String, Int) -> SshRemoteHost
SshRemoteHost
                    ((String, Int) -> SshRemoteHost)
-> Either CPError (String, Int) -> Either CPError SshRemoteHost
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (,)
                            (String -> Int -> (String, Int))
-> Either CPError String -> Either CPError (Int -> (String, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either CPError String
forall a. CPGet a => String -> Either CPError a
getsec String
repoRemoteSshHostK
                            Either CPError (Int -> (String, Int))
-> Either CPError Int -> Either CPError (String, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError Int
forall a. CPGet a => String -> Either CPError a
getsec String
repoRemoteSshPortK
                        )
                )
            Either CPError (SshRemoteUser -> RemoteRepo)
-> Either CPError SshRemoteUser -> Either CPError RemoteRepo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> SshRemoteUser
SshRemoteUser (String -> SshRemoteUser)
-> Either CPError String -> Either CPError SshRemoteUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either CPError String
forall a. CPGet a => String -> Either CPError a
getsec String
repoRemoteSshUserK)
          where
            repoId :: String
repoId =
              let prefixLen :: Int
prefixLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
section Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
suffixLen
                  suffixLen :: Int
suffixLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
repoSectionSuffix
               in Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
prefixLen String
section

repoSectionSuffix :: String
repoSectionSuffix :: String
repoSectionSuffix = String
"-repo"

repoRemotePathK :: String
repoRemotePathK :: String
repoRemotePathK = String
"remote_path"

repoRemoteSshKeyK :: String
repoRemoteSshKeyK :: String
repoRemoteSshKeyK = String
"ssh_priv_key_file"

repoRemoteSshHostK :: String
repoRemoteSshHostK :: String
repoRemoteSshHostK = String
"ssh_remote_host"

repoRemoteSshPortK :: String
repoRemoteSshPortK :: String
repoRemoteSshPortK = String
"ssh_remote_port"

repoRemoteSshUserK :: String
repoRemoteSshUserK :: String
repoRemoteSshUserK = String
"ssh_remote_user"