Skip to content

Commit

Permalink
Parametrise all the things + use testCaseSteps for logging
Browse files Browse the repository at this point in the history
  • Loading branch information
@kim
kim committed Jan 22, 2019
1 parent 41008aa commit e659978
Showing 1 changed file with 80 additions and 63 deletions.
143 changes: 80 additions & 63 deletions git-remote-ipfs/test/e2e/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,89 +39,90 @@ import System.Process.Typed
import Test.Tasty
import Test.Tasty.HUnit

type Step = String -> IO ()

main :: IO ()
main = withSystemTempDirectory "git-remote-ipfs-e2e" $ \tmp -> defaultMain $
testGroup "E2E Tests"
[ testCase "Simple push, clone works" $ testPushCloneSimple tmp
, testCase "IPNS push, clone works" $ testPushCloneIPNS tmp
, testCase "LOB push, clone works" $ testLargeObjects tmp
[ testCaseSteps "Push, clone: IPFS" $ testPushCloneSimple tmp
, testCaseSteps "Push, clone: IPNS" $ testPushCloneIPNS tmp
, testCaseSteps "Push, clone: LOB IPFS" $ testLargeObjects tmp
]

testPushCloneSimple :: FilePath -> IO ()
testPushCloneSimple root = do
let repoPath = root </> "simple" </> ".git"
let clonePath = root </> "simple-clone" </> ".git"

initRepo repoPath simpleHistory
pushThenCloneIpfs repoPath (takeDirectory clonePath)
assertSameRepos repoPath clonePath
testPushCloneSimple :: FilePath -> Step -> IO ()
testPushCloneSimple root step = runPushCloneTest PushCloneOpts
{ pcoRepo = root </> "simple" </> ".git"
, pcoClone = root </> "simple-clone" </> ".git"
, pcoRemoteUrl = "ipfs://"
, pcoHistory = simpleHistory
, pcoLog = step
}

testPushCloneIPNS :: HasCallStack => FilePath -> IO ()
testPushCloneIPNS root = do
testPushCloneIPNS :: FilePath -> Step -> IO ()
testPushCloneIPNS root step = do
let keyName = Text.pack (takeBaseName root) -- piggypack on randomness of tmp
step "Creating IPNS name"
ipnsName <- Text.unpack <$> ipfs (createIpnsName keyName)

let repoPath = root </> ipnsName </> ".git"
let clonePath = root </> ipnsName ++ "-clone" </> ".git"
let remoteUrl = "ipfs://ipns/" <> ipnsName

initRepo repoPath simpleHistory

git_ repoPath ["remote", "add", "ipns", remoteUrl]
git_ repoPath ["push", "--quiet", "ipns", "master"]

git_ clonePath ["clone", "--quiet", remoteUrl, takeDirectory clonePath]

assertSameRepos repoPath clonePath
runPushCloneTest PushCloneOpts
{ pcoRepo = root </> ipnsName </> ".git"
, pcoClone = root </> ipnsName ++ "-clone" </> ".git"
, pcoRemoteUrl = "ipfs://ipns/" <> ipnsName
, pcoHistory = simpleHistory
, pcoLog = step
}
where
ipfs m = servantEnv >>= Servant.runClientM m >>= either throwM pure

createIpnsName :: Text -> Servant.ClientM Text
createIpnsName keyName = do
keyId <-
maybe (throwString "Missing key Id") pure
. firstOf (key "Id" . _String)
=<< ipfsKeyGen keyName (Just "ed25519") Nothing
void $
ipfsNamePublish ("/ipfs/" <> emptyRepo)
(Just True) -- resolve
(Just "5m") -- lifetime
Nothing -- caching
(Just keyId) -- key
pure keyId

emptyRepo = "QmUNLLsPACCz1vLxQVkXqqLX5R1X345qqfHbsf67hvA3Nn"
testLargeObjects :: FilePath -> Step -> IO ()
testLargeObjects root step = runPushCloneTest PushCloneOpts
{ pcoRepo = root </> "lobs" </> ".git"
, pcoClone = root </> "lobs-clone" </> ".git"
, pcoRemoteUrl = "ipfs://"
, pcoHistory = lobHistory
, pcoLog = step
}

testLargeObjects :: FilePath -> IO ()
testLargeObjects root = do
let repoPath = root </> "lobs" </> ".git"
let clonePath = root </> "lobs-clone" </> ".git"
data PushCloneOpts = PushCloneOpts
{ pcoRepo :: FilePath
, pcoClone :: FilePath
, pcoRemoteUrl :: String
, pcoHistory :: ReaderT LgRepo IO (Commit LgRepo)
, pcoLog :: Step
}

initRepo repoPath lobHistory
pushThenCloneIpfs repoPath (takeDirectory clonePath)
assertSameRepos repoPath clonePath
runPushCloneTest :: PushCloneOpts -> IO ()
runPushCloneTest PushCloneOpts{..} = do
initRepo pcoLog pcoRepo pcoHistory
url <- pushIpfs pcoLog pcoRepo pcoRemoteUrl
cloneIpfs pcoLog (takeDirectory pcoClone) url
assertSameRepos pcoLog pcoRepo pcoClone

initRepo :: FilePath -> ReaderT LgRepo IO (Commit LgRepo) -> IO ()
initRepo path history =
initRepo :: Step -> FilePath -> ReaderT LgRepo IO (Commit LgRepo) -> IO ()
initRepo step path history = do
step $ "Initializing repo at " <> path
withRepository' lgFactory (mkROpts path True) $
history >>=
updateReference "refs/heads/master" . RefObj . untag . commitOid

pushIpfs :: FilePath -> IO Text
pushIpfs repo = do
git_ repo ["remote", "add", "ipfs", "ipfs://"]
git_ repo ["push", "--quiet", "ipfs", "master"]
Text.strip . decodeUtf8 <$> git repo ["remote", "get-url", "ipfs"]

pushThenCloneIpfs :: FilePath -> FilePath -> IO ()
pushThenCloneIpfs repo clonePath = do
url <- Text.unpack <$> pushIpfs repo
git_ clonePath ["clone", "--quiet", url, clonePath]

assertSameRepos :: FilePath -> FilePath -> IO ()
assertSameRepos src clone = do
pushIpfs :: Step -> FilePath -> String -> IO String
pushIpfs step repo url = do
step $ "Pushing master to " <> url
git_ repo ["remote", "add", "origin", url]
git_ repo ["push", "--quiet", "origin", "master"]
Text.unpack . Text.strip . decodeUtf8
<$> git repo ["remote", "get-url", "origin"]

cloneIpfs :: Step -> FilePath -> String -> IO ()
cloneIpfs step repo url = do
step $ "Cloning " <> url <> " to " <> repo
git_ repo ["clone", "--quiet", url, repo]

assertSameRepos :: Step -> FilePath -> FilePath -> IO ()
assertSameRepos step src clone = do
step $ "Fetching " <> src <> " to " <> clone
git_ clone ["remote", "add", "src", src]
git_ clone ["fetch", "--quiet", "src"]
step "Comparing origin/master src/master"
void $ gitAssert "Source and cloned repository differ"
clone ["diff", "--quiet", "origin/master", "src/master"]

Expand Down Expand Up @@ -199,3 +200,19 @@ servantEnv = liftA2 Servant.mkClientEnv mgr base
base =
Servant.parseBaseUrl
=<< fromMaybe "http://localhost:5001" <$> lookupEnv "IPFS_API_URL"

createIpnsName :: HasCallStack => Text -> Servant.ClientM Text
createIpnsName keyName = do
keyId <-
maybe (throwString "Missing key Id") pure
. firstOf (key "Id" . _String)
=<< ipfsKeyGen keyName (Just "ed25519") Nothing
void $
ipfsNamePublish ("/ipfs/" <> emptyRepo)
(Just True) -- resolve
(Just "5m") -- lifetime
Nothing -- caching
(Just keyId) -- key
pure keyId
where
emptyRepo = "QmUNLLsPACCz1vLxQVkXqqLX5R1X345qqfHbsf67hvA3Nn"

0 comments on commit e659978

Please sign in to comment.