-- |
-- Module      :  Cryptol.Version
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE CPP  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Cryptol.Version (
    commitHash
  , commitShortHash
  , commitBranch
  , commitDirty
  , ffiEnabled
  , version
  , displayVersion
  , displayVersionStr
  ) where

import Control.Monad (when)
import Control.Monad.Writer (MonadWriter(..), Writer, execWriter)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.ByteString as BS
import Data.FileEmbed (embedFileRelative)
import Data.List (intercalate)
import qualified Data.Text as Text
import Data.Version (showVersion)
import qualified GitRev
import Paths_cryptol

commitHash :: String
commitHash :: String
commitHash
  | String
hash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
unknown =
      String
hash
  -- See Note [cryptol.buildinfo.json]
  | Just KeyMap Value
buildinfoVal <- ByteString -> Maybe (KeyMap Value)
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decodeStrict ByteString
buildinfo
  , Just (Aeson.String Text
buildinfoHash) <- Key -> KeyMap Value -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"hash" KeyMap Value
buildinfoVal =
      Text -> String
Text.unpack Text
buildinfoHash
  | Bool
otherwise =
      String
unknown
 where
  hash :: String
hash = String
GitRev.hash

commitShortHash :: String
commitShortHash :: String
commitShortHash = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
7 String
GitRev.hash

commitBranch :: String
commitBranch :: String
commitBranch
  | String
branch String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
unknown =
      String
branch
  -- See Note [cryptol.buildinfo.json]
  | Just KeyMap Value
buildinfoVal <- ByteString -> Maybe (KeyMap Value)
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decodeStrict ByteString
buildinfo
  , Just (Aeson.String Text
buildinfoCommit) <- Key -> KeyMap Value -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"branch" KeyMap Value
buildinfoVal =
      Text -> String
Text.unpack Text
buildinfoCommit
  | Bool
otherwise =
      String
unknown
 where
  branch :: String
branch = String
GitRev.branch

commitDirty :: Bool
commitDirty :: Bool
commitDirty
  | Bool
dirty =
      Bool
dirty
  -- See Note [cryptol.buildinfo.json]
  | Just KeyMap Value
buildinfoVal <- ByteString -> Maybe (KeyMap Value)
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decodeStrict ByteString
buildinfo
  , Just (Aeson.Bool Bool
buildinfoDirty) <- Key -> KeyMap Value -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"dirty" KeyMap Value
buildinfoVal =
      Bool
buildinfoDirty
  | Bool
otherwise =
      Bool
False
 where
  dirty :: Bool
dirty = Bool
GitRev.dirty

-- Helper, not exported
--
-- What to report if we are unable to determine git-related information. This
-- intentionally matches what the @gitrev@ library prints in such a scenario.
unknown :: String
unknown :: String
unknown = String
"UNKNOWN"

-- Helper, not exported
--
-- See Note [cryptol.buildinfo.json]
buildinfo :: BS.ByteString
buildinfo :: ByteString
buildinfo = $(embedFileRelative "cryptol.buildinfo.json")

ffiEnabled :: Bool
#ifdef FFI_ENABLED
ffiEnabled :: Bool
ffiEnabled = Bool
True
#else
ffiEnabled = False
#endif

displayVersion :: Monad m => (String -> m ()) -> m ()
displayVersion :: forall (m :: * -> *). Monad m => (String -> m ()) -> m ()
displayVersion String -> m ()
putLn = do
    let ver :: String
ver = Version -> String
showVersion Version
version
    String -> m ()
putLn (String
"Cryptol " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ver)
    String -> m ()
putLn (String
"Git commit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
commitHash)
    String -> m ()
putLn (String
"    branch " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
commitBranch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dirtyLab)
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ffiEnabled (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
putLn String
"FFI enabled"
      where
      dirtyLab :: String
dirtyLab | Bool
commitDirty = String
" (non-committed files present during build)"
               | Bool
otherwise   = String
""

-- | A pure version of 'displayVersion' that renders the displayed version
-- directly to a 'String'.
displayVersionStr :: String
displayVersionStr :: String
displayVersionStr = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Writer [String] () -> [String]
forall w a. Writer w a -> w
execWriter (Writer [String] () -> [String]) -> Writer [String] () -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Writer [String] ()) -> Writer [String] ()
forall (m :: * -> *). Monad m => (String -> m ()) -> m ()
displayVersion String -> Writer [String] ()
putLn
  where
    putLn :: String -> Writer [String] ()
    putLn :: String -> Writer [String] ()
putLn String
str = [String] -> Writer [String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
str]

{-
Note [cryptol.buildinfo.json]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
By default, we determine the git commit hash, branch, and dirty information
using the gitrev library, which invokes git at compile time to query the
relevant information in the .git subdirectory. This works well for local
developments where the git binary and the .git subdirectory are both readily
available. It does not work so well for building in a Docker image, as we
intentionally do not copy over the .git subdirectory into the image to prevent
spurious cache invalidations caused by the contents of .git changing (which
they do, quite often).

As an alternative to gitrev, we also employ a convention where a build system
can create a cryptol.buildinfo.json file locally which contains the necessary
git-related information. The schema for this file is:

  {
    "hash": <string>,
    "branch": <string>,
    "dirty": <bool>
  }

This way, a build system (which has access to git/.git) can write this
information to a file, proceed to build the Docker image (which does not have
access to git/.git), and then have all of the expected information embedded
into the output of --version.
-}