{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Distribution.Client.CmdUpdate
( updateCommand
, updateAction
) where
import Control.Exception
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.Compat.Directory
( setModificationTime
)
import Distribution.Client.FetchUtils
( downloadIndex
)
import Distribution.Client.HttpUtils
( DownloadResult (..)
)
import Distribution.Client.IndexUtils
( Index (..)
, currentIndexTimestamp
, indexBaseName
, updatePackageIndexCacheFile
, updateRepoIndexCache
, writeIndexTimestamp
)
import Distribution.Client.IndexUtils.IndexState
import Distribution.Client.JobControl
( collectJob
, newParallelJobControl
, spawnJob
)
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..)
, defaultNixStyleFlags
, nixStyleOptions
)
import Distribution.Client.ProjectConfig
( ProjectConfig (..)
, ProjectConfigShared (projectConfigConfigFile)
, projectConfigWithSolverRepoContext
, withGlobalConfig
, withProjectOrGlobalConfig
)
import Distribution.Client.ProjectFlags
( ProjectFlags (..)
)
import Distribution.Client.ProjectOrchestration
import Distribution.Client.Setup
( ConfigFlags (..)
, GlobalFlags
, RepoContext (..)
, UpdateFlags
, defaultUpdateFlags
)
import Distribution.Client.Types
( RemoteRepo (..)
, Repo (..)
, RepoName (..)
, repoName
, unRepoName
)
import Distribution.Simple.Flag
( fromFlagOrDefault
)
import Distribution.Simple.Utils
( dieWithException
, notice
, noticeNoWrap
, warn
, wrapText
, writeFileAtomic
)
import Distribution.Verbosity
( lessVerbose
, normal
)
import qualified Data.Maybe as Unsafe (fromJust)
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
import qualified Data.ByteString.Lazy as BS
import Data.Time (getCurrentTime)
import Distribution.Client.GZipUtils (maybeDecompress)
import Distribution.Simple.Command
( CommandUI (..)
, usageAlternatives
)
import System.FilePath (dropExtension, (<.>))
import Distribution.Client.Errors
import Distribution.Client.IndexUtils.Timestamp (Timestamp (NoTimestamp))
import qualified Hackage.Security.Client as Sec
updateCommand :: CommandUI (NixStyleFlags ())
updateCommand :: CommandUI (NixStyleFlags ())
updateCommand =
CommandUI
{ commandName :: String
commandName = String
"v2-update"
, commandSynopsis :: String
commandSynopsis = String
"Updates list of known packages."
, commandUsage :: String -> String
commandUsage = String -> [String] -> String -> String
usageAlternatives String
"v2-update" [String
"[FLAGS] [REPOS]"]
, commandDescription :: Maybe (String -> String)
commandDescription = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
_ ->
String -> String
wrapText (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String
"For all known remote repositories, download the package list."
, commandNotes :: Maybe (String -> String)
commandNotes = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
pname ->
String
"REPO has the format <repo-id>[,<index-state>] where index-state follows\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"the same format and syntax that is supported by the --index-state flag.\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Examples:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-update\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Download the package list for all known remote repositories.\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org,@1474732068\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org,2016-09-24T17:47:48Z\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org,HEAD\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Download hackage.haskell.org at a specific index state.\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org head.hackage\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Download hackage.haskell.org and head.hackage\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" head.hackage must be a known repo-id. E.g. from\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" your cabal.project(.local) file.\n"
, commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
commandOptions = (ShowOrParseArgs -> [OptionField ()])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions ((ShowOrParseArgs -> [OptionField ()])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags ())])
-> (ShowOrParseArgs -> [OptionField ()])
-> ShowOrParseArgs
-> [OptionField (NixStyleFlags ())]
forall a b. (a -> b) -> a -> b
$ [OptionField ()] -> ShowOrParseArgs -> [OptionField ()]
forall a b. a -> b -> a
const []
, commandDefaultFlags :: NixStyleFlags ()
commandDefaultFlags = () -> NixStyleFlags ()
forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()
}
data UpdateRequest = UpdateRequest
{ UpdateRequest -> RepoName
_updateRequestRepoName :: RepoName
, UpdateRequest -> RepoIndexState
_updateRequestRepoState :: RepoIndexState
}
deriving (Int -> UpdateRequest -> String -> String
[UpdateRequest] -> String -> String
UpdateRequest -> String
(Int -> UpdateRequest -> String -> String)
-> (UpdateRequest -> String)
-> ([UpdateRequest] -> String -> String)
-> Show UpdateRequest
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UpdateRequest -> String -> String
showsPrec :: Int -> UpdateRequest -> String -> String
$cshow :: UpdateRequest -> String
show :: UpdateRequest -> String
$cshowList :: [UpdateRequest] -> String -> String
showList :: [UpdateRequest] -> String -> String
Show)
instance Pretty UpdateRequest where
pretty :: UpdateRequest -> Doc
pretty (UpdateRequest RepoName
n RepoIndexState
s) = RepoName -> Doc
forall a. Pretty a => a -> Doc
pretty RepoName
n Doc -> Doc -> Doc
<<>> Doc
Disp.comma Doc -> Doc -> Doc
<<>> RepoIndexState -> Doc
forall a. Pretty a => a -> Doc
pretty RepoIndexState
s
instance Parsec UpdateRequest where
parsec :: forall (m :: * -> *). CabalParsing m => m UpdateRequest
parsec = do
name <- m RepoName
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m RepoName
parsec
state <- P.char ',' *> parsec <|> pure IndexStateHead
return (UpdateRequest name state)
updateAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
updateAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
updateAction flags :: NixStyleFlags ()
flags@NixStyleFlags{()
HaddockFlags
BenchmarkFlags
ConfigFlags
TestFlags
ProjectFlags
InstallFlags
ConfigExFlags
configFlags :: ConfigFlags
configExFlags :: ConfigExFlags
installFlags :: InstallFlags
haddockFlags :: HaddockFlags
testFlags :: TestFlags
benchmarkFlags :: BenchmarkFlags
projectFlags :: ProjectFlags
extraFlags :: ()
extraFlags :: forall a. NixStyleFlags a -> a
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
..} [String]
extraArgs GlobalFlags
globalFlags = do
let ignoreProject :: Flag Bool
ignoreProject = ProjectFlags -> Flag Bool
flagIgnoreProject ProjectFlags
projectFlags
projectConfig <-
Flag Bool
-> IO ProjectConfig -> IO ProjectConfig -> IO ProjectConfig
forall a. Flag Bool -> IO a -> IO a -> IO a
withProjectOrGlobalConfig
Flag Bool
ignoreProject
(ProjectBaseContext -> ProjectConfig
projectConfig (ProjectBaseContext -> ProjectConfig)
-> IO ProjectBaseContext -> IO ProjectConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext
establishProjectBaseContext Verbosity
verbosity ProjectConfig
cliConfig CurrentCommand
OtherCommand)
(Verbosity
-> Flag String
-> (ProjectConfig -> IO ProjectConfig)
-> IO ProjectConfig
forall a.
Verbosity -> Flag String -> (ProjectConfig -> IO a) -> IO a
withGlobalConfig Verbosity
verbosity Flag String
globalConfigFlag ((ProjectConfig -> IO ProjectConfig) -> IO ProjectConfig)
-> (ProjectConfig -> IO ProjectConfig) -> IO ProjectConfig
forall a b. (a -> b) -> a -> b
$ \ProjectConfig
globalConfig -> ProjectConfig -> IO ProjectConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfig -> IO ProjectConfig)
-> ProjectConfig -> IO ProjectConfig
forall a b. (a -> b) -> a -> b
$ ProjectConfig
globalConfig ProjectConfig -> ProjectConfig -> ProjectConfig
forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig)
projectConfigWithSolverRepoContext
verbosity
(projectConfigShared projectConfig)
(projectConfigBuildOnly projectConfig)
$ \RepoContext
repoCtxt -> do
let repos :: [Repo]
repos :: [Repo]
repos = RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt
parseArg :: String -> IO UpdateRequest
parseArg :: String -> IO UpdateRequest
parseArg String
s = case String -> Maybe UpdateRequest
forall a. Parsec a => String -> Maybe a
simpleParsec String
s of
Just UpdateRequest
r -> UpdateRequest -> IO UpdateRequest
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UpdateRequest
r
Maybe UpdateRequest
Nothing ->
Verbosity -> CabalInstallException -> IO UpdateRequest
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO UpdateRequest)
-> CabalInstallException -> IO UpdateRequest
forall a b. (a -> b) -> a -> b
$ String -> CabalInstallException
UnableToParseRepo String
s
updateRepoRequests <- (String -> IO UpdateRequest) -> [String] -> IO [UpdateRequest]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> IO UpdateRequest
parseArg [String]
extraArgs
unless (null updateRepoRequests) $ do
let remoteRepoNames = (Repo -> RepoName) -> [Repo] -> [RepoName]
forall a b. (a -> b) -> [a] -> [b]
map Repo -> RepoName
repoName [Repo]
repos
unknownRepos =
[ RepoName
r | (UpdateRequest RepoName
r RepoIndexState
_) <- [UpdateRequest]
updateRepoRequests, Bool -> Bool
not (RepoName
r RepoName -> [RepoName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RepoName]
remoteRepoNames)
]
unless (null unknownRepos) $
dieWithException verbosity $
NullUnknownrepos (map unRepoName unknownRepos) (map unRepoName remoteRepoNames)
let reposToUpdate :: [(Repo, RepoIndexState)]
reposToUpdate = case [UpdateRequest]
updateRepoRequests of
[] -> (Repo -> (Repo, RepoIndexState))
-> [Repo] -> [(Repo, RepoIndexState)]
forall a b. (a -> b) -> [a] -> [b]
map (,RepoIndexState
IndexStateHead) [Repo]
repos
[UpdateRequest]
updateRequests ->
let repoMap :: [(RepoName, Repo)]
repoMap = [(Repo -> RepoName
repoName Repo
r, Repo
r) | Repo
r <- [Repo]
repos]
lookup' :: RepoName -> Repo
lookup' RepoName
k = Maybe Repo -> Repo
forall a. HasCallStack => Maybe a -> a
Unsafe.fromJust (RepoName -> [(RepoName, Repo)] -> Maybe Repo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup RepoName
k [(RepoName, Repo)]
repoMap)
in [ (RepoName -> Repo
lookup' RepoName
name, RepoIndexState
state)
| (UpdateRequest RepoName
name RepoIndexState
state) <- [UpdateRequest]
updateRequests
]
case reposToUpdate of
[] ->
Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"No remote repositories configured"
[(Repo
remoteRepo, RepoIndexState
_)] ->
Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Downloading the latest package list from "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ RepoName -> String
unRepoName (Repo -> RepoName
repoName Repo
remoteRepo)
[(Repo, RepoIndexState)]
_ ->
Verbosity -> String -> IO ()
notice Verbosity
verbosity (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Downloading the latest package lists from: "
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((Repo, RepoIndexState) -> String)
-> [(Repo, RepoIndexState)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> ((Repo, RepoIndexState) -> String)
-> (Repo, RepoIndexState)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoName -> String
unRepoName (RepoName -> String)
-> ((Repo, RepoIndexState) -> RepoName)
-> (Repo, RepoIndexState)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> RepoName
repoName (Repo -> RepoName)
-> ((Repo, RepoIndexState) -> Repo)
-> (Repo, RepoIndexState)
-> RepoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repo, RepoIndexState) -> Repo
forall a b. (a, b) -> a
fst) [(Repo, RepoIndexState)]
reposToUpdate
unless (null reposToUpdate) $ do
jobCtrl <- newParallelJobControl (length reposToUpdate)
traverse_
(spawnJob jobCtrl . updateRepo verbosity defaultUpdateFlags repoCtxt)
reposToUpdate
traverse_ (\(Repo, RepoIndexState)
_ -> JobControl IO () -> IO ()
forall (m :: * -> *) a. JobControl m a -> m a
collectJob JobControl IO ()
jobCtrl) reposToUpdate
where
verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
cliConfig :: ProjectConfig
cliConfig = GlobalFlags
-> NixStyleFlags () -> ClientInstallFlags -> ProjectConfig
forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig GlobalFlags
globalFlags NixStyleFlags ()
flags ClientInstallFlags
forall a. Monoid a => a
mempty
globalConfigFlag :: Flag String
globalConfigFlag = ProjectConfigShared -> Flag String
projectConfigConfigFile (ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig)
updateRepo
:: Verbosity
-> UpdateFlags
-> RepoContext
-> (Repo, RepoIndexState)
-> IO ()
updateRepo :: Verbosity
-> UpdateFlags -> RepoContext -> (Repo, RepoIndexState) -> IO ()
updateRepo Verbosity
verbosity UpdateFlags
_updateFlags RepoContext
repoCtxt (Repo
repo, RepoIndexState
indexState) = do
transport <- RepoContext -> IO HttpTransport
repoContextGetTransport RepoContext
repoCtxt
case repo of
RepoLocalNoIndex{} -> do
let index :: Index
index = RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
repo
Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index
RepoRemote{String
RemoteRepo
repoRemote :: RemoteRepo
repoLocalDir :: String
repoLocalDir :: Repo -> String
repoRemote :: Repo -> RemoteRepo
..} -> do
downloadResult <-
HttpTransport
-> Verbosity -> RemoteRepo -> String -> IO DownloadResult
downloadIndex
HttpTransport
transport
Verbosity
verbosity
RemoteRepo
repoRemote
String
repoLocalDir
case downloadResult of
DownloadResult
FileAlreadyInCache ->
String -> UTCTime -> IO ()
setModificationTime (Repo -> String
indexBaseName Repo
repo String -> String -> String
<.> String
"tar")
(UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
FileDownloaded String
indexPath -> do
String -> ByteString -> IO ()
writeFileAtomic (String -> String
dropExtension String
indexPath) (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
maybeDecompress
(ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
indexPath
Verbosity -> Index -> IO ()
updateRepoIndexCache Verbosity
verbosity (RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
repo)
RepoSecure{} -> RepoContext
-> forall a.
Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo RepoContext
repoCtxt Repo
repo ((forall (down :: * -> *). Repository down -> IO ()) -> IO ())
-> (forall (down :: * -> *). Repository down -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Repository down
repoSecure -> do
let index :: Index
index = RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
repo
current_ts <- Verbosity -> Index -> IO Timestamp
currentIndexTimestamp (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) Index
index
writeIndexTimestamp index indexState
updated <- do
ce <-
if repoContextIgnoreExpiry repoCtxt
then Just <$> getCurrentTime
else return Nothing
Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure ce
let rname = RemoteRepo -> RepoName
remoteRepoName (Repo -> RemoteRepo
repoRemote Repo
repo)
case updated of
HasUpdates
Sec.NoUpdates -> do
now <- IO UTCTime
getCurrentTime
setModificationTime (indexBaseName repo <.> "tar") now
`catchIO` \IOException
e ->
Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Could not set modification time of index tarball -- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall e. Exception e => e -> String
displayException IOException
e
noticeNoWrap verbosity $
"Package list of " ++ prettyShow rname ++ " is up to date."
HasUpdates
Sec.HasUpdates -> do
Verbosity -> Index -> IO ()
updateRepoIndexCache Verbosity
verbosity Index
index
Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Package list of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RepoName -> String
forall a. Pretty a => a -> String
prettyShow RepoName
rname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has been updated."
new_ts <- currentIndexTimestamp (lessVerbose verbosity) index
noticeNoWrap verbosity $
"The index-state is set to " ++ prettyShow (IndexStateTime new_ts) ++ "."
when (current_ts /= NoTimestamp && new_ts /= current_ts) $
noticeNoWrap verbosity $
"To revert to previous state run:\n"
++ " cabal v2-update '"
++ prettyShow (UpdateRequest rname (IndexStateTime current_ts))
++ "'\n"