How to increase the precision to get the correct roots at the boundaries?

Question

I want to solve an equation and Plot a graph of $\delta(\tau)$, where $0<\tau,\delta<1$. In principal $\delta(0)=1,\delta(1)=0$. However, when I solve the equation, the points near $\tau=1$ can't get exactly. Below is my sample code:

Clear["Global`*"];
eps = 10^-13;
stepSize = 0.001; 
omegaD = 0.5; 
df = 0.008; 
c1 = omegaD/df; 
c0 = c0 /. FindRoot[1/c0 Log[Cosh[c1 c0]] == Sqrt[c1^2 + 1] - 1, {c0, Log[2]}];
list = Table[{τ, δ /. FindRoot[τ Log[Cosh[c0 Sqrt[c1^2 + \delta^2]/τ]/Cosh[c0 δ/τ]] == c0 (Sqrt[c1^2 + 1] - 1), 
                              {δ, 1}]}, {τ, eps, 1.0,stepSize}];
p1 = ListLinePlot[list]

Program complains that:

The line search decreased the step size to within tolerance specified \
by AccuracyGoal and PrecisionGoal but was unable to find a sufficient \
decrease in the merit function. You may need more than \
MachinePrecision digits of working precision to meet these tolerances.@ 

Also clearly shown in the graph, the points near $\tau=1$ is missing.

So I tried to add an option WorkingPrecision->30 at the end of the FindRoot function, the program complain the following this time:

the precision of the argument function ... is less than WorkingPrecision (30.)

Even I decrease 30 to other number, it still complaining.

Question is how to add the missing points correctly at the boundary?

Answer 1

First, the Table does not run up to t == 1.:

Table[τ, {τ, 1/20, 1, stepSize}]
(*  {1.*10^-13, 0.001,..., 0.998, 0.999}  *)

Update -- Now with the corrected formula (a typo fixed in the OP), let's try

list = Table[{τ, δ /. 
    FindRoot[τ Log[Cosh[c0 Sqrt[c1^2 + δ^2]/τ]/Cosh[c0 δ/τ]] == c0 (Sqrt[c1^2 + 1] - 1),
     {δ, 1}]},
  {τ, Union[Range[eps, 1.0, stepSize], {1.}]}]
p1 = ListLinePlot[list]

We get the desired plot.