IntersectMBO · shmish111 · Apr 4, 2019 · Mar 5, 2019 · Apr 4, 2019 · Apr 4, 2019
diff --git a/default.nix b/default.nix
@@ -59,6 +59,9 @@
 # Forces all warnings as errors
 , forceError ? true
 
+# If we are in Hydra
+, declInput ? null
+
 }:
 
 with pkgs.lib;
@@ -73,6 +76,7 @@ let
   # can't built 0.11.7 with the default compiler either.
   purescriptNixpkgs = import (localLib.iohkNix.fetchNixpkgs ./purescript-11-nixpkgs-src.json) {};
 
+
   packages = self: (rec {
     inherit pkgs localLib;
 
@@ -83,7 +87,10 @@ let
         inherit pkgs;
         filter = localLib.isPlutus;
       };
-      customOverlays = optional forceError errorOverlay;
+      gitModuleOverlay = import ./nix/overlays/git-module.nix {
+        inherit pkgs declInput;
+      };
+      customOverlays = optional forceError errorOverlay ++ [gitModuleOverlay];
       # Filter down to local packages, except those named in the given list
       localButNot = nope:
         let okay = builtins.filter (name: !(builtins.elem name nope)) localLib.plutusPkgList;
@@ -178,13 +185,6 @@ let
           psSrc = generated-purescript;
         };
 
-      docker = pkgs.dockerTools.buildImage {
-        name = "plutus-playgrounds";
-        contents = [ client server-invoker ];
-        config = {
-          Cmd = ["${server-invoker}/bin/plutus-playground" "webserver" "-b" "0.0.0.0" "-p" "8080" "${client}"];
-        };
-      };
     };
 
     meadow = rec {
@@ -215,12 +215,32 @@ let
           pkgs = purescriptNixpkgs;
           psSrc = generated-purescript;
         };
+    };
 
-      docker = pkgs.dockerTools.buildImage {
+    docker = rec {
+      defaultPlaygroundConfig = pkgs.writeTextFile {
+        name = "playground.yaml";
+        destination = "/etc/playground.yaml";
+        text = ''
+        auth:
+          github-client-id: ""
+          github-client-secret: ""
+          jwt-signature: ""
+          redirect-url: "localhost:8080"
+        '';
+      };
+      plutusPlaygroundImage = with plutus-playground; pkgs.dockerTools.buildImage {
+        name = "plutus-playgrounds";
+        contents = [ client server-invoker defaultPlaygroundConfig ];
+        config = {
+          Cmd = ["${server-invoker}/bin/plutus-playground" "--config" "${defaultPlaygroundConfig}/etc/playground.yaml" "webserver" "-b" "0.0.0.0" "-p" "8080" "${client}"];
+        };
+      };
+      meadowImage = with meadow; pkgs.dockerTools.buildImage {
         name = "meadow";
-        contents = [ client server-invoker ];
+        contents = [ client server-invoker defaultPlaygroundConfig ];
         config = {
-          Cmd = ["${server-invoker}/bin/meadow" "webserver" "-b" "0.0.0.0" "-p" "8080" "${client}"];
+          Cmd = ["${server-invoker}/bin/meadow" "--config" "${defaultPlaygroundConfig}/etc/playground.yaml" "webserver" "-b" "0.0.0.0" "-p" "8080" "${client}"];
         };
       };
     };

diff --git a/meadow-client/src/MainFrame.purs b/meadow-client/src/MainFrame.purs
@@ -51,6 +51,7 @@ import Marlowe.Parser (contract)
 import Marlowe.Pretty (pretty)
 import Marlowe.Types (BlockNumber, Choice, Contract(Null), IdChoice(IdChoice), IdOracle, Person, WIdChoice(WIdChoice))
 import Meadow (SPParams_, getOauthStatus, patchGistsByGistId, postGists, postContractHaskell)
+-- import Meadow.Contracts (gitHead)
 import Network.HTTP.Affjax (AJAX)
 import Network.RemoteData (RemoteData(Success, NotAsked), _Success, isLoading, isSuccess)
 import Prelude (not, (||), type (~>), Unit, Void, bind, const, discard, id, pure, show, unit, void, ($), (+), (-), (<$>), (<<<), (<>), (==))
@@ -625,9 +626,9 @@ mainHeader = div_ [ div [classes [btnGroup, pullRight]] (makeLink <$> links)
                   , h1 [class_ $ ClassName "main-title"] [text "Meadow"]
                   ]
   where
-  links = [ Tuple "Getting Started" "https://testnet.iohkdev.io/plutus/get-started/writing-contracts-in-plutus/"
-          , Tuple "Tutorial" "https://github.com/input-output-hk/plutus/blob/master/plutus-tutorial/tutorial/Tutorial/02-wallet-api.md"
-          , Tuple "API" "https://input-output-hk.github.io/plutus/"
+  links = [ -- Tuple "Getting Started" "https://testnet.iohkdev.io/plutus/get-started/writing-contracts-in-plutus/"
+          -- , Tuple "Tutorial" $ "https://github.com/input-output-hk/plutus/blob/" <> gitHead <> "/plutus-tutorial/tutorial/Tutorial/02-wallet-api.md"
+            Tuple "API" "https://input-output-hk.github.io/plutus/"
           , Tuple "Privacy" "https://static.iohk.io/docs/data-protection/iohk-data-protection-gdpr-policy.pdf"
           ]
   makeLink (Tuple name link) = a [ classes [ btn

diff --git a/meadow/app/Main.hs b/meadow/app/Main.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 
 module Main
     ( main
@@ -13,7 +12,7 @@ import           Control.Monad.Logger     (MonadLogger, logInfoN, runStderrLoggi
 import           Data.Monoid              ((<>))
 import qualified Data.Text                as Text
 import           Data.Yaml                (decodeFileThrow)
-import           Development.GitRev       (gitHash)
+import           Git                      (gitHead)
 import           Network.Wai.Handler.Warp (HostPreference, defaultSettings, setHost, setPort)
 import           Options.Applicative      (CommandFields, Mod, Parser, argument, auto, command, customExecParser,
                                            disambiguate, fullDesc, help, helper, idm, info, infoOption, long, metavar,
@@ -39,7 +38,7 @@ data Command
 versionOption :: Parser (a -> a)
 versionOption =
     infoOption
-        $(gitHash)
+        gitHead
         (short 'v' <> long "version" <> help "Show the version")
 
 commandLineParser :: Parser (FilePath, Command)

diff --git a/meadow/app/PSGenerator.hs b/meadow/app/PSGenerator.hs
@@ -22,13 +22,15 @@ import qualified Auth
 import           Control.Applicative                       (empty, (<|>))
 import           Control.Lens                              (set, (&))
 import qualified Data.ByteString                           as BS
+import qualified Data.ByteString.Char8                     as CBS
 import           Data.Monoid                               ()
 import           Data.Proxy                                (Proxy (Proxy))
 import qualified Data.Set                                  as Set ()
 import qualified Data.Text                                 as T ()
 import qualified Data.Text.Encoding                        as T ()
 import qualified Data.Text.IO                              as T ()
 import           Gist                                      (Gist, GistFile, GistId, NewGist, NewGistFile, Owner)
+import           Git                                       (gitHead)
 import           Language.Haskell.Interpreter              (CompilationError, InterpreterError, InterpreterResult,
                                                             SourceCode, Warning)
 import           Language.PureScript.Bridge                (BridgePart, Language (Haskell), PSType, SumType,
@@ -133,7 +135,8 @@ psModule name body = "module " <> name <> " where" <> body
 writeUsecases :: FilePath -> IO ()
 writeUsecases outputDir = do
     let usecases =
-            multilineString "escrow" escrow
+            multilineString "gitHead" (CBS.pack gitHead)
+         <> multilineString "escrow" escrow
          <> multilineString "zeroCouponBond" zeroCouponBond
         usecasesModule = psModule "Meadow.Contracts" usecases
     createDirectoryIfMissing True (outputDir </> "Meadow")

diff --git a/meadow/app/Webserver.hs b/meadow/app/Webserver.hs
@@ -1,17 +1,13 @@
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DeriveAnyClass             #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeApplications           #-}
-{-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# OPTIONS_GHC   -Wno-orphans #-}
 
 module Webserver
@@ -29,7 +25,8 @@ import           Control.Monad.Reader                           (ReaderT, runRea
 import           Data.Default.Class                             (def)
 import           Data.Proxy                                     (Proxy (Proxy))
 import           Data.Text                                      (Text)
-import           Development.GitRev                             (gitHash)
+import qualified Data.Text                                      as Text
+import           Git                                            (gitHead)
 import           Network.HTTP.Types                             (Method)
 import           Network.Wai                                    (Application)
 import           Network.Wai.Handler.Warp                       (Settings, runSettings)
@@ -73,7 +70,7 @@ server handlers _staticDir githubEndpoints Config {..} =
   serveDirectoryFileServer _staticDir
 
 version :: Applicative m => m Text
-version = pure $(gitHash)
+version = pure (Text.pack gitHead)
 
 app ::
      Server MA.API -> FilePath -> Auth.GithubEndpoints -> Config -> Application

diff --git a/meadow/meadow.cabal b/meadow/meadow.cabal
@@ -28,6 +28,7 @@ library
         Interpreter
         Meadow.Contracts
         Gist
+        Git
         Auth
         Auth.Types
         Control.Monad.Now
@@ -92,7 +93,6 @@ executable meadow-exe
         data-default-class -any,
         directory -any,
         filepath -any,
-        gitrev -any,
         http-types -any,
         interpreter -any,
         lens -any,

diff --git a/meadow/src/Git.hs b/meadow/src/Git.hs
@@ -0,0 +1,4 @@
+module Git where
+
+gitHead :: String
+gitHead = "master"
diff --git a/nix/overlays/git-module.nix b/nix/overlays/git-module.nix
@@ -0,0 +1,33 @@
+{ pkgs, declInput }:
+
+with pkgs.lib;
+
+let
+  headPath = ../../.git/HEAD;
+  readRev = let head = if builtins.pathExists headPath then builtins.readFile headPath else "master";
+            in
+              if hasPrefix "ref: " head
+                then builtins.readFile (../../.git + ''/${removeSuffix "\n" (removePrefix "ref: " head)}'')
+                else head;
+  git-rev = removeSuffix "\n" (if isNull declInput then readRev else declInput.rev);
+  gitModulePatch = pkgs.writeText "gitModulePatch" ''
+    diff --git a/src/Git.hs b/src/Git.hs
+    index b0398a7..45a9066 100644
+    --- a/src/Git.hs
+    +++ b/src/Git.hs
+    @@ -1,4 +1,4 @@
+     module Git where
+
+     gitHead :: String
+    -gitHead = "master"
+    +gitHead = "${git-rev}"
+  '';
+in
+self: super: {
+    plutus-playground-server = super.plutus-playground-server.overrideDerivation (oldAttrs: {
+      patches = [gitModulePatch];
+    });
+    meadow = super.meadow.overrideDerivation (oldAttrs: {
+      patches = [gitModulePatch];
+    });
+}
diff --git a/nix/overlays/required.nix b/nix/overlays/required.nix
@@ -11,6 +11,7 @@ let
     postCheck = "./Setup doctest --doctest-options=\"${opts}\"";
   });
   doctestOpts = "-pgmL markdown-unlit -XTemplateHaskell -XDeriveFunctor -XScopedTypeVariables";
+
 in
 
 self: super: {

diff --git a/plutus-playground-client/src/MainFrame.purs b/plutus-playground-client/src/MainFrame.purs
@@ -64,6 +64,7 @@ import Network.HTTP.Affjax (AJAX)
 import Network.RemoteData (RemoteData(NotAsked, Loading, Failure, Success), _Success, isSuccess)
 import Playground.API (SimulatorWallet(SimulatorWallet), _CompilationResult, _FunctionSchema)
 import Playground.Server (SPParams_)
+import Playground.Usecases (gitHead)
 import Prelude (type (~>), Unit, Void, bind, const, discard, flip, join, pure, show, unit, unless, when, ($), (&&), (+), (-), (<$>), (<*>), (<<<), (<>), (=<<), (==))
 import Servant.PureScript.Settings (SPSettings_)
 import StaticData as StaticData
@@ -532,7 +533,7 @@ mainHeader =
     ]
   where
     links = [ Tuple "Getting Started" "https://testnet.iohkdev.io/plutus/get-started/writing-contracts-in-plutus/"
-            , Tuple "Tutorial" "https://github.com/input-output-hk/plutus/blob/master/plutus-tutorial/tutorial/Tutorial/02-wallet-api.md"
+            , Tuple "Tutorial" ("https://github.com/input-output-hk/plutus/blob/" <> gitHead <> "/plutus-tutorial/tutorial/Tutorial/02-wallet-api.md")
             , Tuple "API" "https://input-output-hk.github.io/plutus/"
             , Tuple "Privacy" "https://static.iohk.io/docs/data-protection/iohk-data-protection-gdpr-policy.pdf"
             ]

diff --git a/plutus-playground-server/app/Main.hs b/plutus-playground-server/app/Main.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 
 module Main
     ( main
@@ -13,7 +12,7 @@ import           Control.Monad.Logger     (MonadLogger, logInfoN, runStderrLoggi
 import           Data.Monoid              ((<>))
 import qualified Data.Text                as Text
 import           Data.Yaml                (decodeFileThrow)
-import           Development.GitRev       (gitHash)
+import           Git                      (gitHead)
 import           Network.Wai.Handler.Warp (HostPreference, defaultSettings, setHost, setPort)
 import           Options.Applicative      (CommandFields, Mod, Parser, argument, auto, command, customExecParser,
                                            disambiguate, fullDesc, help, helper, idm, info, infoOption, long, metavar,
@@ -39,7 +38,7 @@ data Command
 versionOption :: Parser (a -> a)
 versionOption =
     infoOption
-        $(gitHash)
+        gitHead
         (short 'v' <> long "version" <> help "Show the version")
 
 commandLineParser :: Parser (FilePath, Command)

diff --git a/plutus-playground-server/app/PSGenerator.hs b/plutus-playground-server/app/PSGenerator.hs
@@ -21,13 +21,15 @@ import           Control.Applicative                       (empty, (<|>))
 import           Control.Lens                              (set, (&))
 import           Control.Monad.Representable.Reader        (MonadReader)
 import qualified Data.ByteString                           as BS
+import qualified Data.ByteString.Char8                     as CBS
 import           Data.Monoid                               ()
 import           Data.Proxy                                (Proxy (Proxy))
 import qualified Data.Set                                  as Set ()
 import qualified Data.Text                                 as T ()
 import qualified Data.Text.Encoding                        as T ()
 import qualified Data.Text.IO                              as T ()
 import           Gist                                      (Gist, GistFile, GistId, NewGist, NewGistFile, Owner)
+import           Git                                       (gitHead)
 import           Language.Haskell.Interpreter              (CompilationError, InterpreterError, InterpreterResult,
                                                             SourceCode, Warning)
 import           Language.PureScript.Bridge                (BridgePart, Language (Haskell), PSType, SumType,
@@ -250,6 +252,7 @@ psModule name body = "module " <> name <> " where" <> body
 writeUsecases :: FilePath -> IO ()
 writeUsecases outputDir = do
     let usecases =
+            multilineString "gitHead" (CBS.pack gitHead) <>
             multilineString "vesting" vesting <> multilineString "game" game <>
             multilineString "crowdfunding" crowdfunding <>
             multilineString "messages" messages

diff --git a/plutus-playground-server/app/Webserver.hs b/plutus-playground-server/app/Webserver.hs
@@ -1,17 +1,13 @@
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DeriveAnyClass             #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeApplications           #-}
-{-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# OPTIONS_GHC   -Wno-orphans #-}
 
 module Webserver
@@ -28,7 +24,8 @@ import           Control.Monad.Reader                           (ReaderT, runRea
 import           Data.Default.Class                             (def)
 import           Data.Proxy                                     (Proxy (Proxy))
 import           Data.Text                                      (Text)
-import           Development.GitRev                             (gitHash)
+import qualified Data.Text                                      as Text
+import           Git                                            (gitHead)
 import           Network.HTTP.Types                             (Method)
 import           Network.Wai                                    (Application)
 import           Network.Wai.Handler.Warp                       (Settings, runSettings)
@@ -73,7 +70,7 @@ server handlers _staticDir githubEndpoints Config {..} =
     serveDirectoryFileServer _staticDir
 
 version :: Applicative m => m Text
-version = pure $(gitHash)
+version = pure . Text.pack $ gitHead
 
 app :: Server PA.API
     -> FilePath

diff --git a/plutus-playground-server/playground.yaml.sample b/plutus-playground-server/playground.yaml.sample
@@ -1,10 +1,10 @@
 auth:
   # Your github OAuth App Credentials.
-  github-client-id:
-  github-client-secret:
+  github-client-id: ""
+  github-client-secret: ""
 
   # You can generate a good signature by running `openssl rand -hex 40` and pasting the result here:
-  jwt-signature:
+  jwt-signature: ""
 
   # This should match the client-facing schema/host/port.
-  redirect-url: https://localhost:8009
+  redirect-url: "https://localhost:8080"